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..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 @@ -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) @@ -1073,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 @@ -1136,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 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..8d69310cca4 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 @@ -1292,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 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) {-------------------------------------------------------------------------------