Add a MithrilLog tracer

This keeps the log output of tests clean and consistent with outputs of
cardano-node and hydra-node processes.

hydra-cluster/exe/hydra-cluster/Main.hs

@@ -25,7 +25,7 @@ run options =
       case knownNetwork of
         Just network -> do
           when (useMithril == UseMithril) $
-            downloadLatestSnapshotTo network workDir
+            downloadLatestSnapshotTo (contramap FromMithril tracer) network workDir
           withCardanoNodeOnKnownNetwork fromCardanoNode workDir network $ \node -> do
             waitForFullySynchronized fromCardanoNode node
             publishOrReuseHydraScripts tracer node

hydra-cluster/hydra-cluster.cabal

@@ -105,6 +105,7 @@ library
     , temporary
     , text
     , time
+    , typed-process
     , unix
     , websockets
 

hydra-cluster/src/Hydra/Cluster/Fixture.hs

@@ -63,4 +63,5 @@ data KnownNetwork
   = Preview
   | Preproduction
   | Mainnet
-  deriving stock (Show, Eq, Enum, Bounded)
+  deriving stock (Generic, Show, Eq, Enum, Bounded)
+  deriving anyclass (ToJSON, FromJSON)

hydra-cluster/src/Hydra/Cluster/Mithril.hs

@@ -3,26 +3,46 @@ module Hydra.Cluster.Mithril where
 
 import Hydra.Prelude
 
+import Control.Tracer (Tracer, traceWith)
+import Data.Aeson (Value)
+import Data.Aeson qualified as Aeson
+import Data.ByteString qualified as BS
 import Hydra.Cluster.Fixture (KnownNetwork (..))
 import Network.HTTP.Simple (getResponseBody, httpBS, parseRequest)
-import System.Process (callProcess)
+import System.Process.Typed (createPipe, getStdout, proc, setStdout, withProcessWait_)
+
+data MithrilLog
+  = StartSnapshotDownload {network :: KnownNetwork, directory :: FilePath}
+  | -- | Output captured directly from mithril-client
+    StdOut {output :: Value}
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (ToJSON, FromJSON)
 
 -- | Downloads and unpacks latest snapshot for given network in db/ of given
 -- directory.
-downloadLatestSnapshotTo :: KnownNetwork -> FilePath -> IO ()
-downloadLatestSnapshotTo network dir = do
-  -- TODO: Use a tracer?
-  putTextLn $ "Downloading latest snapshot of " <> show network <> " to " <> show dir
+downloadLatestSnapshotTo :: Tracer IO MithrilLog -> KnownNetwork -> FilePath -> IO ()
+downloadLatestSnapshotTo tracer network directory = do
+  traceWith tracer StartSnapshotDownload{network, directory}
   genesisKey <- parseRequest (genesisKeyURLForNetwork network) >>= httpBS <&> getResponseBody
-  -- TODO: not inherit handles?
-  callProcess "mithril-client" $
-    concat
-      [ ["--aggregator-endpoint", aggregatorEndpointForNetwork network]
-      , ["snapshot", "download", "latest"]
-      , ["--genesis-verification-key", decodeUtf8 genesisKey]
-      , ["--download-dir", dir]
-      ]
+  let cmd =
+        setStdout createPipe $
+          proc "mithril-client" $
+            concat
+              [ ["--aggregator-endpoint", aggregatorEndpointForNetwork network]
+              , ["snapshot", "download", "latest"]
+              , ["--genesis-verification-key", decodeUtf8 genesisKey]
+              , ["--download-dir", directory]
+              , ["--json"]
+              ]
+  withProcessWait_ cmd traceStdout
  where
+  traceStdout p =
+    forever $ do
+      bytes <- BS.hGetLine (getStdout p)
+      case Aeson.eitherDecodeStrict bytes of
+        Left err -> error $ "failed to decode: \n" <> show bytes <> "\nerror: " <> show err
+        Right output -> traceWith tracer StdOut{output}
+
   genesisKeyURLForNetwork = \case
     Mainnet -> "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-mainnet/genesis.vkey"
     Preproduction -> "https://raw.githubusercontent.com/input-output-hk/mithril/main/mithril-infra/configuration/release-preprod/genesis.vkey"

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -59,6 +59,7 @@ import Hydra.Chain.Direct.Tx (verificationKeyToOnChainId)
 import Hydra.Cluster.Faucet (FaucetLog, createOutputAtAddress, seedFromFaucet, seedFromFaucet_)
 import Hydra.Cluster.Faucet qualified as Faucet
 import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk, carol, carolSk)
+import Hydra.Cluster.Mithril (MithrilLog)
 import Hydra.Cluster.Util (chainConfigFor, keysFor, modifyConfig, setNetworkId)
 import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromNominalDiffTime)
 import Hydra.HeadId (HeadId)
@@ -104,6 +105,7 @@ data EndToEndLog
   = FromCardanoNode NodeLog
   | FromFaucet FaucetLog
   | FromHydraNode HydraNodeLog
+  | FromMithril MithrilLog
   | StartingFunds {actor :: String, utxo :: UTxO}
   | RefueledFunds {actor :: String, refuelingAmount :: Lovelace, utxo :: UTxO}
   | RemainingFunds {actor :: String, utxo :: UTxO}

hydra-cluster/test/Test/Hydra/Cluster/MithrilSpec.hs

@@ -5,20 +5,20 @@ import Test.Hydra.Prelude
 
 import Hydra.Cluster.Fixture (KnownNetwork)
 import Hydra.Cluster.Mithril (downloadLatestSnapshotTo)
+import Hydra.Logging (showLogsOnFailure)
 import System.Directory (doesDirectoryExist, listDirectory)
 import System.FilePath ((</>))
 
 spec :: Spec
-spec = do
+spec = parallel $ do
   describe "downloadLatestSnapshotTo" $
-    -- TODO: generate test tree instead of folding into one case (timings etc.)
-    it "starts downloading db" $ do
-      forAllNetworks $ \network ->
+    forAllNetworks "starts downloading db" $ \network ->
+      showLogsOnFailure "MithrilSpec" $ \tracer ->
         withTempDir ("mithril-download-" <> show network) $ \tmpDir -> do
           let dbPath = tmpDir </> "db"
           doesDirectoryExist dbPath `shouldReturn` False
           race_
-            (downloadLatestSnapshotTo network tmpDir)
+            (downloadLatestSnapshotTo tracer network tmpDir)
             (failAfter 60 $ waitUntilDirContainsFiles dbPath)
 
 waitUntilDirContainsFiles :: FilePath -> IO ()
@@ -32,5 +32,7 @@ waitUntilDirContainsFiles dir = do
         else pure ()
     else threadDelay 1 >> waitUntilDirContainsFiles dir
 
-forAllNetworks :: (KnownNetwork -> IO ()) -> IO ()
-forAllNetworks f = foldMap f (enumFromTo minBound maxBound)
+forAllNetworks :: String -> (KnownNetwork -> IO ()) -> Spec
+forAllNetworks msg action =
+  forM_ (enumFromTo minBound maxBound) $ \network ->
+    it (msg <> " (" <> show network <> ")") $ action network