Change rollForward to expect a NonEmpty list

lib/core/src/Cardano/Wallet.hs

@@ -874,9 +874,8 @@ restoreWallet ctx wid = db & \DBLayer{..} -> do
         { readLocalTip =
             liftIO $ atomically $ listCheckpoints wid
         , rollForward = \tip blocks -> throwInIO $
-            -- FIXME: NE.fromList
             restoreBlocks @ctx @s @k
-                ctx (contramap MsgFollowLog tr') wid (NE.fromList blocks) tip
+                ctx (contramap MsgFollowLog tr') wid blocks tip
         , rollBackward =
             throwInIO . rollbackBlocks @ctx @s @k ctx wid
         }

lib/core/src/Cardano/Wallet/Network.hs

@@ -384,7 +384,7 @@ data ChainFollower m point tip block = ChainFollower
         -- served from genesis.
         --
         -- TODO: Could be named readCheckpoints?
-    , rollForward :: tip -> [block] -> m ()
+    , rollForward :: tip -> NonEmpty block -> m ()
         -- ^ Callback for rolling forward.
         --
         -- Implementors _may_ delete old checkpoints while rolling forward.
@@ -438,7 +438,7 @@ mapChainFollower
 mapChainFollower fpoint ftip fblock cf =
     ChainFollower
         { readLocalTip = map fpoint <$> readLocalTip cf
-        , rollForward = \t bs -> rollForward cf (ftip t) (map fblock bs)
+        , rollForward = \t bs -> rollForward cf (ftip t) (fmap fblock bs)
         , rollBackward = rollBackward cf
         }
 
@@ -721,7 +721,7 @@ addFollowerLogging tr cf = ChainFollower
     { readLocalTip = do
         readLocalTip cf
     , rollForward = \tip blocks -> do
-        -- traceWith tr $ MsgApplyBlocks tip (NE.fromList $ map undefined blocks) -- FIXME NE
+        traceWith tr $ MsgApplyBlocks tip (fmap (error "FIXME: todo") blocks)
         traceWith tr $ MsgFollowerTip (Just tip)
         rollForward cf tip blocks
     , rollBackward = \slot -> do

lib/core/src/Ouroboros/Network/Client/Wallet.hs

@@ -68,6 +68,8 @@ import Data.Functor
     ( (<&>) )
 import Data.Kind
     ( Type )
+import Data.List.NonEmpty
+    ( NonEmpty (..) )
 import Data.Void
     ( Void )
 import Network.TypedProtocol.Pipelined
@@ -105,6 +107,7 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Type
     ( SubmitResult (..) )
 
 import qualified Cardano.Wallet.Primitive.Types as W
+import qualified Data.List.NonEmpty as NE
 import qualified Ouroboros.Network.Protocol.ChainSync.ClientPipelined as P
 import qualified Ouroboros.Network.Protocol.LocalStateQuery.Client as LSQ
 
@@ -214,7 +217,7 @@ chainSyncFollowTip toCardanoEra onTipUpdate =
 
 -- | A little type-alias to ease signatures in 'chainSyncWithBlocks'
 type RequestNextStrategy m n block
-    =  ((Tip block) -> [block] -> m ())
+    =  ((Tip block) -> NonEmpty block -> m ())
     -> P.ClientPipelinedStIdle n block (Point block) (Tip block) m Void
 
 
@@ -346,14 +349,14 @@ chainSyncWithBlocks tr cf =
         P.SendMsgRequestNextPipelined $ pipeline goal (Succ n) respond
 
     collectResponses
-        :: ((Tip block) -> [block] -> m ())
+        :: ((Tip block) -> NonEmpty block -> m ())
         -> [block]
         -> Nat n
         -> P.ClientStNext n block (Point block) (Tip block) m Void
     collectResponses respond blocks Zero = P.ClientStNext
         { P.recvMsgRollForward = \block tip -> do
             traceWith tr $ MsgChainRollForward block (getTipPoint tip)
-            let blocks' = reverse (block:blocks)
+            let blocks' = NE.reverse (block :| blocks)
             respond tip blocks'
             let distance = tipDistance (blockNo block) tip
             traceWith tr $ MsgTipDistance distance
@@ -367,8 +370,9 @@ chainSyncWithBlocks tr cf =
             case r of
                 Buffer xs -> do
                     traceWith tr $ MsgChainRollBackward point (length xs)
-                    let blocks' = reverse xs
-                    rollForward cf tip blocks'
+                    case reverse xs of
+                        []     -> pure ()
+                        (b:blocks') -> rollForward cf tip (b :| blocks') -- FIXME: respond ?
                     clientStIdle oneByOne
                 FollowerExact -> do
                     clientStIdle oneByOne

lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs

@@ -546,7 +546,7 @@ monitorStakePools followTr (NetworkParameters gp sp _pp) nl DBLayer{..} =
 
             chainSync nl followTr $ ChainFollower
                 { readLocalTip = initCursor
-                , rollForward = \tip blocks -> rollForward (NE.fromList blocks) tip innerTr
+                , rollForward = \tip blocks -> rollForward blocks tip innerTr
                 , rollBackward = fmap (either (error "todo") id) . rollback
                 }