From 5a9ddd5afe6f5c08194ae8567b8976d5ce6ba0e4 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Fri, 5 Feb 2021 10:30:16 +0100 Subject: [PATCH 1/4] Move Byron transaction tests to Byron suite --- .../src/Test/Integration/Framework/DSL.hs | 33 ++++ .../Scenario/API/Byron/Transactions.hs | 170 +++++++++++++++- .../Scenario/API/Shelley/Transactions.hs | 186 +----------------- 3 files changed, 211 insertions(+), 178 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index f3f1f85a36d..f38da0c2890 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -114,6 +114,7 @@ module Test.Integration.Framework.DSL , faucetAmt , faucetUtxoAmt , proc' + , postTx , waitForServer , for , utcIso8601ToText @@ -617,6 +618,38 @@ defaultTxTTL = 7200 -- -- Helpers -- + +postTx + :: forall n w m. + ( DecodeAddress n + , DecodeStakeAddress n + , EncodeAddress n + , HasType (ApiT WalletId) w + , MonadIO m + , MonadUnliftIO m + ) + => Context + -> (w, w -> (Method, Text), Text) + -> ApiWallet + -> Natural + -> m (HTTP.Status, Either RequestException (ApiTransaction n)) +postTx ctx (wSrc, postTxEndp, pass) wDest amt = do + addrs <- listAddresses @n ctx wDest + let destination = (addrs !! 1) ^. #id + let payload = Json [aesonQQ|{ + "payments": [{ + "address": #{destination}, + "amount": { + "quantity": #{amt}, + "unit": "lovelace" + } + }], + "passphrase": #{pass} + }|] + r <- request @(ApiTransaction n) ctx (postTxEndp wSrc) Default payload + expectResponseCode HTTP.status202 r + return r + updateMetadataSource :: (MonadIO m, MonadUnliftIO m) => Context -> Text -> m () updateMetadataSource ctx t = do r <- request @SettingsPutData ctx Link.putSettings Default payload diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs index 41bd5bdd49f..87d25c67e1a 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs @@ -17,11 +17,21 @@ import Prelude import Cardano.Wallet.Api.Types ( ApiByronWallet + , ApiFee (..) , ApiTransaction + , ApiTxId (..) + , ApiWallet , DecodeAddress , DecodeStakeAddress + , EncodeAddress (..) , WalletStyle (..) ) +import Cardano.Wallet.Primitive.AddressDerivation + ( PaymentAddress ) +import Cardano.Wallet.Primitive.AddressDerivation.Icarus + ( IcarusKey ) +import Cardano.Wallet.Primitive.Types.Tx + ( Direction (..), TxStatus (..) ) import Control.Monad ( forM_ ) import Control.Monad.IO.Class @@ -34,6 +44,8 @@ import Data.Quantity ( Quantity (..) ) import Data.Text.Class ( fromText ) +import Numeric.Natural + ( Natural ) import Test.Hspec ( SpecWith, describe ) import Test.Hspec.Expectations.Lifted @@ -44,22 +56,34 @@ import Test.Integration.Framework.DSL ( Context , Headers (..) , Payload (..) + , between , emptyIcarusWallet , emptyRandomWallet + , emptyWallet + , eventually , expectErrorMessage , expectField , expectListSize , expectResponseCode + , expectSuccess + , expectSuccess , faucetAmt + , faucetUtxoAmt , fixtureIcarusWallet , fixturePassphrase , fixtureRandomWallet + , fixtureWallet + , getFromResponse , json + , listAddresses + , minUTxOValue , postByronWallet + , postTx , request , toQueryString , verify , walletId + , (.>=) ) import Test.Integration.Framework.Request ( RequestException ) @@ -78,8 +102,152 @@ data TestCase a = TestCase spec :: forall n. ( DecodeAddress n , DecodeStakeAddress n + , EncodeAddress n + , PaymentAddress n IcarusKey ) => SpecWith Context -spec = describe "BYRON_MIGRATIONS" $ do +spec = describe "BYRON_TRANSACTIONS" $ do + + describe "BYRON_TRANS_CREATE_01 - Single Output Transaction with non-Shelley witnesses" $ + forM_ [(fixtureRandomWallet, "Byron wallet"), (fixtureIcarusWallet, "Icarus wallet")] $ + \(srcFixture,name) -> it name $ \ctx -> runResourceT $ do + + (wByron, wShelley) <- (,) <$> srcFixture ctx <*> fixtureWallet ctx + addrs <- listAddresses @n ctx wShelley + + let amt = minUTxOValue :: Natural + let destination = (addrs !! 1) ^. #id + let payload = Json [json|{ + "payments": [{ + "address": #{destination}, + "amount": { + "quantity": #{amt}, + "unit": "lovelace" + } + }] + }|] + + rFeeEst <- request @ApiFee ctx + (Link.getTransactionFee @'Byron wByron) Default payload + verify rFeeEst + [ expectSuccess + , expectResponseCode HTTP.status202 + ] + let (Quantity feeEstMin) = getFromResponse #estimatedMin rFeeEst + let (Quantity feeEstMax) = getFromResponse #estimatedMax rFeeEst + + r <- postTx @n ctx + (wByron, Link.createTransaction @'Byron, fixturePassphrase) + wShelley + amt + verify r + [ expectSuccess + , expectResponseCode HTTP.status202 + , expectField (#amount . #getQuantity) $ + between (feeEstMin + amt, feeEstMax + amt) + , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + , expectField (#status . #getApiT) (`shouldBe` Pending) + ] + + ra <- request @ApiByronWallet ctx (Link.getWallet @'Byron wByron) Default Empty + verify ra + [ expectSuccess + , expectField (#balance . #total) $ + between + ( Quantity (faucetAmt - feeEstMax - amt) + , Quantity (faucetAmt - feeEstMin - amt) + ) + , expectField + (#balance . #available) + (.>= Quantity (faucetAmt - faucetUtxoAmt)) + ] + + eventually "wa and wb balances are as expected" $ do + rb <- request @ApiWallet ctx + (Link.getWallet @'Shelley wShelley) Default Empty + expectField + (#balance . #available) + (`shouldBe` Quantity (faucetAmt + amt)) rb + + ra2 <- request @ApiByronWallet ctx + (Link.getWallet @'Byron wByron) Default Empty + expectField + (#balance . #available) + (`shouldBe` Quantity (faucetAmt - feeEstMax - amt)) ra2 + + it "BYRON_TRANS_CREATE_02 -\ + \ Cannot create tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do + w <- emptyRandomWallet ctx + let wid = w ^. walletId + wDest <- emptyWallet ctx + addr:_ <- listAddresses @n ctx wDest + let destination = addr ^. #id + let payload = Json [json|{ + "payments": [{ + "address": #{destination}, + "amount": { + "quantity": #{minUTxOValue}, + "unit": "lovelace" + } + }], + "passphrase": "cardano-wallet" + }|] + let endpoint = "v2/wallets/" <> wid <> "/transactions" + r <- request @(ApiTransaction n) ctx ("POST", endpoint) Default payload + expectResponseCode HTTP.status404 r + expectErrorMessage (errMsg404NoWallet wid) r + + it "BYRON_TRANS_DELETE -\ + \ Cannot delete tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do + w <- emptyRandomWallet ctx + let wid = w ^. walletId + let txid = "3e6ec12da4414aa0781ff8afa9717ae53ee8cb4aa55d622f65bc62619a4f7b12" + let endpoint = "v2/wallets/" <> wid <> "/transactions/" <> txid + r <- request @ApiTxId ctx ("DELETE", endpoint) Default Empty + expectResponseCode HTTP.status404 r + expectErrorMessage (errMsg404NoWallet wid) r + + it "BYRON_TRANS_ESTIMATE -\ + \ Cannot estimate tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do + w <- emptyRandomWallet ctx + let wid = w ^. walletId + wDest <- emptyWallet ctx + addr:_ <- listAddresses @n ctx wDest + let destination = addr ^. #id + let payload = Json [json|{ + "payments": [{ + "address": #{destination}, + "amount": { + "quantity": #{minUTxOValue}, + "unit": "lovelace" + } + }] + }|] + let endpoint = "v2/wallets/" <> wid <> "/payment-fees" + r <- request @ApiFee ctx ("POST", endpoint) Default payload + expectResponseCode HTTP.status404 r + expectErrorMessage (errMsg404NoWallet wid) r + + it "BYRON_TX_LIST_02 -\ + \ Byron endpoint does not list Shelley wallet transactions" $ \ctx -> runResourceT $ do + w <- emptyWallet ctx + let wid = w ^. walletId + let ep = ("GET", "v2/byron-wallets/" <> wid <> "/transactions") + r <- request @([ApiTransaction n]) ctx ep Default Empty + verify r + [ expectResponseCode HTTP.status404 + , expectErrorMessage (errMsg404NoWallet wid) + ] + + it "BYRON_TX_LIST_03 -\ + \ Shelley endpoint does not list Byron wallet transactions" $ \ctx -> runResourceT $ do + w <- emptyRandomWallet ctx + let wid = w ^. walletId + let ep = ("GET", "v2/wallets/" <> wid <> "/transactions") + r <- request @([ApiTransaction n]) ctx ep Default Empty + verify r + [ expectResponseCode HTTP.status404 + , expectErrorMessage (errMsg404NoWallet wid) + ] it "BYRON_RESTORE_08 - Icarus wallet with high indexes" $ \ctx -> runResourceT $ do -- NOTE 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 8d998fc017b..f287d166bcb 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 @@ -89,8 +89,6 @@ import Data.Time.Utils ( utcTimePred, utcTimeSucc ) import Data.Word ( Word32 ) -import Network.HTTP.Types.Method - ( Method ) import Numeric.Natural ( Natural ) import Test.Hspec @@ -119,7 +117,6 @@ import Test.Integration.Framework.DSL , expectSuccess , faucetAmt , faucetUtxoAmt - , fixtureIcarusWallet , fixtureIcarusWalletAddrs , fixtureMultiAssetWallet , fixturePassphrase @@ -135,6 +132,7 @@ import Test.Integration.Framework.DSL , listTransactions , minUTxOValue , oneSecond + , postTx , postWallet , request , rewardWallet @@ -283,7 +281,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do eventually "Pending tx has pendingSince field" $ do -- Post Tx let amt = (minUTxOValue :: Natural) - r <- postTx ctx + r <- postTx @n ctx (wSrc, Link.createTransaction @'Shelley,fixturePassphrase) wDest amt @@ -606,73 +604,6 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (Link.createTransaction @'Shelley w) Default payload expectResponseCode HTTP.status400 r - describe "TRANS_CREATE_09 - Single Output Transaction with non-Shelley witnesses" $ - forM_ [(fixtureRandomWallet, "Byron wallet"), (fixtureIcarusWallet, "Icarus wallet")] $ - \(srcFixture,name) -> it name $ \ctx -> runResourceT $ do - - (wByron, wShelley) <- (,) <$> srcFixture ctx <*> fixtureWallet ctx - addrs <- listAddresses @n ctx wShelley - - let amt = minUTxOValue :: Natural - let destination = (addrs !! 1) ^. #id - let payload = Json [json|{ - "payments": [{ - "address": #{destination}, - "amount": { - "quantity": #{amt}, - "unit": "lovelace" - } - }] - }|] - - rFeeEst <- request @ApiFee ctx - (Link.getTransactionFee @'Byron wByron) Default payload - verify rFeeEst - [ expectSuccess - , expectResponseCode HTTP.status202 - ] - let (Quantity feeEstMin) = getFromResponse #estimatedMin rFeeEst - let (Quantity feeEstMax) = getFromResponse #estimatedMax rFeeEst - - r <- postTx ctx - (wByron, Link.createTransaction @'Byron, fixturePassphrase) - wShelley - amt - verify r - [ expectSuccess - , expectResponseCode HTTP.status202 - , expectField (#amount . #getQuantity) $ - between (feeEstMin + amt, feeEstMax + amt) - , expectField (#direction . #getApiT) (`shouldBe` Outgoing) - , expectField (#status . #getApiT) (`shouldBe` Pending) - ] - - ra <- request @ApiByronWallet ctx (Link.getWallet @'Byron wByron) Default Empty - verify ra - [ expectSuccess - , expectField (#balance . #total) $ - between - ( Quantity (faucetAmt - feeEstMax - amt) - , Quantity (faucetAmt - feeEstMin - amt) - ) - , expectField - (#balance . #available) - (.>= Quantity (faucetAmt - faucetUtxoAmt)) - ] - - eventually "wa and wb balances are as expected" $ do - rb <- request @ApiWallet ctx - (Link.getWallet @'Shelley wShelley) Default Empty - expectField - (#balance . #available) - (`shouldBe` Quantity (faucetAmt + amt)) rb - - ra2 <- request @ApiByronWallet ctx - (Link.getWallet @'Byron wByron) Default Empty - expectField - (#balance . #available) - (`shouldBe` Quantity (faucetAmt - feeEstMax - amt)) ra2 - it "TRANS_ASSETS_CREATE_01 - Multi-asset balance" $ \ctx -> runResourceT $ do w <- fixtureMultiAssetWallet ctx r <- request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty @@ -1974,10 +1905,10 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (wSrc, w) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx -- post txs let linkTx = (wSrc, Link.createTransaction @'Shelley, "cardano-wallet") - _ <- postTx ctx linkTx w minUTxOValue + _ <- postTx @n ctx linkTx w minUTxOValue verifyWalletBalance ctx w (Quantity minUTxOValue) - _ <- postTx ctx linkTx w (2 * minUTxOValue) + _ <- postTx @n ctx linkTx w (2 * minUTxOValue) verifyWalletBalance ctx w (Quantity (3 * minUTxOValue)) txs <- eventually "I make sure there are exactly 2 transactions" $ do @@ -2343,7 +2274,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx -- post tx let amt = (minUTxOValue :: Natural) - rMkTx <- postTx ctx + rMkTx <- postTx @n ctx (wSrc, Link.createTransaction @'Shelley, "cardano-wallet") wDest amt @@ -2397,7 +2328,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx -- post tx let amt = (minUTxOValue :: Natural) - rMkTx <- postTx ctx + rMkTx <- postTx @n ctx (wSrc, Link.createTransaction @'Shelley, "cardano-wallet") wDest amt @@ -2420,7 +2351,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx -- post tx let amt = (minUTxOValue :: Natural) - rMkTx <- postTx ctx + rMkTx <- postTx @n ctx (wSrc, Link.createTransaction @'Shelley, "cardano-wallet") wDest amt @@ -2484,7 +2415,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- post transaction rTx <- - postTx ctx + postTx @n ctx (wSrc, Link.createTransaction @'Shelley, "cardano-wallet") wDest (minUTxOValue :: Natural) @@ -2555,81 +2486,6 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do request @(ApiTransaction n) ctx linkDel Default Empty >>= expectResponseCode HTTP.status404 - it "BYRON_TRANS_DELETE -\ - \ Cannot delete tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do - w <- emptyRandomWallet ctx - let wid = w ^. walletId - let txid = "3e6ec12da4414aa0781ff8afa9717ae53ee8cb4aa55d622f65bc62619a4f7b12" - let endpoint = "v2/wallets/" <> wid <> "/transactions/" <> txid - r <- request @ApiTxId ctx ("DELETE", endpoint) Default Empty - expectResponseCode HTTP.status404 r - expectErrorMessage (errMsg404NoWallet wid) r - - it "BYRON_TRANS_ESTIMATE -\ - \ Cannot estimate tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do - w <- emptyRandomWallet ctx - let wid = w ^. walletId - wDest <- emptyWallet ctx - addr:_ <- listAddresses @n ctx wDest - let destination = addr ^. #id - let payload = Json [json|{ - "payments": [{ - "address": #{destination}, - "amount": { - "quantity": #{minUTxOValue}, - "unit": "lovelace" - } - }] - }|] - let endpoint = "v2/wallets/" <> wid <> "/payment-fees" - r <- request @ApiFee ctx ("POST", endpoint) Default payload - expectResponseCode HTTP.status404 r - expectErrorMessage (errMsg404NoWallet wid) r - - it "BYRON_TRANS_CREATE -\ - \ Cannot create tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do - w <- emptyRandomWallet ctx - let wid = w ^. walletId - wDest <- emptyWallet ctx - addr:_ <- listAddresses @n ctx wDest - let destination = addr ^. #id - let payload = Json [json|{ - "payments": [{ - "address": #{destination}, - "amount": { - "quantity": #{minUTxOValue}, - "unit": "lovelace" - } - }], - "passphrase": "cardano-wallet" - }|] - let endpoint = "v2/wallets/" <> wid <> "/transactions" - r <- request @(ApiTransaction n) ctx ("POST", endpoint) Default payload - expectResponseCode HTTP.status404 r - expectErrorMessage (errMsg404NoWallet wid) r - - it "BYRON_TX_LIST_02 -\ - \ Byron endpoint does not list Shelley wallet transactions" $ \ctx -> runResourceT $ do - w <- emptyWallet ctx - let wid = w ^. walletId - let ep = ("GET", "v2/byron-wallets/" <> wid <> "/transactions") - r <- request @([ApiTransaction n]) ctx ep Default Empty - verify r - [ expectResponseCode HTTP.status404 - , expectErrorMessage (errMsg404NoWallet wid) - ] - - it "BYRON_TX_LIST_03 -\ - \ Shelley endpoint does not list Byron wallet transactions" $ \ctx -> runResourceT $ do - w <- emptyRandomWallet ctx - let wid = w ^. walletId - let ep = ("GET", "v2/wallets/" <> wid <> "/transactions") - r <- request @([ApiTransaction n]) ctx ep Default Empty - verify r - [ expectResponseCode HTTP.status404 - , expectErrorMessage (errMsg404NoWallet wid) - ] - it "SHELLEY_TX_REDEEM_01 - Can redeem rewards from self" $ \ctx -> runResourceT $ do (wSrc,_) <- rewardWallet ctx addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSrc @@ -2956,7 +2812,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do it resource $ \ctx -> runResourceT $ do -- post tx (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx - rMkTx <- postTx ctx + rMkTx <- postTx @n ctx (wSrc, Link.createTransaction @'Shelley, "cardano-wallet") wDest (minUTxOValue :: Natural) @@ -2972,30 +2828,6 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do expectResponseCode HTTP.status404 ra expectErrorMessage (errMsg404CannotFindTx txid) ra - postTx - :: (MonadIO m, MonadUnliftIO m) - => Context - -> (wal, wal -> (Method, Text), Text) - -> ApiWallet - -> Natural - -> m (HTTP.Status, Either RequestException (ApiTransaction n)) - postTx ctx (wSrc, postTxEndp, pass) wDest amt = do - addrs <- listAddresses @n ctx wDest - let destination = (addrs !! 1) ^. #id - let payload = Json [json|{ - "payments": [{ - "address": #{destination}, - "amount": { - "quantity": #{amt}, - "unit": "lovelace" - } - }], - "passphrase": #{pass} - }|] - r <- request @(ApiTransaction n) ctx (postTxEndp wSrc) Default payload - expectResponseCode HTTP.status202 r - return r - verifyWalletBalance :: (MonadIO m, MonadUnliftIO m) => Context From cd3e179804c10ea76ce6449b357eca0a4d48dfc5 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Fri, 5 Feb 2021 17:32:30 +0100 Subject: [PATCH 2/4] Byron asset tx tests --- .../src/Test/Integration/Framework/DSL.hs | 134 +++++++++++++++++- .../Scenario/API/Byron/Transactions.hs | 93 +++++++++++- .../Scenario/API/Shelley/Transactions.hs | 56 ++------ 3 files changed, 239 insertions(+), 44 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index f38da0c2890..5e9b851772c 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -111,10 +111,14 @@ module Test.Integration.Framework.DSL , fixtureWalletWith , fixtureWalletWithMnemonics , fixtureMultiAssetWallet + , fixtureMultiAssetRandomWallet + , fixtureMultiAssetIcarusWallet , faucetAmt , faucetUtxoAmt , proc' , postTx + , pickAnAsset + , mkTxPayloadMA , waitForServer , for , utcIso8601ToText @@ -318,6 +322,8 @@ import Data.Set ( Set ) import Data.Text ( Text ) +import Data.Text.Class + ( ToText (..) ) import Data.Time ( NominalDiffTime, UTCTime ) import Data.Time.Text @@ -342,7 +348,7 @@ import System.IO import Test.Hspec ( Expectation, HasCallStack, expectationFailure ) import Test.Hspec.Expectations.Lifted - ( shouldBe, shouldContain, shouldSatisfy ) + ( shouldBe, shouldContain, shouldNotBe, shouldSatisfy ) import Test.HUnit.Lang ( FailureReason (..), HUnitFailure (..) ) import Test.Integration.Faucet @@ -379,6 +385,8 @@ import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle +import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap +import qualified Cardano.Wallet.Primitive.Types.TokenQuantity as TokenQuantity import qualified Codec.CBOR.Encoding as CBOR import qualified Codec.CBOR.Write as CBOR import qualified Crypto.Scrypt as Scrypt @@ -618,6 +626,43 @@ defaultTxTTL = 7200 -- -- Helpers -- +pickAnAsset :: TokenMap.TokenMap -> ((Text, Text), Natural) +pickAnAsset tm = case TokenMap.toFlatList tm of + (TokenBundle.AssetId pid an, TokenQuantity.TokenQuantity q):_ -> + ((toText pid, toText an), q) + _ -> error "pickAnAsset: empty TokenMap" + +-- Like mkTxPayload, except that assets are included in the payment. +-- Asset amounts are specified by ((PolicyId Hex, AssetName Hex), amount). +mkTxPayloadMA + :: forall n m. + ( DecodeAddress n + , DecodeStakeAddress n + , EncodeAddress n + , MonadUnliftIO m + ) + => (ApiT Address, Proxy n) + -> Natural + -> [((Text, Text), Natural)] + -> Text + -> m Payload +mkTxPayloadMA destination coin val passphrase = do + let assetJson ((pid, name), q) = [aesonQQ|{ + "policy_id": #{pid}, + "asset_name": #{name}, + "quantity": #{q} + }|] + return $ Json [aesonQQ|{ + "payments": [{ + "address": #{destination}, + "amount": { + "quantity": #{coin}, + "unit": "lovelace" + }, + "assets": #{map assetJson val} + }], + "passphrase": #{passphrase} + }|] postTx :: forall n w m. @@ -1171,6 +1216,93 @@ fixtureMultiAssetWallet -> ResourceT m ApiWallet fixtureMultiAssetWallet = fmap fst . fixtureWalletWithMnemonics (Proxy @"ma") +fixtureMultiAssetRandomWallet + :: forall n m. + ( DecodeAddress n + , DecodeStakeAddress n + , EncodeAddress n + , MonadIO m + , MonadUnliftIO m + ) + => Context + -> ResourceT m ApiByronWallet +fixtureMultiAssetRandomWallet ctx = do + wMA <- fixtureMultiAssetWallet ctx + wB <- fixtureRandomWallet ctx + + -- create Byron address + let p = Json [aesonQQ| { "passphrase": #{fixturePassphrase} }|] + r <- request @(ApiAddress n) ctx (Link.postRandomAddress wB) Default p + expectSuccess r + + -- pick out assets to send + let assetsSrc = wMA ^. #assets . #total . #getApiT + assetsSrc `shouldNotBe` mempty + let val = minUTxOValue <$ pickAnAsset assetsSrc + + rL <- request @[ApiAddress n] ctx (Link.listAddresses @'Byron wB) Default Empty + let addrs = getFromResponse id rL + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination 0 [val] fixturePassphrase + + -- send assets to Byron wallet + rtx <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wMA) Default payload + expectResponseCode HTTP.status202 rtx + + eventually "Byron wallet has assets" $ do + rb <- request @ApiByronWallet ctx + (Link.getWallet @'Byron wB) Default Empty + verify rb + [ expectField (#assets . #available . #getApiT) + (`shouldNotBe` TokenMap.empty) + , expectField (#assets . #total . #getApiT) + (`shouldNotBe` TokenMap.empty) + , expectField (#state . #getApiT) (`shouldBe` Ready) + ] + return (getFromResponse id rb) + + +fixtureMultiAssetIcarusWallet + :: forall n m. + ( DecodeAddress n + , DecodeStakeAddress n + , EncodeAddress n + , MonadIO m + , MonadUnliftIO m + ) + => Context + -> ResourceT m ApiByronWallet +fixtureMultiAssetIcarusWallet ctx = do + wMA <- fixtureMultiAssetWallet ctx + wB <- fixtureIcarusWallet ctx + + -- pick out assets to send + let assetsSrc = wMA ^. #assets . #total . #getApiT + assetsSrc `shouldNotBe` mempty + let val = minUTxOValue <$ pickAnAsset assetsSrc + + rL <- request @[ApiAddress n] ctx (Link.listAddresses @'Byron wB) Default Empty + let addrs = getFromResponse id rL + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination 0 [val] fixturePassphrase + + -- send assets to Icarus wallet + rtx <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wMA) Default payload + expectResponseCode HTTP.status202 rtx + + eventually "Icarus wallet has assets" $ do + rb <- request @ApiByronWallet ctx + (Link.getWallet @'Byron wB) Default Empty + verify rb + [ expectField (#assets . #available . #getApiT) + (`shouldNotBe` TokenMap.empty) + , expectField (#assets . #total . #getApiT) + (`shouldNotBe` TokenMap.empty) + ] + return (getFromResponse id rb) + fixtureRawTx :: Context -> (Address, Natural) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs index 87d25c67e1a..fa9e05a40b6 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs @@ -28,6 +28,8 @@ import Cardano.Wallet.Api.Types ) import Cardano.Wallet.Primitive.AddressDerivation ( PaymentAddress ) +import Cardano.Wallet.Primitive.AddressDerivation.Byron + ( ByronKey ) import Cardano.Wallet.Primitive.AddressDerivation.Icarus ( IcarusKey ) import Cardano.Wallet.Primitive.Types.Tx @@ -49,7 +51,7 @@ import Numeric.Natural import Test.Hspec ( SpecWith, describe ) import Test.Hspec.Expectations.Lifted - ( shouldBe ) + ( shouldBe, shouldNotBe ) import Test.Hspec.Extra ( it ) import Test.Integration.Framework.DSL @@ -70,6 +72,8 @@ import Test.Integration.Framework.DSL , faucetAmt , faucetUtxoAmt , fixtureIcarusWallet + , fixtureMultiAssetIcarusWallet + , fixtureMultiAssetRandomWallet , fixturePassphrase , fixtureRandomWallet , fixtureWallet @@ -77,6 +81,8 @@ import Test.Integration.Framework.DSL , json , listAddresses , minUTxOValue + , mkTxPayloadMA + , pickAnAsset , postByronWallet , postTx , request @@ -91,6 +97,7 @@ import Test.Integration.Framework.TestData ( errMsg400StartTimeLaterThanEndTime, errMsg404NoWallet ) import qualified Cardano.Wallet.Api.Link as Link +import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP @@ -103,10 +110,94 @@ spec :: forall n. ( DecodeAddress n , DecodeStakeAddress n , EncodeAddress n + , PaymentAddress n ByronKey , PaymentAddress n IcarusKey ) => SpecWith Context spec = describe "BYRON_TRANSACTIONS" $ do + describe "BYRON_TRANS_ASSETS_CREATE_01 - Multi-asset transaction with ADA" $ + forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") + , (fixtureMultiAssetIcarusWallet @n, "Icarus wallet")] $ + \(srcFixture, name) -> it name $ \ctx -> runResourceT $ do + + wSrc <- srcFixture ctx + wDest <- emptyWallet ctx + + -- pick out an asset to send + let assetsSrc = wSrc ^. #assets . #total . #getApiT + assetsSrc `shouldNotBe` mempty + let val = minUTxOValue <$ pickAnAsset assetsSrc + + addrs <- listAddresses @n ctx wDest + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination (minUTxOValue * 2) [val] fixturePassphrase + + rtx <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Byron wSrc) Default payload + expectResponseCode HTTP.status202 rtx + + eventually "Payee wallet balance is as expected" $ do + rb <- request @ApiWallet ctx + (Link.getWallet @'Shelley wDest) Default Empty + verify rb + [ expectField (#assets . #available . #getApiT) + (`shouldNotBe` TokenMap.empty) + , expectField (#assets . #total . #getApiT) + (`shouldNotBe` TokenMap.empty) + ] + + describe "BYRON_TRANS_ASSETS_CREATE_02 - Multi-asset transaction with too little ADA" $ + forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") + , (fixtureMultiAssetIcarusWallet @n, "Icarus wallet")] $ + \(srcFixture, name) -> it name $ \ctx -> runResourceT $ do + + wSrc <- srcFixture ctx + wDest <- emptyWallet ctx + + -- pick out an asset to send + let assetsSrc = wSrc ^. #assets . #total . #getApiT + assetsSrc `shouldNotBe` mempty + let val = minUTxOValue <$ pickAnAsset assetsSrc + + addrs <- listAddresses @n ctx wDest + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination minUTxOValue [val] fixturePassphrase + + rtx <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Byron wSrc) Default payload + expectResponseCode HTTP.status403 rtx + + describe "BYRON_TRANS_ASSETS_CREATE_02a - Multi-asset transaction with no ADA" $ + forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") + , (fixtureMultiAssetIcarusWallet @n, "Icarus wallet")] $ + \(srcFixture, name) -> it name $ \ctx -> runResourceT $ do + + wSrc <- srcFixture ctx + wDest <- emptyWallet ctx + + -- pick out an asset to send + let assetsSrc = wSrc ^. #assets . #total . #getApiT + assetsSrc `shouldNotBe` mempty + let val = minUTxOValue <$ pickAnAsset assetsSrc + + addrs <- listAddresses @n ctx wDest + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination 0 [val] fixturePassphrase + + rtx <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Byron wSrc) Default payload + expectResponseCode HTTP.status202 rtx + + eventually "Payee wallet balance is as expected" $ do + rb <- request @ApiWallet ctx + (Link.getWallet @'Shelley wDest) Default Empty + verify rb + [ expectField (#assets . #available . #getApiT) + (`shouldNotBe` TokenMap.empty) + , expectField (#assets . #total . #getApiT) + (`shouldNotBe` TokenMap.empty) + ] + describe "BYRON_TRANS_CREATE_01 - Single Output Transaction with non-Shelley witnesses" $ forM_ [(fixtureRandomWallet, "Byron wallet"), (fixtureIcarusWallet, "Icarus wallet")] $ \(srcFixture,name) -> it name $ \ctx -> runResourceT $ do 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 f287d166bcb..5f2fe2f9459 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 @@ -131,7 +131,9 @@ import Test.Integration.Framework.DSL , listAllTransactions , listTransactions , minUTxOValue + , mkTxPayloadMA , oneSecond + , pickAnAsset , postTx , postWallet , request @@ -170,10 +172,8 @@ import Web.HttpApiData ( ToHttpApiData (..) ) import qualified Cardano.Wallet.Api.Link as Link -import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap import qualified Cardano.Wallet.Primitive.Types.TokenPolicy as TokenPolicy -import qualified Cardano.Wallet.Primitive.Types.TokenQuantity as TokenQuantity import qualified Codec.Binary.Bech32 as Bech32 import qualified Data.Aeson as Aeson import qualified Data.ByteString as BS @@ -627,7 +627,9 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- Allow for a higher minimum utxo coin due to assets let minCoin = minUTxOValue * 2 - payload <- mkTxPayloadMA ctx wDest minCoin [val] fixturePassphrase + addrs <- listAddresses @n ctx wDest + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination minCoin [val] fixturePassphrase rtx <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload @@ -662,7 +664,9 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- due to assets in the transaction. let coin = minUTxOValue - payload <- mkTxPayloadMA ctx wDest coin [val] fixturePassphrase + addrs <- listAddresses @n ctx wDest + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination coin [val] fixturePassphrase rtx <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload @@ -680,7 +684,9 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do assetsSrc `shouldNotBe` mempty let val = minUTxOValue <$ pickAnAsset assetsSrc - payload <- mkTxPayloadMA ctx wDest 0 [val] fixturePassphrase + addrs <- listAddresses @n ctx wDest + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination 0 [val] fixturePassphrase rtx <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload @@ -707,7 +713,9 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do assetsSrc `shouldNotBe` mempty let val = minUTxOValue <$ pickAnAsset assetsSrc - payload <- mkTxPayloadMA ctx wDest 0 [val] fixturePassphrase + addrs <- listAddresses @n ctx wDest + let destination = (addrs !! 1) ^. #id + payload <- mkTxPayloadMA @n destination 0 [val] fixturePassphrase rtx <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload @@ -2871,42 +2879,6 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do "passphrase": #{passphrase} }|] - pickAnAsset :: TokenMap.TokenMap -> ((Text, Text), Natural) - pickAnAsset tm = case TokenMap.toFlatList tm of - (TokenBundle.AssetId pid an, TokenQuantity.TokenQuantity q):_ -> - ((toText pid, toText an), q) - _ -> error "pickAnAsset: empty TokenMap" - - -- Like mkTxPayload, except that assets are included in the payment. - -- Asset amounts are specified by ((PolicyId Hex, AssetName Hex), amount). - mkTxPayloadMA - :: MonadUnliftIO m - => Context - -> ApiWallet - -> Natural - -> [((Text, Text), Natural)] - -> Text - -> m Payload - mkTxPayloadMA ctx wDest coin val passphrase = do - addrs <- listAddresses @n ctx wDest - let destination = (addrs !! 1) ^. #id - let assetJson ((pid, name), q) = [json|{ - "policy_id": #{pid}, - "asset_name": #{name}, - "quantity": #{q} - }|] - return $ Json [json|{ - "payments": [{ - "address": #{destination}, - "amount": { - "quantity": #{coin}, - "unit": "lovelace" - }, - "assets": #{map assetJson val} - }], - "passphrase": #{passphrase} - }|] - addTxTTL :: Double -> Payload -> Payload addTxTTL t (Json (Aeson.Object o)) = Json (Aeson.Object (o <> ttl)) where From 0660ea6a059dbc9980e1e33c77769180ca938c9b Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Mon, 8 Feb 2021 16:15:17 +0100 Subject: [PATCH 3/4] Byron asset list/get tests --- .../Test/Integration/Framework/TestData.hs | 4 + .../Scenario/API/Byron/Transactions.hs | 89 ++++++++++++++++++- .../Scenario/API/Shelley/Transactions.hs | 4 + lib/core/src/Cardano/Wallet/Api/Link.hs | 29 ++++++ 4 files changed, 124 insertions(+), 2 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs index 9885536ed19..486842a988a 100644 --- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs +++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs @@ -48,6 +48,7 @@ module Test.Integration.Framework.TestData , errMsg403NotDelegating , errMsg403NonNullReward , errMsg403NothingToMigrate + , errMsg404NoAsset , errMsg404NoEndpoint , errMsg404CannotFindTx , errMsg403NoRootKey @@ -316,6 +317,9 @@ errMsg403NothingToMigrate wid = ", because it's either empty or full of small coins which wouldn't be \ \worth migrating." +errMsg404NoAsset :: String +errMsg404NoAsset = "The requested asset is not associated with this wallet." + errMsg404NoEndpoint :: String errMsg404NoEndpoint = "I couldn't find the requested endpoint. If the endpoint\ \ contains path parameters, please ensure they are well-formed, otherwise I\ diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs index fa9e05a40b6..012d277e27b 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs @@ -16,8 +16,10 @@ module Test.Integration.Scenario.API.Byron.Transactions import Prelude import Cardano.Wallet.Api.Types - ( ApiByronWallet + ( ApiAsset (..) + , ApiByronWallet , ApiFee (..) + , ApiT (..) , ApiTransaction , ApiTxId (..) , ApiWallet @@ -32,14 +34,20 @@ import Cardano.Wallet.Primitive.AddressDerivation.Byron ( ByronKey ) import Cardano.Wallet.Primitive.AddressDerivation.Icarus ( IcarusKey ) +import Cardano.Wallet.Primitive.Types.Hash + ( Hash (..) ) import Cardano.Wallet.Primitive.Types.Tx ( Direction (..), TxStatus (..) ) +import Cardano.Wallet.Unsafe + ( unsafeFromText ) import Control.Monad ( forM_ ) import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Resource ( runResourceT ) +import Data.Bifunctor + ( bimap ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Quantity @@ -66,6 +74,7 @@ import Test.Integration.Framework.DSL , expectErrorMessage , expectField , expectListSize + , expectListSizeSatisfy , expectResponseCode , expectSuccess , expectSuccess @@ -94,10 +103,13 @@ import Test.Integration.Framework.DSL import Test.Integration.Framework.Request ( RequestException ) import Test.Integration.Framework.TestData - ( errMsg400StartTimeLaterThanEndTime, errMsg404NoWallet ) + ( errMsg400StartTimeLaterThanEndTime, errMsg404NoAsset, errMsg404NoWallet ) import qualified Cardano.Wallet.Api.Link as Link import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap +import qualified Cardano.Wallet.Primitive.Types.TokenPolicy as TokenPolicy +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP @@ -166,6 +178,7 @@ spec = describe "BYRON_TRANSACTIONS" $ do rtx <- request @(ApiTransaction n) ctx (Link.createTransaction @'Byron wSrc) Default payload expectResponseCode HTTP.status403 rtx + expectErrorMessage "Some outputs have ada values that are too small." rtx describe "BYRON_TRANS_ASSETS_CREATE_02a - Multi-asset transaction with no ADA" $ forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") @@ -198,6 +211,78 @@ spec = describe "BYRON_TRANSACTIONS" $ do (`shouldNotBe` TokenMap.empty) ] + describe "BYRON_TRANS_ASSETS_LIST_01 - Asset list present" $ + forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") + , (fixtureMultiAssetIcarusWallet @n, "Icarus wallet")] $ + \(srcFixture, name) -> it name $ \ctx -> runResourceT $ do + + wal <- srcFixture ctx + r <- request @([ApiAsset]) ctx (Link.listByronAssets wal) Default Empty + verify r + [ expectSuccess + , expectListSizeSatisfy ( > 0) + ] + + describe "BYRON_TRANS_ASSETS_LIST_02 - Asset list present when not used" $ + forM_ [ (fixtureRandomWallet, "Byron fixture wallet") + , (fixtureIcarusWallet, "Icarus fixture wallet") + , (emptyRandomWallet, "Byron empty wallet") + , (emptyIcarusWallet, "Icarus empty wallet")] $ + \(srcFixture, name) -> it name $ \ctx -> runResourceT $ do + + wal <- srcFixture ctx + r <- request @([ApiAsset]) ctx (Link.listByronAssets wal) Default Empty + verify r + [ expectSuccess + , expectListSize 0 + ] + + describe "BYRON_TRANS_ASSETS_GET_01 - Asset list present" $ + forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") + , (fixtureMultiAssetIcarusWallet @n, "Icarus wallet")] $ + \(srcFixture, name) -> it name $ \ctx -> runResourceT $ do + + wal <- srcFixture ctx + + -- pick an asset from the fixture wallet + let assetsSrc = wal ^. (#assets . #total . #getApiT) + assetsSrc `shouldNotBe` mempty + let (polId, assName) = bimap unsafeFromText unsafeFromText $ fst $ + pickAnAsset assetsSrc + let ep = Link.getByronAsset wal polId assName + r <- request @(ApiAsset) ctx ep Default Empty + verify r + [ expectSuccess + , expectField #policyId (`shouldBe` ApiT polId) + , expectField #assetName (`shouldBe` ApiT assName) + , expectField #metadata (`shouldBe` Nothing) + ] + + describe "BYRON_TRANS_ASSETS_GET_02 - Asset not present when isn't associated" $ + forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") + , (fixtureMultiAssetIcarusWallet @n, "Icarus wallet")] $ + \(srcFixture, name) -> it name $ \ctx -> runResourceT $ do + + wal <- srcFixture ctx + let polId = TokenPolicy.UnsafeTokenPolicyId $ Hash $ BS.replicate 28 0 + let assName = TokenPolicy.UnsafeTokenName $ B8.replicate 4 'x' + let ep = Link.getByronAsset wal polId assName + r <- request @(ApiAsset) ctx ep Default Empty + expectResponseCode HTTP.status404 r + expectErrorMessage errMsg404NoAsset r + + describe "BYRON_TRANS_ASSETS_GET_02a - Asset not present when isn't associated" $ + forM_ [ (fixtureMultiAssetRandomWallet @n, "Byron wallet") + , (fixtureMultiAssetIcarusWallet @n, "Icarus wallet")] $ + \(srcFixture, name) -> it name $ \ctx -> runResourceT $ do + + wal <- srcFixture ctx + let polId = TokenPolicy.UnsafeTokenPolicyId $ Hash $ BS.replicate 28 0 + let ep = Link.getByronAsset wal polId TokenPolicy.nullTokenName + r <- request @(ApiAsset) ctx ep Default Empty + expectResponseCode HTTP.status404 r + expectErrorMessage errMsg404NoAsset r + describe "BYRON_TRANS_CREATE_01 - Single Output Transaction with non-Shelley witnesses" $ forM_ [(fixtureRandomWallet, "Byron wallet"), (fixtureIcarusWallet, "Icarus wallet")] $ \(srcFixture,name) -> it name $ \ctx -> runResourceT $ do 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 5f2fe2f9459..5c31ec7c558 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 @@ -164,6 +164,7 @@ import Test.Integration.Framework.TestData , errMsg403WithdrawalNotWorth , errMsg403WrongPass , errMsg404CannotFindTx + , errMsg404NoAsset , errMsg404NoWallet ) import UnliftIO.Concurrent @@ -672,6 +673,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (Link.createTransaction @'Shelley wSrc) Default payload -- It should fail with InsufficientMinCoinValueError expectResponseCode HTTP.status403 rtx + expectErrorMessage "Some outputs have ada values that are too small." rtx it "TRANS_ASSETS_CREATE_02a - Multi-asset transaction without Ada" $ \ctx -> runResourceT $ do wSrc <- fixtureMultiAssetWallet ctx @@ -807,6 +809,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let ep = Link.getAsset wal polId assName r <- request @(ApiAsset) ctx ep Default Empty expectResponseCode HTTP.status404 r + expectErrorMessage errMsg404NoAsset r it "TRANS_ASSETS_GET_02a - Asset not present when isn't associated" $ \ctx -> runResourceT $ do wal <- fixtureMultiAssetWallet ctx @@ -814,6 +817,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let ep = Link.getAsset wal polId TokenPolicy.nullTokenName r <- request @(ApiAsset) ctx ep Default Empty expectResponseCode HTTP.status404 r + expectErrorMessage errMsg404NoAsset r let absSlotB = view (#absoluteSlotNumber . #getApiT) let absSlotS = view (#absoluteSlotNumber . #getApiT) diff --git a/lib/core/src/Cardano/Wallet/Api/Link.hs b/lib/core/src/Cardano/Wallet/Api/Link.hs index 2ce703db623..9dc7b93c88d 100644 --- a/lib/core/src/Cardano/Wallet/Api/Link.hs +++ b/lib/core/src/Cardano/Wallet/Api/Link.hs @@ -67,6 +67,8 @@ module Cardano.Wallet.Api.Link -- * Assets , listAssets , getAsset + , listByronAssets + , getByronAsset -- * Transactions , createTransaction @@ -430,6 +432,33 @@ getAsset w pid n mkURL mk = mk wid (ApiT pid) (ApiT n) mkURLDefault mk = mk wid (ApiT pid) +listByronAssets + :: forall w. + ( HasType (ApiT WalletId) w + ) + => w + -> (Method, Text) +listByronAssets w = + endpoint @Api.ListByronAssets (wid &) + where + wid = w ^. typed @(ApiT WalletId) + +getByronAsset + :: forall w. + ( HasType (ApiT WalletId) w + ) + => w + -> TokenPolicyId + -> TokenName + -> (Method, Text) +getByronAsset w pid n + | n == nullTokenName = endpoint @Api.GetByronAssetDefault mkURLDefault + | otherwise = endpoint @Api.GetByronAsset mkURL + where + wid = w ^. typed @(ApiT WalletId) + mkURL mk = mk wid (ApiT pid) (ApiT n) + mkURLDefault mk = mk wid (ApiT pid) + -- -- Transactions -- From 24e6b3ccbe4f6f350ebde04eb5352ef5ba9d95b8 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Mon, 8 Feb 2021 18:14:22 +0100 Subject: [PATCH 4/4] Fix icarus asset endpoints --- lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs index e7e1697b821..89c9fde2c96 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs @@ -352,15 +352,15 @@ server byron icarus shelley spl ntp = byronAssets = (\wid -> withLegacyLayer wid (byron, listAssets byron wid) - (icarus, listAssets byron wid) + (icarus, listAssets icarus wid) ) :<|> (\wid t n -> withLegacyLayer wid (byron, getAsset byron wid t n) - (icarus, getAsset byron wid t n) + (icarus, getAsset icarus wid t n) ) :<|> (\wid t -> withLegacyLayer wid (byron, getAssetDefault byron wid t) - (icarus, getAssetDefault byron wid t) + (icarus, getAssetDefault icarus wid t) ) byronAddresses :: Server (ByronAddresses n)