[ADP-3350] Remove BlockHeader from Cardano.Wallet.Network.Logging (…

…#4559)

This pull request removes the use of the `BlockHeader` type from the
module `Cardano.Wallet.Network.Logging`. Instead, we use the
`Read.BHeader` type from `Cardano.Wallet.Read`.

In order to do so, the pull request also

* Fixes the implementation of `BHeader`
* Changes `getEraSlotNo` and `getEraBlockNo`
* Simplifies `numberOfTransactionsInBlock`

### Comments

* The goal is to eventually remove the legacy `primitive` types.

### Issue Number

ADP-3350

lib/benchmarks/exe/restore-bench.hs

@@ -298,9 +298,6 @@ import Data.Time.Clock.POSIX
     , getCurrentTime
     , utcTimeToPOSIXSeconds
     )
-import Data.Word
-    ( Word32
-    )
 import Fmt
     ( Buildable
     , blockListF'
@@ -774,7 +771,7 @@ bench_baseline_restoration
         networkId = networkIdVal (sNetworkId @n)
         networkTrace = trMessageText wlTr
     doRestore
-        :: Tracer IO (Maybe (Quantity "block" Word32))
+        :: Tracer IO (Maybe Read.BlockNo)
         -> NetworkLayer IO (CardanoBlock StandardCrypto)
         -> IO SomeBenchmarkResults
     doRestore progressTrace nw = do
@@ -883,10 +880,10 @@ bench_restoration
 
 walletWorkerLogToBlockHeight
     :: WalletWorkerLog
-    -> Maybe (Quantity "block" Word32)
+    -> Maybe Read.BlockNo
 walletWorkerLogToBlockHeight = \case
     MsgChainFollow (MsgChainSync (MsgChainRollForward bs _nodeTip)) ->
-        Just $ blockHeight $ NE.last bs
+        Just $ Read.applyEraFun Read.getEraBlockNo $ NE.last bs
     _ ->
         Nothing
 
@@ -898,7 +895,7 @@ withWalletLayerTracer
     => Text
     -> a
     -> Bool
-    -> (Tracer IO (Maybe (Quantity "block" Word32)) -> IO r)
+    -> (Tracer IO (Maybe Read.BlockNo) -> IO r)
     -> IO r
 withWalletLayerTracer benchname pipelining traceToDisk act = do
     let benchmarkFilename
@@ -942,9 +939,9 @@ dummySeedFromName = SomeMnemonic @24
 traceBlockHeadersProgressForPlotting
     :: UTCTime
     -> Tracer IO Text
-    -> Tracer IO (Maybe (Quantity "block" Word32))
-traceBlockHeadersProgressForPlotting t0  tr = Tracer $ \bs -> do
-    let mtip = pretty . getQuantity <$> bs
+    -> Tracer IO (Maybe Read.BlockNo)
+traceBlockHeadersProgressForPlotting t0 tr = Tracer $ \bs -> do
+    let mtip = Read.prettyBlockNo <$> bs
     time <- pretty . (`diffUTCTime` t0) <$> getCurrentTime
     case mtip of
         Just tip -> traceWith tr $ time <> " " <> tip

lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs

@@ -95,9 +95,6 @@ import Cardano.Wallet.Network.Implementation.UnliftIO
 import Cardano.Wallet.Primitive.Ledger.Byron
     ( byronCodecConfig
     )
-import Cardano.Wallet.Primitive.Ledger.Read.Block.Header
-    ( getBlockHeader
-    )
 import Cardano.Wallet.Primitive.Ledger.Shelley
     ( nodeToClientVersions
     , toCardanoEra
@@ -478,7 +475,9 @@ withNodeNetworkLayerBase
                                 trFollowLog
                                 (_syncProgress interpreterVar)
                     withStats $ \trChainSyncLog -> do
-                        let mapB = getBlockHeader getGenesisBlockHash
+                        let mapB =
+                                Read.applyEraFunValue Read.getEraBHeader
+                                . Read.fromConsensusBlock
                             mapP = fromOuroborosPoint
                         let client =
                                 mkWalletClient
@@ -527,8 +526,7 @@ withNodeNetworkLayerBase
                 }
       where
         GenesisParameters
-            { getGenesisBlockHash
-            , getGenesisBlockDate
+            { getGenesisBlockDate
             } = genesisParameters np
         sp = slottingParameters np
         cfg = codecConfig sp

lib/network-layer/src/Cardano/Wallet/Network/Implementation/Types.hs

@@ -17,10 +17,10 @@ module Cardano.Wallet.Network.Implementation.Types
 import Prelude
 
 import Cardano.Wallet.Read
-    ( BHeader
-    , BlockNo (..)
+    ( BlockNo (..)
     , ChainPoint (..)
     , ChainTip (..)
+    , EraIndependentBlockHeader
     , SlotNo (..)
     )
 import Cardano.Wallet.Read.Hash
@@ -89,10 +89,14 @@ toCardanoSlotNo (SlotNo slot) = O.SlotNo (toEnum $ fromEnum slot)
 fromCardanoSlotNo :: O.SlotNo -> SlotNo
 fromCardanoSlotNo (O.SlotNo slot) = SlotNo (fromIntegral slot)
 
-toCardanoHash :: Hash Blake2b_256 BHeader -> OneEraHash (CardanoEras sc)
+toCardanoHash
+    :: Hash Blake2b_256 EraIndependentBlockHeader
+    -> OneEraHash (CardanoEras sc)
 toCardanoHash = OneEraHash . hashToBytesShort
 
-fromCardanoHash :: OneEraHash (CardanoEras sc) -> Hash Blake2b_256 BHeader
+fromCardanoHash
+    :: OneEraHash (CardanoEras sc)
+    -> Hash Blake2b_256 EraIndependentBlockHeader
 fromCardanoHash = fromJust . hashFromBytesShort . getOneEraHash
 
 toCardanoBlockNo :: BlockNo -> O.BlockNo

lib/network-layer/src/Cardano/Wallet/Network/Logging.hs

@@ -42,10 +42,6 @@ import Cardano.Wallet.Network.Logging.Aggregation
 import Cardano.Wallet.Primitive.SyncProgress
     ( SyncProgress (..)
     )
-import Cardano.Wallet.Primitive.Types.Block
-    ( BlockHeader
-    , slotNo
-    )
 import Control.Concurrent.Class.MonadSTM
     ( atomically
     )
@@ -68,9 +64,6 @@ import Data.Text.Class
 import Data.Time.Clock
     ( getCurrentTime
     )
-import Fmt
-    ( pretty
-    )
 import GHC.Generics
     ( Generic
     )
@@ -114,6 +107,8 @@ mapChainSyncLog f g = \case
     MsgLocalTip point -> MsgLocalTip (g point)
     MsgTipDistance d -> MsgTipDistance d
 
+type BlockHeader = Read.EraValue Read.BHeader
+
 instance ToText (ChainSyncLog BlockHeader Read.ChainPoint) where
     toText = \case
         MsgChainFindIntersect cps ->
@@ -127,7 +122,9 @@ instance ToText (ChainSyncLog BlockHeader Read.ChainPoint) where
         MsgChainRollForward headers tip ->
             let buildRange (x :| []) = x
                 buildRange xs = NE.head xs <> ".." <> NE.last xs
-                slots = pretty . slotNo <$> headers
+                slots =
+                    Read.prettySlotNo . Read.applyEraFun Read.getEraSlotNo
+                    <$> headers
             in  mconcat
                     [ "ChainSync roll forward: "
                     , "applying blocks at slots ["

lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Read/Block.hs

@@ -26,7 +26,6 @@ import Cardano.Wallet.Read
     , ConsensusBlock
     , IsEra
     , fromConsensusBlock
-    , (:.:) (Comp)
     )
 import Cardano.Wallet.Read.Block.Txs
     ( getEraTransactions
@@ -66,7 +65,7 @@ primitiveBlock hg = do
 
 getTxsAndCertificates :: IsEra era => Block era -> [(W.Tx, [W.Certificate])]
 getTxsAndCertificates block =
-    let Comp txs = getEraTransactions block
+    let txs = getEraTransactions block
         ptxs = primitiveTx <$> txs
         pcts = getCertificates . getEraCertificates <$> txs
     in  zip ptxs pcts

lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Read/Block/Header.hs

@@ -30,6 +30,9 @@ import Cardano.Wallet.Read
     , fromConsensusBlock
     , theEra
     )
+import Cardano.Wallet.Read.Block.BHeader
+    ( getEraBHeader
+    )
 import Cardano.Wallet.Read.Block.BlockNo
     ( BlockNo (..)
     , getEraBlockNo
@@ -88,8 +91,8 @@ primitiveBlockHeader
     -> Block era
     -> W.BlockHeader
 primitiveBlockHeader gp = do
-    slotNo <- fromSlotNo <$> getEraSlotNo
-    blockNo <- fromBlockNo <$> getEraBlockNo
+    slotNo <- fromSlotNo <$> getEraSlotNo . getEraBHeader
+    blockNo <- fromBlockNo <$> getEraBlockNo . getEraBHeader
     headerHash <- primitiveHash . getEraHeaderHash
     prevHeaderHash <- primitivePrevHash gp . getEraPrevHeaderHash
     pure $ W.BlockHeader slotNo blockNo headerHash (Just prevHeaderHash)

lib/primitive/lib/Cardano/Wallet/Primitive/Ledger/Shelley.hs

@@ -9,7 +9,6 @@
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -78,7 +77,6 @@ module Cardano.Wallet.Primitive.Ledger.Shelley
     , fromNonMyopicMemberRewards
     , optimumNumberOfPools
     , getProducer
-    , fromBlockNo
     , toCardanoEra
     , fromShelleyTxOut
     , fromGenesisData
@@ -117,13 +115,6 @@ import Cardano.Api.Shelley
     ( ShelleyBasedEra (..)
     , ShelleyGenesis (..)
     )
-import Cardano.Chain.Block
-    ( ABlockOrBoundary (ABOBBlock, ABOBBoundary)
-    , blockTxPayload
-    )
-import Cardano.Chain.UTxO
-    ( unTxPayload
-    )
 import Cardano.Crypto.Hash.Class
     ( Hash (UnsafeHash)
     , hashToBytes
@@ -166,9 +157,6 @@ import Cardano.Slotting.Slot
 import Cardano.Wallet.Primitive.Ledger.Byron
     ( maryTokenBundleMaxSize
     )
-import Cardano.Wallet.Primitive.Ledger.Read.Tx
-    ( primitiveTx
-    )
 import Cardano.Wallet.Primitive.Ledger.Read.Tx.Features.Certificates
     ( fromStakeCredential
     )
@@ -192,9 +180,6 @@ import Cardano.Wallet.Primitive.Types.StakePoolMetadata
     ( StakePoolMetadataHash (..)
     , StakePoolMetadataUrl (..)
     )
-import Cardano.Wallet.Read
-    ( Byron
-    )
 import Cardano.Wallet.Read.Tx.Hash
     ( fromShelleyTxId
     )
@@ -261,9 +246,6 @@ import Fmt
 import GHC.Stack
     ( HasCallStack
     )
-import Ouroboros.Consensus.Byron.Ledger
-    ( byronBlockRaw
-    )
 import Ouroboros.Consensus.Cardano.Block
     ( CardanoBlock
     , CardanoEras
@@ -287,9 +269,6 @@ import Ouroboros.Consensus.Shelley.Eras
 import Ouroboros.Consensus.Shelley.Ledger.Block
     ( ShelleyBlock (..)
     )
-import Ouroboros.Network.Block
-    ( BlockNo (..)
-    )
 import Ouroboros.Network.NodeToClient
     ( ConnectionId (..)
     , LocalAddress (..)
@@ -302,17 +281,13 @@ import qualified Cardano.Api.Shelley as Cardano
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Ledger.Address as SL
 import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
-import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo
 import qualified Cardano.Ledger.Api as Ledger
-import qualified Cardano.Ledger.Babbage as Babbage
 import qualified Cardano.Ledger.BaseTypes as SL
 import qualified Cardano.Ledger.Coin as Ledger
-import qualified Cardano.Ledger.Conway as Conway
 import qualified Cardano.Ledger.Credential as SL
 import qualified Cardano.Ledger.Crypto as SL
 import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Cardano.Ledger.Shelley.API as SLAPI
-import qualified Cardano.Ledger.Shelley.BlockChain as SL
 import qualified Cardano.Protocol.TPraos.BHeader as SL
 import qualified Cardano.Slotting.Slot as Slotting
 import qualified Cardano.Wallet.Primitive.Ledger.Convert as Ledger
@@ -430,69 +405,20 @@ getConwayProducer (ShelleyBlock (SL.Block (Consensus.Header header _) _) _) =
     fromPoolKeyHash $ SL.hashKey (Consensus.hbVk header)
 
 numberOfTransactionsInBlock
-    :: CardanoBlock StandardCrypto -> (Int, (Quantity "block" Word32, O.SlotNo))
-numberOfTransactionsInBlock = \case
-    BlockByron byb -> transactionsByron byb
-    BlockShelley shb -> transactions shb
-    BlockAllegra shb -> transactions shb
-    BlockMary shb -> transactions shb
-    BlockAlonzo shb -> transactionsAlonzo shb
-    BlockBabbage shb -> transactionsBabbage shb
-    BlockConway shb -> transactionsConway shb
+    :: CardanoBlock StandardCrypto -> (Int, (Read.BlockNo, O.SlotNo))
+numberOfTransactionsInBlock =
+    Read.applyEraFun get . Read.fromConsensusBlock
   where
-    transactions
-        (ShelleyBlock
-            (SL.Block (SL.BHeader header _) (SL.ShelleyTxSeq txs'))
-            _
-        ) =
-            ( length txs'
-            , (fromBlockNo $ SL.bheaderBlockNo header, SL.bheaderSlotNo header)
-            )
-    transactionsAlonzo
-        (ShelleyBlock
-            (SL.Block (SL.BHeader header _) (Alonzo.AlonzoTxSeq txs'))
-            _
-        ) =
-            ( length txs'
-            , (fromBlockNo $ SL.bheaderBlockNo header, SL.bheaderSlotNo header)
-            )
-    transactionsBabbage
-        :: ShelleyBlock
-            (Consensus.Praos StandardCrypto)
-            (Babbage.BabbageEra StandardCrypto)
-        -> (Int, (Quantity "block" Word32, O.SlotNo))
-    transactionsBabbage
-        (ShelleyBlock
-            (SL.Block (Consensus.Header header _)
-            (Alonzo.AlonzoTxSeq txs')) _) =
-                ( length txs'
-                , ( fromBlockNo $ Consensus.hbBlockNo header
-                  , Consensus.hbSlotNo header
-                  )
-                )
-    transactionsByron blk =
-        (, (fromBlockNo $ O.blockNo blk, O.blockSlot blk)) $
-            case byronBlockRaw blk of
-            ABOBBlock blk' ->
-                length $ primitiveTx @Byron . Read.Tx
-                    <$> unTxPayload (blockTxPayload blk')
-            ABOBBoundary _ ->
-                0
-
-    transactionsConway
-        :: ShelleyBlock
-            (Consensus.Praos StandardCrypto)
-            (Conway.ConwayEra StandardCrypto)
-        -> (Int, (Quantity "block" Word32, O.SlotNo))
-    transactionsConway
-        (ShelleyBlock
-            (SL.Block (Consensus.Header header _)
-            (Alonzo.AlonzoTxSeq txs')) _) =
-                ( length txs'
-                , ( fromBlockNo $ Consensus.hbBlockNo header
-                  , Consensus.hbSlotNo header
-                  )
-                )
+    get :: Read.IsEra era => Read.Block era -> (Int, (Read.BlockNo, O.SlotNo))
+    get block =
+        ( length (Read.getEraTransactions block)
+        , (blockNo, O.SlotNo slotNo)
+        )
+      where
+        header = Read.getEraBHeader block
+        blockNo = Read.getEraBlockNo header
+        slotNo =
+            toEnum $ fromIntegral $ Read.unSlotNo $ Read.getEraSlotNo header
 
 toCardanoEra :: CardanoBlock c -> AnyCardanoEra
 toCardanoEra = \case
@@ -504,10 +430,6 @@ toCardanoEra = \case
     BlockBabbage{} -> AnyCardanoEra BabbageEra
     BlockConway{}  -> AnyCardanoEra ConwayEra
 
--- FIXME unsafe conversion (Word64 -> Word32)
-fromBlockNo :: BlockNo -> Quantity "block" Word32
-fromBlockNo (BlockNo h) = Quantity (fromIntegral h)
-
 -- NOTE: Unsafe conversion from Natural -> Word16
 fromMaxSize :: Word32 -> Quantity "byte" Word16
 fromMaxSize = Quantity . fromIntegral

lib/read/cardano-wallet-read.cabal

@@ -45,6 +45,7 @@ library
   exposed-modules:
     Cardano.Wallet.Read
     Cardano.Wallet.Read.Block
+    Cardano.Wallet.Read.Block.BHeader
     Cardano.Wallet.Read.Block.Block
     Cardano.Wallet.Read.Block.BlockNo
     Cardano.Wallet.Read.Block.Gen