wip: Refactor all chain-sync stuff

lib/core/src/Cardano/Wallet.hs

@@ -229,13 +229,7 @@ import Cardano.Wallet.Logging
     , unliftIOTracer
     )
 import Cardano.Wallet.Network
-    ( ErrPostTx (..)
-    , FollowAction (..)
-    , FollowExceptionRecovery (..)
-    , FollowLog (..)
-    , NetworkLayer (..)
-    , follow
-    )
+    ( ChainFollower (..), ErrPostTx (..), FollowLog (..), NetworkLayer (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( DelegationAddress (..)
     , Depth (..)
@@ -514,7 +508,7 @@ import Statistics.Quantile
 import Type.Reflection
     ( Typeable, typeRep )
 import UnliftIO.Exception
-    ( Exception )
+    ( Exception, throwIO )
 import UnliftIO.MVar
     ( modifyMVar_, newMVar )
 
@@ -876,18 +870,26 @@ restoreWallet
     -> WalletId
     -> ExceptT ErrNoSuchWallet IO ()
 restoreWallet ctx wid = db & \DBLayer{..} -> do
-    let readCps = liftIO $ atomically $ listCheckpoints wid
-    let forward bs h innerTr = run $ do
-            restoreBlocks @ctx @s @k ctx innerTr wid bs h
-    let backward = runExceptT . rollbackBlocks @ctx @s @k ctx wid
-    liftIO $ follow nw tr readCps forward backward RetryOnExceptions (view #header)
+    liftIO $ chainSync nw tr' $ ChainFollower
+        { readLocalTip = \_tr ->
+            liftIO $ atomically $ listCheckpoints wid
+        , rollForward = \tr tip blocks -> throwInIO $
+            -- FIXME: NE.fromList
+            restoreBlocks @ctx @s @k
+                ctx (contramap MsgFollowLog tr) wid (NE.fromList blocks) tip
+        , rollBackward = \_tr ->
+            throwInIO . rollbackBlocks @ctx @s @k ctx wid
+        }
+    --liftIO $ follow nw tr readCps forward backward RetryOnExceptions (view #header)
   where
     db = ctx ^. dbLayer @IO @s @k
-    nw = ctx ^. networkLayer
-    tr = contramap MsgFollow (ctx ^. logger @WalletWorkerLog)
+    nw = ctx ^. networkLayer @IO
+    tr' = contramap MsgFollow (ctx ^. logger @WalletWorkerLog)
 
-    run :: ExceptT ErrNoSuchWallet IO () -> IO (FollowAction ErrNoSuchWallet)
-    run = fmap (either ExitWith (const Continue)) . runExceptT
+    throwInIO :: ExceptT ErrNoSuchWallet IO a -> IO a
+    throwInIO x = runExceptT x >>= \case
+        Right a -> pure a
+        Left e -> throwIO e
 
 -- | Rewind the UTxO snapshots, transaction history and other information to a
 -- the earliest point in the past that is before or is the point of rollback.

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

@@ -1084,8 +1084,8 @@ data ApiLayer s (k :: Depth -> Type -> Type)
         (Tracer IO TxSubmitLog)
         (Tracer IO (WorkerLog WalletId WalletWorkerLog))
         (Block, NetworkParameters, SyncTolerance)
-        (NetworkLayer IO (Block))
-        (TransactionLayer k SealedTx)
+        (NetworkLayer IO Block)
+        (TransactionLayer k)
         (DBFactory IO s k)
         (WorkerRegistry WalletId (DBLayer IO s k))
         (Concierge IO WalletLock)

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

@@ -63,6 +63,8 @@ import Cardano.Wallet.Primitive.Types.Tx
     , TxMeta
     , TxStatus
     )
+import Control.Exception
+    ( Exception )
 import Control.Monad.IO.Class
     ( MonadIO )
 import Control.Monad.Trans.Except
@@ -329,6 +331,8 @@ newtype ErrNoSuchWallet
     = ErrNoSuchWallet WalletId -- Wallet is gone or doesn't exist yet
     deriving (Eq, Show)
 
+instance Exception ErrNoSuchWallet
+
 -- | Can't add a transaction to the local tx submission pool.
 data ErrPutLocalTxSubmission
     = ErrPutLocalTxSubmissionNoSuchWallet ErrNoSuchWallet