Change watchNodeTip to use Read.ChainPoint

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

@@ -145,7 +145,7 @@ data NetworkLayer m block = NetworkLayer
     -- ^ Get the last known slotting parameters. In principle, these can
     -- only change once per era.
     , watchNodeTip
-        :: (BlockHeader -> m ())
+        :: (Read.ChainTip -> m ())
         -> m ()
     -- ^ Register a callback for when the node tip changes.
     -- This function should never finish, unless the callback throws an

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

@@ -99,7 +99,6 @@ import Cardano.Wallet.Primitive.Ledger.Read.Block.Header
     )
 import Cardano.Wallet.Primitive.Ledger.Shelley
     ( fromPoint
-    , fromTip
     , fromTip'
     , nodeToClientVersions
     , toCardanoEra
@@ -385,6 +384,7 @@ import qualified Cardano.Wallet.Primitive.SyncProgress as SP
 import qualified Cardano.Wallet.Primitive.Types.Coin as W
 import qualified Cardano.Wallet.Primitive.Types.RewardAccount as W
 import qualified Cardano.Wallet.Primitive.Types.Tx as W
+import qualified Cardano.Wallet.Read as Read
 import qualified Codec.CBOR.Term as CBOR
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -654,10 +654,11 @@ withNodeNetworkLayerBase
                     return res
                 Nothing -> pure $ StakePoolsSummary 0 mempty mempty
 
-        _watchNodeTip readTip cb = do
+        _watchNodeTip readTip callback = do
             observeForever readTip $ \tip -> do
-                let header = fromTip getGenesisBlockHash tip
-                bracketTracer (contramap (MsgWatcherUpdate header) tr) $ cb header
+                let tip' = fromOuroborosTip tip
+                bracketTracer (contramap (MsgWatcherUpdate tip') tr)
+                    $ callback tip'
 
         -- TODO(#2042): Make wallets call manually, with matching stopObserving.
         _getCachedRewardAccountBalance rewardsObserver k = do
@@ -1356,7 +1357,7 @@ data Log where
         -> Log
         -- ^ Number of pools in stake distribution, and rewards map,
         -- respectively.
-    MsgWatcherUpdate :: BlockHeader -> BracketLog -> Log
+    MsgWatcherUpdate :: Read.ChainTip -> BracketLog -> Log
     MsgInterpreter :: CardanoInterpreter StandardCrypto -> Log
     -- TODO: Combine ^^ and vv
     MsgInterpreterLog :: TimeInterpreterLog -> Log
@@ -1428,7 +1429,7 @@ instance ToText Log where
                 ]
         MsgWatcherUpdate tip b ->
             "Update watcher with tip: "
-                <> pretty tip
+                <> Read.prettyChainTip tip
                 <> ". Callback "
                 <> toText b
                 <> "."

lib/unit/test/unit/Cardano/WalletSpec.hs

@@ -125,7 +125,6 @@ import Cardano.Wallet.Primitive.Passphrase.Current
     )
 import Cardano.Wallet.Primitive.Types
     ( ActiveSlotCoefficient (..)
-    , BlockHeader (BlockHeader)
     , NetworkParameters (..)
     , SlotNo (..)
     , SlottingParameters (..)
@@ -1002,13 +1001,20 @@ prop_localTxSubmission tc = monadicIO $ do
         , watchNodeTip = mockNodeTip (numSlots tc) 0
         }
 
-    mockNodeTip end sl cb
-        | sl < end = do
-            let h = Hash ""
-            void $ cb $ BlockHeader (SlotNo sl) (Quantity (fromIntegral sl)) h (Just h)
-            mockNodeTip end (sl + 1) cb
+    mockNodeTip end slot callback
+        | slot < end = do
+            let tip = Read.BlockTip
+                    { slotNo = Read.SlotNo $ fromIntegral slot
+                    , headerHash = mockHash
+                    , blockNo = Read.BlockNo $ fromIntegral slot
+                    }
+            void $ callback tip
+            mockNodeTip end (slot + 1) callback
         | otherwise = pure ()
 
+    mockHash :: Read.RawHeaderHash
+    mockHash = Read.mockRawHeaderHash 0
+
     stash :: MVar [a] -> a -> TxRetryTestM ()
     stash var x = modifyMVar_ var (\xs -> pure (x:xs))
 

lib/wallet/src/Cardano/Wallet.hs

@@ -1651,8 +1651,8 @@ manageRewardBalance
     -> DBLayer IO (SeqState n ShelleyKey)
     -> IO ()
 manageRewardBalance tr' netLayer db = do
-    watchNodeTip netLayer $ \bh -> do
-         traceWith tr $ MsgRewardBalanceQuery bh
+    watchNodeTip netLayer $ \nodeTip -> do
+         traceWith tr $ MsgRewardBalanceQuery nodeTip
          query <- do
             (acct, _, _) <- readRewardAccount db
             liftIO $ getCachedRewardAccountBalance netLayer acct
@@ -1695,8 +1695,8 @@ manageSharedRewardBalance
     -> DBLayer IO (SharedState n SharedKey)
     -> IO ()
 manageSharedRewardBalance tr' netLayer db = do
-    watchNodeTip netLayer $ \bh -> do
-         traceWith tr $ MsgRewardBalanceQuery bh
+    watchNodeTip netLayer $ \nodeTip -> do
+         traceWith tr $ MsgRewardBalanceQuery nodeTip
          query <- runExceptT $ do
             (acct, _, _) <-
                 lift $ readRewardAccount @(SharedState n SharedKey) db
@@ -2804,10 +2804,13 @@ runLocalTxSubmissionPool
     -> WalletLayer m s
     -> m ()
 runLocalTxSubmissionPool cfg ctx = db & \DBLayer{..} -> do
-    submitPending <- rateLimited $ \bh -> bracketTracer trBracket $ do
+    submitPending <- rateLimited $ \nodeTip -> bracketTracer trBracket $ do
         sp <- currentSlottingParameters nw
         pending <- readLocalTxSubmissionPending ctx
-        let sl = bh ^. #slotNo
+        let sl = case nodeTip of
+                Read.GenesisTip -> SlotNo 0
+                Read.BlockTip{slotNo} ->
+                    SlotNo $ fromIntegral $ Read.unSlotNo slotNo
             pendingOldStyle = pending >>= mkLocalTxSubmission
         -- Re-submit transactions due, ignore errors
         forM_ (filter (isScheduled sp sl) pendingOldStyle) $ \st -> do
@@ -3856,7 +3859,7 @@ data WalletFollowLog
 data WalletLog
     = MsgMigrationUTxOBefore UTxOStatistics
     | MsgMigrationUTxOAfter UTxOStatistics
-    | MsgRewardBalanceQuery BlockHeader
+    | MsgRewardBalanceQuery Read.ChainTip
     | MsgRewardBalanceResult (Either ErrFetchRewards Coin)
     | MsgRewardBalanceExited
     | MsgTxSubmit TxSubmitLog
@@ -3906,8 +3909,9 @@ instance ToText WalletLog where
             "About to migrate the following distribution: \n" <> pretty summary
         MsgMigrationUTxOAfter summary ->
             "Expected distribution after complete migration: \n" <> pretty summary
-        MsgRewardBalanceQuery bh ->
-            "Updating the reward balance for block " <> pretty bh
+        MsgRewardBalanceQuery nodeTip ->
+            "Updating the reward balance for block "
+            <> Read.prettyChainTip nodeTip
         MsgRewardBalanceResult (Right amt) ->
             "The reward balance is " <> pretty amt
         MsgRewardBalanceResult (Left err) ->