From 17c3a48b85e55afd978d111d83d4e9d9e25d9cf9 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Fri, 5 Mar 2021 16:44:10 +0100 Subject: [PATCH 1/6] Add integration test for large asset counts To ensure that our calculation matches the one of the ledger. See https://github.com/input-output-hk/cardano-wallet/pull/2552#discussion_r589335232 for what it helped catch. --- .../src/Test/Integration/Faucet.hs | 56 ++++++++++++++++-- .../src/Test/Integration/Framework/Context.hs | 8 +++ .../Scenario/API/Shelley/Transactions.hs | 58 ++++++++++++++++++- lib/shelley/bench/Latency.hs | 1 + lib/shelley/exe/local-cluster.hs | 2 +- .../Cardano/Wallet/Shelley/Launch/Cluster.hs | 5 +- .../cardano-node-shelley/shelley-genesis.yaml | 2 +- lib/shelley/test/integration/Main.hs | 12 ++-- 8 files changed, 130 insertions(+), 14 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Faucet.hs b/lib/core-integration/src/Test/Integration/Faucet.hs index 713ecf73c9b..2d0f4a67cb1 100644 --- a/lib/core-integration/src/Test/Integration/Faucet.hs +++ b/lib/core-integration/src/Test/Integration/Faucet.hs @@ -20,9 +20,14 @@ module Test.Integration.Faucet , mirMnemonics , maMnemonics + -- * Sea horses + , seaHorseTokenName + , seaHorsePolicyId + -- * Integration test funds , shelleyIntegrationTestFunds , maryIntegrationTestAssets + , seaHorseTestAssets -- * Internals , genByronFaucets @@ -93,6 +98,7 @@ import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle +import qualified Data.ByteString.Char8 as B8 import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -2128,7 +2134,7 @@ bigDustWallet = unsafeMkMnemonic shelleyIntegrationTestFunds :: [(Address, Coin)] shelleyIntegrationTestFunds = mconcat - [ seqMnemonics >>= (take 10 . map (, defaultAmt) . addresses . SomeMnemonic) + [ seqMnemonics >>= take 10 . map (, defaultAmt) . addresses . SomeMnemonic , zip (addresses $ SomeMnemonic onlyDustWallet) @@ -2189,9 +2195,6 @@ maryAssetScripts = map (first (unsafeFromText . T.pack)) , ( "b3579e6306a5b3f49ba91ed4c5fd79dbe92d54867433ff6f92d47b40" , ( "58209e1caa45500051163e03176099f53dd85aff98331d6fc2c857226d6c406fe2dc" , "31fe7edd49aaca7982a28cfb917f8af01b9c1088bff300b1bc784f03" ) ) - , ( "4ff049585c4b3070563966370f5427d4a2f3588bce4146d57a93c7d3" - , ( "582082a0d2af81ca0528387c37823706507478cead44f0250661542cdc5619ecaead" - , "452bbda4110154506faaddbbdf366e4db088e963a3f56e98832b3332" ) ) , ( "e9f14eb5a8c5c4b70d7e41ba16b833396191bee9fb3966ccd0d012f8" , ( "5820e58c10bac5b4cbc984524a92576fad307fa8d53da4f408abd8ee8c1d3d0e9daf" , "84f25deb23ec4ebaa20998fdb9db5aa91d46938c1a5a5efa35766e30" ) ) @@ -2239,6 +2242,51 @@ maryIntegrationTestAssets = maMnemonics >>= take 3 ] combined p = simple p `TokenBundle.add` fruit p +-- Assets containing 120 different SeaHorses. Same policyId, but all different. +-- +-- This is for testing with large token bundles / asset counts. +-- +-- This is a separate defenition from maryIntegrationTestAssets to allow minting +-- only 1 bundle per transaction without going over the maximum size +-- (as we do want them as large as possible). +seaHorseTestAssets + :: Int + -> [Address] + -> [(Address, (TokenBundle, [(String, String)]))] +seaHorseTestAssets nPerAddr addrs = zip addrs $ + map + (\is -> mint (seaHorse is) seaHorseAssetScript) + (chunks nPerAddr [1..]) + where + mint mk (pid, info) = (mk pid, [info]) + seaHorse is p = bundle p $ flip map is $ \i -> + (seaHorseTokenName i, TokenQuantity 1) + bundle p assets = TokenBundle.fromNestedList + (Coin 1000_000_000) + [(p, NE.fromList assets)] + +seaHorsePolicyId :: TokenPolicyId +seaHorsePolicyId = fst seaHorseAssetScript + +-- | A pre-generated policy ID, paired with +-- @(signing key, verification key hash)@ . +seaHorseAssetScript :: (TokenPolicyId, (String, String)) +seaHorseAssetScript = first (unsafeFromText . T.pack) + ( "4ff049585c4b3070563966370f5427d4a2f3588bce4146d57a93c7d3" + , ( "582082a0d2af81ca0528387c37823706507478cead44f0250661542cdc5619ecaead" + , "452bbda4110154506faaddbbdf366e4db088e963a3f56e98832b3332" ) ) + +seaHorseTokenName :: Int -> TokenName +seaHorseTokenName i = UnsafeTokenName $ + B8.pack $ "00000000000000000SeaHorse" <> show i + +-- https://stackoverflow.com/questions/12876384/grouping-a-list-into-lists-of-n-elements-in-haskell +chunks :: Int -> [a] -> [[a]] +chunks _ [] = [] +chunks n xs = + let (ys, zs) = splitAt n xs + in ys : chunks n zs + -- -- Helpers -- diff --git a/lib/core-integration/src/Test/Integration/Framework/Context.hs b/lib/core-integration/src/Test/Integration/Framework/Context.hs index 73c93083763..e41e39a0a56 100644 --- a/lib/core-integration/src/Test/Integration/Framework/Context.hs +++ b/lib/core-integration/src/Test/Integration/Framework/Context.hs @@ -15,6 +15,8 @@ import Cardano.Wallet.Api.Types ( ApiEra ) import Cardano.Wallet.Primitive.Types ( EpochNo, NetworkParameters, PoolRetirementCertificate ) +import Cardano.Wallet.Primitive.Types.Address + ( Address ) import Cardano.Wallet.Transaction ( DelegationAction ) import Data.IORef @@ -59,6 +61,12 @@ data Context = Context -- era-specific assertions. , _smashUrl :: Text -- ^ Base URL of the mock smash server. + + , _mintSeaHorseAssets :: Int -> [Address] -> IO () + -- ^ TODO: Remove once we can unify cardano-wallet-core-integration and + -- cardano-wallet:integration, or when the wallet supports minting. + -- + -- Cannot be used be serveral tests at a time. (!) } deriving Generic 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 5362c694f7a..8697d5eff22 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 @@ -7,6 +7,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -55,7 +56,7 @@ import Cardano.Wallet.Primitive.Types.Tx import Cardano.Wallet.Unsafe ( unsafeFromText ) import Control.Monad - ( forM_ ) + ( forM, forM_ ) import Control.Monad.IO.Unlift ( MonadIO (..), MonadUnliftIO (..), liftIO ) import Control.Monad.Trans.Resource @@ -100,8 +101,10 @@ import Test.Hspec.Expectations.Lifted ( expectationFailure, shouldBe, shouldNotBe, shouldSatisfy ) import Test.Hspec.Extra ( flakyBecauseOf, it ) +import Test.Integration.Faucet + ( seaHorsePolicyId, seaHorseTokenName ) import Test.Integration.Framework.DSL - ( Context + ( Context (_mintSeaHorseAssets) , Headers (..) , Payload (..) , between @@ -146,6 +149,7 @@ import Test.Integration.Framework.DSL , unsafeRequest , utcIso8601ToText , verify + , waitForTxImmutability , walletId , (.<) , (.<=) @@ -715,6 +719,56 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectField (#assets . #total . #getApiT) (`shouldNotBe` TokenMap.empty) ] + it "TRANS_ASSETS_CREATE_02c - Send SeaHorses" $ \ctx -> runResourceT $ do + -- Notes on the style of this test: + -- - By doing the minting here it is easier to control, and tweak + -- the values. + -- - The current _mintSeaHorseAssets cannot be called concurrently + -- - By grouping the setup of multiple wallets in a single test, we + -- gain some time. + + -- 1. Setup by minting funds + let assetsPerAddrScenarios = [64 .. 70] + sourceWallets <- forM assetsPerAddrScenarios $ \nAssetsPerAddr -> do + wSrc <- fixtureWallet ctx + srcAddrs <- + map (getApiT . fst . view #id) <$> listAddresses @n ctx wSrc + liftIO $ _mintSeaHorseAssets ctx nAssetsPerAddr (take 2 srcAddrs) + return (wSrc, nAssetsPerAddr) + wDest <- emptyWallet ctx + destAddr <- head . map (view #id) <$> listAddresses @n ctx wDest + waitForTxImmutability ctx + + -- 2. Try spending from each wallet, and record the response. + responses <- forM sourceWallets $ \(wSrc, nPerAddr) -> do + let seaHorses = map $ \ix -> + (( toText seaHorsePolicyId + , toText $ seaHorseTokenName ix) + , 1) + payload <- mkTxPayloadMA @n + destAddr + 0 + (seaHorses [1, nPerAddr * 2]) + -- Send one token from our first bundle, and one token from + -- our second bundle, to ensure the change output is large. + fixturePassphrase + + let verifyRes r = case r of + (s, Right _) + | s == HTTP.status202 -> Right () + | otherwise -> Left $ mconcat + [ "impossible: request succeeded, but got " + , "status code " + , show s + ] + (_, Left e) -> Left $ show e + + (nPerAddr,) . verifyRes <$> request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wSrc) Default payload + + -- 3. They should all succeed + responses `shouldBe` (map (, Right ()) assetsPerAddrScenarios) + let hasAssetOutputs :: [AddressAmount (ApiT Address, Proxy n)] -> Bool hasAssetOutputs = any ((/= mempty) . view #assets) diff --git a/lib/shelley/bench/Latency.hs b/lib/shelley/bench/Latency.hs index 79cd4da6de0..7b823e57b58 100644 --- a/lib/shelley/bench/Latency.hs +++ b/lib/shelley/bench/Latency.hs @@ -397,6 +397,7 @@ withShelleyServer tracers action = do error "poolGarbageCollectionEvents not available" , _smashUrl = "" , _mainEra = maxBound + , _mintSeaHorseAssets = error "mintSeaHorseAssets not available" } race_ (takeMVar ctx >>= action) (withServer setupContext) diff --git a/lib/shelley/exe/local-cluster.hs b/lib/shelley/exe/local-cluster.hs index 8e29038097b..f561f5eacbf 100644 --- a/lib/shelley/exe/local-cluster.hs +++ b/lib/shelley/exe/local-cluster.hs @@ -231,7 +231,7 @@ main = withLocalClusterSetup $ \dir clusterLogs walletLogs -> sendFaucetFundsTo trCluster' socketPath dir $ encodeAddresses shelleyIntegrationTestFunds - sendFaucetAssetsTo trCluster' socketPath dir $ + sendFaucetAssetsTo trCluster' socketPath dir 20 $ encodeAddresses maryIntegrationTestAssets moveInstantaneousRewardsTo trCluster' socketPath dir rewards diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs index f721138c790..b69cf949b69 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs @@ -1249,12 +1249,13 @@ sendFaucetAssetsTo :: Tracer IO ClusterLog -> CardanoNodeConn -> FilePath + -> Int -- ^ batch size -> [(String, (TokenBundle, [(String, String)]))] -- ^ (address, assets) -> IO () -sendFaucetAssetsTo tr conn dir targets = do +sendFaucetAssetsTo tr conn dir batchSize targets = do era <- getClusterEra dir when (era >= MaryHardFork) $ - batch 20 targets $ sendFaucet tr conn dir "assets" + batch batchSize targets $ sendFaucet tr conn dir "assets" -- | Build, sign, and send a batch of faucet funding transactions using -- @cardano-cli@. This function is used by 'sendFaucetFundsTo' and diff --git a/lib/shelley/test/data/cardano-node-shelley/shelley-genesis.yaml b/lib/shelley/test/data/cardano-node-shelley/shelley-genesis.yaml index 80da38957cb..c6519c07541 100644 --- a/lib/shelley/test/data/cardano-node-shelley/shelley-genesis.yaml +++ b/lib/shelley/test/data/cardano-node-shelley/shelley-genesis.yaml @@ -16,7 +16,7 @@ protocolParams: major: 0 minUTxOValue: 1000000 decentralisationParam: 0.25 # means 75% decentralised - maxTxSize: 4096 + maxTxSize: 16384 minFeeA: 100 maxBlockBodySize: 239857 minFeeB: 100000 diff --git a/lib/shelley/test/integration/Main.hs b/lib/shelley/test/integration/Main.hs index 8481dda22e5..a3020f9f50c 100644 --- a/lib/shelley/test/integration/Main.hs +++ b/lib/shelley/test/integration/Main.hs @@ -122,6 +122,7 @@ import Test.Integration.Faucet ( genRewardAccounts , maryIntegrationTestAssets , mirMnemonics + , seaHorseTestAssets , shelleyIntegrationTestFunds ) import Test.Integration.Framework.Context @@ -238,7 +239,7 @@ specWithServer testDir (tr, tracers) = aroundAll withContext poolGarbageCollectionEvents <- newIORef [] let dbEventRecorder = recordPoolGarbageCollectionEvents poolGarbageCollectionEvents - let setupContext smashUrl np wAddr = bracketTracer' tr "setupContext" $ do + let setupContext smashUrl faucetConn np wAddr = bracketTracer' tr "setupContext" $ do let baseUrl = "http://" <> T.pack (show wAddr) <> "/" prometheusUrl <- (maybe "none" (\(h, p) -> T.pack h <> ":" <> toText @(Port "Prometheus") p)) <$> getPrometheusURL ekgUrl <- (maybe "none" (\(h, p) -> T.pack h <> ":" <> toText @(Port "EKG") p)) <$> getEKGURL @@ -261,6 +262,9 @@ specWithServer testDir (tr, tracers) = aroundAll withContext , _poolGarbageCollectionEvents = poolGarbageCollectionEvents , _mainEra = era , _smashUrl = smashUrl + , _mintSeaHorseAssets = \addrs nPerAddr -> do + sendFaucetAssetsTo tr' faucetConn testDir 1 $ + encodeAddresses (seaHorseTestAssets addrs nPerAddr) } let action' = bracketTracer' tr "spec" . action res <- race @@ -297,15 +301,15 @@ specWithServer testDir (tr, tracers) = aroundAll withContext onClusterStart (onReady $ T.pack smashUrl) dbDecorator tr' = contramap MsgCluster tr + encodeAddresses = map (first (T.unpack . encodeAddress @'Mainnet)) setupFaucet conn = do traceWith tr MsgSettingUpFaucet let rewards = (,Coin $ fromIntegral oneMillionAda) <$> concatMap genRewardAccounts mirMnemonics moveInstantaneousRewardsTo tr' conn testDir rewards - let encodeAddresses = map (first (T.unpack . encodeAddress @'Mainnet)) sendFaucetFundsTo tr' conn testDir $ encodeAddresses shelleyIntegrationTestFunds - sendFaucetAssetsTo tr' conn testDir $ + sendFaucetAssetsTo tr' conn testDir 20 $ encodeAddresses maryIntegrationTestAssets onClusterStart action dbDecorator (RunningNode conn block0 (gp, vData)) = do @@ -329,7 +333,7 @@ specWithServer testDir (tr, tracers) = aroundAll withContext conn block0 (gp, vData) - (action gp) + (action conn gp) `withException` (traceWith tr . MsgServerError) {------------------------------------------------------------------------------- From 49895f59cc0fc468897e49f22c3e63ae37b7b851 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 11 Mar 2021 13:23:25 +0100 Subject: [PATCH 2/6] Increase minting faucet TTL --- lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs index b69cf949b69..8d69310cca4 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs @@ -1293,7 +1293,9 @@ sendFaucet tr conn dir what targets = do cli tr $ [ "transaction", "build-raw" , "--tx-in", faucetInput - , "--ttl", "600" + , "--ttl", "6000000" + -- Big enough to allow minting in the actual integration tests, + -- before the wallet API supports it. , "--fee", show (faucetAmt - total) , "--out-file", file , cardanoCliEra era From d420edcf04352dc0c45f591695aa237a27503d96 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 11 Mar 2021 16:09:23 +0100 Subject: [PATCH 3/6] Now need more metadata to exceed bound --- .../Integration/Scenario/API/Shelley/Transactions.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) 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 8697d5eff22..fd22c342a82 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 @@ -1127,11 +1127,11 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do basePayload <- mkTxPayload ctx wb amt fixturePassphrase - -- This will encode to at least 8k of CBOR. The max tx size for the - -- integration tests cluster is 4k. + -- This will encode to at least 32k of CBOR. The max tx size for the + -- integration tests cluster is 16k. let txMeta = Aeson.object [ (toText @Int i, bytes) - | i <- [0..127] ] + | i <- [0..511] ] bytes = [json|{ "bytes": #{T.replicate 64 "a"} }|] let payload = addTxMetadata txMeta basePayload @@ -1190,11 +1190,11 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do basePayload <- mkTxPayload ctx wb amt fixturePassphrase - -- This will encode to at least 8k of CBOR. The max tx size for the - -- integration tests cluster is 4k. + -- This will encode to at least 32k of CBOR. The max tx size for the + -- integration tests cluster is 16k. let txMeta = Aeson.object [ (toText @Int i, bytes) - | i <- [0..127] ] + | i <- [0..511] ] bytes = [json|{ "bytes": #{T.replicate 64 "a"} }|] let payload = addTxMetadata txMeta basePayload r <- request @ApiFee ctx From bbefb712b3f61cdf2371e78dd5bede1048414f50 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Fri, 12 Mar 2021 09:51:57 +0100 Subject: [PATCH 4/6] Update lib/core-integration/src/Test/Integration/Faucet.hs Co-authored-by: Jonathan Knowles --- lib/core-integration/src/Test/Integration/Faucet.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/core-integration/src/Test/Integration/Faucet.hs b/lib/core-integration/src/Test/Integration/Faucet.hs index 2d0f4a67cb1..a310b6bc81e 100644 --- a/lib/core-integration/src/Test/Integration/Faucet.hs +++ b/lib/core-integration/src/Test/Integration/Faucet.hs @@ -2246,7 +2246,7 @@ maryIntegrationTestAssets = maMnemonics >>= take 3 -- -- This is for testing with large token bundles / asset counts. -- --- This is a separate defenition from maryIntegrationTestAssets to allow minting +-- This is a separate definition from maryIntegrationTestAssets to allow minting -- only 1 bundle per transaction without going over the maximum size -- (as we do want them as large as possible). seaHorseTestAssets From 08fb522dec24b2d454b0b072f02e42dd7a25ec74 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Fri, 12 Mar 2021 09:52:08 +0100 Subject: [PATCH 5/6] Update lib/core-integration/src/Test/Integration/Framework/Context.hs Co-authored-by: Jonathan Knowles --- lib/core-integration/src/Test/Integration/Framework/Context.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/Context.hs b/lib/core-integration/src/Test/Integration/Framework/Context.hs index e41e39a0a56..55548dd8e14 100644 --- a/lib/core-integration/src/Test/Integration/Framework/Context.hs +++ b/lib/core-integration/src/Test/Integration/Framework/Context.hs @@ -66,7 +66,7 @@ data Context = Context -- ^ TODO: Remove once we can unify cardano-wallet-core-integration and -- cardano-wallet:integration, or when the wallet supports minting. -- - -- Cannot be used be serveral tests at a time. (!) + -- Cannot be used by several tests at a time. (!) } deriving Generic From 173613c0e53117999d9e715e547ab7a0078aa02a Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Fri, 12 Mar 2021 09:55:41 +0100 Subject: [PATCH 6/6] Tweak doc comment --- lib/core-integration/src/Test/Integration/Faucet.hs | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Faucet.hs b/lib/core-integration/src/Test/Integration/Faucet.hs index a310b6bc81e..42cae2e485d 100644 --- a/lib/core-integration/src/Test/Integration/Faucet.hs +++ b/lib/core-integration/src/Test/Integration/Faucet.hs @@ -2242,15 +2242,11 @@ maryIntegrationTestAssets = maMnemonics >>= take 3 ] combined p = simple p `TokenBundle.add` fruit p --- Assets containing 120 different SeaHorses. Same policyId, but all different. +-- | Create @n@ unique SeaHorse tokens for each provided @Address@. -- --- This is for testing with large token bundles / asset counts. --- --- This is a separate definition from maryIntegrationTestAssets to allow minting --- only 1 bundle per transaction without going over the maximum size --- (as we do want them as large as possible). +-- The result can be used for minting using the cli-based faucet. seaHorseTestAssets - :: Int + :: Int -- ^ Number of sea horses per address -> [Address] -> [(Address, (TokenBundle, [(String, String)]))] seaHorseTestAssets nPerAddr addrs = zip addrs $