Byron asset tx tests

cardano-foundation · Feb 5, 2021 · 6ccf392 · 6ccf392
1 parent 8b189c7
commit 6ccf392
Show file tree

Hide file tree

Showing 3 changed files with 198 additions and 44 deletions.
diff --git 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
@@ -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,13 +74,17 @@ import Test.Integration.Framework.DSL
     , faucetAmt
     , faucetUtxoAmt
     , fixtureIcarusWallet
+    , fixtureMultiAssetIcarusWallet
+    , fixtureMultiAssetRandomWallet
     , fixturePassphrase
     , fixtureRandomWallet
     , fixtureWallet
     , getFromResponse
     , 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
@@ -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