Implement remaining error "todo" cases

cardano-foundation · Oct 26, 2021 · b6f80d6 · b6f80d6
1 parent 24259a9
commit b6f80d6
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 6 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Network.hs b/lib/core/src/Cardano/Wallet/Network.hs
@@ -715,13 +715,15 @@ instance HasSeverityAnnotation (FollowStats LogState) where
 addFollowerLogging
     :: Monad m
     => Tracer m (FollowLog msg)
+    -> (block -> BlockHeader)
+    -- ^ Extract a 'BlockHeader' for pretty printing.
     -> ChainFollower m ChainPoint BlockHeader block
     -> ChainFollower m ChainPoint BlockHeader block
-addFollowerLogging tr cf = ChainFollower
+addFollowerLogging tr fromBlock cf = ChainFollower
     { readLocalTip = do
         readLocalTip cf
     , rollForward = \tip blocks -> do
-        traceWith tr $ MsgApplyBlocks tip (fmap (error "FIXME: todo") blocks)
+        traceWith tr $ MsgApplyBlocks tip (fromBlock <$> blocks)
         traceWith tr $ MsgFollowerTip (Just tip)
         rollForward cf tip blocks
     , rollBackward = \point -> do

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network.hs
@@ -100,6 +100,7 @@ import Cardano.Wallet.Shelley.Compatibility
     , nodeToClientVersions
     , optimumNumberOfPools
     , slottingParametersFromGenesis
+    , toCardanoBlockHeader
     , toCardanoEra
     , toPoint
     , toShelleyCoin
@@ -350,14 +351,16 @@ withNetworkLayerBase tr net np conn versionData tol action = do
                     followTr'
                     (_syncProgress interpreterVar)
             withStats $ \followTr -> do
+                let addLogging =
+                        addFollowerLogging followTr (toCardanoBlockHeader gp)
                 client <- mkWalletClient
                     followTr
                     (mapChainFollower
                         toPoint
                         fromPoint
                         (fromTip' gp)
                         id
-                        (addFollowerLogging followTr follower))
+                        (addLogging follower))
                     cfg
                 connectClient tr handlers client versionData conn
 

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs
@@ -544,7 +544,7 @@ monitorStakePools followTr (NetworkParameters gp sp _pp) nl DBLayer{..} =
                     liftIO . atomically $ rollbackTo $ pseudoPointSlot point
                     -- The DB will always rollback to the requested slot, so we
                     -- return it.
-                    return $ Right point
+                    return point
 
                 -- See NOTE [PointSlotNo]
                 pseudoPointSlot :: ChainPoint -> SlotNo
@@ -556,8 +556,8 @@ monitorStakePools followTr (NetworkParameters gp sp _pp) nl DBLayer{..} =
 
             chainSync nl followTr $ ChainFollower
                 { readLocalTip = map toChainPoint <$> initCursor
-                , rollForward = \tip blocks -> rollForward blocks tip innerTr
-                , rollBackward = fmap (either (error "todo") id) . rollback
+                , rollForward  = \tip blocks -> rollForward blocks tip innerTr
+                , rollBackward = rollback
                 }
 
     GenesisParameters  { getGenesisBlockHash  } = gp