From 3d903f005a07d7a2afc475ad315ec3036cd9c341 Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Tue, 17 Sep 2024 16:19:45 +0200 Subject: [PATCH] Add tests for `rollForward` and `rollBackward` --- .../customer-deposit-wallet.cabal | 2 + .../src/Cardano/Wallet/Deposit/Pure.hs | 3 + .../src/Cardano/Wallet/Deposit/Read.hs | 1 + .../unit/Cardano/Wallet/Deposit/PureSpec.hs | 152 ++++++++++++++++++ 4 files changed, 158 insertions(+) create mode 100644 lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/PureSpec.hs diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal index 1286d7d1c15..e5a6f866649 100644 --- a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal +++ b/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 diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs index 71f1dd7b9f3..7d73b25d976 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs +++ b/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 diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs index 2b0f18a8943..3acf6c08953 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs +++ b/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 diff --git a/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/PureSpec.hs b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/PureSpec.hs new file mode 100644 index 00000000000..1630495174b --- /dev/null +++ b/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