lazy traces

Trace types should be lazy, they are either discarded or converted to some representation (text, json, etc) and never stored.
IntersectMBO · Nov 24, 2021 · 9dfc26b · 9dfc26b
1 parent 273f006
commit 9dfc26b
Show file tree

Hide file tree

Showing 13 changed files with 101 additions and 101 deletions.
diff --git a/network-mux/src/Network/Mux/Trace.hs b/network-mux/src/Network/Mux/Trace.hs
@@ -121,31 +121,31 @@ data MuxBearerState = Mature
 --
 data MuxTrace =
       MuxTraceRecvHeaderStart
-    | MuxTraceRecvHeaderEnd !MuxSDUHeader
-    | MuxTraceRecvDeltaQObservation !MuxSDUHeader Time
-    | MuxTraceRecvDeltaQSample !Double !Int !Int !Double !Double !Double !Double !String
-    | MuxTraceRecvStart !Int
-    | MuxTraceRecvEnd !Int
-    | MuxTraceSendStart !MuxSDUHeader
+    | MuxTraceRecvHeaderEnd MuxSDUHeader
+    | MuxTraceRecvDeltaQObservation MuxSDUHeader Time
+    | MuxTraceRecvDeltaQSample Double Int Int Double Double Double Double String
+    | MuxTraceRecvStart Int
+    | MuxTraceRecvEnd Int
+    | MuxTraceSendStart MuxSDUHeader
     | MuxTraceSendEnd
-    | MuxTraceState !MuxBearerState
-    | MuxTraceCleanExit !MiniProtocolNum !MiniProtocolDir
-    | MuxTraceExceptionExit !MiniProtocolNum !MiniProtocolDir !SomeException
-    | MuxTraceChannelRecvStart !MiniProtocolNum
-    | MuxTraceChannelRecvEnd !MiniProtocolNum !Int
-    | MuxTraceChannelSendStart !MiniProtocolNum !Int
-    | MuxTraceChannelSendEnd !MiniProtocolNum
+    | MuxTraceState MuxBearerState
+    | MuxTraceCleanExit MiniProtocolNum MiniProtocolDir
+    | MuxTraceExceptionExit MiniProtocolNum MiniProtocolDir SomeException
+    | MuxTraceChannelRecvStart MiniProtocolNum
+    | MuxTraceChannelRecvEnd MiniProtocolNum Int
+    | MuxTraceChannelSendStart MiniProtocolNum Int
+    | MuxTraceChannelSendEnd MiniProtocolNum
     | MuxTraceHandshakeStart
-    | MuxTraceHandshakeClientEnd !DiffTime
+    | MuxTraceHandshakeClientEnd DiffTime
     | MuxTraceHandshakeServerEnd
-    | forall e. Exception e => MuxTraceHandshakeClientError !e !DiffTime
-    | forall e. Exception e => MuxTraceHandshakeServerError !e
+    | forall e. Exception e => MuxTraceHandshakeClientError e DiffTime
+    | forall e. Exception e => MuxTraceHandshakeServerError e
     | MuxTraceSDUReadTimeoutException
     | MuxTraceSDUWriteTimeoutException
-    | MuxTraceStartEagerly !MiniProtocolNum !MiniProtocolDir
-    | MuxTraceStartOnDemand !MiniProtocolNum !MiniProtocolDir
-    | MuxTraceStartedOnDemand !MiniProtocolNum !MiniProtocolDir
-    | MuxTraceTerminating !MiniProtocolNum !MiniProtocolDir
+    | MuxTraceStartEagerly MiniProtocolNum MiniProtocolDir
+    | MuxTraceStartOnDemand MiniProtocolNum MiniProtocolDir
+    | MuxTraceStartedOnDemand MiniProtocolNum MiniProtocolDir
+    | MuxTraceTerminating MiniProtocolNum MiniProtocolDir
     | MuxTraceShutdown
 
 instance Show MuxTrace where

diff --git a/ntp-client/src/Network/NTP/Client/Query.hs b/ntp-client/src/Network/NTP/Client/Query.hs
@@ -366,17 +366,17 @@ runNtpQueries ioManager tracer protocol netSettings localAddr destAddrs
 
 data NtpTrace
     = NtpTraceStartNtpClient
-    | NtpTraceRestartDelay !Int
+    | NtpTraceRestartDelay Int
     | NtpTraceRestartingClient
-    | NtpTraceIOError !IOError
+    | NtpTraceIOError IOError
     | NtpTraceLookupsFails
     | NtpTraceClientStartQuery
     | NtpTraceNoLocalAddr
-    | NtpTraceResult !NtpStatus
-    | NtpTraceRunProtocolResults !(ResultOrFailure [NtpOffset])
-    | NtpTracePacketSent !SockAddr !NtpPacket
-    | NtpTracePacketSendError !SockAddr !IOException
-    | NtpTracePacketDecodeError !SockAddr !String
-    | NtpTracePacketReceived SockAddr !NtpPacket
-    | NtpTraceWaitingForRepliesTimeout !IPVersion
+    | NtpTraceResult NtpStatus
+    | NtpTraceRunProtocolResults (ResultOrFailure [NtpOffset])
+    | NtpTracePacketSent SockAddr NtpPacket
+    | NtpTracePacketSendError SockAddr IOException
+    | NtpTracePacketDecodeError SockAddr String
+    | NtpTracePacketReceived SockAddr NtpPacket
+    | NtpTraceWaitingForRepliesTimeout IPVersion
     deriving (Show)
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionHandler.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionHandler.hs
@@ -388,8 +388,8 @@ makeConnectionHandler muxTracer singMuxMode
 data ConnectionHandlerTrace versionNumber versionData =
       TrHandshakeSuccess versionNumber versionData
     | TrHandshakeClientError
-        !(HandshakeException versionNumber)
+        (HandshakeException versionNumber)
     | TrHandshakeServerError
-        !(HandshakeException versionNumber)
-    | TrError !ErrorContext !SomeException !ErrorCommand
+        (HandshakeException versionNumber)
+    | TrError ErrorContext SomeException ErrorCommand
   deriving Show
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Types.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Types.hs
@@ -820,33 +820,33 @@ data AssertionLocation peerAddr
 -- which is filled with 'ConnectionHandlerTrace'.
 --
 data ConnectionManagerTrace peerAddr handlerTrace
-  = TrIncludeConnection            !Provenance !peerAddr
-  | TrUnregisterConnection         !Provenance !peerAddr
-  | TrConnect                      !(Maybe peerAddr) -- ^ local address
-                                   !peerAddr         -- ^ remote address
-  | TrConnectError                 !(Maybe peerAddr) -- ^ local address
-                                   !peerAddr         -- ^ remote address
-                                   !SomeException
-  | TrTerminatingConnection        !Provenance !(ConnectionId peerAddr)
-  | TrTerminatedConnection         !Provenance !peerAddr
-  | TrConnectionHandler            !(ConnectionId peerAddr) !handlerTrace
+  = TrIncludeConnection            Provenance peerAddr
+  | TrUnregisterConnection         Provenance peerAddr
+  | TrConnect                      (Maybe peerAddr) -- ^ local address
+                                   peerAddr         -- ^ remote address
+  | TrConnectError                 (Maybe peerAddr) -- ^ local address
+                                   peerAddr         -- ^ remote address
+                                   SomeException
+  | TrTerminatingConnection        Provenance (ConnectionId peerAddr)
+  | TrTerminatedConnection         Provenance peerAddr
+  | TrConnectionHandler            (ConnectionId peerAddr) handlerTrace
   | TrShutdown
-  | TrConnectionExists             !Provenance !peerAddr    !AbstractState
-  | TrForbiddenConnection          !(ConnectionId peerAddr)
-  | TrImpossibleConnection         !(ConnectionId peerAddr)
-  | TrConnectionFailure            !(ConnectionId peerAddr)
-  | TrConnectionNotFound           !Provenance !peerAddr
-  | TrForbiddenOperation           !peerAddr                !AbstractState
-  | TrPruneConnections             !(Set peerAddr) -- ^ prunning set
-                                   !Int            -- ^ number connections that must be prunned
-                                   !(Set peerAddr) -- ^ choice set
-  | TrConnectionCleanup            !(ConnectionId peerAddr)
-  | TrConnectionTimeWait           !(ConnectionId peerAddr)
-  | TrConnectionTimeWaitDone       !(ConnectionId peerAddr)
-  | TrConnectionManagerCounters    !ConnectionManagerCounters
-  | TrState                        !(Map peerAddr AbstractState)
+  | TrConnectionExists             Provenance peerAddr    AbstractState
+  | TrForbiddenConnection          (ConnectionId peerAddr)
+  | TrImpossibleConnection         (ConnectionId peerAddr)
+  | TrConnectionFailure            (ConnectionId peerAddr)
+  | TrConnectionNotFound           Provenance peerAddr
+  | TrForbiddenOperation           peerAddr                AbstractState
+  | TrPruneConnections             (Set peerAddr) -- ^ prunning set
+                                   Int            -- ^ number connections that must be prunned
+                                   (Set peerAddr) -- ^ choice set
+  | TrConnectionCleanup            (ConnectionId peerAddr)
+  | TrConnectionTimeWait           (ConnectionId peerAddr)
+  | TrConnectionTimeWaitDone       (ConnectionId peerAddr)
+  | TrConnectionManagerCounters    ConnectionManagerCounters
+  | TrState                        (Map peerAddr AbstractState)
   -- ^ traced on SIGUSR1 signal, installed in 'runDataDiffusion'
-  | TrUnexpectedlyFalseAssertion   !(AssertionLocation peerAddr)
+  | TrUnexpectedlyFalseAssertion   (AssertionLocation peerAddr)
   -- ^ This case is unexpected at call site.
   deriving Show
 

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ErrorPolicy.hs b/ouroboros-network-framework/src/Ouroboros/Network/ErrorPolicy.hs
@@ -279,9 +279,9 @@ completeApplicationTx ErrorPolicies {epConErrorPolicies} (ConnectionError t addr
 
 -- | Trace data for error policies
 data ErrorPolicyTrace
-  = ErrorPolicySuspendPeer (Maybe (ConnectionOrApplicationExceptionTrace SomeException)) !DiffTime !DiffTime
+  = ErrorPolicySuspendPeer (Maybe (ConnectionOrApplicationExceptionTrace SomeException)) DiffTime DiffTime
   -- ^ suspending peer with a given exception until
-  | ErrorPolicySuspendConsumer (Maybe (ConnectionOrApplicationExceptionTrace SomeException)) !DiffTime
+  | ErrorPolicySuspendConsumer (Maybe (ConnectionOrApplicationExceptionTrace SomeException)) DiffTime
   -- ^ suspending consumer until
   | ErrorPolicyLocalNodeError (ConnectionOrApplicationExceptionTrace SomeException)
   -- ^ caught a local exception
@@ -320,8 +320,8 @@ traceErrorPolicy _ _ =
     Nothing
 
 data WithAddr addr a = WithAddr {
-      wiaAddr  :: !addr
-    , wiaEvent :: !a
+      wiaAddr  :: addr
+    , wiaEvent :: a
     }
 
 instance (Show addr, Show a) => Show (WithAddr addr a) where

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Server2.hs b/ouroboros-network-framework/src/Ouroboros/Network/Server2.hs
@@ -276,12 +276,12 @@ run ServerArguments {
 --
 
 data ServerTrace peerAddr
-    = TrAcceptConnection            !peerAddr
-    | TrAcceptError                 !SomeException
-    | TrAcceptPolicyTrace           !AcceptConnectionsPolicyTrace
-    | TrServerStarted               ![peerAddr]
+    = TrAcceptConnection            peerAddr
+    | TrAcceptError                 SomeException
+    | TrAcceptPolicyTrace           AcceptConnectionsPolicyTrace
+    | TrServerStarted               [peerAddr]
     | TrServerStopped
-    | TrServerError                 !SomeException
+    | TrServerError                 SomeException
     -- ^ similar to 'TrAcceptConnection' but it is logged once the connection is
     -- handed to inbound connection manager, e.g. after handshake negotiation.
   deriving Show
diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Subscription/Dns.hs b/ouroboros-network-framework/src/Ouroboros/Network/Subscription/Dns.hs
@@ -300,8 +300,8 @@ dnsSubscriptionWorker snocket subTracer dnsTracer errTrace networkState
        k
 
 data WithDomainName a = WithDomainName {
-      wdnDomain :: !DNS.Domain
-    , wdnEvent  :: !a
+      wdnDomain :: DNS.Domain
+    , wdnEvent  :: a
     }
 
 instance Show a => Show (WithDomainName a) where

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Subscription/Ip.hs b/ouroboros-network-framework/src/Ouroboros/Network/Subscription/Ip.hs
@@ -216,9 +216,9 @@ subscriptionWorker snocket
            k
 
 data WithIPList a = WithIPList {
-      wilSrc   :: !(LocalAddresses Socket.SockAddr)
-    , wilDsts  :: ![Socket.SockAddr]
-    , wilEvent :: !a
+      wilSrc   :: (LocalAddresses Socket.SockAddr)
+    , wilDsts  :: [Socket.SockAddr]
+    , wilEvent :: a
     }
 
 instance (Show a) => Show (WithIPList a) where

diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/Common.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/Common.hs
@@ -47,22 +47,22 @@ import qualified Ouroboros.Network.NodeToClient as NodeToClient
 -- TODO: use LocalAddress where appropriate rather than 'path'.
 --
 data InitializationTracer ntnAddr ntcAddr
-  = RunServer !(NonEmpty ntnAddr)
-  | RunLocalServer !ntcAddr
-  | UsingSystemdSocket !ntcAddr
+  = RunServer (NonEmpty ntnAddr)
+  | RunLocalServer ntcAddr
+  | UsingSystemdSocket ntcAddr
   -- Rename as 'CreateLocalSocket'
-  | CreateSystemdSocketForSnocketPath !ntcAddr
-  | CreatedLocalSocket !ntcAddr
-  | ConfiguringLocalSocket !ntcAddr !FileDescriptor
-  | ListeningLocalSocket !ntcAddr !FileDescriptor
-  | LocalSocketUp  !ntcAddr !FileDescriptor
+  | CreateSystemdSocketForSnocketPath ntcAddr
+  | CreatedLocalSocket ntcAddr
+  | ConfiguringLocalSocket ntcAddr FileDescriptor
+  | ListeningLocalSocket ntcAddr FileDescriptor
+  | LocalSocketUp  ntcAddr FileDescriptor
   -- Rename as 'CreateServerSocket'
-  | CreatingServerSocket !ntnAddr
-  | ConfiguringServerSocket !ntnAddr
-  | ListeningServerSocket !ntnAddr
-  | ServerSocketUp !ntnAddr
+  | CreatingServerSocket ntnAddr
+  | ConfiguringServerSocket ntnAddr
+  | ListeningServerSocket ntnAddr
+  | ServerSocketUp ntnAddr
   -- Rename as 'UnsupportedLocalSocketType'
-  | UnsupportedLocalSystemdSocket !ntnAddr
+  | UnsupportedLocalSystemdSocket ntnAddr
   -- Remove (this is impossible case), there's no systemd on Windows
   | UnsupportedReadySocketCase
   | DiffusionErrored SomeException

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs
@@ -303,9 +303,9 @@ data PeerSelectionState peeraddr peerconn = PeerSelectionState {
   deriving (Show, Functor)
 
 data PeerSelectionCounters = PeerSelectionCounters {
-      coldPeers :: !Int,
-      warmPeers :: !Int,
-      hotPeers  :: !Int
+      coldPeers :: Int,
+      warmPeers :: Int,
+      hotPeers  :: Int
     } deriving (Eq, Show)
 
 peerStateToCounters :: Ord peeraddr => PeerSelectionState peeraddr peerconn -> PeerSelectionCounters

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/LedgerPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/LedgerPeers.hs
@@ -65,20 +65,20 @@ newtype LedgerPeersConsensusInterface m = LedgerPeersConsensusInterface {
 
 -- | Trace LedgerPeers events.
 data TraceLedgerPeers =
-      PickedPeer !RelayAccessPoint !AccPoolStake !PoolStake
+      PickedPeer RelayAccessPoint AccPoolStake PoolStake
       -- ^ Trace for a peer picked with accumulated and relative stake of its pool.
-    | PickedPeers !NumberOfPeers ![RelayAccessPoint]
+    | PickedPeers NumberOfPeers [RelayAccessPoint]
       -- ^ Trace for the number of peers we wanted to pick and the list of peers picked.
-    | FetchingNewLedgerState !Int
+    | FetchingNewLedgerState Int
       -- ^ Trace for fetching a new list of peers from the ledger. Int is the number of peers
       -- returned.
     | DisabledLedgerPeers
       -- ^ Trace for when getting peers from the ledger is disabled, that is DontUseLedger.
-    | TraceUseLedgerAfter !UseLedgerAfter
+    | TraceUseLedgerAfter UseLedgerAfter
       -- ^ Trace UseLedgerAfter value
     | WaitingOnRequest
-    | RequestForPeers !NumberOfPeers
-    | ReusingLedgerState !Int !DiffTime
+    | RequestForPeers NumberOfPeers
+    | ReusingLedgerState Int DiffTime
     | FallingBackToBootstrapPeers
 
 

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs
@@ -1050,8 +1050,8 @@ data PeerStatusChangeType peerAddr =
 -- | Traces produced by 'peerSelectionActions'.
 --
 data PeerSelectionActionsTrace peerAddr =
-      PeerStatusChanged       !(PeerStatusChangeType peerAddr)
-    | PeerStatusChangeFailure !(PeerStatusChangeType peerAddr) !FailureType
-    | PeerMonitoringError     !(ConnectionId peerAddr) !SomeException
-    | PeerMonitoringResult    !(ConnectionId peerAddr) !(WithSomeProtocolTemperature FirstToFinishResult)
+      PeerStatusChanged       (PeerStatusChangeType peerAddr)
+    | PeerStatusChangeFailure (PeerStatusChangeType peerAddr) FailureType
+    | PeerMonitoringError     (ConnectionId peerAddr) SomeException
+    | PeerMonitoringResult    (ConnectionId peerAddr) (WithSomeProtocolTemperature FirstToFinishResult)
   deriving Show
diff --git a/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs b/ouroboros-network/src/Ouroboros/Network/TxSubmission/Inbound.hs
@@ -69,17 +69,17 @@ data TxSubmissionMempoolWriter txid tx idx m =
 
 data ProcessedTxCount = ProcessedTxCount {
       -- | Just accepted this many transactions.
-      ptxcAccepted :: !Int
+      ptxcAccepted :: Int
       -- | Just rejected this many transactions.
-    , ptxcRejected :: !Int
+    , ptxcRejected :: Int
     }
   deriving (Eq, Show)
 
 data TraceTxSubmissionInbound txid tx =
     -- | Number of transactions just about to be inserted.
-    TraceTxSubmissionCollected !Int
+    TraceTxSubmissionCollected Int
     -- | Just processed transaction pass/fail breakdown.
-  | TraceTxSubmissionProcessed !ProcessedTxCount
+  | TraceTxSubmissionProcessed ProcessedTxCount
     -- | Server received 'MsgDone'
   | TraceTxInboundTerminated
   | TraceTxInboundCanRequestMoreTxs Int