Skip to content

Commit

Permalink
Restore onClusterStartup hook for cardano-testnet
Browse files Browse the repository at this point in the history
  • Loading branch information
errfrom committed Sep 17, 2024
1 parent be434c4 commit 566e715
Show file tree
Hide file tree
Showing 4 changed files with 53 additions and 7 deletions.
7 changes: 2 additions & 5 deletions src/Internal/Contract/Hooks.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -22,10 +22,7 @@ type Hooks =
}

type ClusterParameters =
{ privateKeys :: Array PrivateKey
, nodeSocketPath :: String
, nodeConfigPath :: String
, privateKeysDirectory :: String
{ nodeSocketPath :: FilePath
}

emptyHooks :: Hooks
Expand Down
7 changes: 6 additions & 1 deletion src/Internal/Testnet/Contract.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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'
Expand Down
3 changes: 2 additions & 1 deletion test/Testnet.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
43 changes: 43 additions & 0 deletions test/Testnet/ClusterParameters.purs
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit 566e715

Please sign in to comment.