Skip to content

Commit

Permalink
Fix proxyLastToEither so that any tracer mismatches
Browse files Browse the repository at this point in the history 
in cardano-node results in a compiler error.
  • Loading branch information
@Jimbo4350
Jimbo4350 committed Mar 1, 2022
1 parent b60f49a commit 26677a9
Showing 1 changed file with 61 additions and 58 deletions.
119 changes: 61 additions & 58 deletions cardano-node/src/Cardano/Tracing/Config.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ import Cardano.Prelude
import Prelude (String)

import Data.Aeson
import Data.Aeson.Types
import qualified Data.Text as Text
import Generic.Data (gmappend)

Expand Down Expand Up @@ -253,61 +254,60 @@ instance Semigroup PartialTraceSelection where
instance FromJSON PartialTraceSelection where
parseJSON = withObject "PartialTraceSelection" $ \v -> do
PartialTraceSelection
<$> Last <$> v .:? "TracingVerbosity"
-- Per-trace toggles, alpha-sorted.
<*> (Last <$> v .:? proxyName (Proxy @TraceAcceptPolicy))
<*> (Last <$> v .:? proxyName (Proxy @TraceBlockchainTime))
<*> (Last <$> v .:? proxyName (Proxy @TraceBlockFetchClient))
<*> (Last <$> v .:? proxyName (Proxy @TraceBlockFetchDecisions))
<*> (Last <$> v .:? proxyName (Proxy @TraceBlockFetchProtocol))
<*> (Last <$> v .:? proxyName (Proxy @TraceBlockFetchProtocolSerialised))
<*> (Last <$> v .:? proxyName (Proxy @TraceBlockFetchServer))
<*> (Last <$> v .:? proxyName (Proxy @TraceChainDB))
<*> (Last <$> v .:? proxyName (Proxy @TraceChainSyncBlockServer))
<*> (Last <$> v .:? proxyName (Proxy @TraceChainSyncClient))
<*> (Last <$> v .:? proxyName (Proxy @TraceChainSyncHeaderServer))
<*> (Last <$> v .:? proxyName (Proxy @TraceChainSyncProtocol))
<*> (Last <$> v .:? proxyName (Proxy @TraceConnectionManager))
<*> (Last <$> v .:? proxyName (Proxy @TraceConnectionManagerCounters))
<*> (Last <$> v .:? proxyName (Proxy @TraceConnectionManagerTransitions))
<*> (Last <$> v .:? proxyName (Proxy @DebugPeerSelectionInitiator))
<*> (Last <$> v .:? proxyName (Proxy @DebugPeerSelectionInitiatorResponder))
<*> (Last <$> v .:? proxyName (Proxy @TraceDiffusionInitialization))
<*> (Last <$> v .:? proxyName (Proxy @TraceDnsResolver))
<*> (Last <$> v .:? proxyName (Proxy @TraceDnsSubscription))
<*> (Last <$> v .:? proxyName (Proxy @TraceErrorPolicy))
<*> (Last <$> v .:? proxyName (Proxy @TraceForge))
<*> (Last <$> v .:? proxyName (Proxy @TraceForgeStateInfo))
<*> (Last <$> v .:? proxyName (Proxy @TraceHandshake))
<*> (Last <$> v .:? proxyName (Proxy @TraceIpSubscription))
<*> (Last <$> v .:? proxyName (Proxy @TraceKeepAliveClient))
<*> (Last <$> v .:? proxyName (Proxy @TraceInboundGovernorTransitions))
<*> (Last <$> v .:? proxyName (Proxy @TraceLedgerPeers))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalChainSyncProtocol))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalConnectionManager))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalErrorPolicy))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalHandshake))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalInboundGovernor))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalRootPeers))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalServer))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalStateQueryProtocol))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalTxMonitorProtocol))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalTxSubmissionProtocol))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalTxSubmissionServer))
<*> (Last <$> v .:? proxyName (Proxy @TraceMempool))
<*> (Last <$> v .:? proxyName (Proxy @TraceMux))
<*> (Last <$> v .:? proxyName (Proxy @TraceLocalMux))
<*> (Last <$> v .:? proxyName (Proxy @TracePeerSelection))
<*> (Last <$> v .:? proxyName (Proxy @TracePeerSelectionCounters))
<*> (Last <$> v .:? proxyName (Proxy @TracePeerSelectionActions))
<*> (Last <$> v .:? proxyName (Proxy @TracePublicRootPeers))
<*> (Last <$> v .:? proxyName (Proxy @TraceServer))
<*> (Last <$> v .:? proxyName (Proxy @TraceInboundGovernor))
<*> (Last <$> v .:? proxyName (Proxy @TraceInboundGovernorCounters))
<*> (Last <$> v .:? proxyName (Proxy @TraceTxInbound))
<*> (Last <$> v .:? proxyName (Proxy @TraceTxOutbound))
<*> (Last <$> v .:? proxyName (Proxy @TraceTxSubmissionProtocol))
<*> (Last <$> v .:? proxyName (Proxy @TraceTxSubmission2Protocol))
<$> Last <$> v .:? "TracingVerbosity"
<*> parseTracer (Proxy @TraceAcceptPolicy) v
<*> parseTracer (Proxy @TraceBlockchainTime) v
<*> parseTracer (Proxy @TraceBlockFetchClient) v
<*> parseTracer (Proxy @TraceBlockFetchDecisions) v
<*> parseTracer (Proxy @TraceBlockFetchProtocol) v
<*> parseTracer (Proxy @TraceBlockFetchProtocolSerialised) v
<*> parseTracer (Proxy @TraceBlockFetchServer) v
<*> parseTracer (Proxy @TraceChainDB) v
<*> parseTracer (Proxy @TraceChainSyncBlockServer) v
<*> parseTracer (Proxy @TraceChainSyncClient) v
<*> parseTracer (Proxy @TraceChainSyncHeaderServer) v
<*> parseTracer (Proxy @TraceChainSyncProtocol) v
<*> parseTracer (Proxy @TraceConnectionManager) v
<*> parseTracer (Proxy @TraceConnectionManagerCounters) v
<*> parseTracer (Proxy @TraceConnectionManagerTransitions) v
<*> parseTracer (Proxy @DebugPeerSelectionInitiator) v
<*> parseTracer (Proxy @TraceDiffusionInitialization) v
<*> parseTracer (Proxy @DebugPeerSelectionInitiatorResponder) v
<*> parseTracer (Proxy @TraceDnsResolver) v
<*> parseTracer (Proxy @TraceDnsSubscription) v
<*> parseTracer (Proxy @TraceErrorPolicy) v
<*> parseTracer (Proxy @TraceForge) v
<*> parseTracer (Proxy @TraceForgeStateInfo) v
<*> parseTracer (Proxy @TraceHandshake) v
<*> parseTracer (Proxy @TraceInboundGovernor) v
<*> parseTracer (Proxy @TraceInboundGovernorCounters) v
<*> parseTracer (Proxy @TraceInboundGovernorTransitions) v
<*> parseTracer (Proxy @TraceIpSubscription) v
<*> parseTracer (Proxy @TraceKeepAliveClient) v
<*> parseTracer (Proxy @TraceLedgerPeers) v
<*> parseTracer (Proxy @TraceLocalChainSyncProtocol) v
<*> parseTracer (Proxy @TraceLocalConnectionManager) v
<*> parseTracer (Proxy @TraceLocalErrorPolicy) v
<*> parseTracer (Proxy @TraceLocalHandshake) v
<*> parseTracer (Proxy @TraceLocalInboundGovernor) v
<*> parseTracer (Proxy @TraceLocalMux) v
<*> parseTracer (Proxy @TraceLocalRootPeers) v
<*> parseTracer (Proxy @TraceLocalServer) v
<*> parseTracer (Proxy @TraceLocalStateQueryProtocol) v
<*> parseTracer (Proxy @TraceLocalTxMonitorProtocol) v
<*> parseTracer (Proxy @TraceLocalTxSubmissionProtocol) v
<*> parseTracer (Proxy @TraceLocalTxSubmissionServer) v
<*> parseTracer (Proxy @TraceMempool) v
<*> parseTracer (Proxy @TraceMux) v
<*> parseTracer (Proxy @TracePeerSelection) v
<*> parseTracer (Proxy @TracePeerSelectionCounters) v
<*> parseTracer (Proxy @TracePeerSelectionActions) v
<*> parseTracer (Proxy @TracePublicRootPeers) v
<*> parseTracer (Proxy @TraceServer) v
<*> parseTracer (Proxy @TraceTxInbound) v
<*> parseTracer (Proxy @TraceTxOutbound) v
<*> parseTracer (Proxy @TraceTxSubmissionProtocol) v
<*> parseTracer (Proxy @TraceTxSubmission2Protocol) v


defaultPartialTraceConfiguration :: PartialTraceSelection
Expand Down Expand Up @@ -430,7 +430,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio
traceTxOutbound <- proxyLastToEither (Proxy @TraceTxOutbound) pTraceTxOutbound
traceTxSubmissionProtocol <- proxyLastToEither (Proxy @TraceTxSubmissionProtocol) pTraceTxSubmissionProtocol
traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol
Right $ TracingOnLegacy $ TraceSelection
Right $ TraceDispatcher $ TraceSelection
{ traceVerbosity = traceVerbosity
, traceAcceptPolicy = traceAcceptPolicy
, traceBlockFetchClient = traceBlockFetchClient
Expand Down Expand Up @@ -516,9 +516,9 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio
traceForgeStateInfo <- proxyLastToEither (Proxy @TraceForgeStateInfo) pTraceForgeStateInfo
traceHandshake <- proxyLastToEither (Proxy @TraceHandshake) pTraceHandshake
traceInboundGovernor <- proxyLastToEither (Proxy @TraceInboundGovernor) pTraceInboundGovernor
traceIpSubscription <- proxyLastToEither (Proxy @TraceIpSubscription) pTraceIpSubscription
traceInboundGovernorCounters <- proxyLastToEither (Proxy @TraceInboundGovernorCounters) pTraceInboundGovernorCounters
traceInboundGovernorTransitions <- proxyLastToEither (Proxy @TraceInboundGovernorTransitions) pTraceInboundGovernorTransitions
traceIpSubscription <- proxyLastToEither (Proxy @TraceIpSubscription) pTraceIpSubscription
traceKeepAliveClient <- proxyLastToEither (Proxy @TraceKeepAliveClient) pTraceKeepAliveClient
traceLedgerPeers <- proxyLastToEither (Proxy @TraceLedgerPeers) pTraceLedgerPeers
traceLocalChainSyncProtocol <- proxyLastToEither (Proxy @TraceLocalChainSyncProtocol) pTraceLocalChainSyncProtocol
Expand Down Expand Up @@ -601,9 +601,12 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio
, traceTxSubmission2Protocol = traceTxSubmission2Protocol
}

proxyLastToEither :: KnownSymbol name => Proxy name -> Last a -> Either Text a
proxyLastToEither :: KnownSymbol name => Proxy name -> Last (OnOff name) -> Either Text (OnOff name)
proxyLastToEither name (Last x) =
maybe (Left $ "Default value not specified for " <> proxyName name) Right x

parseTracer :: KnownSymbol name => Proxy name -> Object -> Parser (Last (OnOff name))
parseTracer p obj = Last <$> obj .:? proxyName p

lastToEither :: String -> Last a -> Either String a
lastToEither errMsg (Last x) = maybe (Left errMsg) Right x

0 comments on commit 26677a9

Please sign in to comment.