diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index f38da0c2890..c745eb01e5e 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,94 @@ 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) + ] + + liftIO $ print wB + pure wB + +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) + ] + pure wB + 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..0eb8a1495ad 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,8 +28,12 @@ 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.SyncProgress + ( SyncProgress (..) ) import Cardano.Wallet.Primitive.Types.Tx ( Direction (..), TxStatus (..) ) import Control.Monad @@ -49,7 +53,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 +74,8 @@ import Test.Integration.Framework.DSL , faucetAmt , faucetUtxoAmt , fixtureIcarusWallet + , fixtureMultiAssetIcarusWallet + , fixtureMultiAssetRandomWallet , fixturePassphrase , fixtureRandomWallet , fixtureWallet @@ -77,6 +83,8 @@ import Test.Integration.Framework.DSL , json , listAddresses , minUTxOValue + , mkTxPayloadMA + , pickAnAsset , postByronWallet , postTx , request @@ -91,6 +99,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 +112,50 @@ spec :: forall n. ( DecodeAddress n , DecodeStakeAddress n , EncodeAddress n + , PaymentAddress n ByronKey , PaymentAddress n IcarusKey ) => SpecWith Context spec = describe "BYRON_TRANSACTIONS" $ do + it "BYRON_TRANS_ASSETS_CREATE_01 - Multi-asset transaction from Random" + $ \ctx -> runResourceT $ do + wSrc <- fixtureMultiAssetRandomWallet @n ctx + eventually "Byron wallet has assets" $ do + rb <- request @ApiByronWallet ctx + (Link.getWallet @'Byron wSrc) Default Empty + verify rb + [ expectField (#assets . #available . #getApiT) + (`shouldNotBe` TokenMap.empty) + , expectField (#assets . #total . #getApiT) + (`shouldNotBe` TokenMap.empty) + , expectField (#state . #getApiT) (`shouldBe` Ready) + ] + wDest <- emptyWallet ctx + + -- pick out an asset to send + liftIO $ print wSrc + 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 b99267acf1a..aca309d216b 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 @@ -2880,42 +2888,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