diff --git a/lib/core-integration/cardano-wallet-core-integration.cabal b/lib/core-integration/cardano-wallet-core-integration.cabal index d7d7cbfd84d..01d12f680d6 100644 --- a/lib/core-integration/cardano-wallet-core-integration.cabal +++ b/lib/core-integration/cardano-wallet-core-integration.cabal @@ -76,6 +76,7 @@ library Test.Integration.Scenario.API.Byron.Addresses Test.Integration.Scenario.API.Byron.Transactions Test.Integration.Scenario.API.Byron.Migrations + Test.Integration.Scenario.API.Byron.TransactionsShelley Test.Integration.Scenario.API.Byron.Network Test.Integration.Scenario.API.Shelley.Addresses Test.Integration.Scenario.API.Shelley.HWWallets diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/TransactionsShelley.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/TransactionsShelley.hs new file mode 100644 index 00000000000..839ae8e9f0b --- /dev/null +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/TransactionsShelley.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +module Test.Integration.Scenario.API.Byron.TransactionsShelley + ( spec + ) where + +import Prelude + +import Cardano.Wallet.Api.Types + ( ApiByronWallet + , ApiFee + , ApiTransaction + , ApiWallet + , DecodeAddress + , DecodeStakeAddress + , EncodeAddress + , WalletStyle (..) + ) +import Cardano.Wallet.Primitive.Types + ( Direction (..), TxStatus (..) ) +import Control.Monad + ( forM_ ) +import Data.Generics.Internal.VL.Lens + ( (^.) ) +import Data.Quantity + ( Quantity (..) ) +import Data.Text + ( Text ) +import Network.HTTP.Types.Method + ( Method ) +import Numeric.Natural + ( Natural ) +import Test.Hspec + ( SpecWith, describe ) +import Test.Hspec.Expectations.Lifted + ( shouldBe ) +import Test.Hspec.Extra + ( it ) +import Test.Integration.Framework.DSL + ( Context + , Headers (..) + , Payload (..) + , between + , eventually + , expectField + , expectResponseCode + , expectSuccess + , faucetAmt + , faucetUtxoAmt + , fixtureIcarusWallet + , fixturePassphrase + , fixtureRandomWallet + , fixtureWallet + , getFromResponse + , json + , listAddresses + , request + , verify + , (.>=) + ) +import Test.Integration.Framework.Request + ( RequestException ) + +import qualified Cardano.Wallet.Api.Link as Link +import qualified Network.HTTP.Types.Status as HTTP + +spec :: forall n t. + ( DecodeAddress n + , DecodeStakeAddress n + , EncodeAddress n + ) => SpecWith (Context t) +spec = do + describe "BYRON_TRANS_SHELLEY_01 - Single Output Transaction with non-Shelley witnesses" $ + forM_ [(fixtureRandomWallet, "Byron wallet"), (fixtureIcarusWallet, "Icarus wallet")] $ + \(srcFixture,name) -> it name $ \ctx -> do + + (wByron, wShelley) <- (,) <$> srcFixture ctx <*> fixtureWallet ctx + addrs <- listAddresses @n ctx wShelley + + let amt = 1 + 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 "wByron and wShelley balances are as expected" $ do + rb <- request @ApiWallet ctx + (Link.getWallet @'Shelley wShelley) Default Empty + expectField + (#balance . #getApiT . #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 + where + + postTx + :: Context t + -> (wal, wal -> (Method, Text), Text) + -> ApiWallet + -> Natural + -> IO (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 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 d38e5a849e2..e41595ed1c7 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 @@ -16,8 +16,7 @@ module Test.Integration.Scenario.API.Shelley.Transactions import Prelude import Cardano.Wallet.Api.Types - ( ApiByronWallet - , ApiFee + ( ApiFee , ApiT (..) , ApiTransaction , ApiTxId (..) @@ -77,7 +76,6 @@ import Test.Integration.Framework.DSL , expectSuccess , faucetAmt , faucetUtxoAmt - , fixtureIcarusWallet , fixturePassphrase , fixtureRandomWallet , fixtureWallet @@ -472,73 +470,6 @@ spec = do (Link.createTransaction @'Shelley w) Default payload expectResponseCode @IO 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 -> do - - (wByron, wShelley) <- (,) <$> srcFixture ctx <*> fixtureWallet ctx - addrs <- listAddresses @n ctx wShelley - - let amt = 1 - 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 . #getApiT . #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 - describe "TRANS_ESTIMATE_08 - Bad payload" $ do let matrix = [ ( "empty payload", NonJson "" ) diff --git a/lib/shelley/test/integration/Main.hs b/lib/shelley/test/integration/Main.hs index 5f716e001ee..81ea32e4b80 100644 --- a/lib/shelley/test/integration/Main.hs +++ b/lib/shelley/test/integration/Main.hs @@ -126,11 +126,12 @@ import qualified Cardano.Wallet.Api.Link as Link import qualified Data.Aeson as Aeson import qualified Data.ByteString as BS import qualified Data.Text as T --- TODO: enable when byron transactions/addresses supported in the cardano-node -import qualified Test.Integration.Scenario.API.Byron.Transactions as ByronTransactionsCommon + import qualified Test.Integration.Scenario.API.Byron.Addresses as ByronAddresses -import qualified Test.Integration.Scenario.API.Byron.Migrations as ByronMigrations import qualified Test.Integration.Scenario.API.Byron.HWWallets as ByronHWWallets +import qualified Test.Integration.Scenario.API.Byron.Migrations as ByronMigrations +import qualified Test.Integration.Scenario.API.Byron.Transactions as ByronTransactionsCommon +import qualified Test.Integration.Scenario.API.Byron.TransactionsShelley as ByronTransactionsShelley import qualified Test.Integration.Scenario.API.Byron.Wallets as ByronWallets import qualified Test.Integration.Scenario.API.Network as Network import qualified Test.Integration.Scenario.API.Shelley.Addresses as Addresses @@ -172,6 +173,7 @@ main = withUtf8Encoding $ withTracers $ \tracers -> do ByronAddresses.spec @n ByronMigrations.spec @n ByronHWWallets.spec @n + ByronTransactionsShelley.spec @n ByronTransactionsCommon.spec @n describe "CLI Specifications" $ do AddressesCLI.spec @n