Late fixes

Build fixes Hlint fix Build patch cardano-tracer: test-ext More fixes
IntersectMBO · Jan 20, 2023 · 3b70450 · 3b70450
1 parent 03b7836
commit 3b70450
Show file tree

Hide file tree

Showing 11 changed files with 62 additions and 65 deletions.
diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs
@@ -49,7 +49,8 @@ import           Ouroboros.Consensus.Util.Enclose
 
 import qualified Ouroboros.Network.AnchoredFragment as AF
 
--- {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-}
+{-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-}
+
 -- TODO implement differently so that it uses configuration
 withAddedToCurrentChainEmptyLimited
   :: Trace IO (ChainDB.TraceEvent blk)

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs
@@ -10,6 +10,7 @@
 
 module Cardano.Node.Tracing.Tracers.NodeToClient () where
 
+
 import           Cardano.Logging
 import           Cardano.Prelude hiding (Show, show)
 import           Data.Aeson (Value (String), (.=))
@@ -24,6 +25,8 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LSQ
 import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS
 
+{-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-}
+
 
 instance LogFormatting (AnyMessageAndAgency ps)
       => LogFormatting (TraceSendRecv ps) where

diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NonP2P.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 {-# OPTIONS_GHC -Wno-orphans  #-}

diff --git a/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Config.hs b/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Config.hs
@@ -17,7 +17,7 @@ import           Cardano.Logging
 config1 :: TraceConfig
 config1 = emptyTraceConfig {
   tcOptions = fromList
-    [([] :: Namespace,
+    [([],
          [ ConfSeverity (SeverityF (Just Debug))
          , ConfDetail DNormal
          , ConfBackend [Stdout HumanFormatColoured, Forwarder, EKGBackend]
@@ -28,7 +28,7 @@ config1 = emptyTraceConfig {
 config2 :: TraceConfig
 config2 = emptyTraceConfig {
   tcOptions = fromList
-    [ ([] :: Namespace,
+    [ ([],
          [ ConfSeverity (SeverityF (Just Debug))
          , ConfDetail DNormal
          , ConfBackend [Stdout HumanFormatColoured, Forwarder, EKGBackend]
@@ -50,7 +50,7 @@ config2 = emptyTraceConfig {
 config3 :: TraceConfig
 config3 = emptyTraceConfig {
   tcOptions = fromList
-    [ ([] :: Namespace,
+    [ ([],
          [ ConfSeverity (SeverityF (Just Debug))
          , ConfDetail DNormal
          , ConfBackend [Stdout HumanFormatColoured, Forwarder, EKGBackend]
@@ -73,7 +73,7 @@ config3 = emptyTraceConfig {
 config4 :: TraceConfig
 config4 = emptyTraceConfig {
   tcOptions = fromList
-    [([] :: Namespace,
+    [([],
          [ ConfSeverity (SeverityF (Just Debug))
          , ConfDetail DNormal
          , ConfBackend [EKGBackend]

diff --git a/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Messages.hs b/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Messages.hs
@@ -1,13 +1,8 @@
 module Cardano.Tracer.Test.ForwardingStressTest.Messages (
-    namesForMessage
-  , severityForMessage
-  , privacyForMessage
-  , docMessage
-  , getMessageID
+    getMessageID
   , setMessageID
   ) where
 
-import           Data.Text
 
 import           Cardano.Logging
 import           Cardano.Tracer.Test.ForwardingStressTest.Types
@@ -22,33 +17,35 @@ setMessageID (Message1 _ v) mid = Message1 mid v
 setMessageID (Message2 _ v) mid = Message2 mid v
 setMessageID (Message3 _ v) mid = Message3 mid v
 
-namesForMessage :: Message -> [Text]
-namesForMessage Message1 {} = ["Message1"]
-namesForMessage Message2 {} = ["Message2"]
-namesForMessage Message3 {} = ["Message3"]
-
-severityForMessage :: Message -> SeverityS
-severityForMessage Message1 {} = Debug
-severityForMessage Message2 {} = Info
-severityForMessage Message3 {} = Error
-
-privacyForMessage :: Message -> Privacy
-privacyForMessage Message1 {} = Public
-privacyForMessage Message2 {} = Confidential
-privacyForMessage Message3 {} = Public
-
-docMessage :: Documented Message
-docMessage = Documented [
-    DocMsg
-      ["Message1"]
-      []
-      "The first message."
-  , DocMsg
-      ["Message2"]
-      []
-      "The second message."
-  , DocMsg
-      ["Message3"]
-      [("Metrics1", "A number")]
-      "The third message."
-  ]
+instance MetaTrace Message where
+  namespaceFor  Message1 {} = Namespace [] ["Message1"]
+  namespaceFor  Message2 {} = Namespace [] ["Message2"]
+  namespaceFor  Message3 {} = Namespace [] ["Message3"]
+
+  severityFor   (Namespace _ ["Message1"]) _ = Just Debug
+  severityFor   (Namespace _ ["Message2"]) _ = Just Info
+  severityFor   (Namespace _ ["Message3"]) _ = Just Error
+  severityFor   _ns _ = Nothing
+
+  privacyFor    (Namespace _ ["Message1"]) _ = Just Public
+  privacyFor    (Namespace _ ["Message2"]) _ = Just Confidential
+  privacyFor    (Namespace _ ["Message3"]) _ = Just Public
+  privacyFor    _ns _ = Nothing
+
+  documentFor   (Namespace _ ["Message1"]) = Just "The first message."
+  documentFor   (Namespace _ ["Message2"]) = Just "The second message."
+  documentFor   (Namespace _ ["Message3"]) = Just "The third message."
+  documentFor   _ns = Nothing
+
+  metricsDocFor (Namespace _ ["Message1"]) =
+    [ ("Metrics1", "A number")
+    , ("Metrics2", "A number")
+    , ("Metrics3", "A number")
+    , ("Metrics4", "A number")
+    , ("Metrics5", "A number")
+    ]
+  metricsDocFor _ =  []
+
+  allNamespaces = [ Namespace [] ["Message1"]
+                  , Namespace [] ["Message2"]
+                  , Namespace [] ["Message3"]]
diff --git a/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Script.hs b/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Script.hs
@@ -35,7 +35,7 @@ import           Cardano.Tracer.Test.Utils
 simpleTestConfig :: TraceConfig
 simpleTestConfig = emptyTraceConfig {
   tcOptions = fromList
-    [([] :: Namespace,
+    [([],
          [ ConfSeverity (SeverityF (Just Debug))
          , ConfDetail DNormal
          , ConfBackend [Forwarder]
@@ -50,29 +50,25 @@ runScriptForwarding ::
   -> IORef Int
   -> IO (Trace IO Message)
   -> Property
-runScriptForwarding ts@TestSetup{..} msgCounter tracerGetter =
-    trace ("Test setup " ++ show ts) $ do
+runScriptForwarding TestSetup{..} msgCounter tracerGetter = do
       let generator :: Gen [Script] = vectorOf (unI tsThreads) $
             case unI tsMessages of
               Nothing -> scale (* 1000) arbitrary
               Just numMsg -> Script <$> vectorOf numMsg arbitrary
       forAll generator (\ (scripts :: [Script])
         -> ioProperty $ do
           tr <- tracerGetter
-          configureTracers simpleTestConfig docMessage [tr]
-          let scripts' = map (\ (Script sc) -> Script
-                             $ filter (\(ScriptedMessage _ msg) ->
-                                namesForMessage msg /= ["Message2"]) sc) scripts
-              scripts'' = map (\ (Script sc) -> Script (sort sc))  scripts'
-              scripts''' = zipWith (\ (Script sc) ind -> Script (
-                            withMessageIds (unI tsThreads) ind sc)) scripts'' [0..]
-              scripts'''' = map (\ (Script sc) -> Script
-                              $ map (withTimeFactor (unI tsTime)) sc) scripts'''
+          configureTracers simpleTestConfig [tr]
+          let scripts' = map (\ (Script sc) -> Script (sort sc))  scripts
+              scripts'' = zipWith (\ (Script sc) ind -> Script (
+                            withMessageIds (unI tsThreads) ind sc)) scripts' [0..]
+              scripts''' = map (\ (Script sc) -> Script
+                              $ map (withTimeFactor (unI tsTime)) sc) scripts''
 
 
           -- putStrLn ("runTest " ++ show scripts)
           children :: MVar [MVar (Either SomeException ())] <- newMVar []
-          mapM_ (\sc -> forkChild children (playIt sc tr 0.0)) scripts''''
+          mapM_ (\sc -> forkChild children (playIt sc tr 0.0)) scripts'''
           res <- waitForChildren children []
           let resErr = mapMaybe
                       (\case
@@ -82,7 +78,7 @@ runScriptForwarding ts@TestSetup{..} msgCounter tracerGetter =
           if not (null resErr)
             then throw (head resErr)
             else        -- Oracle
-              let numMsg = sum (map (\ (Script sc) -> length sc) scripts'''')
+              let numMsg = sum (map (\ (Script sc) -> length sc) scripts''')
               in if numMsg > 0 then do
                 -- TODO mutiple files
                 let logfileGlobPattern = unI tsWorkDir <> "/logs/*sock@*/node-*.json"

diff --git a/cardano-tracer/test/cardano-tracer-test-ext.hs b/cardano-tracer/test/cardano-tracer-test-ext.hs
@@ -19,7 +19,6 @@ import           Test.Tasty
 import           Test.Tasty.QuickCheck
 
 import           Cardano.Logging
-import           Cardano.Tracer.Test.ForwardingStressTest.Messages
 import           Cardano.Tracer.Test.ForwardingStressTest.Script
 import           Cardano.Tracer.Test.ForwardingStressTest.Types
 import           Cardano.Tracer.Test.Utils
@@ -38,7 +37,7 @@ main = do
              , tsSockInternal = Last $ Just "tracer.sock"
              , tsSockExternal = Last $ Just "tracer.sock"
              , tsNetworkMagic = Last $ Just $ NetworkMagic 42
-             , tsWorkDir      = Last $ Just "./test"
+             , tsWorkDir      = Last $ Just "/tmp/testTracerExt"
              }
 
     -- 1. Prepare directory hierarchy
@@ -96,7 +95,6 @@ getExternalTracerState TestSetup{..} ref = do
       tr <- mkCardanoTracer
               stdTr fwdTr Nothing
               ["Test"]
-              namesForMessage severityForMessage privacyForMessage
       let st = (procHdl, tr)
       writeIORef ref $ Just st
       pure st

diff --git a/cardano-tracer/test/config.yaml b/cardano-tracer/test/config.yaml
@@ -0,0 +1,8 @@
+networkMagic: 42
+network:
+  tag: AcceptAt
+  contents: "tracer.sock"
+logging:
+- logRoot: "/tmp/logs"
+  logMode: FileMode
+  logFormat: ForMachine
diff --git a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 

diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal
@@ -183,7 +183,6 @@ benchmark trace-dispatcher-bench
                         Cardano.Logging.Test.Oracles
                         Cardano.Logging.Test.Config
                         Cardano.Logging.Test.Tracer
-                        Cardano.Logging.Test.Messages
                         Cardano.Logging.Test.Script
   build-depends:        base >=4.12 && <5
                       , aeson                         >= 2.1.0.0

diff --git a/trace-resources/test/trace-resources-test.hs b/trace-resources/test/trace-resources-test.hs
@@ -32,10 +32,7 @@ playScript = ioProperty $ do
                       forwardTracer'
                       (Just ekgTracer')
                       ["Test"]
-                      (const ["ResourceStats"])
-                      (const Info)
-                      (const Public)
-  configureTracers emptyTraceConfig docResourceStats [tr]
+  configureTracers emptyTraceConfig [tr]
   traceIt tr 10
 
 traceIt :: Trace IO ResourceStats -> Int -> IO Bool