Bump cardano-node to v10.1.4; Fix and refactor cardano-testnet

flake.nix

@@ -16,12 +16,12 @@
       flake = false;
     };
 
-    cardano-node.url = "github:input-output-hk/cardano-node/10.1.3";
+    cardano-node.url = "github:input-output-hk/cardano-node/10.1.4";
 
     # Repository with network parameters
     # NOTE(bladyjoker): Cardano configurations (yaml/json) often change format and break, that's why we pin to a specific known version.
     cardano-configurations = {
-      url = "github:input-output-hk/cardano-configurations?rev=3c5f35bda1b8fd29ab310ad222403a9167f512de";
+      url = "github:input-output-hk/cardano-configurations?rev=a913d87246dc2484562a00c86e5f9c74a20e82ce";
       flake = false;
     };
 

src/Internal/Testnet/Contract.purs

@@ -70,7 +70,7 @@ import Ctl.Internal.Testnet.Server
 import Ctl.Internal.Testnet.Types (TestnetConfig)
 import Ctl.Internal.Testnet.Utils
   ( cleanupOnExit
-  , read872GenesisKey
+  , readGenesisKey
   , runCleanup
   , whenError
   )
@@ -274,7 +274,7 @@ startTestnetContractEnv cfg distr cleanupRef = do
     readGenesisWallets =
       traverse
         ( \location -> do
-            paymentKey <- read872GenesisKey location
+            paymentKey <- readGenesisKey location
             pure $ mkKeyWalletFromPrivateKeys paymentKey Nothing Nothing
         )
         (unwrap cluster).paths.genesisKeys

src/Internal/Testnet/Server.purs

@@ -41,6 +41,7 @@ import Ctl.Internal.Testnet.Types
   ( TestnetClusterConfig
   , TestnetConfig
   , TestnetPaths
+  , TestnetRuntime
   )
 import Ctl.Internal.Testnet.Utils
   ( EventSource
@@ -214,19 +215,10 @@ startTestnetCluster
   -> Logger
   -> Aff StartedTestnetCluster
 startTestnetCluster cfg cleanupRef logger = do
-  { testnet, channels, workdirAbsolute } <-
+  { testnet, channels, workdirAbsolute, runtime: { paths } } <-
     annotateError "Could not start cardano-testnet" $
       startCardanoTestnet cfg.clusterConfig cleanupRef logger
 
-  { paths } <- waitUntil (Milliseconds 4000.0)
-    $ map hush
-    $ tryAndLogErrors "Waiting for ready state"
-    $ liftEffect do
-
-        paths <- liftEither =<< findTestnetPaths { workdir: workdirAbsolute }
-        runtime <- getRuntime paths
-        pure { runtime, paths }
-
   ogmios <- annotateError "Could not start ogmios"
     $ startOgmios' { paths, workdir: workdirAbsolute }
   kupo <- annotateError "Could not start kupo"
@@ -324,6 +316,7 @@ startCardanoTestnet
            , stdout :: EventSource String
            }
        , workdirAbsolute :: FilePath
+       , runtime :: TestnetRuntime
        }
 startCardanoTestnet params cleanupRef logger =
   annotateError "startCardanoTestnet" do
@@ -363,7 +356,13 @@ startCardanoTestnet params cleanupRef logger =
 
     channels <- liftEffect $ getChannels testnet
     attachStdoutMonitors testnet
-    pure { testnet, workdirAbsolute: workspace, channels }
+    runtime <- getTestnetRuntime workspace
+    pure
+      { testnet
+      , workdirAbsolute: workspace
+      , channels
+      , runtime
+      }
   where
   findWorkspaceDir :: forall m. MonadEffect m => FilePath -> m (Maybe FilePath)
   findWorkspaceDir workdir =
@@ -395,6 +394,14 @@ startCardanoTestnet params cleanupRef logger =
           logger Trace $ "Cleaning up cardano-testnet workspace: " <> workspace
           _rmdirSync workspace
 
+  getTestnetRuntime :: FilePath -> Aff TestnetRuntime
+  getTestnetRuntime workdir =
+    waitUntil (Milliseconds 4000.0) do
+      map hush $ tryAndLogErrors (Just logger) "getTestnetRuntime" $
+        liftEffect do
+          paths <- findTestnetPaths workdir
+          getRuntime paths
+
 type StdStreams =
   { stderr :: EventSource String
   , stdout :: EventSource String
@@ -449,14 +456,15 @@ redirectLogging
      }
   -> Aff (Aff.Fiber (Either Error Unit))
 redirectLogging events { handleLine, storeLogs } =
-  Aff.forkAff $ tryAndLogErrors "redirectLogging" $ flip tailRecM unit \_ -> do
-    line <- waitForEvent events
-    liftEffect $ suppressAndLogErrors "redirectLogging: callback error" $ void
-      do
-        handleLine line
-        for storeLogs \{ logFile, toString } ->
-          Node.FS.appendTextFile UTF8 logFile $ toString line <> "\n"
-    pure $ Loop unit
+  Aff.forkAff $ tryAndLogErrors Nothing "redirectLogging" $ flip tailRecM unit
+    \_ -> do
+      line <- waitForEvent events
+      liftEffect $ suppressAndLogErrors "redirectLogging: callback error" $ void
+        do
+          handleLine line
+          for storeLogs \{ logFile, toString } ->
+            Node.FS.appendTextFile UTF8 logFile $ toString line <> "\n"
+      pure $ Loop unit
 
 type ClusterConfig r =
   ( ogmiosConfig :: ServerConfig

src/Internal/Testnet/Types.purs

@@ -3,8 +3,6 @@ module Ctl.Internal.Testnet.Types
   , Era(Byron, Shelley, Allegra, Mary, Alonzo, Babbage, Conway)
   , LoggingFormat(LogAsJson, LogAsText)
   , TestnetPaths
-  , Event(Ready872, Finished, Failed, StartupFailed)
-  , StartupFailure(SpawnFailed, InitializationFailed)
   , NodeLocation
   , Node
   , GenesisUtxoKeyLocation
@@ -57,26 +55,6 @@ data Era
   | Babbage
   | Conway
 
-data StartupFailure
-  = SpawnFailed
-  | InitializationFailed
-
-derive instance Eq StartupFailure
-derive instance Generic StartupFailure _
-instance Show StartupFailure where
-  show = genericShow
-
-data Event
-  = Ready872 -- when cardano-testnet 8.7.2 is ready to go
-  | Finished
-  | Failed
-  | StartupFailed StartupFailure
-
-derive instance Eq Event
-derive instance Generic Event _
-instance Show Event where
-  show = genericShow
-
 instance Show Era where
   show = case _ of
     Byron -> "byron-era"
@@ -127,56 +105,38 @@ defaultOptionalStartupParams =
   , nodeLoggingFormat: Nothing
   }
 
+type TestnetRuntime =
+  { nodes :: Array Node
+  , paths :: TestnetPaths
+  }
+
 type TestnetPaths =
   { testnetDirectory :: FilePath
-  , genesisKeys :: Array { | GenesisUtxoKeyLocation () }
+  , genesisKeys :: Array GenesisUtxoKeyLocation
   , nodeConfigPath :: FilePath
   , nodeSocketPath :: FilePath
-  , nodeDirs :: Array { | NodeLocation () }
+  , nodeDirs :: Array NodeLocation
   }
 
-type Node r =
-  ( socket :: FilePath
+type Node =
+  { socket :: FilePath
   , port :: UInt
-  | NodeLocation r
-  )
+  , location :: NodeLocation
+  }
 
-type NodeLocation r =
-  ( idx :: Int
-  , name :: String
+type NodeLocation =
+  { idx :: Int
   , workdir :: FilePath
-  | r
-  )
+  }
 
-type GenesisUtxoKeyLocation r =
-  ( path :: FilePath
+type GenesisUtxoKeyLocation =
+  { path :: FilePath
   , idx :: Int
-  | r
-  )
-
-{-
-type TestnetClusterConfig r =
-  ( hooks :: Config.Hooks
-  | KupmiosConfig (LogParams r)
-  )
--}
+  }
 
 type LogParams r =
   ( logLevel :: LogLevel
   , customLogger :: Maybe (LogLevel -> Config.Message -> Aff Unit)
   , suppressLogs :: Boolean
   | r
   )
-
-{-
-type KupmiosConfig r =
-  ( kupoConfig :: Config.ServerConfig
-  , ogmiosConfig :: Config.ServerConfig
-  | r
-  )
--}
-
-type TestnetRuntime r =
-  ( nodes :: Array { | Node () }
-  | r
-  )