cardano-tracer: re-use runInLoop; simplify LogFormatting; proper error tracing

Author: mgmeier

cardano-tracer/src/Cardano/Tracer/Acceptors/Run.hs

@@ -5,16 +5,16 @@ module Cardano.Tracer.Acceptors.Run
   ( runAcceptors
   ) where
 
+import           Cardano.Logging.Types (TraceObject)
+import           Cardano.Logging.Utils (runInLoop)
 import           Cardano.Tracer.Acceptors.Client
 import           Cardano.Tracer.Acceptors.Server
 import           Cardano.Tracer.Configuration
 import           Cardano.Tracer.Environment
 import           Cardano.Tracer.MetaTrace
-import           Cardano.Tracer.Utils
-import           Cardano.Logging.Types (TraceObject)
-import qualified Cardano.Logging.Types as Net
 
 import           Control.Concurrent.Async (forConcurrently_)
+import           Control.Exception (SomeException (..))
 import           "contra-tracer" Control.Tracer (Tracer, contramap, nullTracer, stdoutTracer)
 import qualified Data.List.NonEmpty as NE
 import           Data.Maybe (fromMaybe)
@@ -39,15 +39,19 @@ runAcceptors tracerEnv@TracerEnv{teTracer} tracerEnvRTView = do
     AcceptAt howToConnect ->
       -- Run one server that accepts connections from the nodes.
       runInLoop
-        (runAcceptorsServer tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect))
-        verbosity howToConnect initialPauseInSec
+        (runAcceptorsServer tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (show howToConnect))
+        (handleOnInterruption howToConnect) initialPauseInSec 10
     ConnectTo localSocks ->
       -- Run N clients that initiate connections to the nodes.
       forConcurrently_ (NE.nub localSocks) \howToConnect ->
         runInLoop
-          (runAcceptorsClient tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (Net.howToConnectString howToConnect))
-          verbosity howToConnect initialPauseInSec
+          (runAcceptorsClient tracerEnv tracerEnvRTView howToConnect $ acceptorsConfigs (show howToConnect))
+          (handleOnInterruption howToConnect) initialPauseInSec 30
  where
+  handleOnInterruption howToConnect (SomeException e)
+    | verbosity == Just Minimum = pure ()
+    | otherwise                 = traceWith teTracer $ TracerForwardingInterrupted howToConnect $ show e
+
   TracerConfig{network, ekgRequestFreq, verbosity, ekgRequestFull} = teConfig tracerEnv
   ekgUseFullRequests = fromMaybe False ekgRequestFull
 

cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs

@@ -64,7 +64,7 @@ runAcceptorsServer
   -> IO ()
 runAcceptorsServer tracerEnv tracerEnvRTView howToConnect ( ekgConfig, tfConfig, dpfConfig) =
   withIOManager \iocp -> do
-  traceWith (teTracer tracerEnv) $ TracerSockListen (Net.howToConnectString howToConnect)
+  traceWith (teTracer tracerEnv) $ TracerSockListen (show howToConnect)
   case howToConnect of
     Net.LocalPipe p ->
       doListenToForwarderLocal

cardano-tracer/src/Cardano/Tracer/Configuration.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -11,7 +10,7 @@
 {- HLINT ignore "Use any" -}
 
 module Cardano.Tracer.Configuration
-  ( Address -- (..)
+  ( Address
   , Net.HowToConnect (..)
   , Endpoint (..)
   , setEndpoint
@@ -24,14 +23,14 @@ module Cardano.Tracer.Configuration
   , TracerConfig (..)
   , Verbosity (..)
   , readTracerConfig
-  , parseHostPort
   ) where
 
+import           Cardano.Logging.Types (HowToConnect)
 import qualified Cardano.Logging.Types as Log
+import qualified Cardano.Logging.Types as Net
 
 import           Control.Applicative ((<|>))
-import           Data.Aeson (FromJSON (..), ToJSON (..), withText, withObject, (.:))
-import           Data.Aeson.Types (Parser, Value)
+import           Data.Aeson (FromJSON (..), ToJSON (..), withObject, (.:))
 import           Data.Fixed (Pico)
 import           Data.Function ((&))
 import           Data.Functor ((<&>))
@@ -45,52 +44,15 @@ import           Data.Maybe (catMaybes)
 import           Data.String (fromString)
 import           Data.Text (Text)
 import qualified Data.Text as Text
-import qualified Data.Text.Read as Text
 import           Data.Word (Word16, Word32, Word64)
 import           Data.Yaml (decodeFileEither)
 import           GHC.Generics (Generic)
 import           Network.Wai.Handler.Warp (HostPreference, Port, Settings, setHost, setPort)
 import           System.Exit (die)
 
-import           Cardano.Logging.Types (HowToConnect)
-import qualified Cardano.Logging.Types as Net
-
 type Address :: Type
 type Address = HowToConnect
 
--- first try to host:port, and if that fails revert to parsing any
--- string literal and assume it is a localpipe.
-instance FromJSON HowToConnect where
-  parseJSON :: Value -> Parser HowToConnect
-  parseJSON = withText "HowToConnect" $ \t ->
-        (uncurry Net.RemoteSocket <$> parseHostPort t)
-    <|> (        Net.LocalPipe    <$> parseLocalPipe t)
-
-instance ToJSON HowToConnect where
-  toJSON :: HowToConnect -> Value
-  toJSON = toJSON . Net.howToConnectString
-
-parseLocalPipe :: Text -> Parser FilePath
-parseLocalPipe t
-  | Text.null t = fail "parseLocalPipe: empty Text"
-  | otherwise   = pure $ Text.unpack t
-
-parseHostPort :: Text -> Parser (Text, Word16)
-parseHostPort t
-  | Text.null t
-  = fail "parseHostPort: empty Text"
-  | otherwise
-  = let
-    (host_, portText) = Text.breakOnEnd ":" t
-    host              = maybe "" fst (Text.unsnoc host_)
-  in if
-    | Text.null host      -> fail "parseHostPort: Empty host or no colon found."
-    | Text.null portText  -> fail "parseHostPort: Empty port."
-    | Right (port, remainder) <- Text.decimal portText
-    , Text.null remainder
-    , 0 <= port, port <= 65535 -> pure (host, port)
-    | otherwise -> fail "parseHostPort: Non-numeric port or value out of range."
-
 -- | Endpoint for internal services.
 data Endpoint = Endpoint
   { epHost :: !String

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs

@@ -41,7 +41,7 @@ runLogsRotator TracerEnv
   } = do
   whenJust rotation \rotParams -> do
     traceWith teTracer TracerStartedLogRotator
-    launchRotator loggingParamsForFiles rotParams verbosity teRegistry teCurrentLogLock
+    launchRotator loggingParamsForFiles rotParams verbosity teTracer teRegistry teCurrentLogLock
  where
   loggingParamsForFiles :: [LoggingParams]
   loggingParamsForFiles = nub (NE.filter filesOnly logging)
@@ -53,14 +53,15 @@ launchRotator
   :: [LoggingParams]
   -> RotationParams
   -> Maybe Verbosity
+  -> Trace IO TracerTrace
   -> HandleRegistry
   -> Lock
   -> IO ()
-launchRotator [] _ _ _ _ = return ()
+launchRotator [] _ _ _ _ _ = return ()
 launchRotator loggingParamsForFiles
-              rotParams@RotationParams{rpFrequencySecs} verb registry currentLogLock =
+              rotParams@RotationParams{rpFrequencySecs} verb tracer registry currentLogLock =
   forever do
-    showProblemIfAny verb do
+    showProblemIfAny verb tracer do
       forM_ loggingParamsForFiles \loggingParam -> do
         checkRootDir currentLogLock registry rotParams loggingParam
     sleep $ fromIntegral rpFrequencySecs

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/TraceObjects.hs

@@ -38,7 +38,7 @@ traceObjectsHandler _ _ _ [] = return ()
 traceObjectsHandler tracerEnv _tracerEnvRTView nodeId traceObjects = do
   nodeName <- askNodeName tracerEnv nodeId
   forConcurrently_ logging \loggingParams@LoggingParams{logMode, logFormat} -> do
-    showProblemIfAny verbosity do
+    showProblemIfAny verbosity teTracer do
       case logMode of
         FileMode ->
           writeTraceObjectsToFile teRegistry
@@ -56,6 +56,7 @@ traceObjectsHandler tracerEnv _tracerEnvRTView nodeId traceObjects = do
       , teCurrentLogLock
       , teReforwardTraceObjects
       , teRegistry
+      , teTracer
       } = tracerEnv
 
 deregisterNodeId :: TracerEnv -> NodeId -> IO ()