wip manage reward balance

lib/core/src/Cardano/Wallet.hs

@@ -845,10 +845,7 @@ deleteWallet ctx wid = db & \DBLayer{..} -> do
   where
     db = ctx ^. dbLayer @s @k
 
--- | Fetch the reward balance of a given wallet.
---
--- Rather than force all callers of 'readWallet' to wait for fetching the
--- account balance (via the 'NetworkLayer'), we expose this function for it.
+-- | Fetch the cached reward balance of a given wallet from the database.
 fetchRewardBalance
     :: forall ctx s k.
         ( HasDBLayer s k ctx
@@ -869,6 +866,57 @@ fetchRewardBalance ctx wid = db & \DBLayer{..} -> do
     pk = PrimaryKey wid
     db = ctx ^. dbLayer @s @k
 
+-- | Query the node for the reward balance of a given wallet.
+--
+-- Rather than force all callers of 'readWallet' to wait for fetching the
+-- account balance (via the 'NetworkLayer'), we expose this function for it.
+queryRewardBalance
+    :: forall ctx s t k.
+        ( HasDBLayer s k ctx
+        , HasNetworkLayer t ctx
+        , HasRewardAccount s
+        , k ~ RewardAccountKey s
+        , WalletKey k
+        )
+    => ctx
+    -> WalletId
+    -> ExceptT ErrFetchRewards IO (Quantity "lovelace" Word64)
+queryRewardBalance ctx wid = db & \DBLayer{..} -> do
+    cp <- withExceptT ErrFetchRewardsNoSuchWallet
+        . mapExceptT atomically
+        . withNoSuchWallet wid
+        $ readCheckpoint pk
+    mapExceptT (fmap handleErr)
+        . getAccountBalance nw
+        . toChimericAccount
+        . rewardAccount
+        $ getState cp
+  where
+    pk = PrimaryKey wid
+    db = ctx ^. dbLayer @s @k
+
+manageRewardBalance
+    :: forall ctx s t k.
+        ( HasLogger WalletLog ctx
+        , HasNetworkLayer t ctx
+        , HasDBLayer s k ctx
+        , HasGenesisData ctx
+        , IsOurs s Address
+        , IsOurs s ChimericAccount
+        )
+    => ctx
+    -> WalletId
+    -> ExceptT ErrNoSuchWallet IO ()
+manageRewardBalance ctx wid = db & \DBLayer{..} ->
+    watchNodeTip nw $ \bh -> do
+        amt <- queryRewardBalance wid amt
+        lift . atomically $ putDelegationRewardBalance pk amt
+  where
+    pk = PrimaryKey wid
+    db = ctx ^. dbLayer @s @k
+    nw = ctx ^. networkLayer @t
+    tr = contramap MsgFollow (ctx ^. logger @WalletLog)
+
 {-------------------------------------------------------------------------------
                                     Address
 -------------------------------------------------------------------------------}

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

@@ -1610,8 +1610,9 @@ registerWorker ctx wid =
         , workerMain = \ctx' _ -> do
             -- FIXME:
             -- Review error handling here
-            unsafeRunExceptT $
-                W.restoreWallet @(WorkerCtx ctx) @s @t ctx' wid
+            unsafeRunExceptT $ concurrently_
+                (W.restoreWallet @(WorkerCtx ctx) @s @t ctx' wid)
+                (W.manageRewardBalance @(WorkerCtx ctx) @s @t ctx' wid)
 
         , workerAfter =
             defaultWorkerAfter