Skip to content

Commit

Permalink
Merge #2370 #2405
Browse files Browse the repository at this point in the history 
2370: [ADP-500] Change addresses are not listed as soon as a transaction is no longer pending r=KtorZ a=hasufell

# Issue Number

ADP-500

# Overview

- [x] created an integration test that checks the accepctance criteria and fails on the current branch
- [x] fixed the code in `knownAddresses` to also return all used change addresses

# Comments

## Questions

Do we need to communicate this to API users?


2405: Additional checks for input existence in transactions r=KtorZ a=piotr-iohk

# Issue Number

It turns out there are no checks for that.
A bit related to #2327.

# Overview

- 1c7215b
  Additional checks for inputs in incoming and outgoing transactions in integration tests
  
- cabc8b9
  Additional checks for inputs in join/quit pool transactions




# Comments

<!-- Additional comments or screenshots to attach if any -->

<!--
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Jira will detect and link to this PR once created, but you can also link this PR in the description of the corresponding ticket
 ✓ Acknowledge any changes required to the Wiki
 ✓ Finally, in the PR description delete any empty sections and all text commented in <!--, so that this text does not appear in merge commit messages.
-->


Co-authored-by: Julian Ospald <[email protected]>
Co-authored-by: KtorZ <[email protected]>
Co-authored-by: Piotr Stachyra <[email protected]>
  • Loading branch information
@iohk-bors @KtorZ
4 people authored Dec 31, 2020
3 parents c08ac82 + 9012186 + bd2916b commit ad99db8
Show file tree
Hide file tree
Showing 7 changed files with 223 additions and 41 deletions.
15 changes: 15 additions & 0 deletions lib/core-integration/src/Test/Integration/Framework/DSL.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,6 +93,7 @@ module Test.Integration.Framework.DSL
, quitStakePoolUnsigned
, selectCoins
, listAddresses
, getWallet
, listTransactions
, listAllTransactions
, deleteAllWallets
Expand Down Expand Up @@ -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
Expand Down
89 changes: 85 additions & 4 deletions lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuasiQuotes #-}
Expand All @@ -16,6 +17,7 @@ import Prelude
import Cardano.Wallet.Api.Types
( AnyAddress
, ApiAddress
, ApiT (..)
, ApiTransaction
, ApiVerificationKey
, ApiWallet
Expand All @@ -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
Expand All @@ -59,6 +65,7 @@ import Test.Integration.Framework.DSL
, expectListField
, expectListSize
, expectResponseCode
, fixturePassphrase
, fixtureWallet
, getFromResponse
, json
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -201,7 +208,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do
"unit": "lovelace"
}
}],
"passphrase": "cardano-wallet"
"passphrase": #{fixturePassphrase}
}|]

rTrans <- request @(ApiTransaction n) ctx
Expand Down Expand Up @@ -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
Expand Down
51 changes: 43 additions & 8 deletions lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,8 @@ import Cardano.Wallet.Api.Types
, ApiStakePoolFlag (..)
, ApiT (..)
, ApiTransaction
, ApiTxId (..)
, ApiTxInput (..)
, ApiWallet
, ApiWalletDelegationStatus (..)
, DecodeAddress
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 [])
Expand Down
Loading

0 comments on commit ad99db8

Please sign in to comment.