Merge pull request #21 from input-output-hk/KtorZ/show-logs-on-failur…

…e-part-II

Show network logs on failure in Network specs.

hydra-node/hydra-node.cabal

@@ -190,6 +190,7 @@ test-suite tests
     , io-sim-classes
     , QuickCheck
     , quickcheck-instances
+    , say
     , typed-protocols-examples
     , HUnit
   build-tool-depends:

hydra-node/test/Hydra/NetworkSpec.hs

@@ -4,15 +4,14 @@
 -- | Test the real networking layer
 module Hydra.NetworkSpec where
 
-import Cardano.Prelude hiding (threadDelay)
+import Cardano.Prelude hiding (atomically, onException, threadDelay)
 
 import Cardano.Binary (FromCBOR, ToCBOR, fromCBOR, toCBOR)
 import Codec.CBOR.Read (deserialiseFromBytes)
 import Codec.CBOR.Write (toLazyByteString)
 import Control.Monad.Class.MonadAsync (concurrently_)
 import Hydra.HeadLogic (HydraMessage (..), Snapshot (..))
 import Hydra.Ledger.Mock (MockTx (..))
-import Hydra.Logging (nullTracer)
 import Hydra.Network (Network)
 import Hydra.Network.Ouroboros (broadcast, withOuroborosNetwork)
 import Hydra.Network.ZeroMQ (withZeroMQNetwork)
@@ -25,7 +24,7 @@ import Test.QuickCheck (
   oneof,
   property,
  )
-import Test.Util (arbitraryNatural, failAfter)
+import Test.Util (arbitraryNatural, failAfter, showLogsOnFailure)
 
 spec :: Spec
 spec = describe "Networking layer" $ do
@@ -37,22 +36,20 @@ spec = describe "Networking layer" $ do
   describe "Ouroboros Network" $ do
     it "broadcasts messages to single connected peer" $ do
       received <- newEmptyMVar
-      failAfter 10 $ do
-        -- TODO(MB): Capture the trace and print it on failures.
-        withOuroborosNetwork nullTracer (lo, 45678) [(lo, 45679)] (const @_ @(HydraMessage MockTx) $ pure ()) $ \hn1 ->
-          withOuroborosNetwork @(HydraMessage MockTx) nullTracer (lo, 45679) [(lo, 45678)] (putMVar received) $ \_ -> do
+      showLogsOnFailure $ \tracer -> failAfter 10 $ do
+        withOuroborosNetwork tracer (lo, 45678) [(lo, 45679)] (const @_ @(HydraMessage MockTx) $ pure ()) $ \hn1 ->
+          withOuroborosNetwork @(HydraMessage MockTx) tracer (lo, 45679) [(lo, 45678)] (putMVar received) $ \_ -> do
             broadcast hn1 requestTx
             takeMVar received `shouldReturn` requestTx
 
     it "broadcasts messages between 3 connected peers" $ do
       node1received <- newEmptyMVar
       node2received <- newEmptyMVar
       node3received <- newEmptyMVar
-      failAfter 10 $ do
-        -- TODO(MB): Capture the trace and print it on failures.
-        withOuroborosNetwork @(HydraMessage MockTx) nullTracer (lo, 45678) [(lo, 45679), (lo, 45680)] (putMVar node1received) $ \hn1 ->
-          withOuroborosNetwork nullTracer (lo, 45679) [(lo, 45678), (lo, 45680)] (putMVar node2received) $ \hn2 -> do
-            withOuroborosNetwork nullTracer (lo, 45680) [(lo, 45678), (lo, 45679)] (putMVar node3received) $ \hn3 -> do
+      showLogsOnFailure $ \tracer -> failAfter 10 $ do
+        withOuroborosNetwork @(HydraMessage MockTx) tracer (lo, 45678) [(lo, 45679), (lo, 45680)] (putMVar node1received) $ \hn1 ->
+          withOuroborosNetwork tracer (lo, 45679) [(lo, 45678), (lo, 45680)] (putMVar node2received) $ \hn2 -> do
+            withOuroborosNetwork tracer (lo, 45680) [(lo, 45678), (lo, 45679)] (putMVar node3received) $ \hn3 -> do
               concurrently_ (assertBroadcastFrom requestTx hn1 [node2received, node3received]) $
                 concurrently_
                   (assertBroadcastFrom requestTx hn2 [node1received, node3received])
@@ -63,11 +60,10 @@ spec = describe "Networking layer" $ do
       node1received <- newEmptyMVar
       node2received <- newEmptyMVar
       node3received <- newEmptyMVar
-      failAfter 10 $ do
-        -- TODO(MB): Capture the trace and print it on failures.
-        withZeroMQNetwork nullTracer (lo, 55677) [(lo, 55678), (lo, 55679)] (putMVar node1received) $ \hn1 ->
-          withZeroMQNetwork nullTracer (lo, 55678) [(lo, 55677), (lo, 55679)] (putMVar node2received) $ \hn2 ->
-            withZeroMQNetwork nullTracer (lo, 55679) [(lo, 55677), (lo, 55678)] (putMVar node3received) $ \hn3 -> do
+      showLogsOnFailure $ \tracer -> failAfter 10 $ do
+        withZeroMQNetwork tracer (lo, 55677) [(lo, 55678), (lo, 55679)] (putMVar node1received) $ \hn1 ->
+          withZeroMQNetwork tracer (lo, 55678) [(lo, 55677), (lo, 55679)] (putMVar node2received) $ \hn2 ->
+            withZeroMQNetwork tracer (lo, 55679) [(lo, 55677), (lo, 55678)] (putMVar node3received) $ \hn3 -> do
               concurrently_ (assertBroadcastFrom requestTx hn1 [node2received, node3received]) $
                 concurrently_
                   (assertBroadcastFrom requestTx hn2 [node1received, node3received])

hydra-node/test/Test/Util.hs

@@ -2,13 +2,21 @@
 
 module Test.Util where
 
-import Cardano.Prelude hiding (SrcLoc, callStack, throwIO)
-import Control.Monad.Class.MonadThrow (MonadThrow (throwIO))
+import Cardano.Prelude hiding (SrcLoc, atomically, callStack, onException, throwIO)
+
+import Control.Monad.Class.MonadSTM (
+  MonadSTM (..),
+  newTVarIO,
+  readTVar,
+ )
+import Control.Monad.Class.MonadThrow (MonadCatch, MonadThrow (throwIO), onException)
 import Control.Monad.Class.MonadTimer (DiffTime, MonadTimer, timeout)
 import Control.Monad.IOSim (IOSim, runSim)
 import Data.List (isInfixOf)
 import Data.String (String)
 import GHC.Stack (SrcLoc, callStack)
+import Hydra.Logging (Tracer, traceInTVar)
+import Say (say)
 import Test.HUnit.Lang (FailureReason (ExpectedButGot, Reason), HUnitFailure (HUnitFailure))
 import Test.QuickCheck (Gen, Positive (getPositive), arbitrary)
 
@@ -27,6 +35,15 @@ failAfter seconds action =
     Nothing -> failure $ "Test timed out after " <> show seconds <> " seconds"
     Just _ -> pure ()
 
+showLogsOnFailure ::
+  (MonadSTM m, MonadCatch m, MonadIO m, Show msg) =>
+  (Tracer m msg -> m a) ->
+  m a
+showLogsOnFailure action = do
+  tvar <- newTVarIO []
+  action (traceInTVar tvar)
+    `onException` (atomically (readTVar tvar) >>= mapM_ (say . show))
+
 -- | Run given 'action' in 'IOSim' and fail on exceptions.
 shouldRunInSim :: HasCallStack => (forall s. IOSim s a) -> IO a
 shouldRunInSim action =