Add spec namespace when showing logs on failure

hydra-cluster/test/Test/CardanoClientSpec.hs

@@ -15,7 +15,7 @@ import Test.EndToEndSpec (withClusterTempDir)
 
 spec :: Spec
 spec =
-  around showLogsOnFailure $
+  around (showLogsOnFailure "CardanoClientSpec") $
     it "queryGenesisParameters works as expected" $ \tracer ->
       failAfter 60 $
         withClusterTempDir "queryGenesisParameters" $ \tmpDir -> do

hydra-cluster/test/Test/CardanoNodeSpec.hs

@@ -26,7 +26,7 @@ spec = do
   -- genesis-shelley.json
   it "withCardanoNodeDevnet does start a block-producing devnet within 5 seconds" $
     failAfter 5 $
-      showLogsOnFailure $ \tr -> do
+      showLogsOnFailure "CardanoNodeSpec" $ \tr -> do
         withTempDir "hydra-cluster" $ \tmp -> do
           withCardanoNodeDevnet tr tmp $ \RunningNode{nodeSocket, networkId} -> do
             doesFileExist (unFile nodeSocket) `shouldReturn` True

hydra-cluster/test/Test/ChainObserverSpec.hs

@@ -31,7 +31,7 @@ spec :: Spec
 spec = do
   it "can observe hydra transactions created by hydra-nodes" $
     failAfter 60 $
-      showLogsOnFailure $ \tracer -> do
+      showLogsOnFailure "ChainObserverSpec" $ \tracer -> do
         withTempDir "hydra-chain-observer" $ \tmpDir -> do
           -- Start a cardano devnet
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \cardanoNode@RunningNode{nodeSocket} -> do

hydra-cluster/test/Test/DirectChainSpec.hs

@@ -81,7 +81,7 @@ import System.Process (proc, readCreateProcess)
 import Test.QuickCheck (generate)
 
 spec :: Spec
-spec = around showLogsOnFailure $ do
+spec = around (showLogsOnFailure "DirectChainSpec") $ do
   it "can init and abort a head given nothing has been committed" $ \tracer -> do
     withTempDir "hydra-cluster" $ \tmp -> do
       withCardanoNodeDevnet (contramap FromNode tracer) tmp $ \node@RunningNode{nodeSocket} -> do

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -112,7 +112,7 @@ withClusterTempDir name =
   withTempDir ("hydra-cluster-e2e-" <> name)
 
 spec :: Spec
-spec = around showLogsOnFailure $
+spec = around (showLogsOnFailure "EndToEndSpec") $
   describe "End-to-end on Cardano devnet" $ do
     describe "single party hydra head" $ do
       it "full head life-cycle" $ \tracer -> do

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

@@ -19,7 +19,7 @@ spec :: Spec
 spec = do
   describe "seedFromFaucet" $
     it "should work concurrently" $
-      showLogsOnFailure $ \tracer ->
+      showLogsOnFailure "FaucetSpec" $ \tracer ->
         failAfter 30 $
           withTempDir "end-to-end-cardano-node" $ \tmpDir ->
             withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
@@ -29,7 +29,7 @@ spec = do
 
   describe "returnFundsToFaucet" $
     it "seedFromFaucet and returnFundsToFaucet work together" $ do
-      showLogsOnFailure $ \tracer ->
+      showLogsOnFailure "FaucetSpec" $ \tracer ->
         withTempDir "end-to-end-cardano-node" $ \tmpDir ->
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node@RunningNode{networkId, nodeSocket} -> do
             let faucetTracer = contramap FromFaucet tracer

hydra-node/src/Hydra/Logging.hs

@@ -128,19 +128,21 @@ withTracerOutputTo hdl namespace action = do
 -- metadata.
 showLogsOnFailure ::
   (MonadSTM m, MonadCatch m, MonadFork m, MonadTime m, MonadSay m, ToJSON msg) =>
+  Text ->
   (Tracer m msg -> m a) ->
   m a
-showLogsOnFailure action = do
+showLogsOnFailure namespace action = do
   tvar <- newTVarIO []
-  action (traceInTVar tvar)
+  action (traceInTVar tvar namespace)
     `onException` (readTVarIO tvar >>= mapM_ (say . decodeUtf8 . Aeson.encode) . reverse)
 
 traceInTVar ::
   (MonadFork m, MonadTime m, MonadSTM m) =>
   TVar m [Envelope msg] ->
+  Text ->
   Tracer m msg
-traceInTVar tvar = Tracer $ \msg -> do
-  envelope <- mkEnvelope "TEST" msg
+traceInTVar tvar namespace = Tracer $ \msg -> do
+  envelope <- mkEnvelope namespace msg
   atomically $ modifyTVar tvar (envelope :)
 -- * Internal functions
 

hydra-node/test/Hydra/API/ServerSpec.hs

@@ -58,7 +58,7 @@ spec :: Spec
 spec = describe "ServerSpec" $
   parallel $ do
     it "should fail on port in use" $ do
-      showLogsOnFailure $ \tracer -> failAfter 5 $ do
+      showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $ do
         let withServerOnPort p = withTestAPIServer p alice mockPersistence tracer
         withFreePort $ \port -> do
           -- We should not be able to start the server on the same port twice
@@ -70,15 +70,15 @@ spec = describe "ServerSpec" $
 
     it "greets" $ do
       failAfter 5 $
-        showLogsOnFailure $ \tracer ->
+        showLogsOnFailure "ServerSpec" $ \tracer ->
           withFreePort $ \port ->
             withTestAPIServer port alice mockPersistence tracer $ \_ -> do
               withClient port "/" $ \conn -> do
                 waitMatch 5 conn $ guard . matchGreetings
 
     it "Greetings should contain the hydra-node version" $ do
       failAfter 5 $
-        showLogsOnFailure $ \tracer ->
+        showLogsOnFailure "ServerSpec" $ \tracer ->
           withFreePort $ \port ->
             withTestAPIServer port alice mockPersistence tracer $ \_ -> do
               withClient port "/" $ \conn -> do
@@ -89,7 +89,7 @@ spec = describe "ServerSpec" $
 
     it "sends sendOutput to all connected clients" $ do
       queue <- atomically newTQueue
-      showLogsOnFailure $ \tracer -> failAfter 5 $
+      showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $
         withFreePort $ \port -> do
           withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
             semaphore <- newTVarIO 0
@@ -110,7 +110,7 @@ spec = describe "ServerSpec" $
                 failAfter 1 $ atomically (tryReadTQueue queue) `shouldReturn` Nothing
 
     it "sends all sendOutput history to all connected clients after a restart" $ do
-      showLogsOnFailure $ \tracer -> failAfter 5 $
+      showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $
         withTempDir "ServerSpec" $ \tmpDir -> do
           let persistentFile = tmpDir <> "/history"
           arbitraryMsg <- generate arbitrary
@@ -158,7 +158,7 @@ spec = describe "ServerSpec" $
         monitor $ cover 0.1 (length outputs == 1) "only one message when reconnecting"
         monitor $ cover 1 (length outputs > 1) "more than one message when reconnecting"
         run $
-          showLogsOnFailure $ \tracer ->
+          showLogsOnFailure "ServerSpec" $ \tracer ->
             withFreePort $ \port ->
               withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
                 mapM_ sendOutput outputs
@@ -178,7 +178,7 @@ spec = describe "ServerSpec" $
         monitor $ cover 0.1 (length history == 1) "only one message when reconnecting"
         monitor $ cover 1 (length history > 1) "more than one message when reconnecting"
         run $
-          showLogsOnFailure $ \tracer ->
+          showLogsOnFailure "ServerSpec" $ \tracer ->
             withFreePort $ \port ->
               withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
                 let sendFromApiServer = sendOutput
@@ -202,7 +202,7 @@ spec = describe "ServerSpec" $
                       (output <$> timedOutputs') `shouldBe` [notHistoryMessage]
 
     it "outputs tx as cbor or json depending on the client" $
-      showLogsOnFailure $ \tracer ->
+      showLogsOnFailure "ServerSpec" $ \tracer ->
         withFreePort $ \port ->
           withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
             tx :: SimpleTx <- generate arbitrary
@@ -264,7 +264,7 @@ spec = describe "ServerSpec" $
                 guardForValue v (toJSON tx)
 
     it "removes UTXO from snapshot when clients request it" $
-      showLogsOnFailure $ \tracer -> failAfter 5 $
+      showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $
         withFreePort $ \port ->
           withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
             snapshot <- generate arbitrary
@@ -285,7 +285,7 @@ spec = describe "ServerSpec" $
       monadicIO $ do
         outputs :: [ServerOutput SimpleTx] <- pick arbitrary
         run $
-          showLogsOnFailure $ \tracer -> failAfter 5 $
+          showLogsOnFailure "ServerSpec" $ \tracer -> failAfter 5 $
             withFreePort $ \port ->
               withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
                 mapM_ sendOutput outputs
@@ -298,7 +298,7 @@ spec = describe "ServerSpec" $
                       seq <$> timedOutputs `shouldSatisfy` strictlyMonotonic
 
     it "displays correctly headStatus and snapshotUtxo in a Greeting message" $
-      showLogsOnFailure $ \tracer ->
+      showLogsOnFailure "ServerSpec" $ \tracer ->
         withFreePort $ \port -> do
           -- Prime some relevant server outputs already into persistence to
           -- check whether the latest headStatus is loaded correctly.
@@ -341,7 +341,7 @@ spec = describe "ServerSpec" $
               guard $ v ^? key "snapshotUtxo" == Just (toJSON utxo')
 
     it "greets with correct head status and snapshot utxo after restart" $
-      showLogsOnFailure $ \tracer ->
+      showLogsOnFailure "ServerSpec" $ \tracer ->
         withTempDir "api-server-head-status" $ \persistenceDir ->
           withFreePort $ \port -> do
             let generateSnapshot =
@@ -379,7 +379,7 @@ strictlyMonotonic = \case
 
 sendsAnErrorWhenInputCannotBeDecoded :: PortNumber -> Expectation
 sendsAnErrorWhenInputCannotBeDecoded port = do
-  showLogsOnFailure $ \tracer ->
+  showLogsOnFailure "ServerSpec" $ \tracer ->
     withTestAPIServer port alice mockPersistence tracer $ \_server -> do
       withClient port "/" $ \con -> do
         _greeting :: ByteString <- receiveData con

hydra-node/test/Hydra/NetworkSpec.hs

@@ -31,7 +31,7 @@ spec = do
   describe "Ouroboros Network" $ do
     it "broadcasts messages to single connected peer" $ do
       received <- atomically newTQueue
-      showLogsOnFailure $ \tracer -> failAfter 30 $ do
+      showLogsOnFailure "NetworkSpec" $ \tracer -> failAfter 30 $ do
         [port1, port2] <- fmap fromIntegral <$> randomUnusedTCPPorts 2
         withOuroborosNetwork tracer (Host lo port1) [Host lo port2] (const @_ @Integer $ pure ()) $ \hn1 ->
           withOuroborosNetwork @Integer tracer (Host lo port2) [Host lo port1] (atomically . writeTQueue received) $ \_ -> do
@@ -42,7 +42,7 @@ spec = do
       node1received <- atomically newTQueue
       node2received <- atomically newTQueue
       node3received <- atomically newTQueue
-      showLogsOnFailure $ \tracer -> failAfter 30 $ do
+      showLogsOnFailure "NetworkSpec" $ \tracer -> failAfter 30 $ do
         [port1, port2, port3] <- fmap fromIntegral <$> randomUnusedTCPPorts 3
         withOuroborosNetwork @Integer tracer (Host lo port1) [Host lo port2, Host lo port3] (atomically . writeTQueue node1received) $ \hn1 ->
           withOuroborosNetwork tracer (Host lo port2) [Host lo port1, Host lo port3] (atomically . writeTQueue node2received) $ \hn2 -> do

hydra-node/test/Hydra/NodeSpec.hs

@@ -54,7 +54,7 @@ import Test.Hydra.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk, cperiod)
 spec :: Spec
 spec = parallel $ do
   it "emits a single ReqSn and AckSn as leader, even after multiple ReqTxs" $
-    showLogsOnFailure $ \tracer -> do
+    showLogsOnFailure "NodeSpec" $ \tracer -> do
       -- NOTE(SN): Sequence of parties in OnInitTx of
       -- 'eventsToOpenHead' is relevant, so 10 is the (initial) snapshot leader
       let tx1 = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]}
@@ -73,7 +73,7 @@ spec = parallel $ do
       getNetworkMessages `shouldReturn` [ReqSn 1 [1], AckSn signedSnapshot 1]
 
   it "rotates snapshot leaders" $
-    showLogsOnFailure $ \tracer -> do
+    showLogsOnFailure "NodeSpec" $ \tracer -> do
       let tx1 = SimpleTx{txSimpleId = 1, txInputs = utxoRefs [2], txOutputs = utxoRefs [4]}
           sn1 = testSnapshot 1 (utxoRefs [1, 2, 3]) mempty
           sn2 = testSnapshot 2 (utxoRefs [1, 3, 4]) [1]
@@ -92,7 +92,7 @@ spec = parallel $ do
       getNetworkMessages `shouldReturn` [AckSn (sign bobSk sn1) 1, ReqSn 2 [1], AckSn (sign bobSk sn2) 2]
 
   it "processes out-of-order AckSn" $
-    showLogsOnFailure $ \tracer -> do
+    showLogsOnFailure "NodeSpec" $ \tracer -> do
       let snapshot = testSnapshot 1 (utxoRefs [1, 2, 3]) []
           sigBob = sign bobSk snapshot
           sigAlice = sign aliceSk snapshot
@@ -107,7 +107,7 @@ spec = parallel $ do
       getNetworkMessages `shouldReturn` [AckSn{signed = sigAlice, snapshotNumber = 1}]
 
   it "notifies client when postTx throws PostTxError" $
-    showLogsOnFailure $ \tracer -> do
+    showLogsOnFailure "NodeSpec" $ \tracer -> do
       let events = [ClientEvent Init]
       (node, getServerOutputs) <- createHydraNode aliceSk [bob, carol] cperiod events >>= throwExceptionOnPostTx NoSeedInput >>= recordServerOutputs
 
@@ -118,7 +118,7 @@ spec = parallel $ do
 
   it "signs snapshot even if it has seen conflicting transactions" $
     failAfter 1 $
-      showLogsOnFailure $ \tracer -> do
+      showLogsOnFailure "NodeSpec" $ \tracer -> do
         let snapshot = testSnapshot 1 (utxoRefs [1, 3, 5]) [2]
             sigBob = sign bobSk snapshot
             events =
@@ -134,7 +134,7 @@ spec = parallel $ do
 
   it "can continue after restart via persisted state" $
     failAfter 1 $
-      showLogsOnFailure $ \tracer -> do
+      showLogsOnFailure "NodeSpec" $ \tracer -> do
         persistence <- createPersistenceInMemory
 
         createHydraNode' persistence bobSk [alice, carol] defaultContestationPeriod eventsToOpenHead
@@ -161,18 +161,18 @@ spec = parallel $ do
         headState = inInitialState [alice, bob]
 
     it "accepts configuration consistent with HeadState" $
-      showLogsOnFailure $ \tracer -> do
+      showLogsOnFailure "NodeSpec" $ \tracer -> do
         checkHeadState tracer defaultEnv headState `shouldReturn` ()
 
     it "throws exception given contestation period differs" $
-      showLogsOnFailure $ \tracer -> do
+      showLogsOnFailure "NodeSpec" $ \tracer -> do
         let invalidPeriodEnv =
               defaultEnv{HeadLogic.contestationPeriod = defaultContestationPeriod}
         checkHeadState tracer invalidPeriodEnv headState
           `shouldThrow` \(_ :: ParameterMismatch) -> True
 
     it "throws exception given parties differ" $
-      showLogsOnFailure $ \tracer -> do
+      showLogsOnFailure "NodeSpec" $ \tracer -> do
         let invalidPeriodEnv = defaultEnv{otherParties = []}
         checkHeadState tracer invalidPeriodEnv headState
           `shouldThrow` \(_ :: ParameterMismatch) -> True

hydra-tui/test/Hydra/TUISpec.hs

@@ -144,7 +144,7 @@ spec = do
 
 setupNodeAndTUI' :: Lovelace -> (TUITest -> IO ()) -> IO ()
 setupNodeAndTUI' lovelace action =
-  showLogsOnFailure $ \tracer ->
+  showLogsOnFailure "TUISpec" $ \tracer ->
     withTempDir "tui-end-to-end" $ \tmpDir -> do
       (aliceCardanoVk, _) <- keysFor Alice
       withCardanoNodeDevnet (contramap FromCardano tracer) tmpDir $ \node@RunningNode{nodeSocket, networkId} -> do