Caputure stderr of mithril-client and wait for bytes_downloaded

They slightly changed the messages produced by mithril-client.

Author: ch1bo

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

@@ -10,12 +10,12 @@ import Data.ByteString qualified as BS
 import Hydra.Cluster.Fixture (KnownNetwork (..))
 import Network.HTTP.Simple (getResponseBody, httpBS, parseRequest)
 import System.IO.Error (isEOFError)
-import System.Process.Typed (createPipe, getStdout, proc, setStdout, withProcessWait_)
+import System.Process.Typed (createPipe, getStderr, proc, setStderr, withProcessWait_)
 
 data MithrilLog
   = StartSnapshotDownload {network :: KnownNetwork, directory :: FilePath}
-  | -- | Output captured directly from mithril-client
-    StdOut {output :: Value}
+  | -- | Output captured directly from mithril-client stderr.
+    StdErr {output :: Value}
   deriving stock (Eq, Show, Generic)
   deriving anyclass (ToJSON, FromJSON)
 
@@ -28,7 +28,7 @@ downloadLatestSnapshotTo tracer network directory = do
       traceWith tracer StartSnapshotDownload{network, directory}
       genesisKey <- parseRequest genesisKeyURL >>= httpBS <&> getResponseBody
       let cmd =
-            setStdout createPipe $
+            setStderr createPipe $
               proc "mithril-client" $
                 concat
                   [ ["--aggregator-endpoint", aggregatorEndpoint]
@@ -37,15 +37,15 @@ downloadLatestSnapshotTo tracer network directory = do
                   , ["--download-dir", directory]
                   , ["--json"]
                   ]
-      withProcessWait_ cmd traceStdout
+      withProcessWait_ cmd traceStderr
     _ -> error $ "Network " <> show network <> " not supported by mithril."
  where
-  traceStdout p =
+  traceStderr p =
     ignoreEOFErrors . forever $ do
-      bytes <- BS.hGetLine (getStdout p)
+      bytes <- BS.hGetLine (getStderr p)
       case Aeson.eitherDecodeStrict bytes of
         Left err -> error $ "failed to decode: \n" <> show bytes <> "\nerror: " <> show err
-        Right output -> traceWith tracer StdOut{output}
+        Right output -> traceWith tracer StdErr{output}
 
   ignoreEOFErrors =
     handleJust (guard . isEOFError) (const $ pure ())

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

@@ -4,8 +4,8 @@ import Hydra.Prelude
 import Test.Hydra.Prelude
 
 import Control.Concurrent.Class.MonadSTM (newTVarIO, readTVarIO)
-import Control.Lens ((^?!))
-import Data.Aeson.Lens (key, _Number)
+import Control.Lens ((^?))
+import Data.Aeson.Lens (key)
 import Hydra.Cluster.Mithril (MithrilLog (..), downloadLatestSnapshotTo)
 import Hydra.Logging (Envelope (..), Tracer, traceInTVar)
 import System.Directory (doesDirectoryExist)
@@ -22,19 +22,19 @@ spec = parallel $ do
         doesDirectoryExist dbPath `shouldReturn` False
         race_
           (downloadLatestSnapshotTo tracer network tmpDir)
-          (waitForStep 3 getTraces)
+          (waitForDownload getTraces)
 
--- | Wait for the 'StdOut' message that matches the given step number.
-waitForStep :: HasCallStack => Natural -> IO [Envelope MithrilLog] -> IO ()
-waitForStep step getTraces = do
+-- | Wait for the 'StdErr' message to indicate it starts downloading.
+waitForDownload :: HasCallStack => IO [Envelope MithrilLog] -> IO ()
+waitForDownload getTraces = do
   traces <- getTraces
-  unless (any isRightStep traces) $ do
+  unless (any isRightTrace traces) $ do
     threadDelay 1
-    waitForStep step getTraces
+    waitForDownload getTraces
  where
-  isRightStep = \case
-    Envelope{message = StdOut{output}} ->
-      output ^?! key "step_num" . _Number == fromIntegral step
+  isRightTrace = \case
+    Envelope{message = StdErr{output}} ->
+      isJust $ output ^? key "bytes_downloaded"
     _ -> False
 
 -- | Create a tracer that captures all messages and a function to retrieve all