diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 63fccd5c402..2bef2fa060e 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 @@ -1672,6 +1673,20 @@ listAddresses ctx w = do (_, addrs) <- unsafeRequest @[ApiAddress n] ctx link Empty return addrs +getWallet + :: forall w m. + ( MonadIO m + , MonadUnliftIO m + , HasType (ApiT WalletId) w + ) + => Context + -> w + -> 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..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 @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE QuasiQuotes #-} @@ -16,6 +17,7 @@ import Prelude import Cardano.Wallet.Api.Types ( AnyAddress , ApiAddress + , ApiT (..) , ApiTransaction , ApiVerificationKey , ApiWallet @@ -30,14 +32,18 @@ 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 + ( liftIO ) import Control.Monad.Trans.Resource ( runResourceT ) import Data.Aeson ( ToJSON (..), object, (.=) ) import Data.Generics.Internal.VL.Lens - ( (^.) ) + ( view, (^.) ) import Data.Quantity ( Quantity (..) ) import Data.Text @@ -59,6 +65,7 @@ import Test.Integration.Framework.DSL , expectListField , expectListSize , expectResponseCode + , fixturePassphrase , fixtureWallet , getFromResponse , json @@ -105,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 @@ -177,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 @@ -201,7 +208,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do "unit": "lovelace" } }], - "passphrase": "cardano-wallet" + "passphrase": #{fixturePassphrase} }|] rTrans <- request @(ApiTransaction n) ctx @@ -253,6 +260,80 @@ spec = describe "SHELLEY_ADDRESSES" $ do (`shouldNotSatisfy` T.isPrefixOf "addr_test") ] + 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": #{amount}, + "unit": "lovelace" + } + }], + "passphrase": #{fixturePassphrase} + }|] + (_, 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" r <- request @Aeson.Value ctx (Link.inspectAddress str) Default Empty 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..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 @@ -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,19 @@ 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 + , 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 waitForNextEpoch ctx waitForNextEpoch ctx @@ -507,11 +524,11 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do 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) - ] + [ expectListField 0 + (#direction . #getApiT) (`shouldBe` Outgoing) + , expectListField 0 + (#status . #getApiT) (`shouldBe` InLedger) + ] request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty >>= flip verify @@ -859,11 +876,29 @@ 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) + , expectField #inputs $ \inputs' -> do + inputs' `shouldSatisfy` all (isJust . source) ] - eventually "Wallet is not delegating and it got his deposit back" $ - do + + let txId = getFromResponse #id rQuit + let link = Link.getTransaction @'Shelley w (ApiTxId txId) + eventually "quit transaction is in ledger" $ do + rSrc <- request @(ApiTransaction n) ctx link Default Empty + verify rSrc + [ expectResponseCode HTTP.status200 + , 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 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 808d9c7bf77..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 @@ -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,55 +293,87 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do insertedAt tx' `shouldBe` Nothing pendingSince tx' `shouldBe` pendingSince tx - it "TRANS_CREATE_01 - Single Output Transaction" $ \ctx -> runResourceT $ do - (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx + it "TRANS_CREATE_01x - Single Output Transaction" $ \ctx -> runResourceT $ do + 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 + ra <- request @ApiWallet ctx + (Link.getWallet @'Shelley wa) Default Empty - verify r + verify rTx [ expectSuccess , expectResponseCode HTTP.status202 , expectField (#amount . #getQuantity) $ between (feeMin + amt, feeMax + amt) + , expectField #inputs $ \inputs' -> do + inputs' `shouldSatisfy` all (isJust . source) , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` Pending) , 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) + ( Quantity (initialAmt - feeMax - amt) + , Quantity (initialAmt - feeMin - amt) ) , expectField (#balance . #getApiT . #available) - (.>= Quantity (faucetAmt - faucetUtxoAmt)) + (`shouldBe` Quantity 0) ] + let txid = getFromResponse #id rTx + let linkSrc = Link.getTransaction @'Shelley wa (ApiTxId txid) + eventually "transaction is no longer pending on source wallet" $ do + rSrc <- request @(ApiTransaction n) ctx linkSrc Default Empty + verify rSrc + [ expectResponseCode HTTP.status200 + , expectField (#amount . #getQuantity) $ + between (feeMin + amt, feeMax + amt) + , expectField #inputs $ \inputs' -> do + 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 + [ expectResponseCode HTTP.status200 + , expectField (#amount . #getQuantity) (`shouldBe` amt) + , expectField #inputs $ \inputs' -> do + inputs' `shouldSatisfy` all (isNothing . source) + , expectField (#direction . #getApiT) (`shouldBe` Incoming) + , expectField (#status . #getApiT) (`shouldBe` InLedger) + , expectField (#metadata . #getApiTxMetadata) (`shouldBe` Nothing) + ] + 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_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 @@ -373,6 +406,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (Link.createTransaction @'Shelley wSrc) Default payload ra <- request @ApiWallet ctx (Link.getWallet @'Shelley wSrc) Default Empty + verify r [ expectResponseCode HTTP.status202 , expectField (#amount . #getQuantity) $ @@ -380,6 +414,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` Pending) ] + verify ra [ expectField (#balance . #getApiT . #total) $ between diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index 2851fa8081d..870d2626e1c 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs @@ -945,20 +945,32 @@ instance ( PaymentAddress n k ) => KnownAddresses (SeqState n k) where knownAddresses s = - let - (PendingIxs ixs) = - 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) + nonChangeAddresses <> usedChangeAddresses <> pendingChangeAddresses + where nonChangeAddresses = addresses (liftPaymentAddress @n @k) (externalPool s) - in - nonChangeAddresses <> changeAddresses + + changeAddresses = + addresses (liftPaymentAddress @n @k) (internalPool s) + + 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 -------------------------------------------------------------------------------- -- diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs index b258d7f415b..f8b5670df5c 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs @@ -555,7 +555,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))