Add tests for rollForward and rollBackward

lib/customer-deposit-wallet/customer-deposit-wallet.cabal

@@ -182,6 +182,7 @@ test-suite unit
     , cardano-crypto
     , cardano-wallet-read
     , cardano-wallet-test-utils
+    , containers
     , contra-tracer
     , customer-deposit-wallet
     , customer-deposit-wallet:http
@@ -198,6 +199,7 @@ test-suite unit
   other-modules:
     Cardano.Wallet.Deposit.HTTP.JSON.JSONSpec
     Cardano.Wallet.Deposit.HTTP.OpenAPISpec
+    Cardano.Wallet.Deposit.PureSpec
     Cardano.Wallet.Deposit.RESTSpec
     Paths_customer_deposit_wallet
     Spec

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

@@ -42,6 +42,9 @@ module Cardano.Wallet.Deposit.Pure
 
     , addTxSubmission
     , listTxsInSubmission
+
+    -- * Internal, for testing
+    , availableUTxO
     ) where
 
 import Prelude

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

@@ -25,6 +25,7 @@ module Cardano.Wallet.Deposit.Read
     , Read.TxOut
     , address
     , Read.Value
+    , Read.lessOrEqual
     , UTxO
 
     , Read.TxId

lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/PureSpec.hs

@@ -0,0 +1,152 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-|
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+Property tests for the deposit wallet.
+-}
+module Cardano.Wallet.Deposit.PureSpec
+    ( spec
+    ) where
+
+import Prelude
+
+import Cardano.Crypto.Wallet
+    ( XPub
+    , generate
+    , toXPub
+    )
+import Test.Hspec
+    ( Spec
+    , describe
+    , it
+    )
+import Test.QuickCheck
+    ( Property
+    , (.&&.)
+    , (=/=)
+    , (===)
+    )
+
+import qualified Cardano.Wallet.Deposit.Pure as Wallet
+import qualified Cardano.Wallet.Deposit.Pure.UTxO as UTxO
+import qualified Cardano.Wallet.Deposit.Read as Read
+import qualified Cardano.Wallet.Deposit.Write as Write
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+spec :: Spec
+spec = do
+    describe "UTxO availableBalance" $ do
+        it "rollForward twice"
+            prop_availableBalance_rollForward_twice
+        it "rollBackward . rollForward"
+            prop_availableBalance_rollForward_rollBackward
+
+{-----------------------------------------------------------------------------
+    Properties
+------------------------------------------------------------------------------}
+prop_availableBalance_rollForward_twice :: Property
+prop_availableBalance_rollForward_twice =
+    Wallet.availableBalance w2 === Write.mkAda 3
+  where
+    w0 = emptyWalletWith17Addresses
+    Just addr1 = Wallet.customerAddress 1 w0
+    Just addr2 = Wallet.customerAddress 2 w0
+
+    tx1 = payFromFaucet [(addr1, Write.mkAda 1)]
+    block1 = Read.mockNextBlock Read.GenesisPoint [tx1]
+    chainPoint1 = Read.getChainPoint block1
+    w1 = Wallet.rollForwardOne block1 w0
+
+    tx2 = payFromFaucet [(addr2, Write.mkAda 2)]
+    block2 = Read.mockNextBlock chainPoint1 [tx2]
+    w2 = Wallet.rollForwardOne block2 w1
+
+prop_availableBalance_rollForward_rollBackward :: Property
+prop_availableBalance_rollForward_rollBackward =
+        Wallet.availableBalance (fst $ Wallet.rollBackward chainPoint0 w3)
+            === Wallet.availableBalance w0
+    .&&.
+        Wallet.availableBalance (fst $ Wallet.rollBackward chainPoint1 w3)
+            === Wallet.availableBalance w1
+    .&&.
+        Wallet.availableBalance (fst $ Wallet.rollBackward chainPoint2 w3)
+            === Wallet.availableBalance w2
+    .&&.
+        Wallet.availableBalance w3
+            =/= Wallet.availableBalance w2
+    .&&.
+        Wallet.availableBalance w3
+            `Read.lessOrEqual` Wallet.availableBalance w2
+  where
+    w0 = emptyWalletWith17Addresses
+    Just addr1 = Wallet.customerAddress 1 w0
+    Just addr2 = Wallet.customerAddress 2 w0
+    chainPoint0 = Read.GenesisPoint
+
+    tx1 = payFromFaucet [(addr1, Write.mkAda 1)]
+    block1 = Read.mockNextBlock chainPoint0 [tx1]
+    w1 = Wallet.rollForwardOne block1 w0
+    chainPoint1 = Read.getChainPoint block1
+
+    tx2 = payFromFaucet [(addr2, Write.mkAda 2)]
+    block2 = Read.mockNextBlock chainPoint1 [tx2]
+    chainPoint2 = Read.getChainPoint block2
+    w2 = Wallet.rollForwardOne block2 w1
+
+    tx3 = spendOneTxOut (Wallet.availableUTxO w2)
+    block3 = Read.mockNextBlock chainPoint2 [tx3]
+    w3 = Wallet.rollForwardOne block3 w2
+
+emptyWalletWith17Addresses :: Wallet.WalletState
+emptyWalletWith17Addresses =
+    Wallet.fromXPubAndGenesis testXPub 17 testGenesis
+
+testXPub :: XPub
+testXPub =
+    toXPub
+    $ generate (B8.pack "random seed for a testing xpub lala") B8.empty
+
+{-----------------------------------------------------------------------------
+    Test blockchain
+------------------------------------------------------------------------------}
+
+testGenesis :: Read.GenesisData
+testGenesis = undefined
+
+spendOneTxOut :: UTxO.UTxO -> Read.Tx
+spendOneTxOut utxo =
+    Write.toConwayTx txid tx
+  where
+    txBody = Write.TxBody
+        { Write.spendInputs = Set.singleton . fst . head $ Map.toList utxo
+        , Write.collInputs = mempty
+        , Write.txouts = Map.empty
+        , Write.collRet = Nothing
+        }
+    tx = Write.Tx
+        { Write.txbody = txBody
+        , Write.txwits = ()
+        }
+    txid = Write.mockTxId txBody
+
+payFromFaucet :: [(Write.Address, Write.Value)] -> Read.Tx
+payFromFaucet destinations =
+    Write.toConwayTx txid tx
+  where
+    toTxOut (addr, value) = Write.mkTxOut addr value
+    txBody = Write.TxBody
+        { Write.spendInputs = mempty
+        , Write.collInputs = mempty
+        , Write.txouts =
+            Map.fromList $ zip [toEnum 0..] $ map toTxOut destinations
+        , Write.collRet = Nothing
+        }
+    tx = Write.Tx
+        { Write.txbody = txBody
+        , Write.txwits = ()
+        }
+    txid = Write.mockTxId txBody