Include TxHistory roll forward in deposit wallet state roll forward

Author: paolino

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs

@@ -46,6 +46,9 @@ import Cardano.Crypto.Wallet
 import Cardano.Wallet.Address.BIP32
     ( BIP32Path
     )
+import Cardano.Wallet.Deposit.IO.Network.Type
+    ( NetworkEnv (slotsToUTCTimes)
+    )
 import Cardano.Wallet.Deposit.Pure
     ( Customer
     , ValueTransfer
@@ -56,6 +59,7 @@ import Cardano.Wallet.Deposit.Pure
 import Cardano.Wallet.Deposit.Pure.API.TxHistory
     ( ByCustomer
     , ByTime
+    , getEraSlotOfBlock
     )
 import Cardano.Wallet.Deposit.Read
     ( Address
@@ -65,19 +69,28 @@ import Cardano.Wallet.Deposit.Read
 import Cardano.Wallet.Network.Checkpoints.Policy
     ( defaultPolicy
     )
+import Cardano.Wallet.Read
+    ( applyEraFun
+    )
 import Control.Tracer
     ( Tracer
     , contramap
     )
 import Data.Bifunctor
     ( first
     )
+import Data.Foldable
+    ( Foldable (..)
+    )
 import Data.List.NonEmpty
     ( NonEmpty
     )
 import Data.Map.Strict
     ( Map
     )
+import Data.Ord
+    ( Down (..)
+    )
 import Data.Time
     ( UTCTime
     )
@@ -92,6 +105,8 @@ import qualified Data.Delta as Delta
     ( Replace (..)
     )
 import qualified Data.Delta.Update as Delta
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Store as Store
 
 {-----------------------------------------------------------------------------
@@ -113,8 +128,7 @@ data WalletBootEnv m = WalletBootEnv
 type WalletStore = Store.UpdateStore IO Wallet.DeltaWalletState
 
 -- | The full environment needed to run a wallet.
-data WalletEnv m
-    = WalletEnv
+data WalletEnv m = WalletEnv
     { bootEnv :: WalletBootEnv m
     -- ^ The boot environment.
     , store :: WalletStore
@@ -269,11 +283,27 @@ getAllDeposits w i =
     Wallet.getAllDeposits i <$> readWalletState w
 
 rollForward
-    :: WalletInstance -> NonEmpty (Read.EraValue Read.Block) -> tip -> IO ()
-rollForward w blocks _nodeTip =
+    :: WalletInstance
+    -> NonEmpty (Read.EraValue Read.Block)
+    -> tip
+    -> IO ()
+rollForward w blocks _nodeTip = do
+    let blockSlots =
+            Set.fromList
+                $ applyEraFun getEraSlotOfBlock
+                    <$> toList blocks
+    resolveSlot <-
+        fmap (flip Map.lookup)
+            $ flip slotsToUTCTimes blockSlots
+            $ networkEnv
+            $ bootEnv
+            $ env w
     onWalletState w
         $ Delta.update
-        $ Delta.Replace . Wallet.rollForwardMany blocks
+        $ Delta.Replace
+            . Wallet.rollForwardMany
+                (fmap Down <$> resolveSlot)
+                blocks
 
 rollBackward
     :: WalletInstance -> Read.ChainPoint -> IO Read.ChainPoint

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs

@@ -80,10 +80,16 @@ import Cardano.Wallet.Deposit.Pure.API.TxHistory
     ( ByCustomer
     , ByTime
     , DownTime
+    , ResolveSlot
     , TxHistory (..)
     )
+import Cardano.Wallet.Deposit.Pure.UTxO.Tx
+    ( resolveInputs
+    , valueTransferFromResolvedTx
+    )
 import Cardano.Wallet.Deposit.Pure.UTxO.UTxOHistory
     ( UTxOHistory
+    , getUTxO
     )
 import Cardano.Wallet.Deposit.Pure.UTxO.ValueTransfer
     ( ValueTransfer (..)
@@ -120,6 +126,7 @@ import Data.Word.Odd
     )
 
 import qualified Cardano.Wallet.Deposit.Pure.Address as Address
+import qualified Cardano.Wallet.Deposit.Pure.API.TxHistory as TxHistory
 import qualified Cardano.Wallet.Deposit.Pure.Balance as Balance
 import qualified Cardano.Wallet.Deposit.Pure.RollbackWindow as Rollback
 import qualified Cardano.Wallet.Deposit.Pure.Submissions as Sbm
@@ -230,16 +237,32 @@ getWalletTip :: WalletState -> Read.ChainPoint
 getWalletTip = walletTip
 
 rollForwardMany
-    :: NonEmpty (Read.EraValue Read.Block) -> WalletState -> WalletState
-rollForwardMany blocks w = foldl' (flip rollForwardOne) w blocks
+    :: ResolveSlot
+    -> NonEmpty (Read.EraValue Read.Block)
+    -> WalletState
+    -> WalletState
+rollForwardMany resolveSlot blocks w =
+    foldl' (flip $ rollForwardOne resolveSlot) w blocks
 
 rollForwardOne
-    :: Read.EraValue Read.Block -> WalletState -> WalletState
-rollForwardOne (Read.EraValue block) w =
+    :: ResolveSlot
+    -> Read.EraValue Read.Block
+    -> WalletState
+    -> WalletState
+rollForwardOne resolveSlot eblock@(Read.EraValue block) w =
     w
         { walletTip = Read.getChainPoint block
         , utxoHistory = rollForwardUTxO isOurs block (utxoHistory w)
         , submissions = Delta.apply (Sbm.rollForward block) (submissions w)
+        , txHistory =
+            TxHistory.rollForward
+                ( valueTransferFromResolvedTx . resolveInputs
+                    (getUTxO $ utxoHistory w)
+                )
+                (`addressToCustomer` w)
+                resolveSlot
+                eblock
+                (txHistory w)
         }
   where
     isOurs :: Address -> Bool
@@ -282,8 +305,8 @@ rollBackward targetPoint w =
     -- any other point than the target point (or genesis).
     actualPoint =
         if (targetSlot `Rollback.member` UTxOHistory.getRollbackWindow h)
-            -- FIXME: Add test for rollback window of `submissions`
-            then targetPoint
+            then -- FIXME: Add test for rollback window of `submissions`
+                targetPoint
             else Read.GenesisPoint
 
 availableBalance :: WalletState -> Read.Value