Skip to content

Commit

Permalink
Include TxHistory roll forward in deposit wallet state roll forward
Browse files Browse the repository at this point in the history
  • Loading branch information
paolino committed Nov 1, 2024
1 parent e9ad52d commit 3eea066
Show file tree
Hide file tree
Showing 2 changed files with 64 additions and 11 deletions.
40 changes: 35 additions & 5 deletions lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
)
Expand All @@ -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

{-----------------------------------------------------------------------------
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
35 changes: 29 additions & 6 deletions lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 3eea066

Please sign in to comment.