diff --git a/CHANGELOG.md b/CHANGELOG.md index 4377a9446..31ef6a94b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -127,6 +127,8 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) - Fixed transaction witness set 'attach' functions. Previously, the updated witness set was incorrectly appended to the existing set, causing performance degradation when processing constraints for complex transactions. ([#1653](https://github.com/Plutonomicon/cardano-transaction-lib/pull/1653)) - Fixed a critical bug where Blockfrost `getUtxo` would also return **spent** outputs ([#1664](https://github.com/Plutonomicon/cardano-transaction-lib/pull/1664)) +- Fixed `onClusterStartup` hook so it is now correctly invoked when using cardano-testnet ([#1651](https://github.com/Plutonomicon/cardano-transaction-lib/pull/1651)) + - Removed the `privateKeys` and `privateKeysDirectory` fields from the `ClusterParameters` record to ensure compatibility with the new cardano-testnet environment ## [v9.3.1] diff --git a/packages.dhall b/packages.dhall index 10c9fe2a0..b1b4bf76c 100644 --- a/packages.dhall +++ b/packages.dhall @@ -1,6 +1,6 @@ let upstream = -- https://github.com/mlabs-haskell/purescript-cardano-package-set - https://raw.githubusercontent.com/mlabs-haskell/purescript-cardano-package-set/v3.0.0/packages.dhall - sha256:53f8de47606b6cb349432c2f2f03e656b204ebe132ef2d39d76339d9d97620ee + https://raw.githubusercontent.com/mlabs-haskell/purescript-cardano-package-set/v3.1.0/packages.dhall + sha256:0d8a7ca4e8ecfc8d1d795a989b76364caa9583d60e765c490cfa215a8824c246 in upstream diff --git a/spago-packages.nix b/spago-packages.nix index c0cebf081..cc26f8319 100644 --- a/spago-packages.nix +++ b/spago-packages.nix @@ -331,11 +331,11 @@ let "cardano-transaction-balancer" = pkgs.stdenv.mkDerivation { name = "cardano-transaction-balancer"; - version = "v1.0.0"; + version = "v1.1.0"; src = pkgs.fetchgit { url = "https://github.com/mlabs-haskell/purescript-cardano-transaction-balancer"; - rev = "6380e1998b5e6fd17c1961cc0290a41ffae7669e"; - sha256 = "0hn7gbw6zbxcpn71gc6z9xvwg48465h0kgkij56rwa154mfwhlr4"; + rev = "a2f5db9774a0128add6cac2c967c7b08e5dd1b8e"; + sha256 = "1r2zibh3fkbxh4wa7kdp3381j1332gr0ahp78qxybpr09vhvgzbv"; }; phases = "installPhase"; installPhase = "ln -s $src $out"; diff --git a/src/Contract/BalanceTxConstraints.purs b/src/Contract/BalanceTxConstraints.purs index 8c50daed7..574753bb0 100644 --- a/src/Contract/BalanceTxConstraints.purs +++ b/src/Contract/BalanceTxConstraints.purs @@ -6,8 +6,10 @@ import Cardano.Transaction.Balancer.Constraints ( BalanceTxConstraintsBuilder , BalancerConfig(BalancerConfig) , BalancerConstraints(BalancerConstraints) + , UtxoPredicate , mustGenChangeOutsWithMaxTokenQuantity , mustNotSpendUtxoWithOutRef + , mustNotSpendUtxosWhere , mustNotSpendUtxosWithOutRefs , mustSendChangeToAddress , mustSendChangeWithDatum diff --git a/src/Internal/Contract/Hooks.purs b/src/Internal/Contract/Hooks.purs index 52a2d5558..3d64f568f 100644 --- a/src/Internal/Contract/Hooks.purs +++ b/src/Internal/Contract/Hooks.purs @@ -6,11 +6,11 @@ module Ctl.Internal.Contract.Hooks import Prelude -import Cardano.Types.PrivateKey (PrivateKey) import Cardano.Types.Transaction (Transaction) import Data.Maybe (Maybe(Nothing)) import Effect (Effect) import Effect.Exception (Error) +import Node.Path (FilePath) type Hooks = { beforeSign :: Maybe (Effect Unit) @@ -22,10 +22,8 @@ type Hooks = } type ClusterParameters = - { privateKeys :: Array PrivateKey - , nodeSocketPath :: String - , nodeConfigPath :: String - , privateKeysDirectory :: String + { nodeSocketPath :: FilePath + , nodeConfigPath :: FilePath } emptyHooks :: Hooks diff --git a/src/Internal/Testnet/Contract.purs b/src/Internal/Testnet/Contract.purs index baaae047e..57132c45c 100644 --- a/src/Internal/Testnet/Contract.purs +++ b/src/Internal/Testnet/Contract.purs @@ -44,6 +44,7 @@ import Control.Monad.State (State, execState, modify_) import Control.Monad.Trans.Class (lift) import Control.Monad.Writer (censor, execWriterT, tell) import Control.Parallel (parTraverse) +import Ctl.Internal.Contract.Hooks (ClusterParameters) import Ctl.Internal.Test.ContractTest ( ContractTest(ContractTest) , ContractTestPlan(ContractTestPlan) @@ -62,7 +63,7 @@ import Ctl.Internal.Testnet.DistributeFunds ) import Ctl.Internal.Testnet.DistributeFunds (Tx(Tx)) as DistrFunds import Ctl.Internal.Testnet.Server - ( StartedTestnetCluster + ( StartedTestnetCluster(StartedTestnetCluster) , makeClusterContractEnv , mkLogging , startTestnetCluster @@ -77,8 +78,8 @@ import Ctl.Internal.Testnet.Utils import Data.Array (concat, fromFoldable, zip) as Array import Data.Bifunctor (lmap) import Data.Map (values) as Map +import Effect.Aff (apathize, try) import Effect.Aff (bracket) as Aff -import Effect.Aff (try) import Effect.Exception (error) import Effect.Ref (Ref) import Effect.Ref (new, read, write) as Ref @@ -243,9 +244,17 @@ startTestnetContractEnv startTestnetContractEnv cfg distr cleanupRef = do _ <- cleanupOnExit cleanupRef logging@{ logger } <- liftEffect $ mkLogging cfg - cluster <- startTestnetCluster cfg cleanupRef logger + cluster@(StartedTestnetCluster { paths: { nodeSocketPath, nodeConfigPath } }) <- + startTestnetCluster cfg cleanupRef logger { env, printLogs, clearLogs } <- makeClusterContractEnv cleanupRef logging wallets <- mkWallets env cluster + let + clusterParams :: ClusterParameters + clusterParams = + { nodeSocketPath + , nodeConfigPath + } + apathize $ liftEffect $ for_ env.hooks.onClusterStartup (_ $ clusterParams) pure { cluster , env diff --git a/src/Internal/Testnet/Server.purs b/src/Internal/Testnet/Server.purs index 5a63d1a51..c011bc13e 100644 --- a/src/Internal/Testnet/Server.purs +++ b/src/Internal/Testnet/Server.purs @@ -1,6 +1,6 @@ module Ctl.Internal.Testnet.Server ( Channels - , StartedTestnetCluster(MkStartedTestnetCluster) + , StartedTestnetCluster(StartedTestnetCluster) , startKupo , startOgmios , startTestnetCluster @@ -103,7 +103,7 @@ type Channels a = , stdout :: EventSource a } -newtype StartedTestnetCluster = MkStartedTestnetCluster +newtype StartedTestnetCluster = StartedTestnetCluster { ogmios :: { process :: ManagedProcess , channels :: Channels String @@ -224,7 +224,7 @@ startTestnetCluster cfg cleanupRef logger = do kupo <- annotateError "Could not start kupo" $ startKupo' { paths, workdir: workdirAbsolute } - pure $ MkStartedTestnetCluster + pure $ StartedTestnetCluster { paths , ogmios , kupo diff --git a/templates/ctl-scaffold/flake.lock b/templates/ctl-scaffold/flake.lock index e211ef521..394ec1757 100644 --- a/templates/ctl-scaffold/flake.lock +++ b/templates/ctl-scaffold/flake.lock @@ -1905,17 +1905,17 @@ "ogmios": "ogmios_2" }, "locked": { - "lastModified": 1744295997, - "narHash": "sha256-sdN2QmAZXksJvcTwLBggxId27+tzTySnWyP0TwQfDuc=", + "lastModified": 1746022448, + "narHash": "sha256-J3W8046Knh73quXe+FKKEUND5b6+rW06nPb2CTED1p8=", "owner": "Plutonomicon", "repo": "cardano-transaction-lib", - "rev": "7599eb6f57d58d5e2cee4c25c6c768392ea94d6e", + "rev": "9f7d48085966a4f4d2c5f1c190dca3cd700a502d", "type": "github" }, "original": { "owner": "Plutonomicon", "repo": "cardano-transaction-lib", - "rev": "7599eb6f57d58d5e2cee4c25c6c768392ea94d6e", + "rev": "9f7d48085966a4f4d2c5f1c190dca3cd700a502d", "type": "github" } }, diff --git a/templates/ctl-scaffold/flake.nix b/templates/ctl-scaffold/flake.nix index eaa24aef4..0c4377cbf 100644 --- a/templates/ctl-scaffold/flake.nix +++ b/templates/ctl-scaffold/flake.nix @@ -16,7 +16,7 @@ type = "github"; owner = "Plutonomicon"; repo = "cardano-transaction-lib"; - rev = "7599eb6f57d58d5e2cee4c25c6c768392ea94d6e"; + rev = "9f7d48085966a4f4d2c5f1c190dca3cd700a502d"; }; # To use the same version of `nixpkgs` as we do nixpkgs.follows = "ctl/nixpkgs"; diff --git a/templates/ctl-scaffold/packages.dhall b/templates/ctl-scaffold/packages.dhall index 33897c21b..57588d30f 100644 --- a/templates/ctl-scaffold/packages.dhall +++ b/templates/ctl-scaffold/packages.dhall @@ -1,7 +1,7 @@ let upstream = -- https://github.com/mlabs-haskell/purescript-cardano-package-set - https://raw.githubusercontent.com/mlabs-haskell/purescript-cardano-package-set/v3.0.0/packages.dhall - sha256:53f8de47606b6cb349432c2f2f03e656b204ebe132ef2d39d76339d9d97620ee + https://raw.githubusercontent.com/mlabs-haskell/purescript-cardano-package-set/v3.1.0/packages.dhall + sha256:0d8a7ca4e8ecfc8d1d795a989b76364caa9583d60e765c490cfa215a8824c246 let additions = { cardano-transaction-lib = @@ -112,7 +112,7 @@ let additions = , "web-storage" ] , repo = "https://github.com/Plutonomicon/cardano-transaction-lib.git" - , version = "7599eb6f57d58d5e2cee4c25c6c768392ea94d6e" + , version = "9f7d48085966a4f4d2c5f1c190dca3cd700a502d" } } diff --git a/templates/ctl-scaffold/spago-packages.nix b/templates/ctl-scaffold/spago-packages.nix index 2b41102a5..0d371873e 100644 --- a/templates/ctl-scaffold/spago-packages.nix +++ b/templates/ctl-scaffold/spago-packages.nix @@ -331,11 +331,11 @@ let "cardano-transaction-balancer" = pkgs.stdenv.mkDerivation { name = "cardano-transaction-balancer"; - version = "v1.0.0"; + version = "v1.1.0"; src = pkgs.fetchgit { url = "https://github.com/mlabs-haskell/purescript-cardano-transaction-balancer"; - rev = "6380e1998b5e6fd17c1961cc0290a41ffae7669e"; - sha256 = "0hn7gbw6zbxcpn71gc6z9xvwg48465h0kgkij56rwa154mfwhlr4"; + rev = "a2f5db9774a0128add6cac2c967c7b08e5dd1b8e"; + sha256 = "1r2zibh3fkbxh4wa7kdp3381j1332gr0ahp78qxybpr09vhvgzbv"; }; phases = "installPhase"; installPhase = "ln -s $src $out"; @@ -355,11 +355,11 @@ let "cardano-transaction-lib" = pkgs.stdenv.mkDerivation { name = "cardano-transaction-lib"; - version = "7599eb6f57d58d5e2cee4c25c6c768392ea94d6e"; + version = "9f7d48085966a4f4d2c5f1c190dca3cd700a502d"; src = pkgs.fetchgit { url = "https://github.com/Plutonomicon/cardano-transaction-lib.git"; - rev = "7599eb6f57d58d5e2cee4c25c6c768392ea94d6e"; - sha256 = "1rqf3w24zx13bfkj8kvkxgppd1y440c2rw64pl4lnphrc117dlxi"; + rev = "9f7d48085966a4f4d2c5f1c190dca3cd700a502d"; + sha256 = "17yn0cqhkxpnkhx6vbdypvjl6hqii99gipp5mbvix7laiv9vqx97"; }; phases = "installPhase"; installPhase = "ln -s $src $out"; diff --git a/test/Testnet.purs b/test/Testnet.purs index 7f29b68c0..32d29004e 100644 --- a/test/Testnet.purs +++ b/test/Testnet.purs @@ -26,6 +26,7 @@ import Mote.Monad (mapTest) import Mote.TestPlanM as Utils import Test.Ctl.BalanceTx.ChangeGeneration as ChangeGeneration import Test.Ctl.KupmiosM.AffInterface as KupmiosM.AffInterface +import Test.Ctl.Testnet.ClusterParameters (runTest) as ClusterParameters import Test.Ctl.Testnet.Contract as Contract import Test.Ctl.Testnet.Contract.Assert as Assert import Test.Ctl.Testnet.Contract.Mnemonics as Mnemonics @@ -64,6 +65,7 @@ main = interruptOnSignal SIGINT =<< launchAff do testTestnetContracts config OgmiosMempool.suite -- FIXME: ClusterParameters.runTest runTestnetTestPlan config SameWallets.suite + ClusterParameters.runTest {- configWithMaxExUnits :: PlutipConfig diff --git a/test/Testnet/ClusterParameters.purs b/test/Testnet/ClusterParameters.purs new file mode 100644 index 000000000..9152df8a5 --- /dev/null +++ b/test/Testnet/ClusterParameters.purs @@ -0,0 +1,48 @@ +module Test.Ctl.Testnet.ClusterParameters + ( mkSuite + , runTest + ) where + +import Prelude + +import Contract.Log (logDebug') +import Contract.Test (ContractTest, withWallets) +import Contract.Test.Mote (TestPlanM) +import Contract.Test.Testnet (defaultTestnetConfig, testTestnetContracts) +import Ctl.Internal.Contract.Hooks (ClusterParameters) +import Data.Maybe (Maybe(Just)) +import Effect.Aff (Aff) +import Effect.Class (liftEffect) +import Effect.Ref (Ref) +import Effect.Ref as Ref +import Mote (group, test) +import Node.FS.Sync (exists) +import Test.Spec.Assertions (shouldNotEqual, shouldReturn) + +runTest :: TestPlanM (Aff Unit) Unit +runTest = do + clusterParamsRef <- + liftEffect $ Ref.new + { nodeSocketPath: mempty + , nodeConfigPath: mempty + } + testTestnetContracts + defaultTestnetConfig + { hooks = defaultTestnetConfig.hooks + { onClusterStartup = Just (flip Ref.write clusterParamsRef) + } + } + (mkSuite clusterParamsRef) + +mkSuite :: Ref ClusterParameters -> TestPlanM ContractTest Unit +mkSuite ref = do + group "ClusterParameters" do + test "Reading cardano-testnet cluster parameters" do + withWallets unit \_ -> do + clusterParams <- liftEffect $ Ref.read ref + clusterParams.nodeSocketPath `shouldNotEqual` mempty + clusterParams.nodeConfigPath `shouldNotEqual` mempty + liftEffect (exists clusterParams.nodeSocketPath) `shouldReturn` true + liftEffect (exists clusterParams.nodeConfigPath) `shouldReturn` true + logDebug' $ "ClusterParameters: " <> show clusterParams + pure unit diff --git a/test/Testnet/Contract.purs b/test/Testnet/Contract.purs index 37ed10e76..2be531752 100644 --- a/test/Testnet/Contract.purs +++ b/test/Testnet/Contract.purs @@ -46,7 +46,8 @@ import Contract.BalanceTxConstraints , mustUseAdditionalUtxos ) as BalanceTxConstraints import Contract.BalanceTxConstraints - ( mustNotSpendUtxosWithOutRefs + ( mustNotSpendUtxosWhere + , mustNotSpendUtxosWithOutRefs , mustUseCollateralUtxos ) import Contract.Chain (currentTime, waitUntilSlot) @@ -107,6 +108,7 @@ import Contract.Transaction , lookupTxHash , signTransaction , submit + , submitTxFromBlueprint , submitTxFromConstraints , withBalancedTx , withBalancedTxs @@ -114,7 +116,7 @@ import Contract.Transaction import Contract.TxConstraints (TxConstraints) import Contract.TxConstraints as Constraints import Contract.UnbalancedTx (mkUnbalancedTx, mkUnbalancedTxE) -import Contract.Utxos (UtxoMap, utxosAt) +import Contract.Utxos (UtxoMap, getUtxo, utxosAt) import Contract.Value (Coin(Coin), Value, coinToValue) import Contract.Value as Value import Contract.Wallet @@ -132,7 +134,7 @@ import Contract.Wallet , signData , withKeyWallet ) -import Control.Monad.Error.Class (try) +import Control.Monad.Error.Class (liftEither, try) import Control.Monad.Trans.Class (lift) import Control.Parallel (parallel, sequential) import Ctl.Examples.AdditionalUtxos (contract) as AdditionalUtxos @@ -163,12 +165,12 @@ import Ctl.Internal.Test.UtxoDistribution (TestWalletSpec) import Ctl.Internal.Types.Interval (getSlotLength) import Ctl.Internal.Wallet.Cip30Mock (withCip30Mock) import Data.Array (head, (!!)) -import Data.Array (singleton) as Array +import Data.Array (replicate, singleton, take) as Array import Data.Either (Either(Left, Right), hush, isLeft, isRight) import Data.Foldable (fold, foldM, length) import Data.Lens (view) import Data.Map as Map -import Data.Maybe (Maybe(Just, Nothing), fromJust, fromMaybe, isJust) +import Data.Maybe (Maybe(Just, Nothing), fromJust, fromMaybe, isJust, maybe) import Data.Newtype (unwrap, wrap) import Data.Traversable (traverse, traverse_) import Data.Tuple (Tuple(Tuple)) @@ -198,6 +200,7 @@ import Test.Ctl.Testnet.Utils (getLockedInputs, submitAndLog) import Test.Ctl.Testnet.UtxoDistribution (checkUtxoDistribution) import Test.Spec.Assertions ( expectError + , fail , shouldEqual , shouldNotEqual , shouldReturn @@ -224,6 +227,7 @@ suite = do ] withWallets distribution \alice -> do withKeyWallet alice ManyAssets.contract + test "#1509 - Collateral set to one of the inputs in mustNotSpendUtxosWithOutRefs " do @@ -255,6 +259,59 @@ suite = do ) res `shouldSatisfy` isLeft + test + "#1581 - Fallback to CTL collateral selection when all collateral inputs are non-spendable" + do + let + distribution = + [ BigNum.fromInt 10_000_000 + , BigNum.fromInt 10_000_000 + ] + withWallets distribution \alice -> + withKeyWallet alice do + validator <- AlwaysSucceeds.alwaysSucceedsScript + let vhash = validatorHash validator + logInfo' "Attempt to lock value" + txId <- AlwaysSucceeds.payToAlwaysSucceeds vhash + awaitTxConfirmed txId + logInfo' "Try to spend locked values" + + scriptAddress <- mkAddress (wrap $ ScriptHashCredential vhash) + Nothing + utxos <- utxosAt scriptAddress + scriptUtxo <- + liftM + ( error + ( "The id " + <> show txId + <> " does not have output locked at: " + <> show scriptAddress + ) + ) + $ head (lookupTxHash txId utxos) + + unbalancedTx <- buildTx + [ SpendOutput scriptUtxo $ Just $ PlutusScriptOutput + (ScriptValue validator) + RedeemerDatum.unit + (Just $ DatumValue PlutusData.unit) + ] + + collUtxos <- getWalletCollateral + let + balancerConstraints = + maybe + mempty + (mustNotSpendUtxosWithOutRefs <<< Map.keys <<< toUtxoMap) + collUtxos + + balancedTx <- liftEither =<< defaultBalancer unbalancedTx + { balancerConstraints + , extraUtxos: toUtxoMap [ scriptUtxo ] + } + balancedSignedTx <- signTransaction balancedTx + submitAndLog balancedSignedTx + test "#1480 - test that does nothing but fails" do let someUtxos = @@ -281,6 +338,48 @@ suite = do withWallets distribution \_ → pure unit group "Contract interface" do + test "mustNotSpendUtxosWhere balancer constraint" do + let + distrSize = 10 + distr = Array.replicate distrSize $ BigNum.fromInt 2_000_000 + withWallets distr \alice -> + withKeyWallet alice do + address <- liftedM "Could not get wallet address" $ head <$> + getWalletAddresses + utxos <- liftedM "Could not get wallet utxos" getWalletUtxos + let + nonSpendableUtxos = Array.take (distrSize / 2) $ Map.toUnfoldable + utxos + { txHash } <- submitTxFromBlueprint + { buildSteps: + Array.singleton $ Pay $ TransactionOutput + { address + , amount: Value.lovelaceValueOf $ BigNum.fromInt 5_000_000 + , datum: Nothing + , scriptRef: Nothing + } + , balancer: defaultBalancer + , balancerCtx: + { balancerConstraints: + mustNotSpendUtxosWhere + ( \oref _ -> Map.member oref $ Map.fromFoldable + nonSpendableUtxos + ) + , extraUtxos: Map.empty + } + } + awaitTxConfirmed txHash + traverse_ + ( \(oref /\ _) -> + getUtxo oref >>= case _ of + Just _ -> pure unit + Nothing -> + fail $ + "mustNotSpendUtxosWhere: an unspendable utxo has been spent: " + <> show oref + ) + nonSpendableUtxos + test "mustUseCollateralUtxos should not fail if enough UTxOs are provided" do diff --git a/test/Unit.purs b/test/Unit.purs index 9dae79756..c338a9901 100644 --- a/test/Unit.purs +++ b/test/Unit.purs @@ -10,6 +10,7 @@ import Data.Time.Duration (Milliseconds(Milliseconds)) import Effect (Effect) import Effect.Aff (Aff, cancelWith, effectCanceler, launchAff) import Effect.Class (liftEffect) +import Mote (skip) import Mote.Monad (mapTest) import Test.Ctl.ApplyArgs as ApplyArgs import Test.Ctl.Blockfrost.Aeson.Suite as Blockfrost.Aeson @@ -51,7 +52,7 @@ testPlan = do Ipv6.suite NativeScript.suite Bip32.suite - CslGc.suite + skip CslGc.suite Data.suite Hashing.suite Partition.suite