Merge pull request #1226 from input-output-hk/check-protocol-parameters-roundtrip

Align protocol parameters JSON

Author: ch1bo

.github/workflows/ci-nix.yaml

@@ -174,6 +174,14 @@ jobs:
         name: benchmarks-${{matrix.package}}-${{matrix.bench}}
         path: benchmarks
 
+    # NOTE: This depends on the path used in hydra-cluster bench
+    - name: 💾 Upload logs
+      if: always()
+      uses: actions/upload-artifact@v4
+      with:
+        name: hydra-cluster-bench-logs
+        path: /tmp/nix-shell.*/bench-*/**/*.log
+
   publish-benchmark-results:
     name: Publish benchmark results
     if: github.event_name == 'pull_request' && github.event.pull_request.head.repo.full_name == github.repository

hydra-cluster/bench/Bench/EndToEnd.hs

@@ -77,7 +77,8 @@ data Event = Event
   deriving anyclass (ToJSON)
 
 bench :: Int -> DiffTime -> FilePath -> Dataset -> IO Summary
-bench startingNodeId timeoutSeconds workDir dataset@Dataset{clientDatasets, title, description} =
+bench startingNodeId timeoutSeconds workDir dataset@Dataset{clientDatasets, title, description} = do
+  putStrLn $ "Test logs available in: " <> (workDir </> "test.log")
   withFile (workDir </> "test.log") ReadWriteMode $ \hdl ->
     withTracerOutputTo hdl "Test" $ \tracer ->
       failAfter timeoutSeconds $ do
@@ -87,12 +88,13 @@ bench startingNodeId timeoutSeconds workDir dataset@Dataset{clientDatasets, titl
         let parties = Set.fromList (deriveParty <$> hydraKeys)
         let clusterSize = fromIntegral $ length clientDatasets
         withOSStats workDir $
-          withCardanoNodeDevnet (contramap FromCardanoNode tracer) workDir $ \node@RunningNode{nodeSocket, pparams} -> do
+          withCardanoNodeDevnet (contramap FromCardanoNode tracer) workDir $ \node@RunningNode{nodeSocket} -> do
             putTextLn "Seeding network"
             let hydraTracer = contramap FromHydraNode tracer
             hydraScriptsTxId <- seedNetwork node dataset (contramap FromFaucet tracer)
             let contestationPeriod = UnsafeContestationPeriod 10
-            withHydraCluster hydraTracer workDir nodeSocket startingNodeId cardanoKeys hydraKeys hydraScriptsTxId pparams contestationPeriod $ \(leader :| followers) -> do
+            putStrLn $ "Starting hydra cluster in " <> workDir
+            withHydraCluster hydraTracer workDir nodeSocket startingNodeId cardanoKeys hydraKeys hydraScriptsTxId contestationPeriod $ \(leader :| followers) -> do
               let clients = leader : followers
               waitForNodesConnected hydraTracer 20 clients
 
@@ -238,14 +240,17 @@ seedNetwork :: RunningNode -> Dataset -> Tracer IO FaucetLog -> IO TxId
 seedNetwork node@RunningNode{nodeSocket, networkId} Dataset{fundingTransaction, clientDatasets} tracer = do
   fundClients
   forM_ clientDatasets fuelWith100Ada
+  putTextLn "Publishing hydra scripts"
   publishHydraScriptsAs node Faucet
  where
   fundClients = do
+    putTextLn "Fund scenario from faucet"
     submitTransaction networkId nodeSocket fundingTransaction
     void $ awaitTransaction networkId nodeSocket fundingTransaction
 
   fuelWith100Ada ClientDataset{clientKeys = ClientKeys{signingKey}} = do
     let vk = getVerificationKey signingKey
+    putTextLn $ "Seed client " <> show vk
     seedFromFaucet node vk 100_000_000 tracer
 
 -- | Commit all (expected to exit) 'initialUTxO' from the dataset using the

hydra-cluster/bench/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 
 module Main where
 
@@ -10,69 +11,71 @@ import Bench.Options (Options (..), benchOptionsParser)
 import Bench.Summary (Summary (..), markdownReport, textReport)
 import Cardano.Binary (decodeFull, serialize)
 import Data.Aeson (eitherDecodeFileStrict')
-import Data.ByteString (hPut)
 import Data.ByteString.Base16 qualified as Base16
 import Data.ByteString.Lazy qualified as LBS
 import Hydra.Cardano.Api (
   ShelleyBasedEra (..),
   ShelleyGenesis (..),
   fromLedgerPParams,
  )
-import Hydra.Generator (Dataset, generateConstantUTxODataset)
+import Hydra.Generator (Dataset (..), generateConstantUTxODataset)
 import Options.Applicative (
   execParser,
  )
-import System.Directory (createDirectory, createDirectoryIfMissing, doesDirectoryExist)
+import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
 import System.Environment (withArgs)
-import System.FilePath ((</>))
+import System.FilePath (takeDirectory, takeFileName, (</>))
 import Test.HUnit.Lang (formatFailureReason)
 import Test.QuickCheck (generate, getSize, scale)
 
 main :: IO ()
 main =
   execParser benchOptionsParser >>= \case
-    StandaloneOptions{workDirectory = Just benchDir, outputDirectory, timeoutSeconds, startingNodeId, scalingFactor, clusterSize} -> do
-      existsDir <- doesDirectoryExist benchDir
+    StandaloneOptions{workDirectory = Just workDir, outputDirectory, timeoutSeconds, startingNodeId, scalingFactor, clusterSize} -> do
+      -- XXX: This option is a bit weird as it allows to re-run a test by
+      -- providing --work-directory, which is now redundant of the dataset
+      -- sub-command.
+      existsDir <- doesDirectoryExist workDir
       if existsDir
-        then replay outputDirectory timeoutSeconds startingNodeId benchDir
-        else createDirectory benchDir >> play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId benchDir
+        then replay outputDirectory timeoutSeconds startingNodeId workDir
+        else play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId workDir
     StandaloneOptions{workDirectory = Nothing, outputDirectory, timeoutSeconds, scalingFactor, clusterSize, startingNodeId} -> do
-      tmpDir <- createSystemTempDirectory "bench"
-      play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId tmpDir
+      workDir <- createSystemTempDirectory "bench"
+      play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId workDir
     DatasetOptions{datasetFiles, outputDirectory, timeoutSeconds, startingNodeId} -> do
-      benchDir <- createSystemTempDirectory "bench"
-      datasets <- mapM loadDataset datasetFiles
-      let targets = zip datasets $ (benchDir </>) . show <$> [1 .. length datasets]
-      forM_ (snd <$> targets) (createDirectoryIfMissing True)
-      run outputDirectory timeoutSeconds startingNodeId targets
+      run outputDirectory timeoutSeconds startingNodeId datasetFiles
  where
-  play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId benchDir = do
+  play outputDirectory timeoutSeconds scalingFactor clusterSize startingNodeId workDir = do
+    putStrLn $ "Generating single dataset in work directory: " <> workDir
     numberOfTxs <- generate $ scale (* scalingFactor) getSize
     pparams <-
       eitherDecodeFileStrict' ("config" </> "devnet" </> "genesis-shelley.json") >>= \case
         Left err -> fail $ show err
         Right shelleyGenesis ->
           pure $ fromLedgerPParams ShelleyBasedEraShelley (sgProtocolParams shelleyGenesis)
     dataset <- generateConstantUTxODataset pparams (fromIntegral clusterSize) numberOfTxs
-    saveDataset (benchDir </> "dataset.cbor") dataset
-    run outputDirectory timeoutSeconds startingNodeId [(dataset, benchDir)]
+    let datasetPath = workDir </> "dataset.cbor"
+    saveDataset datasetPath dataset
+    run outputDirectory timeoutSeconds startingNodeId [datasetPath]
 
   replay outputDirectory timeoutSeconds startingNodeId benchDir = do
-    dataset <- loadDataset $ benchDir </> "dataset.cbor"
-    putStrLn $ "Using UTxO and Transactions from: " <> benchDir
-    run outputDirectory timeoutSeconds startingNodeId [(dataset, benchDir)]
+    let datasetPath = benchDir </> "dataset.cbor"
+    putStrLn $ "Replaying single dataset from work directory: " <> datasetPath
+    run outputDirectory timeoutSeconds startingNodeId [datasetPath]
 
-  run outputDirectory timeoutSeconds startingNodeId targets = do
-    results <- forM targets $ \(dataset, dir) -> do
-      putStrLn $ "Test logs available in: " <> (dir </> "test.log")
-      withArgs [] $ do
-        -- XXX: Wait between each bench run to give the OS time to cleanup resources??
-        threadDelay 10
-        try @_ @HUnitFailure (bench startingNodeId timeoutSeconds dir dataset) >>= \case
-          Left exc -> pure $ Left (dataset, dir, TestFailed exc)
-          Right summary@Summary{numberOfInvalidTxs}
-            | numberOfInvalidTxs == 0 -> pure $ Right summary
-            | otherwise -> pure $ Left (dataset, dir, InvalidTransactions numberOfInvalidTxs)
+  run outputDirectory timeoutSeconds startingNodeId datasetFiles = do
+    results <- forM datasetFiles $ \datasetPath -> do
+      putTextLn $ "Running benchmark with dataset " <> show datasetPath
+      dataset <- loadDataset datasetPath
+      withTempDir ("bench-" <> takeFileName datasetPath) $ \dir ->
+        withArgs [] $ do
+          -- XXX: Wait between each bench run to give the OS time to cleanup resources??
+          threadDelay 10
+          try @_ @HUnitFailure (bench startingNodeId timeoutSeconds dir dataset) >>= \case
+            Left exc -> pure $ Left (dataset, dir, TestFailed exc)
+            Right summary@Summary{numberOfInvalidTxs}
+              | numberOfInvalidTxs == 0 -> pure $ Right summary
+              | otherwise -> pure $ Left (dataset, dir, InvalidTransactions numberOfInvalidTxs)
     let (failures, summaries) = partitionEithers results
     case failures of
       [] -> benchmarkSucceeded outputDirectory summaries
@@ -86,6 +89,7 @@ main =
   saveDataset :: FilePath -> Dataset -> IO ()
   saveDataset f dataset = do
     putStrLn $ "Writing dataset to: " <> f
+    createDirectoryIfMissing True $ takeDirectory f
     writeFileBS f $ Base16.encode $ LBS.toStrict $ serialize dataset
 
 data BenchmarkFailed
@@ -116,8 +120,9 @@ benchmarkSucceeded outputDirectory summaries = do
   dumpToStdout = mapM_ putTextLn (concatMap textReport summaries)
 
   writeReport outputDir = do
+    let reportPath = outputDir </> "end-to-end-benchmarks.md"
+    putStrLn $ "Writing report to: " <> reportPath
     now <- getCurrentTime
     let report = markdownReport now summaries
     createDirectoryIfMissing True outputDir
-    withFile (outputDir </> "end-to-end-benchmarks.md") WriteMode $ \hdl -> do
-      hPut hdl $ encodeUtf8 $ unlines report
+    writeFileBS reportPath . encodeUtf8 $ unlines report