diff --git a/cardano-config/src/Cardano/Tracing/ToObjectOrphans.hs b/cardano-config/src/Cardano/Tracing/ToObjectOrphans.hs index 2b1b6bb45f3..444341f12b2 100644 --- a/cardano-config/src/Cardano/Tracing/ToObjectOrphans.hs +++ b/cardano-config/src/Cardano/Tracing/ToObjectOrphans.hs @@ -106,9 +106,9 @@ showTip :: Condense (HeaderHash blk) showTip verb = showPoint verb . getTipPoint showPoint :: Condense (HeaderHash blk) - => TracingVerbosity - -> Point blk - -> String + => TracingVerbosity + -> Point blk + -> String showPoint verb pt = case pt of GenesisPoint -> "genesis (origin)" @@ -117,7 +117,7 @@ showPoint verb pt = trim :: [a] -> [a] trim = case verb of MinimalVerbosity -> take 7 - NormalVerbosity -> take 7 + NormalVerbosity -> take 7 MaximalVerbosity -> id instance ( Show a @@ -132,8 +132,8 @@ instance DefineSeverity (WithIPList (SubscriptionTrace Socket.SockAddr)) where defineSeverity (WithIPList _ _ ev) = case ev of SubscriptionTraceConnectStart _ -> Info SubscriptionTraceConnectEnd _ connectResult -> case connectResult of - ConnectSuccess -> Info - ConnectSuccessLast -> Notice + ConnectSuccess -> Info + ConnectSuccessLast -> Notice ConnectValencyExceeded -> Warning SubscriptionTraceConnectException {} -> Error SubscriptionTraceSocketAllocationException {} -> Error @@ -202,28 +202,28 @@ instance DefineSeverity (WithAddr Socket.SockAddr ErrorPolicyTrace) where instance DefinePrivacyAnnotation (WithMuxBearer peer MuxTrace) instance DefineSeverity (WithMuxBearer peer MuxTrace) where defineSeverity (WithMuxBearer _ ev) = case ev of - MuxTraceRecvHeaderStart -> Debug - MuxTraceRecvHeaderEnd {} -> Debug - MuxTraceRecvPayloadStart {} -> Debug - MuxTraceRecvPayloadEnd {} -> Debug - MuxTraceRecvStart {} -> Debug - MuxTraceRecvEnd {} -> Debug - MuxTraceSendStart {} -> Debug - MuxTraceSendEnd -> Debug - MuxTraceState {} -> Info - MuxTraceCleanExit {} -> Info - MuxTraceExceptionExit {} -> Info - MuxTraceChannelRecvStart {} -> Debug - MuxTraceChannelRecvEnd {} -> Debug - MuxTraceChannelSendStart {} -> Debug - MuxTraceChannelSendEnd {} -> Debug - MuxTraceHandshakeStart -> Debug - MuxTraceHandshakeClientEnd {} -> Info - MuxTraceHandshakeServerEnd -> Debug - MuxTraceHandshakeClientError {} -> Error - MuxTraceHandshakeServerError {} -> Error + MuxTraceRecvHeaderStart -> Debug + MuxTraceRecvHeaderEnd {} -> Debug + MuxTraceRecvPayloadStart {} -> Debug + MuxTraceRecvPayloadEnd {} -> Debug + MuxTraceRecvStart {} -> Debug + MuxTraceRecvEnd {} -> Debug + MuxTraceSendStart {} -> Debug + MuxTraceSendEnd -> Debug + MuxTraceState {} -> Info + MuxTraceCleanExit {} -> Info + MuxTraceExceptionExit {} -> Info + MuxTraceChannelRecvStart {} -> Debug + MuxTraceChannelRecvEnd {} -> Debug + MuxTraceChannelSendStart {} -> Debug + MuxTraceChannelSendEnd {} -> Debug + MuxTraceHandshakeStart -> Debug + MuxTraceHandshakeClientEnd {} -> Info + MuxTraceHandshakeServerEnd -> Debug + MuxTraceHandshakeClientError {} -> Error + MuxTraceHandshakeServerError {} -> Error MuxTraceRecvDeltaQObservation {} -> Debug - MuxTraceRecvDeltaQSample {} -> Info + MuxTraceRecvDeltaQSample {} -> Info instance DefinePrivacyAnnotation (WithTip blk (ChainDB.TraceEvent blk)) instance DefineSeverity (WithTip blk (ChainDB.TraceEvent blk)) where @@ -491,11 +491,11 @@ readableChainDBTracer tracer = Tracer $ \case "Ignoring previously seen invalid block: " <> condense pt ChainDB.BlockInTheFuture pt slot -> tr $ WithTip tip $ "Ignoring block from future: " <> condense pt <> ", slot " <> condense slot - ChainDB.StoreButDontChange pt -> tr $ WithTip tip $ + ChainDB.StoreButDontChange pt -> tr $ WithTip tip $ "Ignoring block: " <> condense pt ChainDB.TryAddToCurrentChain pt -> tr $ WithTip tip $ "Block fits onto the current chain: " <> condense pt - ChainDB.TrySwitchToAFork pt _ -> tr $ WithTip tip $ + ChainDB.TrySwitchToAFork pt _ -> tr $ WithTip tip $ "Block fits onto some fork: " <> condense pt ChainDB.AddedToCurrentChain _ _ c -> tr $ WithTip tip $ "Chain extended, new tip: " <> condense (AF.headPoint c) @@ -512,7 +512,7 @@ readableChainDBTracer tracer = Tracer $ \case "Exceeds rollback " <> condense (AF.headPoint c) ChainDB.AddedBlockToVolDB pt _ _ -> tr $ WithTip tip $ "Chain added block " <> condense pt - ChainDB.ChainChangedInBg c1 c2 -> tr $ WithTip tip $ + ChainDB.ChainChangedInBg c1 c2 -> tr $ WithTip tip $ "Chain changed in bg, from " <> condense (AF.headPoint c1) <> " to " <> condense (AF.headPoint c2) ChainDB.ScheduledChainSelection pt slot _n -> tr $ WithTip tip $ "Chain selection scheduled for future: " <> condense pt @@ -541,7 +541,7 @@ readableChainDBTracer tracer = Tracer $ \case ChainDB.NoBlocksToCopyToImmDB -> tr $ WithTip tip "There are no blocks to copy to the ImmutableDB" WithTip tip (ChainDB.TraceGCEvent ev) -> case ev of - ChainDB.PerformedGC slot -> tr $ WithTip tip $ + ChainDB.PerformedGC slot -> tr $ WithTip tip $ "Performed a garbage collection for " <> condense slot ChainDB.ScheduledGC slot _difft -> tr $ WithTip tip $ "Scheduled a garbage collection for " <> condense slot @@ -685,12 +685,12 @@ instance (Condense (HeaderHash blk), LedgerSupportsProtocol blk) mkObject [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.CandidateExceedsRollback" , "block" .= showPoint verb (AF.headPoint c) , "supported" .= show supported - , "actual" .= show actual ] + , "actual" .= show actual ] ChainDB.AddedBlockToVolDB pt (BlockNo bn) _ -> mkObject [ "kind" .= String "TraceAddBlockEvent.AddedBlockToVolDB" , "block" .= toObject verb pt , "blockNo" .= show bn ] - ChainDB.ChainChangedInBg c1 c2 -> + ChainDB.ChainChangedInBg c1 c2 -> mkObject [ "kind" .= String "TraceAddBlockEvent.ChainChangedInBg" , "prev" .= showPoint verb (AF.headPoint c1) , "new" .= showPoint verb (AF.headPoint c2) ] @@ -944,15 +944,15 @@ instance ( Condense (HeaderHash blk) => ToObject (TraceForgeEvent blk tx) where toObject MaximalVerbosity (TraceAdoptedBlock slotNo blk txs) = mkObject - [ "kind" .= String "TraceAdoptedBlock" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceAdoptedBlock" + , "slot" .= toJSON (unSlotNo slotNo) , "block hash" .= (condense $ blockHash blk) , "tx ids" .= (show $ map txId txs) ] toObject _verb (TraceAdoptedBlock slotNo blk _txs) = mkObject - [ "kind" .= String "TraceAdoptedBlock" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceAdoptedBlock" + , "slot" .= toJSON (unSlotNo slotNo) , "block hash" .= (condense $ blockHash blk) ] toObject _verb (TraceBlockFromFuture currentSlot tip) = @@ -970,44 +970,44 @@ instance ( Condense (HeaderHash blk) ] toObject _verb (TraceDidntAdoptBlock slotNo _) = mkObject - [ "kind" .= String "TraceDidntAdoptBlock" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceDidntAdoptBlock" + , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceForgedBlock slotNo _ _) = mkObject - [ "kind" .= String "TraceForgedBlock" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceForgedBlock" + , "slot" .= toJSON (unSlotNo slotNo) ] toObject verb (TraceForgedInvalidBlock slotNo _ reason) = mkObject - [ "kind" .= String "TraceForgedInvalidBlock" - , "slot" .= toJSON (unSlotNo slotNo) - , "reason" .= toObject verb reason + [ "kind" .= String "TraceForgedInvalidBlock" + , "slot" .= toJSON (unSlotNo slotNo) + , "reason" .= toObject verb reason ] toObject _verb (TraceNodeIsLeader slotNo) = mkObject - [ "kind" .= String "TraceNodeIsLeader" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceNodeIsLeader" + , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceNodeNotLeader slotNo) = mkObject - [ "kind" .= String "TraceNodeNotLeader" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceNodeNotLeader" + , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceNoLedgerState slotNo _blk) = mkObject - [ "kind" .= String "TraceNoLedgerState" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceNoLedgerState" + , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceNoLedgerView slotNo _) = mkObject - [ "kind" .= String "TraceNoLedgerView" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceNoLedgerView" + , "slot" .= toJSON (unSlotNo slotNo) ] toObject _verb (TraceStartLeadershipCheck slotNo) = mkObject - [ "kind" .= String "TraceStartLeadershipCheck" - , "slot" .= toJSON (unSlotNo slotNo) + [ "kind" .= String "TraceStartLeadershipCheck" + , "slot" .= toJSON (unSlotNo slotNo) ] instance (Show (GenTx blk), Show (GenTxId blk)) @@ -1044,13 +1044,13 @@ instance ( StandardHash blk => ToObject (ChainDB.InvalidBlockReason blk) where toObject verb (ChainDB.ValidationError extvalerr) = mkObject - [ "kind" .= String "ValidationError" + [ "kind" .= String "ValidationError" , "error" .= toObject verb extvalerr ] toObject verb (ChainDB.InChainAfterInvalidBlock point extvalerr) = mkObject - [ "kind" .= String "InChainAfterInvalidBlock" - , "point" .= String (pack $ show point) + [ "kind" .= String "InChainAfterInvalidBlock" + , "point" .= String (showPoint point) , "error" .= toObject verb extvalerr ] @@ -1067,12 +1067,12 @@ instance ( StandardHash blk => ToObject (HeaderError blk) where toObject verb (HeaderProtocolError err) = mkObject - [ "kind" .= String "HeaderProtocolError" + [ "kind" .= String "HeaderProtocolError" , "error" .= toObject verb err ] toObject verb (HeaderEnvelopeError err) = mkObject - [ "kind" .= String "HeaderEnvelopeError" + [ "kind" .= String "HeaderEnvelopeError" , "error" .= toObject verb err ] @@ -1080,162 +1080,162 @@ instance (StandardHash blk) => ToObject (HeaderEnvelopeError blk) where toObject _verb (UnexpectedBlockNo expect act) = mkObject - [ "kind" .= String "UnexpectedBlockNo" + [ "kind" .= String "UnexpectedBlockNo" , "expected" .= condense expect - , "actual" .= condense act + , "actual" .= condense act ] toObject _verb (UnexpectedSlotNo expect act) = mkObject - [ "kind" .= String "UnexpectedSlotNo" + [ "kind" .= String "UnexpectedSlotNo" , "expected" .= condense expect - , "actual" .= condense act + , "actual" .= condense act ] toObject _verb (UnexpectedPrevHash expect act) = mkObject - [ "kind" .= String "UnexpectedPrevHash" + [ "kind" .= String "UnexpectedPrevHash" , "expected" .= String (pack $ show expect) - , "actual" .= String (pack $ show act) + , "actual" .= String (pack $ show act) ] toObject _verb (OtherEnvelopeError text) = mkObject - [ "kind" .= String "OtherEnvelopeError" + [ "kind" .= String "OtherEnvelopeError" , "error" .= String text ] instance StandardHash blk => ToObject (Mock.MockError blk) where toObject _verb (Mock.MockUtxoError e) = mkObject - [ "kind" .= String "MockUtxoError" + [ "kind" .= String "MockUtxoError" , "error" .= String (pack $ show e) ] toObject _verb (Mock.MockInvalidHash expect act) = mkObject - [ "kind" .= String "MockInvalidHash" + [ "kind" .= String "MockInvalidHash" , "expected" .= String (pack $ show expect) - , "actual" .= String (pack $ show act) + , "actual" .= String (pack $ show act) ] instance (Show (PBFT.PBftVerKeyHash c)) => ToObject (PBFT.PBftValidationErr c) where toObject _verb (PBFT.PBftInvalidSignature text) = mkObject - [ "kind" .= String "PBftInvalidSignature" + [ "kind" .= String "PBftInvalidSignature" , "error" .= String text ] toObject _verb (PBFT.PBftNotGenesisDelegate vkhash _ledgerView) = mkObject - [ "kind" .= String "PBftNotGenesisDelegate" - , "vk" .= String (pack $ show vkhash) + [ "kind" .= String "PBftNotGenesisDelegate" + , "vk" .= String (pack $ show vkhash) ] toObject _verb (PBFT.PBftExceededSignThreshold vkhash n) = mkObject - [ "kind" .= String "PBftExceededSignThreshold" - , "vk" .= String (pack $ show vkhash) - , "n" .= String (pack $ show n) + [ "kind" .= String "PBftExceededSignThreshold" + , "vk" .= String (pack $ show vkhash) + , "n" .= String (pack $ show n) ] toObject _verb PBFT.PBftInvalidSlot = mkObject - [ "kind" .= String "PBftInvalidSlot" + [ "kind" .= String "PBftInvalidSlot" ] instance ToObject BFT.BftValidationErr where toObject _verb (BFT.BftInvalidSignature err) = mkObject - [ "kind" .= String "BftInvalidSignature" + [ "kind" .= String "BftInvalidSignature" , "error" .= String (pack err) ] instance ToObject (Praos.PraosValidationError c) where toObject _verb (Praos.PraosInvalidSlot expect act) = mkObject - [ "kind" .= String "PraosInvalidSlot" + [ "kind" .= String "PraosInvalidSlot" , "expected" .= String (pack $ show expect) - , "actual" .= String (pack $ show act) + , "actual" .= String (pack $ show act) ] toObject _verb (Praos.PraosUnknownCoreId cid) = mkObject - [ "kind" .= String "PraosUnknownCoreId" + [ "kind" .= String "PraosUnknownCoreId" , "error" .= String (pack $ show cid) ] toObject _verb (Praos.PraosInvalidSig str _ _ _) = mkObject - [ "kind" .= String "PraosInvalidSig" + [ "kind" .= String "PraosInvalidSig" , "error" .= String (pack str) ] toObject _verb (Praos.PraosInvalidCert _vkvrf y nat _vrf) = mkObject - [ "kind" .= String "PraosInvalidCert" - , "y" .= String (pack $ show y) - , "nat" .= String (pack $ show nat) + [ "kind" .= String "PraosInvalidCert" + , "y" .= String (pack $ show y) + , "nat" .= String (pack $ show nat) ] toObject _verb (Praos.PraosInsufficientStake t y) = mkObject - [ "kind" .= String "PraosInsufficientStake" - , "t" .= String (pack $ show t) - , "y" .= String (pack $ show y) + [ "kind" .= String "PraosInsufficientStake" + , "t" .= String (pack $ show t) + , "y" .= String (pack $ show y) ] instance ToObject Block.ChainValidationError where toObject _verb Block.ChainValidationBoundaryTooLarge = mkObject - [ "kind" .= String "ChainValidationBoundaryTooLarge" ] + [ "kind" .= String "ChainValidationBoundaryTooLarge" ] toObject _verb Block.ChainValidationBlockAttributesTooLarge = mkObject - [ "kind" .= String "ChainValidationBlockAttributesTooLarge" ] + [ "kind" .= String "ChainValidationBlockAttributesTooLarge" ] toObject _verb (Block.ChainValidationBlockTooLarge _ _) = mkObject - [ "kind" .= String "ChainValidationBlockTooLarge" ] + [ "kind" .= String "ChainValidationBlockTooLarge" ] toObject _verb Block.ChainValidationHeaderAttributesTooLarge = mkObject - [ "kind" .= String "ChainValidationHeaderAttributesTooLarge" ] + [ "kind" .= String "ChainValidationHeaderAttributesTooLarge" ] toObject _verb (Block.ChainValidationHeaderTooLarge _ _) = mkObject - [ "kind" .= String "ChainValidationHeaderTooLarge" ] + [ "kind" .= String "ChainValidationHeaderTooLarge" ] toObject _verb (Block.ChainValidationDelegationPayloadError err) = mkObject - [ "kind" .= String err ] + [ "kind" .= String err ] toObject _verb (Block.ChainValidationInvalidDelegation _ _) = mkObject - [ "kind" .= String "ChainValidationInvalidDelegation" ] + [ "kind" .= String "ChainValidationInvalidDelegation" ] toObject _verb (Block.ChainValidationGenesisHashMismatch _ _) = mkObject - [ "kind" .= String "ChainValidationGenesisHashMismatch" ] + [ "kind" .= String "ChainValidationGenesisHashMismatch" ] toObject _verb (Block.ChainValidationExpectedGenesisHash _ _) = mkObject - [ "kind" .= String "ChainValidationExpectedGenesisHash" ] + [ "kind" .= String "ChainValidationExpectedGenesisHash" ] toObject _verb (Block.ChainValidationExpectedHeaderHash _ _) = mkObject - [ "kind" .= String "ChainValidationExpectedHeaderHash" ] + [ "kind" .= String "ChainValidationExpectedHeaderHash" ] toObject _verb (Block.ChainValidationInvalidHash _ _) = mkObject - [ "kind" .= String "ChainValidationInvalidHash" ] + [ "kind" .= String "ChainValidationInvalidHash" ] toObject _verb (Block.ChainValidationMissingHash _) = mkObject - [ "kind" .= String "ChainValidationMissingHash" ] + [ "kind" .= String "ChainValidationMissingHash" ] toObject _verb (Block.ChainValidationUnexpectedGenesisHash _) = mkObject - [ "kind" .= String "ChainValidationUnexpectedGenesisHash" ] + [ "kind" .= String "ChainValidationUnexpectedGenesisHash" ] toObject _verb (Block.ChainValidationInvalidSignature _) = mkObject - [ "kind" .= String "ChainValidationInvalidSignature" ] + [ "kind" .= String "ChainValidationInvalidSignature" ] toObject _verb (Block.ChainValidationDelegationSchedulingError _) = mkObject - [ "kind" .= String "ChainValidationDelegationSchedulingError" ] + [ "kind" .= String "ChainValidationDelegationSchedulingError" ] toObject _verb (Block.ChainValidationProtocolMagicMismatch _ _) = mkObject - [ "kind" .= String "ChainValidationProtocolMagicMismatch" ] + [ "kind" .= String "ChainValidationProtocolMagicMismatch" ] toObject _verb Block.ChainValidationSignatureLight = mkObject - [ "kind" .= String "ChainValidationSignatureLight" ] + [ "kind" .= String "ChainValidationSignatureLight" ] toObject _verb (Block.ChainValidationTooManyDelegations _) = mkObject - [ "kind" .= String "ChainValidationTooManyDelegations" ] + [ "kind" .= String "ChainValidationTooManyDelegations" ] toObject _verb (Block.ChainValidationUpdateError _ _) = mkObject - [ "kind" .= String "ChainValidationUpdateError" ] + [ "kind" .= String "ChainValidationUpdateError" ] toObject _verb (Block.ChainValidationUTxOValidationError _) = mkObject - [ "kind" .= String "ChainValidationUTxOValidationError" ] + [ "kind" .= String "ChainValidationUTxOValidationError" ] toObject _verb (Block.ChainValidationProofValidationError _) = mkObject - [ "kind" .= String "ChainValidationProofValidationError" ] + [ "kind" .= String "ChainValidationProofValidationError" ]