Merge branch 'dshuiski/cluster-params' into dshuiski/balancer-constraints

Author: errfrom

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,7 @@ type Hooks =
   }
 
 type ClusterParameters =
-  { privateKeys :: Array PrivateKey
-  , nodeSocketPath :: String
-  , nodeConfigPath :: String
-  , privateKeysDirectory :: String
+  { nodeSocketPath :: FilePath
   }
 
 emptyHooks :: Hooks

src/Internal/Testnet/Contract.purs

@@ -77,8 +77,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
@@ -246,6 +246,11 @@ startTestnetContractEnv cfg distr cleanupRef = do
   { env, printLogs, clearLogs } <- makeClusterContractEnv cleanupRef cfg
   let env' = env { networkId = TestnetId }
   wallets <- mkWallets env' cluster
+  apathize $ liftEffect $
+    for_ env.hooks.onClusterStartup \onClusterStartup ->
+      onClusterStartup
+        { nodeSocketPath: (unwrap cluster).paths.nodeSocketPath
+        }
   pure
     { cluster
     , env: env'

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.QueryM.AffInterface as QueryM.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
@@ -63,7 +64,7 @@ main = interruptOnSignal SIGINT =<< launchAff do
           UtxoDistribution.suite
           testTestnetContracts config OgmiosMempool.suite
           runTestnetTestPlan config SameWallets.suite
--- FIXME: ClusterParameters.runTest
+          ClusterParameters.runTest
 
 {-
 configWithMaxExUnits :: PlutipConfig

test/Testnet/ClusterParameters.purs

@@ -0,0 +1,43 @@
+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 Test.Spec.Assertions (shouldNotEqual)
+
+runTest :: TestPlanM (Aff Unit) Unit
+runTest = do
+  clusterParamsRef <-
+    liftEffect $ Ref.new
+      { nodeSocketPath: 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
+        logDebug' $ "ClusterParameters: " <> show clusterParams
+        pure unit