[ADP-3350] Change chainSync to use Read.ChainTip (#4551)

This pull request changes the `chainSync` function to use the data type
`ChainTip` from the `Cardano.Wallet.Read` hierarchy. The other pull
request #4550 has changed the type of the chain point, here we change
the type of the **tip**.

### Comments

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

### Issue Number

ADP-3350

lib/benchmarks/exe/restore-bench.hs

@@ -208,9 +208,6 @@ import Cardano.Wallet.Primitive.Types
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..)
     )
-import Cardano.Wallet.Primitive.Types.Block
-    ( chainPointFromBlockHeader'
-    )
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..)
     )
@@ -788,9 +785,9 @@ bench_baseline_restoration
             $ ChainFollower
             { checkpointPolicy = const CP.atTip
             , readChainPoints  = readTVarIO chainPointT
-            , rollForward = \blocks ntip -> do
+            , rollForward = \blocks nodeTip -> do
                 atomically $ writeTVar chainPointT
-                    [chainPointFromBlockHeader' ntip]
+                    [Read.chainPointFromChainTip nodeTip]
                 let (ntxs, hss) = NE.unzip $
                         numberOfTransactionsInBlock <$> blocks
                     (heights, slots) = NE.unzip hss

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

@@ -50,9 +50,6 @@ import Cardano.Wallet.Primitive.Slotting
 import Cardano.Wallet.Primitive.SyncProgress
     ( SyncProgress (..)
     )
-import Cardano.Wallet.Primitive.Types.Block
-    ( BlockHeader
-    )
 import Cardano.Wallet.Primitive.Types.Checkpoints.Policy
     ( CheckpointPolicy
     )
@@ -113,7 +110,7 @@ import qualified Internal.Cardano.Write.Tx as Write
 data NetworkLayer m block = NetworkLayer
     { chainSync
         :: Tracer IO ChainFollowLog
-        -> ChainFollower m Read.ChainPoint BlockHeader (NonEmpty block)
+        -> ChainFollower m Read.ChainPoint Read.ChainTip (NonEmpty block)
         -> m ()
     -- ^ Connect to the node and run the ChainSync protocol.
     -- The callbacks provided in the 'ChainFollower' argument

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

@@ -99,8 +99,7 @@ import Cardano.Wallet.Primitive.Ledger.Read.Block.Header
     ( getBlockHeader
     )
 import Cardano.Wallet.Primitive.Ledger.Shelley
-    ( fromTip'
-    , nodeToClientVersions
+    ( nodeToClientVersions
     , toCardanoEra
     , unsealShelleyTx
     )
@@ -481,15 +480,14 @@ withNodeNetworkLayerBase
                     withStats $ \trChainSyncLog -> do
                         let mapB = getBlockHeader getGenesisBlockHash
                             mapP = fromOuroborosPoint
-                        let blockHeader = fromTip' gp
                         let client =
                                 mkWalletClient
                                     (mapChainSyncLog mapB mapP >$< trChainSyncLog)
                                     pipeliningStrategy
                                     (mapChainFollower
                                         toOuroborosPoint
                                         mapP
-                                        blockHeader
+                                        fromOuroborosTip
                                         id
                                         follower
                                     )
@@ -528,7 +526,7 @@ withNodeNetworkLayerBase
                 , syncProgress = _syncProgress interpreterVar
                 }
       where
-        gp@GenesisParameters
+        GenesisParameters
             { getGenesisBlockHash
             , getGenesisBlockDate
             } = genesisParameters np

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

@@ -82,9 +82,6 @@ module Cardano.Wallet.Primitive.Ledger.Shelley
     , toCardanoEra
     , fromShelleyTxOut
     , fromGenesisData
-    , fromTip
-    , fromTip'
-    , toTip
     , slottingParametersFromGenesis
     , getBabbageProducer
     , getConwayProducer
@@ -221,8 +218,7 @@ import Data.ByteString
     ( ByteString
     )
 import Data.ByteString.Short
-    ( fromShort
-    , toShort
+    ( toShort
     )
 import Data.Coerce
     ( coerce
@@ -293,19 +289,13 @@ import Ouroboros.Consensus.Shelley.Ledger.Block
     )
 import Ouroboros.Network.Block
     ( BlockNo (..)
-    , Point (..)
-    , Tip (..)
-    , getTipPoint
     )
 import Ouroboros.Network.NodeToClient
     ( ConnectionId (..)
     , LocalAddress (..)
     , NodeToClientVersion (..)
     , NodeToClientVersionData
     )
-import Ouroboros.Network.Point
-    ( WithOrigin (..)
-    )
 
 import qualified Cardano.Api as Cardano
 import qualified Cardano.Api.Shelley as Cardano
@@ -376,7 +366,6 @@ import qualified Ouroboros.Consensus.Protocol.Praos.Header as Consensus
 import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as O
 import qualified Ouroboros.Network.Block as O
-import qualified Ouroboros.Network.Point as Point
 
 --------------------------------------------------------------------------------
 --
@@ -515,49 +504,10 @@ toCardanoEra = \case
     BlockBabbage{} -> AnyCardanoEra BabbageEra
     BlockConway{}  -> AnyCardanoEra ConwayEra
 
-fromCardanoHash :: O.HeaderHash (CardanoBlock sc) -> W.Hash "BlockHeader"
-fromCardanoHash = W.Hash . fromShort . getOneEraHash
-
 -- FIXME unsafe conversion (Word64 -> Word32)
 fromBlockNo :: BlockNo -> Quantity "block" Word32
 fromBlockNo (BlockNo h) = Quantity (fromIntegral h)
 
-fromTip' :: W.GenesisParameters -> Tip (CardanoBlock sc) -> W.BlockHeader
-fromTip' gp = fromTip (W.getGenesisBlockHash gp)
-
-fromTip
-    :: W.Hash "Genesis"
-    -> Tip (CardanoBlock sc)
-    -> W.BlockHeader
-fromTip genesisHash tip = case getPoint (getTipPoint tip) of
-    Origin -> W.BlockHeader
-        { slotNo = Slotting.SlotNo 0
-        , blockHeight = Quantity 0
-        , headerHash = coerce genesisHash
-        , parentHeaderHash = Nothing
-        }
-    At blk -> W.BlockHeader
-        { slotNo = Point.blockPointSlot blk
-        , blockHeight = fromBlockNo $ getLegacyTipBlockNo tip
-        , headerHash = fromCardanoHash $ Point.blockPointHash blk
-        -- TODO: parentHeaderHash could be removed.
-        , parentHeaderHash = Just $ W.Hash "parentHeaderHash - unused in Shelley"
-        }
-  where
-    -- TODO: This function was marked deprecated in ouroboros-network.
-    -- It is wrong, because `Origin` doesn't have a block number.
-    -- We should remove it.
-    getLegacyTipBlockNo t = case O.getTipBlockNo t of
-        Origin -> BlockNo 0
-        At x -> x
-
-toTip :: W.Hash "Genesis" -> W.BlockHeader -> Tip (CardanoBlock sc)
-toTip genesisHash (W.BlockHeader sl bl h _)
-    | h == (coerce genesisHash) = O.TipGenesis
-    | otherwise = O.Tip sl
-        (toCardanoHash h)
-        (BlockNo $ fromIntegral $ getQuantity bl)
-
 -- NOTE: Unsafe conversion from Natural -> Word16
 fromMaxSize :: Word32 -> Quantity "byte" Word16
 fromMaxSize = Quantity . fromIntegral

lib/primitive/test/spec/Cardano/Wallet/Primitive/Ledger/ShelleySpec.hs

@@ -49,13 +49,11 @@ import Cardano.Wallet.Primitive.Ledger.Shelley
     , StandardCrypto
     , decentralizationLevelFromPParams
     , fromCardanoValue
-    , fromTip
     , interval0
     , interval1
     , invertUnitInterval
     , toCardanoHash
     , toCardanoValue
-    , toTip
     )
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..)
@@ -168,7 +166,6 @@ import qualified Cardano.Api as Cardano
 import qualified Cardano.Ledger.BaseTypes as SL
 import qualified Cardano.Ledger.Shelley as SL
 import qualified Cardano.Ledger.Shelley.PParams as SL
-import qualified Cardano.Wallet.Primitive.Types.Block as W
 import qualified Cardano.Wallet.Primitive.Types.EpochNo as W
 import qualified Cardano.Wallet.Primitive.Types.SlotId as W
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
@@ -178,10 +175,6 @@ import qualified Data.Text.Encoding as T
 spec :: Spec
 spec = do
     describe "Conversions" $ do
-        it "toTip' . fromTip' == id" $ property $ \gh tip -> do
-            let fromTip' = fromTip gh
-            let toTip' = toTip gh :: W.BlockHeader -> Tip (CardanoBlock StandardCrypto)
-            toTip' (fromTip' tip) === tip
 
         it "unsafeIntToWord" $
             property prop_unsafeIntToWord

lib/wallet/src/Cardano/Wallet.hs

@@ -1357,7 +1357,7 @@ restoreBlocks
     => WalletLayer IO s
     -> Tracer IO WalletFollowLog
     -> BlockData IO (Either Address RewardAccount) ChainEvents s
-    -> BlockHeader
+    -> Read.ChainTip
     -> IO ()
 restoreBlocks ctx tr blocks nodeTip = db & \DBLayer{..} -> atomically $ do
     slottingParams  <- liftIO $ currentSlottingParameters nl
@@ -1389,8 +1389,18 @@ restoreBlocks ctx tr blocks nodeTip = db & \DBLayer{..} -> atomically $ do
         epochStability = (3*) <$> getSecurityParameter slottingParams
         localTip = currentTip $ NE.last cps
 
-        finalitySlot = nodeTip ^. #slotNo
-            - stabilityWindowShelley slottingParams
+        nodeTipSlotNo = case nodeTip of
+            Read.GenesisTip ->
+                SlotNo 0
+            Read.BlockTip{slotNo} ->
+                SlotNo $ fromIntegral $ Read.unSlotNo slotNo
+        nodeTipBlockNo = case nodeTip of
+            Read.GenesisTip ->
+                Quantity 0
+            Read.BlockTip{blockNo} ->
+                Quantity $ fromIntegral $ Read.unBlockNo blockNo
+
+        finalitySlot = nodeTipSlotNo - stabilityWindowShelley slottingParams
 
         -- Checkpoint deltas
         wcps = snd . fromWallet <$> cps
@@ -1399,7 +1409,7 @@ restoreBlocks ctx tr blocks nodeTip = db & \DBLayer{..} -> atomically $ do
                 getSlot
                 (view $ #currentTip . #blockHeight)
                 epochStability
-                (nodeTip ^. #blockHeight)
+                nodeTipBlockNo
                 wcps
 
         deltaPruneCheckpoints wallet =

lib/wallet/src/Cardano/Wallet/Pools.hs

@@ -744,7 +744,7 @@ monitorStakePools tr (NetworkParameters gp sp _pp) genesisPools nl DBLayer{..} =
     forward
         :: IORef EpochNo
         -> NonEmpty (CardanoBlock StandardCrypto)
-        -> BlockHeader
+        -> Read.ChainTip
         -> IO ()
     forward latestGarbageCollectionEpochRef blocks _ =
         atomically $ forAllAndLastM blocks forAllBlocks forLastBlock