Restore onClusterStartup hook for cardano-testnet

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]
 

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

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

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

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

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

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";

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"
         }
       }
 

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

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