From e603e692e2aec60cb331ccb1e63f9aa937bd051d Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Thu, 3 Dec 2020 15:52:30 +0100 Subject: [PATCH 1/8] Add integration test for ADP-500, which ought to fail now --- .../src/Test/Integration/Framework/DSL.hs | 12 +++ .../Scenario/API/Shelley/Addresses.hs | 84 +++++++++++++++++++ .../test/unit/Cardano/Wallet/DB/SqliteSpec.hs | 2 +- .../AddressDiscovery/SequentialSpec.hs | 10 ++- 4 files changed, 104 insertions(+), 4 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 0ac8dbfbe01..26f841a3e6f 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -93,6 +93,7 @@ module Test.Integration.Framework.DSL , quitStakePoolUnsigned , selectCoins , listAddresses + , getWallet , listTransactions , listAllTransactions , deleteAllWallets @@ -1673,6 +1674,17 @@ listAddresses ctx w = do (_, addrs) <- unsafeRequest @[ApiAddress n] ctx link Empty return addrs +getWallet + :: forall m. (MonadIO m, MonadCatch m) + => Context + -> ApiWallet + -> m ApiWallet +getWallet ctx w = do + let link = Link.getWallet @'Shelley w + (_, wallet) <- unsafeRequest @ApiWallet ctx + link Empty + return wallet + listAllTransactions :: forall n w m. ( DecodeAddress n diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs index 16db1545fb1..732d0050e5c 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE QuasiQuotes #-} @@ -32,6 +33,8 @@ import Cardano.Wallet.Primitive.Types.Address ( AddressState (..) ) import Control.Monad ( forM, forM_ ) +import Control.Monad.IO.Class + ( liftIO ) import Control.Monad.Trans.Resource ( runResourceT ) import Data.Aeson @@ -61,6 +64,7 @@ import Test.Integration.Framework.DSL , expectResponseCode , fixtureWallet , getFromResponse + , getWallet , json , listAddresses , minUTxOValue @@ -77,6 +81,7 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Lens as Aeson import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP +import qualified Test.Hspec as Hspec import qualified Test.Hspec.Expectations.Lifted as Expectations spec :: forall n. @@ -253,6 +258,85 @@ spec = describe "SHELLEY_ADDRESSES" $ do (`shouldNotSatisfy` T.isPrefixOf "addr_test") ] + Hspec.it "ADDRESS_LIST_06 - Used change addresses are listed after a transaction is no longer pending" $ \ctx -> runResourceT @IO $ do + let initPoolGap = 10 + toDestVal = 10 * minUTxOValue + backToSrcVal = fmap (1 * minUTxOValue +) + + let verifyAddrs i p addr = do + liftIO (length (filter ((== Used) . (^. (#state . #getApiT))) addr) + `shouldBe` p) + liftIO (length addr `shouldBe` i) + + -- 1. create shelley wallet + wSrc <- fixtureWallet ctx + wDest <- emptyWalletWith ctx ("Wallet", "cardano-wallet", initPoolGap) + + -- 2. list addresses of that wallet (for later comparison) + listAddresses @n ctx wSrc >>= verifyAddrs 30 10 + + -- 3. send a transaction from that wallet + addrs <- listAddresses @n ctx wDest + verifyAddrs 10 0 addrs + let destination = (head addrs) ^. #id + let payload = Json [json|{ + "payments": [{ + "address": #{destination}, + "amount": { + "quantity": #{toDestVal}, + "unit": "lovelace" + } + }], + "passphrase": "cardano-wallet" + }|] + + request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wSrc) Default payload + >>= flip verify + [ expectResponseCode HTTP.status202 ] + + -- 4. wait for transaction to be inserted + eventually "Wallet balance = minUTxOValue" $ do + rb <- request @ApiWallet ctx + (Link.getWallet @'Shelley wDest) Default Empty + expectField + (#balance . #getApiT . #available) + (`shouldBe` Quantity toDestVal) + rb + + -- 5. Check that change address is still there as unused + -- and the gap moved. + listAddresses @n ctx wSrc >>= verifyAddrs 31 11 + + -- 6. send another transaction from the destination wallet + listAddresses @n ctx wDest >>= verifyAddrs 11 1 + addrs' <- listAddresses @n ctx wSrc + let destination' = (addrs' !! 5) ^. #id + let payload' = Json [json|{ + "payments": [{ + "address": #{destination'}, + "amount": { + "quantity": #{minUTxOValue}, + "unit": "lovelace" + } + }], + "passphrase": "cardano-wallet" + }|] + currentSrcWallet <- getWallet ctx wSrc + let currentSrcWalletBalance = currentSrcWallet ^. (#balance . #getApiT . #available) + request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wDest) Default payload' + >>= flip verify + [ expectResponseCode HTTP.status202 ] + eventually "Wallet balance = minUTxOValue + current" $ do + rb <- request @ApiWallet ctx + (Link.getWallet @'Shelley wSrc) Default Empty + expectField + (#balance . #getApiT . #available) + (`shouldBe` backToSrcVal currentSrcWalletBalance) + rb + listAddresses @n ctx wDest >>= verifyAddrs 12 2 + it "ADDRESS_INSPECT_01 - Address inspect OK" $ \ctx -> do let str = "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" r <- request @Aeson.Value ctx (Link.inspectAddress str) Default Empty diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs index 169798f2d24..ad022383a4c 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs @@ -386,7 +386,7 @@ testMigrationRole dbName = do readCheckpoint wid let migrationMsg = filter isMsgManualMigration logs length migrationMsg `shouldBe` 3 - length (knownAddresses $ getState cp) `shouldBe` 69 + length (knownAddresses $ getState cp) `shouldBe` 71 where isMsgManualMigration :: DBLog -> Bool isMsgManualMigration = \case diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs index 9133df92672..90521a05ffa 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs @@ -481,7 +481,7 @@ prop_changeIsOnlyKnownAfterGeneration (intPool, extPool) = sPool = newVerificationKeyPool (accountPubKey extPool) (gap extPool) s0 :: SeqState 'Mainnet ShelleyKey s0 = SeqState intPool extPool emptyPendingIxs rewardAccount defaultPrefix sPool - addrs0 = fst <$> knownAddresses s0 + addrs0 = knownAddresses s0 (change, s1) = genChange (\k _ -> paymentAddress @'Mainnet k) s0 addrs1 = fst <$> knownAddresses s1 in conjoin @@ -490,9 +490,13 @@ prop_changeIsOnlyKnownAfterGeneration (intPool, extPool) = ] where prop_addrsNotInInternalPool addrs = - map (\x -> (ShowFmt x, isNothing $ fst $ lookupAddress id x intPool)) addrs + map (\(x, s) -> + let notInPool = isNothing $ fst $ lookupAddress id x intPool + isUsed = s == Used + in (ShowFmt x, notInPool || isUsed)) + addrs === - map (\x -> (ShowFmt x, True)) addrs + map (\(x, _) -> (ShowFmt x, True)) addrs prop_changeAddressIsKnown addr addrs = counterexample (show (ShowFmt addr) <> " not in " <> show (ShowFmt <$> addrs)) From 55cab26ebbc3acb39f21c735bab9d44191b936e6 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 8 Dec 2020 16:05:18 +0100 Subject: [PATCH 2/8] Always show all change addresses in `knownAddresses` --- .../Primitive/AddressDiscovery/Sequential.hs | 26 ++++++++++++++----- 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index 2851fa8081d..158a623489e 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs @@ -950,15 +950,29 @@ instance pendingChangeIxs s internalGap = fromEnum . getAddressPoolGap . gap . internalPool $ s - discardUndiscoveredChange xs = - take (length ixs) $ drop (length xs - internalGap) xs - changeAddresses = - discardUndiscoveredChange $ - addresses (liftPaymentAddress @n @k) (internalPool s) + + changeAddresses = addresses (liftPaymentAddress @n @k) (internalPool s) + -- pick as many unused change addresses as there are pending + -- transactions + changeAddressesForPending = + -- the last `gap` addresses are all unused + let availUnusedChangeAddresses = drop (length changeAddresses - internalGap) + changeAddresses + in take (length ixs) + availUnusedChangeAddresses + usedChangeAddresses = filter ((== Used) . snd) changeAddresses + nonChangeAddresses = addresses (liftPaymentAddress @n @k) (externalPool s) + + -- Instead of only showing as many unused change addresses as there + -- are pending transactions (as previously), we also show all used ones. + -- Also see https://jira.iohk.io/browse/ADP-500 + visibleChangeAddresses = usedChangeAddresses <> changeAddressesForPending + + visibleNonChangeAddresses = nonChangeAddresses in - nonChangeAddresses <> changeAddresses + visibleNonChangeAddresses <> visibleChangeAddresses -------------------------------------------------------------------------------- -- From f4fa6248fa95bc240b6384e60201aa5f70f8872c Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 31 Dec 2020 10:49:52 +0100 Subject: [PATCH 3/8] slightly rewrite 'knownAddresses' for Sequential states I removed some intermediate local declaration which created more noise than readability. Also renamed some (e.g. 'edgeChangeAddresses') to be more consistent with the rest of the module. --- .../Primitive/AddressDiscovery/Sequential.hs | 46 +++++++++---------- 1 file changed, 22 insertions(+), 24 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index 158a623489e..870d2626e1c 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs @@ -945,34 +945,32 @@ instance ( PaymentAddress n k ) => KnownAddresses (SeqState n k) where knownAddresses s = - let - (PendingIxs ixs) = - pendingChangeIxs s - internalGap = - fromEnum . getAddressPoolGap . gap . internalPool $ s - - changeAddresses = addresses (liftPaymentAddress @n @k) (internalPool s) - -- pick as many unused change addresses as there are pending - -- transactions - changeAddressesForPending = - -- the last `gap` addresses are all unused - let availUnusedChangeAddresses = drop (length changeAddresses - internalGap) - changeAddresses - in take (length ixs) - availUnusedChangeAddresses - usedChangeAddresses = filter ((== Used) . snd) changeAddresses - + nonChangeAddresses <> usedChangeAddresses <> pendingChangeAddresses + where nonChangeAddresses = addresses (liftPaymentAddress @n @k) (externalPool s) - -- Instead of only showing as many unused change addresses as there - -- are pending transactions (as previously), we also show all used ones. - -- Also see https://jira.iohk.io/browse/ADP-500 - visibleChangeAddresses = usedChangeAddresses <> changeAddressesForPending + changeAddresses = + addresses (liftPaymentAddress @n @k) (internalPool s) - visibleNonChangeAddresses = nonChangeAddresses - in - visibleNonChangeAddresses <> visibleChangeAddresses + usedChangeAddresses = + filter ((== Used) . snd) changeAddresses + + -- pick as many unused change addresses as there are pending + -- transactions. Note: the last `internalGap` addresses are all + -- unused. + pendingChangeAddresses = + let + (PendingIxs ixs) = + pendingChangeIxs s + + internalGap = + fromEnum . getAddressPoolGap . gap . internalPool $ s + + edgeChangeAddresses = + drop (length changeAddresses - internalGap) changeAddresses + in + take (length ixs) edgeChangeAddresses -------------------------------------------------------------------------------- -- From aa9121c052210ad50c4aff08ca5aced74f52976c Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 31 Dec 2020 11:11:09 +0100 Subject: [PATCH 4/8] fix and slightly generalize 'createWallet' in the integration DSL 'MonadCatch' is no longer after the unlift-io integration. --- .../src/Test/Integration/Framework/DSL.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 26f841a3e6f..52d0df16b6d 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -1675,14 +1675,17 @@ listAddresses ctx w = do return addrs getWallet - :: forall m. (MonadIO m, MonadCatch m) + :: forall w m. + ( MonadIO m + , MonadUnliftIO m + , HasType (ApiT WalletId) w + ) => Context - -> ApiWallet + -> w -> m ApiWallet getWallet ctx w = do let link = Link.getWallet @'Shelley w - (_, wallet) <- unsafeRequest @ApiWallet ctx - link Empty + (_, wallet) <- unsafeRequest @ApiWallet ctx link Empty return wallet listAllTransactions From 9012186f3fcc1aecf477fee3b6a0e223c9964109 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 31 Dec 2020 11:18:06 +0100 Subject: [PATCH 5/8] rewrite 'ADDRESS_LIST_06' to make it easier to follow It was confusing to define 2 wallets as 'src' and 'dest' when there are transactions made from both and to both. Also, several 'magic' numbers which did not really capture the 'why' behind the assertion: 'assert (a == 11)' is far less descriptive than 'assert (a == originalValue + 1)'. Also, there's no need to assert balances of each wallets, it's not the point of the test and is just a pain to maintain when we change something with regards to fees in the test cluster. All we really care about in these tests is that the transaction is at some point inserted and that, as a result there's one extra change address. --- .../Scenario/API/Shelley/Addresses.hs | 149 +++++++++--------- 1 file changed, 73 insertions(+), 76 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs index 732d0050e5c..1acb25765bc 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs @@ -17,6 +17,7 @@ import Prelude import Cardano.Wallet.Api.Types ( AnyAddress , ApiAddress + , ApiT (..) , ApiTransaction , ApiVerificationKey , ApiWallet @@ -31,6 +32,8 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( defaultAddressPoolGap, getAddressPoolGap ) import Cardano.Wallet.Primitive.Types.Address ( AddressState (..) ) +import Cardano.Wallet.Primitive.Types.Tx + ( TxStatus (..) ) import Control.Monad ( forM, forM_ ) import Control.Monad.IO.Class @@ -40,7 +43,7 @@ import Control.Monad.Trans.Resource import Data.Aeson ( ToJSON (..), object, (.=) ) import Data.Generics.Internal.VL.Lens - ( (^.) ) + ( view, (^.) ) import Data.Quantity ( Quantity (..) ) import Data.Text @@ -62,9 +65,9 @@ import Test.Integration.Framework.DSL , expectListField , expectListSize , expectResponseCode + , fixturePassphrase , fixtureWallet , getFromResponse - , getWallet , json , listAddresses , minUTxOValue @@ -81,7 +84,6 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Lens as Aeson import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP -import qualified Test.Hspec as Hspec import qualified Test.Hspec.Expectations.Lifted as Expectations spec :: forall n. @@ -110,7 +112,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do it "ADDRESS_LIST_01 - Can list addresses with non-default pool gap" $ \ctx -> runResourceT $ do let g = 15 - w <- emptyWalletWith ctx ("Wallet", "cardano-wallet", g) + w <- emptyWalletWith ctx ("Wallet", fixturePassphrase, g) r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley w) Default Empty expectResponseCode HTTP.status200 r @@ -182,7 +184,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do it "ADDRESS_LIST_03 - Generates new address pool gap" $ \ctx -> runResourceT $ do let initPoolGap = 10 wSrc <- fixtureWallet ctx - wDest <- emptyWalletWith ctx ("Wallet", "cardano-wallet", initPoolGap) + wDest <- emptyWalletWith ctx ("Wallet", fixturePassphrase, initPoolGap) -- make sure all addresses in address_pool_gap are 'Unused' r <- request @[ApiAddress n] ctx @@ -206,7 +208,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do "unit": "lovelace" } }], - "passphrase": "cardano-wallet" + "passphrase": #{fixturePassphrase} }|] rTrans <- request @(ApiTransaction n) ctx @@ -258,84 +260,79 @@ spec = describe "SHELLEY_ADDRESSES" $ do (`shouldNotSatisfy` T.isPrefixOf "addr_test") ] - Hspec.it "ADDRESS_LIST_06 - Used change addresses are listed after a transaction is no longer pending" $ \ctx -> runResourceT @IO $ do - let initPoolGap = 10 - toDestVal = 10 * minUTxOValue - backToSrcVal = fmap (1 * minUTxOValue +) - - let verifyAddrs i p addr = do - liftIO (length (filter ((== Used) . (^. (#state . #getApiT))) addr) - `shouldBe` p) - liftIO (length addr `shouldBe` i) - - -- 1. create shelley wallet - wSrc <- fixtureWallet ctx - wDest <- emptyWalletWith ctx ("Wallet", "cardano-wallet", initPoolGap) - - -- 2. list addresses of that wallet (for later comparison) - listAddresses @n ctx wSrc >>= verifyAddrs 30 10 - - -- 3. send a transaction from that wallet - addrs <- listAddresses @n ctx wDest - verifyAddrs 10 0 addrs - let destination = (head addrs) ^. #id + it "ADDRESS_LIST_06 - Used change addresses are listed after a transaction is no longer pending" $ \ctx -> runResourceT @IO $ do + let verifyAddrs nTotal nUsed addrs = do + liftIO (length addrs `shouldBe` nTotal) + let onlyUsed = filter ((== Used) . (^. (#state . #getApiT))) addrs + liftIO (length onlyUsed `shouldBe` nUsed) + + -- 1. Create Shelley wallets + let initialTotalA = 30 + let initialUsedA = 10 + wA <- fixtureWallet ctx + listAddresses @n ctx wA + >>= verifyAddrs initialTotalA initialUsedA + + let initialTotalB = 20 + let initialUsedB = 0 + wB <- emptyWallet ctx + listAddresses @n ctx wB + >>= verifyAddrs initialTotalB initialUsedB + + -- 2. Send a transaction from A -> B + destination <- view #id . head <$> listAddresses @n ctx wB + let amount = 10 * minUTxOValue let payload = Json [json|{ "payments": [{ "address": #{destination}, "amount": { - "quantity": #{toDestVal}, - "unit": "lovelace" - } - }], - "passphrase": "cardano-wallet" - }|] - - request @(ApiTransaction n) ctx - (Link.createTransaction @'Shelley wSrc) Default payload - >>= flip verify - [ expectResponseCode HTTP.status202 ] - - -- 4. wait for transaction to be inserted - eventually "Wallet balance = minUTxOValue" $ do - rb <- request @ApiWallet ctx - (Link.getWallet @'Shelley wDest) Default Empty - expectField - (#balance . #getApiT . #available) - (`shouldBe` Quantity toDestVal) - rb - - -- 5. Check that change address is still there as unused - -- and the gap moved. - listAddresses @n ctx wSrc >>= verifyAddrs 31 11 - - -- 6. send another transaction from the destination wallet - listAddresses @n ctx wDest >>= verifyAddrs 11 1 - addrs' <- listAddresses @n ctx wSrc - let destination' = (addrs' !! 5) ^. #id - let payload' = Json [json|{ - "payments": [{ - "address": #{destination'}, - "amount": { - "quantity": #{minUTxOValue}, + "quantity": #{amount}, "unit": "lovelace" } }], - "passphrase": "cardano-wallet" + "passphrase": #{fixturePassphrase} }|] - currentSrcWallet <- getWallet ctx wSrc - let currentSrcWalletBalance = currentSrcWallet ^. (#balance . #getApiT . #available) - request @(ApiTransaction n) ctx - (Link.createTransaction @'Shelley wDest) Default payload' - >>= flip verify - [ expectResponseCode HTTP.status202 ] - eventually "Wallet balance = minUTxOValue + current" $ do - rb <- request @ApiWallet ctx - (Link.getWallet @'Shelley wSrc) Default Empty - expectField - (#balance . #getApiT . #available) - (`shouldBe` backToSrcVal currentSrcWalletBalance) - rb - listAddresses @n ctx wDest >>= verifyAddrs 12 2 + (_, rtx) <- unsafeRequest @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wA) payload + + -- 3. Check that there's one more used addresses on A. + -- + -- Ideally, we would also like to check that there's no used address on + -- B yet, but this would make the test quite flaky. Indeed, the integration + -- tests produces block very fast and by the time we make this call the + -- transaction may have already been inserted in the ledger and + -- discovered by B. + -- + -- Similarly, we can't assert the length of used addresses on A. It + -- _should_ be 'initialUsedA` but the transaction could have already + -- been inserted and discovered by the time the 'listAddresses' call + -- resolves. + listAddresses @n ctx wA + >>= \addrs -> liftIO $ length addrs `shouldBe` (initialTotalA + 1) + + -- 4. Wait for transaction from A -> B to no longer be pending + eventually "Transaction from A -> B is discovered on B" $ do + request @(ApiTransaction n) ctx + (Link.getTransaction @'Shelley wA rtx) Default Empty + >>= expectField #status (`shouldBe` ApiT InLedger) + request @(ApiTransaction n) ctx + (Link.getTransaction @'Shelley wB rtx) Default Empty + >>= expectField #status (`shouldBe` ApiT InLedger) + + -- 5. Check that there's one more used and total addresses on the wallets + -- A and B. + -- + -- On A: The address comes from the internal pool gap and was hidden up + -- until the transaction is created and remains after it is + -- inserted. + -- + -- On B: There's a new total address because the address used was the + -- first unused address from the consecutive sequence of the address + -- pool. Thus the address window was shifted be exactly one. + listAddresses @n ctx wA + >>= verifyAddrs (initialTotalA + 1) (initialUsedA + 1) + listAddresses @n ctx wB + >>= verifyAddrs (initialTotalB + 1) (initialUsedB + 1) it "ADDRESS_INSPECT_01 - Address inspect OK" $ \ctx -> do let str = "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" From 2605a9f1071aad41bca21d8ef98210c117f7cfb9 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Fri, 18 Dec 2020 09:13:39 +0100 Subject: [PATCH 6/8] Additional checks for inputs in incoming and outgoing transactions in integration tests --- .../Scenario/API/Shelley/Transactions.hs | 91 +++++++++++++++++-- 1 file changed, 85 insertions(+), 6 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index 808d9c7bf77..df3e9e6a76d 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -27,6 +27,7 @@ import Cardano.Wallet.Api.Types , ApiT (..) , ApiTransaction , ApiTxId (..) + , ApiTxInput (..) , ApiWallet , DecodeAddress , DecodeStakeAddress @@ -66,7 +67,7 @@ import Data.Generics.Internal.VL.Lens import Data.Generics.Product.Typed ( HasType ) import Data.Maybe - ( fromJust, fromMaybe, isJust ) + ( fromJust, fromMaybe, isJust, isNothing ) import Data.Quantity ( Quantity (..) ) import Data.Text @@ -292,7 +293,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do insertedAt tx' `shouldBe` Nothing pendingSince tx' `shouldBe` pendingSince tx - it "TRANS_CREATE_01 - Single Output Transaction" $ \ctx -> runResourceT $ do + it "TRANS_CREATE_01x - Single Output Transaction" $ \ctx -> runResourceT $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx let amt = (minUTxOValue :: Natural) @@ -303,17 +304,55 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wa) Default payload - verify r [ expectSuccess , expectResponseCode HTTP.status202 , expectField (#amount . #getQuantity) $ between (feeMin + amt, feeMax + amt) + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` Pending) , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) ] + let txid = getFromResponse #id r + let linkSrc = Link.getTransaction @'Shelley wa (ApiTxId txid) + let linkDest = Link.getTransaction @'Shelley wb (ApiTxId txid) + eventually "transaction is no longer pending and is OK on both wallets" $ do + rSrc <- request @(ApiTransaction n) ctx linkSrc Default Empty + verify rSrc + [ expectSuccess + , expectResponseCode HTTP.status200 + , expectField (#amount . #getQuantity) $ + between (feeMin + amt, feeMax + amt) + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) + , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + , expectField (#status . #getApiT) (`shouldBe` InLedger) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + ] + + rDst <- request @(ApiTransaction n) ctx linkDest Default Empty + verify rDst + [ expectSuccess + , expectResponseCode HTTP.status200 + , expectField (#amount . #getQuantity) $ + (`shouldBe` amt) + -- all tx inputs have NO address and amount + -- as the tx is incoming + , expectField #inputs $ \inputs' -> do + let addrAmt2 = (fmap source inputs') + addrAmt2 `shouldSatisfy` (all isNothing) + , expectField (#direction . #getApiT) (`shouldBe` Incoming) + , expectField (#status . #getApiT) (`shouldBe` InLedger) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + ] + ra <- request @ApiWallet ctx (Link.getWallet @'Shelley wa) Default Empty verify ra [ expectSuccess @@ -340,7 +379,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (#balance . #getApiT . #available) (`shouldBe` Quantity (faucetAmt - feeMax - amt)) ra2 - it "TRANS_CREATE_02 - Multiple Output Tx to single wallet" $ \ctx -> runResourceT $ do + it "TRANS_CREATE_02x - Multiple Output Tx to single wallet" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addrs <- listAddresses @n ctx wDest @@ -371,15 +410,55 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload - - ra <- request @ApiWallet ctx (Link.getWallet @'Shelley wSrc) Default Empty verify r [ expectResponseCode HTTP.status202 , expectField (#amount . #getQuantity) $ between (feeMin + (2*amt), feeMax + (2*amt)) + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` Pending) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) ] + + let txid = getFromResponse #id r + let linkSrc = Link.getTransaction @'Shelley wSrc (ApiTxId txid) + let linkDest = Link.getTransaction @'Shelley wDest (ApiTxId txid) + eventually "transaction is no longer pending and is OK on both wallets" $ do + rSrc <- request @(ApiTransaction n) ctx linkSrc Default Empty + verify rSrc + [ expectSuccess + , expectResponseCode HTTP.status200 + , expectField (#amount . #getQuantity) $ + between (feeMin + (2*amt), feeMax + (2*amt)) + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) + , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + , expectField (#status . #getApiT) (`shouldBe` InLedger) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + ] + + rDst <- request @(ApiTransaction n) ctx linkDest Default Empty + verify rDst + [ expectSuccess + , expectResponseCode HTTP.status200 + , expectField (#amount . #getQuantity) $ + (`shouldBe` (2 * amt) ) + -- all tx inputs have NO address and amount + -- as the tx is incoming + , expectField #inputs $ \inputs' -> do + let addrAmt2 = (fmap source inputs') + addrAmt2 `shouldSatisfy` (all isNothing) + , expectField (#direction . #getApiT) (`shouldBe` Incoming) + , expectField (#status . #getApiT) (`shouldBe` InLedger) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + ] + + ra <- request @ApiWallet ctx (Link.getWallet @'Shelley wSrc) Default Empty verify ra [ expectField (#balance . #getApiT . #total) $ between From 1247f9a75598a3b3f44d6b7631645868fac272a4 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Fri, 18 Dec 2020 13:52:07 +0100 Subject: [PATCH 7/8] Additional checks for inputs in join/quit pool transactions --- .../Scenario/API/Shelley/StakePools.hs | 70 ++++++++++++++++--- .../Scenario/API/Shelley/Transactions.hs | 6 +- 2 files changed, 63 insertions(+), 13 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs index e0a8d8e1299..3ade6114f2c 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs @@ -22,6 +22,8 @@ import Cardano.Wallet.Api.Types , ApiStakePoolFlag (..) , ApiT (..) , ApiTransaction + , ApiTxId (..) + , ApiTxInput (..) , ApiWallet , ApiWalletDelegationStatus (..) , DecodeAddress @@ -221,6 +223,8 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do , expectField (#status . #getApiT) (`shouldBe` Pending) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField #deposit (`shouldBe` Quantity 1000000) + , expectField #inputs $ \inputs' -> do + inputs' `shouldSatisfy` all (isJust . source) ] eventually "Wallet has joined pool and deposit info persists" $ do rJoin' <- request @(ApiTransaction n) ctx @@ -234,6 +238,21 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do , expectField #deposit (`shouldBe` Quantity 1000000) ] + let txId = getFromResponse #id rJoin + let link = Link.getTransaction @'Shelley src (ApiTxId txId) + eventually "delegation transaction is in ledger" $ do + rSrc <- request @(ApiTransaction n) ctx link Default Empty + verify rSrc + [ expectResponseCode HTTP.status200 + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) + , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + , expectField (#status . #getApiT) (`shouldBe` InLedger) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + ] + -- Earn rewards waitForNextEpoch ctx waitForNextEpoch ctx @@ -497,21 +516,32 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty - joinStakePool @n ctx pool1 (w, fixturePassphrase) >>= flip verify + rJoin <- joinStakePool @n ctx pool1 (w, fixturePassphrase) + verify rJoin [ expectResponseCode HTTP.status202 , expectField (#status . #getApiT) (`shouldBe` Pending) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) ] + let txId = getFromResponse #id rJoin + let link = Link.getTransaction @'Shelley w (ApiTxId txId) -- Wait for the certificate to be inserted eventually "Certificates are inserted" $ do - let ep = Link.listTransactions @'Shelley w - request @[ApiTransaction n] ctx ep Default Empty >>= flip verify - [ expectListField 0 - (#direction . #getApiT) (`shouldBe` Outgoing) - , expectListField 0 - (#status . #getApiT) (`shouldBe` InLedger) - ] + rSrc <- request @(ApiTransaction n) ctx link Default Empty + verify rSrc + [ expectResponseCode HTTP.status200 + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) + , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + , expectField (#status . #getApiT) (`shouldBe` InLedger) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + ] request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty >>= flip verify @@ -859,9 +889,31 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do [ expectField #delegation (`shouldBe` delegating pool []) ] - quitStakePool @n ctx (w, fixturePassphrase) >>= flip verify + rQuit <- quitStakePool @n ctx (w, fixturePassphrase) + verify rQuit [ expectResponseCode HTTP.status202 + , expectField (#status . #getApiT) (`shouldBe` Pending) + , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) ] + + let txId = getFromResponse #id rQuit + let link = Link.getTransaction @'Shelley w (ApiTxId txId) + eventually "delegation transaction is in ledger" $ do + rSrc <- request @(ApiTransaction n) ctx link Default Empty + verify rSrc + [ expectResponseCode HTTP.status200 + -- all tx inputs have address and amount + , expectField #inputs $ \inputs' -> do + let addrAmt = (fmap source inputs') + addrAmt `shouldSatisfy` (all isJust) + , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + , expectField (#status . #getApiT) (`shouldBe` InLedger) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + ] eventually "Wallet is not delegating and it got his deposit back" $ do request @ApiWallet ctx (Link.getWallet @'Shelley w) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index df3e9e6a76d..8b5bb2b6091 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -341,8 +341,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do verify rDst [ expectSuccess , expectResponseCode HTTP.status200 - , expectField (#amount . #getQuantity) $ - (`shouldBe` amt) + , expectField (#amount . #getQuantity) (`shouldBe` amt) -- all tx inputs have NO address and amount -- as the tx is incoming , expectField #inputs $ \inputs' -> do @@ -446,8 +445,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do verify rDst [ expectSuccess , expectResponseCode HTTP.status200 - , expectField (#amount . #getQuantity) $ - (`shouldBe` (2 * amt) ) + , expectField (#amount . #getQuantity) (`shouldBe` (2 * amt)) -- all tx inputs have NO address and amount -- as the tx is incoming , expectField #inputs $ \inputs' -> do From bd2916b0423811b85328edb60ae427f2e4b4dee4 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 31 Dec 2020 14:52:22 +0100 Subject: [PATCH 8/8] remove redundant cases & fix fixture wallet sharing common funding UTxOs It's a bit fucked up. Since the scenario is using fixtureWallet, the UtxO from the wallet comes from one of the fixture transaction made when initializing the cluster. There are many pre-funded fixture wallets with 10 UTxO, but in order not to spend 10 days funding them all, the cluster generate pretty large transaction with ~100 outputs. So a single fixture transaction funds about 10 fixture wallets. Now it means that, a particular fixture wallet will know the value of all inputs of its funding fixture transaction and therefore, when picking two fixtureWallet one after the other, it may likely happen that both wallets are able to resolve inputs of any UTxO coming from their original fixture transaction. I fixed it by simply using fixtureWalletWith [...] which generates completly new and uncorrelated UTxOs. --- .../Scenario/API/Shelley/StakePools.hs | 51 +++----- .../Scenario/API/Shelley/Transactions.hs | 110 ++++++------------ 2 files changed, 51 insertions(+), 110 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs index 3ade6114f2c..ef495a3bff3 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs @@ -244,13 +244,11 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do rSrc <- request @(ApiTransaction n) ctx link Default Empty verify rSrc [ expectResponseCode HTTP.status200 - -- all tx inputs have address and amount - , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` InLedger) , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + , expectField #inputs $ \inputs' -> do + inputs' `shouldSatisfy` all (isJust . source) ] -- Earn rewards @@ -516,32 +514,21 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty - rJoin <- joinStakePool @n ctx pool1 (w, fixturePassphrase) - verify rJoin + joinStakePool @n ctx pool1 (w, fixturePassphrase) >>= flip verify [ expectResponseCode HTTP.status202 , expectField (#status . #getApiT) (`shouldBe` Pending) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) - -- all tx inputs have address and amount - , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) ] - let txId = getFromResponse #id rJoin - let link = Link.getTransaction @'Shelley w (ApiTxId txId) -- Wait for the certificate to be inserted eventually "Certificates are inserted" $ do - rSrc <- request @(ApiTransaction n) ctx link Default Empty - verify rSrc - [ expectResponseCode HTTP.status200 - -- all tx inputs have address and amount - , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) - , expectField (#direction . #getApiT) (`shouldBe` Outgoing) - , expectField (#status . #getApiT) (`shouldBe` InLedger) - , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) - ] + let ep = Link.listTransactions @'Shelley w + request @[ApiTransaction n] ctx ep Default Empty >>= flip verify + [ expectListField 0 + (#direction . #getApiT) (`shouldBe` Outgoing) + , expectListField 0 + (#status . #getApiT) (`shouldBe` InLedger) + ] request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty >>= flip verify @@ -894,28 +881,24 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do [ expectResponseCode HTTP.status202 , expectField (#status . #getApiT) (`shouldBe` Pending) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) - -- all tx inputs have address and amount , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) + inputs' `shouldSatisfy` all (isJust . source) ] let txId = getFromResponse #id rQuit let link = Link.getTransaction @'Shelley w (ApiTxId txId) - eventually "delegation transaction is in ledger" $ do + eventually "quit transaction is in ledger" $ do rSrc <- request @(ApiTransaction n) ctx link Default Empty verify rSrc [ expectResponseCode HTTP.status200 - -- all tx inputs have address and amount - , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) - , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + , expectField (#direction . #getApiT) (`shouldBe` Incoming) , expectField (#status . #getApiT) (`shouldBe` InLedger) , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + , expectField #inputs $ \inputs' -> do + inputs' `shouldSatisfy` all (isJust . source) ] - eventually "Wallet is not delegating and it got his deposit back" $ - do + + eventually "Wallet is not delegating and it got his deposit back" $ do request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty >>= flip verify [ expectField #delegation (`shouldBe` notDelegating []) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index 8b5bb2b6091..6e06a090624 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -294,89 +294,84 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do pendingSince tx' `shouldBe` pendingSince tx it "TRANS_CREATE_01x - Single Output Transaction" $ \ctx -> runResourceT $ do - (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx + let initialAmt = 2*minUTxOValue + wa <- fixtureWalletWith @n ctx [initialAmt] + wb <- fixtureWalletWith @n ctx [initialAmt] let amt = (minUTxOValue :: Natural) payload <- liftIO $ mkTxPayload ctx wb amt fixturePassphrase (_, ApiFee (Quantity feeMin) (Quantity feeMax) _) <- unsafeRequest ctx (Link.getTransactionFee @'Shelley wa) payload - - r <- request @(ApiTransaction n) ctx + rTx <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wa) Default payload - verify r + ra <- request @ApiWallet ctx + (Link.getWallet @'Shelley wa) Default Empty + + verify rTx [ expectSuccess , expectResponseCode HTTP.status202 , expectField (#amount . #getQuantity) $ between (feeMin + amt, feeMax + amt) - -- all tx inputs have address and amount , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) + inputs' `shouldSatisfy` all (isJust . source) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` Pending) , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) ] - let txid = getFromResponse #id r + verify ra + [ expectSuccess + , expectField (#balance . #getApiT . #total) $ + between + ( Quantity (initialAmt - feeMax - amt) + , Quantity (initialAmt - feeMin - amt) + ) + , expectField + (#balance . #getApiT . #available) + (`shouldBe` Quantity 0) + ] + + let txid = getFromResponse #id rTx let linkSrc = Link.getTransaction @'Shelley wa (ApiTxId txid) - let linkDest = Link.getTransaction @'Shelley wb (ApiTxId txid) - eventually "transaction is no longer pending and is OK on both wallets" $ do + eventually "transaction is no longer pending on source wallet" $ do rSrc <- request @(ApiTransaction n) ctx linkSrc Default Empty verify rSrc - [ expectSuccess - , expectResponseCode HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField (#amount . #getQuantity) $ between (feeMin + amt, feeMax + amt) - -- all tx inputs have address and amount , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) + inputs' `shouldSatisfy` all (isJust . source) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` InLedger) , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) ] + let linkDest = Link.getTransaction @'Shelley wb (ApiTxId txid) + eventually "transaction is discovered by destination wallet" $ do rDst <- request @(ApiTransaction n) ctx linkDest Default Empty verify rDst - [ expectSuccess - , expectResponseCode HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField (#amount . #getQuantity) (`shouldBe` amt) - -- all tx inputs have NO address and amount - -- as the tx is incoming , expectField #inputs $ \inputs' -> do - let addrAmt2 = (fmap source inputs') - addrAmt2 `shouldSatisfy` (all isNothing) + inputs' `shouldSatisfy` all (isNothing . source) , expectField (#direction . #getApiT) (`shouldBe` Incoming) , expectField (#status . #getApiT) (`shouldBe` InLedger) , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) ] - ra <- request @ApiWallet ctx (Link.getWallet @'Shelley wa) Default Empty - verify ra - [ expectSuccess - , expectField (#balance . #getApiT . #total) $ - between - ( Quantity (faucetAmt - feeMax - amt) - , Quantity (faucetAmt - feeMin - amt) - ) - , expectField - (#balance . #getApiT . #available) - (.>= Quantity (faucetAmt - faucetUtxoAmt)) - ] - eventually "wa and wb balances are as expected" $ do rb <- request @ApiWallet ctx (Link.getWallet @'Shelley wb) Default Empty expectField (#balance . #getApiT . #available) - (`shouldBe` Quantity (faucetAmt + amt)) rb + (`shouldBe` Quantity (initialAmt + amt)) rb ra2 <- request @ApiWallet ctx (Link.getWallet @'Shelley wa) Default Empty expectField (#balance . #getApiT . #available) - (`shouldBe` Quantity (faucetAmt - feeMax - amt)) ra2 + (`shouldBe` Quantity (initialAmt - feeMax - amt)) ra2 it "TRANS_CREATE_02x - Multiple Output Tx to single wallet" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx @@ -409,54 +404,17 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload + + ra <- request @ApiWallet ctx (Link.getWallet @'Shelley wSrc) Default Empty + verify r [ expectResponseCode HTTP.status202 , expectField (#amount . #getQuantity) $ between (feeMin + (2*amt), feeMax + (2*amt)) - -- all tx inputs have address and amount - , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` Pending) - , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) ] - let txid = getFromResponse #id r - let linkSrc = Link.getTransaction @'Shelley wSrc (ApiTxId txid) - let linkDest = Link.getTransaction @'Shelley wDest (ApiTxId txid) - eventually "transaction is no longer pending and is OK on both wallets" $ do - rSrc <- request @(ApiTransaction n) ctx linkSrc Default Empty - verify rSrc - [ expectSuccess - , expectResponseCode HTTP.status200 - , expectField (#amount . #getQuantity) $ - between (feeMin + (2*amt), feeMax + (2*amt)) - -- all tx inputs have address and amount - , expectField #inputs $ \inputs' -> do - let addrAmt = (fmap source inputs') - addrAmt `shouldSatisfy` (all isJust) - , expectField (#direction . #getApiT) (`shouldBe` Outgoing) - , expectField (#status . #getApiT) (`shouldBe` InLedger) - , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) - ] - - rDst <- request @(ApiTransaction n) ctx linkDest Default Empty - verify rDst - [ expectSuccess - , expectResponseCode HTTP.status200 - , expectField (#amount . #getQuantity) (`shouldBe` (2 * amt)) - -- all tx inputs have NO address and amount - -- as the tx is incoming - , expectField #inputs $ \inputs' -> do - let addrAmt2 = (fmap source inputs') - addrAmt2 `shouldSatisfy` (all isNothing) - , expectField (#direction . #getApiT) (`shouldBe` Incoming) - , expectField (#status . #getApiT) (`shouldBe` InLedger) - , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) - ] - - ra <- request @ApiWallet ctx (Link.getWallet @'Shelley wSrc) Default Empty verify ra [ expectField (#balance . #getApiT . #total) $ between