{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Consensus.PeerSimulator.Trace
( TraceBlockFetchClientTerminationEvent (..)
, TraceChainSyncClientTerminationEvent (..)
, TraceEvent (..)
, TraceScheduledBlockFetchServerEvent (..)
, TraceScheduledChainSyncServerEvent (..)
, TraceScheduledServerHandlerEvent (..)
, TraceSchedulerEvent (..)
, mkGDDTracerTestBlock
, prettyDensityBounds
, traceLinesWith
, tracerTestBlock
) where
import Control.Tracer (Tracer (Tracer), contramap, traceWith)
import Data.Bifunctor (second)
import Data.List (intersperse)
import qualified Data.List.NonEmpty as NE
import Data.Time.Clock (DiffTime, diffTimeToPicoseconds)
import Network.TypedProtocol.Codec (AnyMessage (..))
import Ouroboros.Consensus.Block
( GenesisWindow (..)
, Header
, Point
, WithOrigin (NotOrigin, Origin)
, succWithOrigin
)
import Ouroboros.Consensus.Genesis.Governor
( DensityBounds (..)
, GDDDebugInfo (..)
, TraceGDDEvent (..)
)
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
( TraceChainSyncClientEvent (..)
)
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping
( Instruction (..)
, JumpInstruction (..)
, JumpResult (..)
, TraceCsjReason (..)
, TraceEventCsj (..)
, TraceEventDbf (..)
)
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
( ChainSyncJumpingJumperState (..)
, ChainSyncJumpingState (..)
, DynamoInitState (..)
, JumpInfo (..)
)
import Ouroboros.Consensus.Storage.ChainDB.API (LoE (..))
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl as ChainDB
import Ouroboros.Consensus.Storage.ChainDB.Impl.Types
( TraceAddBlockEvent (..)
)
import Ouroboros.Consensus.Util.Condense (condense)
import Ouroboros.Consensus.Util.Enclose
import Ouroboros.Consensus.Util.IOLike
( IOLike
, MonadMonotonicTime
, Time (Time)
, atomically
, getMonotonicTime
, readTVarIO
, uncheckedNewTVarM
, writeTVar
)
import Ouroboros.Network.AnchoredFragment
( AnchoredFragment
, headPoint
)
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block (SlotNo (SlotNo), Tip, castPoint)
import Ouroboros.Network.Driver.Simple (TraceSendRecv (..))
import Ouroboros.Network.Protocol.ChainSync.Type
( ChainSync
, Message (..)
)
import Test.Consensus.PointSchedule.NodeState (NodeState)
import Test.Consensus.PointSchedule.Peers (Peer (Peer), PeerId)
import Test.Util.TersePrinting
( terseAnchor
, terseBlock
, terseFragment
, terseHFragment
, terseHeader
, tersePoint
, terseRealPoint
, terseTip
, terseWithOrigin
)
import Test.Util.TestBlock (TestBlock)
import Text.Printf (printf)
data TraceSchedulerEvent blk
=
TraceBeginningOfTime
|
TraceEndOfTime
|
DiffTime
|
forall m. TraceNewTick
Int
DiffTime
(Peer (NodeState blk))
(AnchoredFragment (Header blk))
(Maybe (AnchoredFragment (Header blk)))
[(PeerId, ChainSyncJumpingState m blk)]
| TraceNodeShutdownStart (WithOrigin SlotNo)
| TraceNodeShutdownComplete
| TraceNodeStartupStart
| TraceNodeStartupComplete (AnchoredFragment (Header blk))
type HandlerName = String
data TraceScheduledServerHandlerEvent state blk
= TraceHandling HandlerName state
| TraceRestarting HandlerName
| TraceDoneHandling HandlerName
data TraceScheduledChainSyncServerEvent state blk
= TraceHandlerEventCS (TraceScheduledServerHandlerEvent state blk)
| TraceLastIntersection (Point blk)
| TraceClientIsDone
| TraceIntersectionFound (Point blk)
| TraceIntersectionNotFound
| TraceRollForward (Header blk) (Tip blk)
| TraceRollBackward (Point blk) (Tip blk)
| TraceChainIsFullyServed
|
| (AnchoredFragment blk)
|
data TraceScheduledBlockFetchServerEvent state blk
= TraceHandlerEventBF (TraceScheduledServerHandlerEvent state blk)
| TraceNoBlocks
| TraceStartingBatch (AnchoredFragment blk)
| TraceWaitingForRange (Point blk) (Point blk)
| TraceSendingBlock blk
| TraceBatchIsDone
| TraceBlockPointIsBehind
data TraceChainSyncClientTerminationEvent
= TraceExceededSizeLimitCS
| TraceExceededTimeLimitCS
| TraceTerminatedByGDDGovernor
| TraceTerminatedByLoP
data TraceBlockFetchClientTerminationEvent
= TraceExceededSizeLimitBF
| TraceExceededTimeLimitBF
data TraceEvent blk
= TraceSchedulerEvent (TraceSchedulerEvent blk)
| TraceScheduledChainSyncServerEvent PeerId (TraceScheduledChainSyncServerEvent (NodeState blk) blk)
| TraceScheduledBlockFetchServerEvent PeerId (TraceScheduledBlockFetchServerEvent (NodeState blk) blk)
| TraceChainDBEvent (ChainDB.TraceEvent blk)
| TraceChainSyncClientEvent PeerId (TraceChainSyncClientEvent blk)
| TraceChainSyncClientTerminationEvent PeerId TraceChainSyncClientTerminationEvent
| TraceBlockFetchClientTerminationEvent PeerId TraceBlockFetchClientTerminationEvent
| TraceGenesisDDEvent (TraceGDDEvent PeerId blk)
| TraceChainSyncSendRecvEvent
PeerId
String
(TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk)))
| TraceDbfEvent (TraceEventDbf PeerId)
| TraceCsjEvent PeerId (TraceEventCsj PeerId blk)
| TraceOther String
tracerTestBlock ::
IOLike m =>
Tracer m String ->
m (Tracer m (TraceEvent TestBlock))
tracerTestBlock :: forall (m :: * -> *).
IOLike m =>
Tracer m String -> m (Tracer m (TraceEvent TestBlock))
tracerTestBlock Tracer m String
tracer0 = do
tickTimeVar <- Time -> m (StrictTVar m Time)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM (Time -> m (StrictTVar m Time)) -> Time -> m (StrictTVar m Time)
forall a b. (a -> b) -> a -> b
$ DiffTime -> Time
Time (-DiffTime
1)
let setTickTime = STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> (Time -> STM m ()) -> Time -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTVar m Time -> Time -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m Time
tickTimeVar
tracer = (String -> m ()) -> Tracer m String
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((String -> m ()) -> Tracer m String)
-> (String -> m ()) -> Tracer m String
forall a b. (a -> b) -> a -> b
$ \String
msg -> do
time <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
tickTime <- readTVarIO tickTimeVar
let timeHeader = Time -> String
prettyTime Time
time String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
prefix =
if Time
time Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
/= Time
tickTime
then String
timeHeader
else Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
timeHeader) Char
' '
traceWith tracer0 $ concat $ intersperse "\n" $ map (prefix ++) $ lines msg
pure $ Tracer $ traceEventTestBlockWith setTickTime tracer0 tracer
mkGDDTracerTestBlock ::
Tracer m (TraceEvent TestBlock) ->
Tracer m (TraceGDDEvent PeerId TestBlock)
mkGDDTracerTestBlock :: forall (m :: * -> *).
Tracer m (TraceEvent TestBlock)
-> Tracer m (TraceGDDEvent PeerId TestBlock)
mkGDDTracerTestBlock = (TraceGDDEvent PeerId TestBlock -> TraceEvent TestBlock)
-> Tracer m (TraceEvent TestBlock)
-> Tracer m (TraceGDDEvent PeerId TestBlock)
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap TraceGDDEvent PeerId TestBlock -> TraceEvent TestBlock
forall blk. TraceGDDEvent PeerId blk -> TraceEvent blk
TraceGenesisDDEvent
traceEventTestBlockWith ::
MonadMonotonicTime m =>
(Time -> m ()) ->
Tracer m String ->
Tracer m String ->
TraceEvent TestBlock ->
m ()
traceEventTestBlockWith :: forall (m :: * -> *).
MonadMonotonicTime m =>
(Time -> m ())
-> Tracer m String
-> Tracer m String
-> TraceEvent TestBlock
-> m ()
traceEventTestBlockWith Time -> m ()
setTickTime Tracer m String
tracer0 Tracer m String
tracer = \case
TraceSchedulerEvent TraceSchedulerEvent TestBlock
traceEvent -> (Time -> m ())
-> Tracer m String
-> Tracer m String
-> TraceSchedulerEvent TestBlock
-> m ()
forall (m :: * -> *).
MonadMonotonicTime m =>
(Time -> m ())
-> Tracer m String
-> Tracer m String
-> TraceSchedulerEvent TestBlock
-> m ()
traceSchedulerEventTestBlockWith Time -> m ()
setTickTime Tracer m String
tracer0 Tracer m String
tracer TraceSchedulerEvent TestBlock
traceEvent
TraceScheduledChainSyncServerEvent PeerId
peerId TraceScheduledChainSyncServerEvent (NodeState TestBlock) TestBlock
traceEvent -> Tracer m String
-> PeerId
-> TraceScheduledChainSyncServerEvent
(NodeState TestBlock) TestBlock
-> m ()
forall (m :: * -> *).
Tracer m String
-> PeerId
-> TraceScheduledChainSyncServerEvent
(NodeState TestBlock) TestBlock
-> m ()
traceScheduledChainSyncServerEventTestBlockWith Tracer m String
tracer PeerId
peerId TraceScheduledChainSyncServerEvent (NodeState TestBlock) TestBlock
traceEvent
TraceScheduledBlockFetchServerEvent PeerId
peerId TraceScheduledBlockFetchServerEvent (NodeState TestBlock) TestBlock
traceEvent -> Tracer m String
-> PeerId
-> TraceScheduledBlockFetchServerEvent
(NodeState TestBlock) TestBlock
-> m ()
forall (m :: * -> *).
Tracer m String
-> PeerId
-> TraceScheduledBlockFetchServerEvent
(NodeState TestBlock) TestBlock
-> m ()
traceScheduledBlockFetchServerEventTestBlockWith Tracer m String
tracer PeerId
peerId TraceScheduledBlockFetchServerEvent (NodeState TestBlock) TestBlock
traceEvent
TraceChainDBEvent TraceEvent TestBlock
traceEvent -> Tracer m String -> TraceEvent TestBlock -> m ()
forall (m :: * -> *).
Monad m =>
Tracer m String -> TraceEvent TestBlock -> m ()
traceChainDBEventTestBlockWith Tracer m String
tracer TraceEvent TestBlock
traceEvent
TraceChainSyncClientEvent PeerId
peerId TraceChainSyncClientEvent TestBlock
traceEvent -> PeerId
-> Tracer m String -> TraceChainSyncClientEvent TestBlock -> m ()
forall (m :: * -> *).
PeerId
-> Tracer m String -> TraceChainSyncClientEvent TestBlock -> m ()
traceChainSyncClientEventTestBlockWith PeerId
peerId Tracer m String
tracer TraceChainSyncClientEvent TestBlock
traceEvent
TraceChainSyncClientTerminationEvent PeerId
peerId TraceChainSyncClientTerminationEvent
traceEvent -> PeerId
-> Tracer m String -> TraceChainSyncClientTerminationEvent -> m ()
forall (m :: * -> *).
PeerId
-> Tracer m String -> TraceChainSyncClientTerminationEvent -> m ()
traceChainSyncClientTerminationEventTestBlockWith PeerId
peerId Tracer m String
tracer TraceChainSyncClientTerminationEvent
traceEvent
TraceBlockFetchClientTerminationEvent PeerId
peerId TraceBlockFetchClientTerminationEvent
traceEvent -> PeerId
-> Tracer m String -> TraceBlockFetchClientTerminationEvent -> m ()
forall (m :: * -> *).
PeerId
-> Tracer m String -> TraceBlockFetchClientTerminationEvent -> m ()
traceBlockFetchClientTerminationEventTestBlockWith PeerId
peerId Tracer m String
tracer TraceBlockFetchClientTerminationEvent
traceEvent
TraceGenesisDDEvent TraceGDDEvent PeerId TestBlock
gddEvent -> Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer (TraceGDDEvent PeerId TestBlock -> String
terseGDDEvent TraceGDDEvent PeerId TestBlock
gddEvent)
TraceChainSyncSendRecvEvent PeerId
peerId String
peerType TraceSendRecv
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
traceEvent -> PeerId
-> String
-> Tracer m String
-> TraceSendRecv
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
-> m ()
forall (m :: * -> *).
Applicative m =>
PeerId
-> String
-> Tracer m String
-> TraceSendRecv
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
-> m ()
traceChainSyncSendRecvEventTestBlockWith PeerId
peerId String
peerType Tracer m String
tracer TraceSendRecv
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
traceEvent
TraceDbfEvent TraceEventDbf PeerId
traceEvent -> Tracer m String -> TraceEventDbf PeerId -> m ()
forall (m :: * -> *).
Tracer m String -> TraceEventDbf PeerId -> m ()
traceDbjEventWith Tracer m String
tracer TraceEventDbf PeerId
traceEvent
TraceCsjEvent PeerId
peerId TraceEventCsj PeerId TestBlock
traceEvent -> PeerId -> Tracer m String -> TraceEventCsj PeerId TestBlock -> m ()
forall (m :: * -> *).
PeerId -> Tracer m String -> TraceEventCsj PeerId TestBlock -> m ()
traceCsjEventWith PeerId
peerId Tracer m String
tracer TraceEventCsj PeerId TestBlock
traceEvent
TraceOther String
msg -> Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer String
msg
traceSchedulerEventTestBlockWith ::
MonadMonotonicTime m =>
(Time -> m ()) ->
Tracer m String ->
Tracer m String ->
TraceSchedulerEvent TestBlock ->
m ()
traceSchedulerEventTestBlockWith :: forall (m :: * -> *).
MonadMonotonicTime m =>
(Time -> m ())
-> Tracer m String
-> Tracer m String
-> TraceSchedulerEvent TestBlock
-> m ()
traceSchedulerEventTestBlockWith Time -> m ()
setTickTime Tracer m String
tracer0 Tracer m String
tracer = \case
TraceSchedulerEvent TestBlock
TraceBeginningOfTime ->
Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer0 String
"Running point schedule ..."
TraceSchedulerEvent TestBlock
TraceEndOfTime ->
Tracer m String -> [String] -> m ()
forall (m :: * -> *). Tracer m String -> [String] -> m ()
traceLinesWith
Tracer m String
tracer0
[ String
"╶──────────────────────────────────────────────────────────────────────────────╴"
, String
"Finished running point schedule"
]
TraceExtraDelay DiffTime
delay -> do
time <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
traceLinesWith
tracer0
[ "┌──────────────────────────────────────────────────────────────────────────────┐"
, "└─ " ++ prettyTime time
, "Waiting an extra delay to keep the simulation running for: " ++ prettyTime (Time delay)
]
TraceNewTick Int
number DiffTime
duration (Peer PeerId
pid NodeState TestBlock
state) AnchoredFragment (Header TestBlock)
currentChain Maybe (AnchoredFragment (Header TestBlock))
mCandidateFrag [(PeerId, ChainSyncJumpingState m TestBlock)]
jumpingStates -> do
time <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
setTickTime time
traceLinesWith
tracer0
[ "┌──────────────────────────────────────────────────────────────────────────────┐"
, "└─ " ++ prettyTime time
, "Tick:"
, " number: " ++ show number
, " duration: " ++ show duration
, " peer: " ++ condense pid
, " state: " ++ condense state
, " current chain: " ++ terseHFragment currentChain
, " candidate fragment: " ++ maybe "Nothing" terseHFragment mCandidateFrag
, " jumping states:\n" ++ traceJumpingStates jumpingStates
]
TraceNodeShutdownStart WithOrigin SlotNo
immTip ->
Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer (String
" Initiating node shutdown with immutable tip at slot " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WithOrigin SlotNo -> String
forall a. Condense a => a -> String
condense WithOrigin SlotNo
immTip)
TraceSchedulerEvent TestBlock
TraceNodeShutdownComplete ->
Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer String
" Node shutdown complete"
TraceSchedulerEvent TestBlock
TraceNodeStartupStart ->
Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer String
" Initiating node startup"
TraceNodeStartupComplete AnchoredFragment (Header TestBlock)
selection ->
Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer (String
" Node startup complete with selection " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredFragment (Header TestBlock) -> String
terseHFragment AnchoredFragment (Header TestBlock)
selection)
where
traceJumpingStates :: [(PeerId, ChainSyncJumpingState m TestBlock)] -> String
traceJumpingStates :: forall (m :: * -> *).
[(PeerId, ChainSyncJumpingState m TestBlock)] -> String
traceJumpingStates = [String] -> String
unlines ([String] -> String)
-> ([(PeerId, ChainSyncJumpingState m TestBlock)] -> [String])
-> [(PeerId, ChainSyncJumpingState m TestBlock)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerId, ChainSyncJumpingState m TestBlock) -> String)
-> [(PeerId, ChainSyncJumpingState m TestBlock)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(PeerId
pid, ChainSyncJumpingState m TestBlock
state) -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
pid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ChainSyncJumpingState m TestBlock -> String
forall (m :: * -> *). ChainSyncJumpingState m TestBlock -> String
traceJumpingState ChainSyncJumpingState m TestBlock
state)
traceJumpingState :: ChainSyncJumpingState m TestBlock -> String
traceJumpingState :: forall (m :: * -> *). ChainSyncJumpingState m TestBlock -> String
traceJumpingState = \case
Dynamo DynamoInitState TestBlock
initState WithOrigin SlotNo
lastJump ->
let showInitState :: String
showInitState = case DynamoInitState TestBlock
initState of
DynamoStarting JumpInfo TestBlock
ji -> String
"(DynamoStarting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
ji String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
DynamoInitState TestBlock
DynamoStarted -> String
"DynamoStarted"
in [String] -> String
unwords [String
"Dynamo", String
showInitState, (SlotNo -> String) -> WithOrigin SlotNo -> String
forall a. (a -> String) -> WithOrigin a -> String
terseWithOrigin SlotNo -> String
forall a. Show a => a -> String
show WithOrigin SlotNo
lastJump]
Objector ObjectorInitState
initState JumpInfo TestBlock
goodJumpInfo Point (Header TestBlock)
badPoint ->
[String] -> String
unwords
[ String
"Objector"
, ObjectorInitState -> String
forall a. Show a => a -> String
show ObjectorInitState
initState
, JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
goodJumpInfo
, Point TestBlock -> String
tersePoint (Point (Header TestBlock) -> Point TestBlock
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint Point (Header TestBlock)
badPoint)
]
Disengaged DisengagedInitState
initState -> String
"Disengaged " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DisengagedInitState -> String
forall a. Show a => a -> String
show DisengagedInitState
initState
Jumper StrictTVar m (Maybe (JumpInfo TestBlock))
_ ChainSyncJumpingJumperState TestBlock
st -> String
"Jumper _ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ChainSyncJumpingJumperState TestBlock -> String
traceJumperState ChainSyncJumpingJumperState TestBlock
st
traceJumperState :: ChainSyncJumpingJumperState TestBlock -> String
traceJumperState :: ChainSyncJumpingJumperState TestBlock -> String
traceJumperState = \case
Happy JumperInitState
initState Maybe (JumpInfo TestBlock)
mGoodJumpInfo ->
String
"Happy " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JumperInitState -> String
forall a. Show a => a -> String
show JumperInitState
initState String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> (JumpInfo TestBlock -> String)
-> Maybe (JumpInfo TestBlock)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Nothing" JumpInfo TestBlock -> String
terseJumpInfo Maybe (JumpInfo TestBlock)
mGoodJumpInfo
FoundIntersection ObjectorInitState
initState JumpInfo TestBlock
goodJumpInfo Point (Header TestBlock)
point ->
[String] -> String
unwords
[ String
"(FoundIntersection"
, ObjectorInitState -> String
forall a. Show a => a -> String
show ObjectorInitState
initState
, JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
goodJumpInfo
, Point TestBlock -> String
tersePoint (Point TestBlock -> String) -> Point TestBlock -> String
forall a b. (a -> b) -> a -> b
$ Point (Header TestBlock) -> Point TestBlock
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint Point (Header TestBlock)
point
, String
")"
]
LookingForIntersection JumpInfo TestBlock
goodJumpInfo JumpInfo TestBlock
badJumpInfo ->
[String] -> String
unwords
[String
"(LookingForIntersection", JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
goodJumpInfo, JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
badJumpInfo, String
")"]
traceScheduledServerHandlerEventTestBlockWith ::
Tracer m String ->
String ->
TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock ->
m ()
traceScheduledServerHandlerEventTestBlockWith :: forall (m :: * -> *).
Tracer m String
-> String
-> TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
-> m ()
traceScheduledServerHandlerEventTestBlockWith Tracer m String
tracer String
unit = \case
TraceHandling String
handler NodeState TestBlock
state ->
[String] -> m ()
traceLines
[ String
"handling " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
handler
, String
" state is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NodeState TestBlock -> String
forall a. Condense a => a -> String
condense NodeState TestBlock
state
]
TraceRestarting String
_ ->
String -> m ()
trace String
" cannot serve at this point; waiting for node state and starting again"
TraceDoneHandling String
handler ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"done handling " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
handler
where
trace :: String -> m ()
trace = Tracer m String -> String -> String -> m ()
forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer String
unit
traceLines :: [String] -> m ()
traceLines = Tracer m String -> String -> [String] -> m ()
forall (m :: * -> *). Tracer m String -> String -> [String] -> m ()
traceUnitLinesWith Tracer m String
tracer String
unit
traceScheduledChainSyncServerEventTestBlockWith ::
Tracer m String ->
PeerId ->
TraceScheduledChainSyncServerEvent (NodeState TestBlock) TestBlock ->
m ()
traceScheduledChainSyncServerEventTestBlockWith :: forall (m :: * -> *).
Tracer m String
-> PeerId
-> TraceScheduledChainSyncServerEvent
(NodeState TestBlock) TestBlock
-> m ()
traceScheduledChainSyncServerEventTestBlockWith Tracer m String
tracer PeerId
peerId = \case
TraceHandlerEventCS TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
traceEvent -> Tracer m String
-> String
-> TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
-> m ()
forall (m :: * -> *).
Tracer m String
-> String
-> TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
-> m ()
traceScheduledServerHandlerEventTestBlockWith Tracer m String
tracer String
unit TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
traceEvent
TraceLastIntersection Point TestBlock
point ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
" last intersection is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
point
TraceScheduledChainSyncServerEvent (NodeState TestBlock) TestBlock
TraceClientIsDone ->
String -> m ()
trace String
"received MsgDoneClient"
TraceScheduledChainSyncServerEvent (NodeState TestBlock) TestBlock
TraceIntersectionNotFound ->
String -> m ()
trace String
" no intersection found"
TraceIntersectionFound Point TestBlock
point ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
" intersection found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
point
TraceRollForward Header TestBlock
header Tip TestBlock
tip ->
[String] -> m ()
traceLines
[ String
" gotta serve " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Header TestBlock -> String
terseHeader Header TestBlock
header
, String
" tip is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tip TestBlock -> String
terseTip Tip TestBlock
tip
]
TraceRollBackward Point TestBlock
point Tip TestBlock
tip ->
[String] -> m ()
traceLines
[ String
" gotta roll back to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
point
, String
" new tip is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tip TestBlock -> String
terseTip Tip TestBlock
tip
]
TraceScheduledChainSyncServerEvent (NodeState TestBlock) TestBlock
TraceChainIsFullyServed ->
String -> m ()
trace String
" chain has been fully served"
TraceScheduledChainSyncServerEvent (NodeState TestBlock) TestBlock
TraceIntersectionIsHeaderPoint ->
String -> m ()
trace String
" intersection is exactly our header point"
TraceIntersectionIsStrictAncestorOfHeaderPoint AnchoredFragment TestBlock
fragment ->
[String] -> m ()
traceLines
[ String
" intersection is before our header point"
, String
" fragment ahead: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredFragment TestBlock -> String
terseFragment AnchoredFragment TestBlock
fragment
]
TraceScheduledChainSyncServerEvent (NodeState TestBlock) TestBlock
TraceIntersectionIsStrictDescendentOfHeaderPoint ->
String -> m ()
trace String
" intersection is further than our header point"
where
unit :: String
unit = String
"ChainSyncServer " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
peerId
trace :: String -> m ()
trace = Tracer m String -> String -> String -> m ()
forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer String
unit
traceLines :: [String] -> m ()
traceLines = Tracer m String -> String -> [String] -> m ()
forall (m :: * -> *). Tracer m String -> String -> [String] -> m ()
traceUnitLinesWith Tracer m String
tracer String
unit
traceScheduledBlockFetchServerEventTestBlockWith ::
Tracer m String ->
PeerId ->
TraceScheduledBlockFetchServerEvent (NodeState TestBlock) TestBlock ->
m ()
traceScheduledBlockFetchServerEventTestBlockWith :: forall (m :: * -> *).
Tracer m String
-> PeerId
-> TraceScheduledBlockFetchServerEvent
(NodeState TestBlock) TestBlock
-> m ()
traceScheduledBlockFetchServerEventTestBlockWith Tracer m String
tracer PeerId
peerId = \case
TraceHandlerEventBF TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
traceEvent -> Tracer m String
-> String
-> TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
-> m ()
forall (m :: * -> *).
Tracer m String
-> String
-> TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
-> m ()
traceScheduledServerHandlerEventTestBlockWith Tracer m String
tracer String
unit TraceScheduledServerHandlerEvent (NodeState TestBlock) TestBlock
traceEvent
TraceScheduledBlockFetchServerEvent (NodeState TestBlock) TestBlock
TraceNoBlocks ->
String -> m ()
trace String
" no blocks available"
TraceStartingBatch AnchoredFragment TestBlock
fragment ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Starting batch for slice " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredFragment TestBlock -> String
terseFragment AnchoredFragment TestBlock
fragment
TraceWaitingForRange Point TestBlock
pointFrom Point TestBlock
pointTo ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Waiting for next tick for range: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
pointFrom String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
pointTo
TraceSendingBlock TestBlock
block ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Sending " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TestBlock -> String
terseBlock TestBlock
block
TraceScheduledBlockFetchServerEvent (NodeState TestBlock) TestBlock
TraceBatchIsDone ->
String -> m ()
trace String
"Batch is done"
TraceScheduledBlockFetchServerEvent (NodeState TestBlock) TestBlock
TraceBlockPointIsBehind ->
String -> m ()
trace String
"BP is behind"
where
unit :: String
unit = String
"BlockFetchServer " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
peerId
trace :: String -> m ()
trace = Tracer m String -> String -> String -> m ()
forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer String
unit
traceChainDBEventTestBlockWith ::
Monad m =>
Tracer m String ->
ChainDB.TraceEvent TestBlock ->
m ()
traceChainDBEventTestBlockWith :: forall (m :: * -> *).
Monad m =>
Tracer m String -> TraceEvent TestBlock -> m ()
traceChainDBEventTestBlockWith Tracer m String
tracer = \case
ChainDB.TraceAddBlockEvent TraceAddBlockEvent TestBlock
event ->
case TraceAddBlockEvent TestBlock
event of
AddedToCurrentChain [LedgerEvent TestBlock]
_ SelectionChangedInfo TestBlock
_ AnchoredFragment (Header TestBlock)
_ AnchoredFragment (Header TestBlock)
newFragment ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Added to current chain; now: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredFragment (Header TestBlock) -> String
terseHFragment AnchoredFragment (Header TestBlock)
newFragment
SwitchedToAFork [LedgerEvent TestBlock]
_ SelectionChangedInfo TestBlock
_ AnchoredFragment (Header TestBlock)
_ AnchoredFragment (Header TestBlock)
newFragment ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Switched to a fork; now: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredFragment (Header TestBlock) -> String
terseHFragment AnchoredFragment (Header TestBlock)
newFragment
StoreButDontChange RealPoint TestBlock
point ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Did not select block due to LoE: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RealPoint TestBlock -> String
terseRealPoint RealPoint TestBlock
point
IgnoreBlockOlderThanK RealPoint TestBlock
point ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Ignored block older than k: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RealPoint TestBlock -> String
terseRealPoint RealPoint TestBlock
point
ChainSelectionLoEDebug AnchoredFragment (Header TestBlock)
curChain (LoEEnabled AnchoredFragment (Header TestBlock)
loeFrag0) -> do
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Current chain: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredFragment (Header TestBlock) -> String
terseHFragment AnchoredFragment (Header TestBlock)
curChain
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"LoE fragment: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredFragment (Header TestBlock) -> String
terseHFragment AnchoredFragment (Header TestBlock)
loeFrag0
ChainSelectionLoEDebug AnchoredFragment (Header TestBlock)
_ LoE (AnchoredFragment (Header TestBlock))
LoEDisabled ->
() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
TraceAddBlockEvent TestBlock
AddedReprocessLoEBlocksToQueue ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Requested ChainSel run"
TraceAddBlockEvent TestBlock
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation Enclosing' (RealPoint TestBlock)
RisingEdge) ->
String -> m ()
trace String
"ChainSel starvation started"
ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation (FallingEdgeWith RealPoint TestBlock
pt)) ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"ChainSel starvation ended thanks to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RealPoint TestBlock -> String
terseRealPoint RealPoint TestBlock
pt
TraceEvent TestBlock
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
trace :: String -> m ()
trace = Tracer m String -> String -> String -> m ()
forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer String
"ChainDB"
traceChainSyncClientEventTestBlockWith ::
PeerId ->
Tracer m String ->
TraceChainSyncClientEvent TestBlock ->
m ()
traceChainSyncClientEventTestBlockWith :: forall (m :: * -> *).
PeerId
-> Tracer m String -> TraceChainSyncClientEvent TestBlock -> m ()
traceChainSyncClientEventTestBlockWith PeerId
pid Tracer m String
tracer = \case
TraceRolledBack Point TestBlock
point ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Rolled back to: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
point
TraceFoundIntersection Point TestBlock
point Our (Tip TestBlock)
_ourTip Their (Tip TestBlock)
_theirTip ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Found intersection at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
point
TraceWaitingBeyondForecastHorizon SlotNo
slot ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Waiting for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SlotNo -> String
forall a. Show a => a -> String
show SlotNo
slot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" beyond forecast horizon"
TraceAccessingForecastHorizon SlotNo
slot ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Accessing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SlotNo -> String
forall a. Show a => a -> String
show SlotNo
slot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", previously beyond forecast horizon"
TraceValidatedHeader Header TestBlock
header ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Validated header: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Header TestBlock -> String
terseHeader Header TestBlock
header
TraceDownloadedHeader Header TestBlock
header ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Downloaded header: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Header TestBlock -> String
terseHeader Header TestBlock
header
TraceGaveLoPToken Bool
didGive Header TestBlock
header BlockNo
bestBlockNo ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
(if Bool
didGive then String
"Gave" else String
"Did not give")
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" LoP token to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Header TestBlock -> String
terseHeader Header TestBlock
header
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" compared to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ BlockNo -> String
forall a. Show a => a -> String
show BlockNo
bestBlockNo
TraceException ChainSyncClientException
exception ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Threw an exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ChainSyncClientException -> String
forall a. Show a => a -> String
show ChainSyncClientException
exception
TraceTermination ChainSyncClientResult
result ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Terminated with result: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ChainSyncClientResult -> String
forall a. Show a => a -> String
show ChainSyncClientResult
result
TraceOfferJump Point TestBlock
point ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Offering jump to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
point
TraceJumpResult (AcceptedJump (JumpTo JumpInfo TestBlock
ji)) ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Accepted jump to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
ji
TraceJumpResult (RejectedJump (JumpTo JumpInfo TestBlock
ji)) ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Rejected jump to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
ji
TraceJumpResult (AcceptedJump (JumpToGoodPoint JumpInfo TestBlock
ji)) ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Accepted jump to good point: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
ji
TraceJumpResult (RejectedJump (JumpToGoodPoint JumpInfo TestBlock
ji)) ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Rejected jump to good point: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
ji
TraceChainSyncClientEvent TestBlock
TraceJumpingWaitingForNextInstruction ->
String -> m ()
trace String
"Waiting for next instruction from the jumping governor"
TraceJumpingInstructionIs Instruction TestBlock
instr ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Received instruction: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Instruction TestBlock -> String
showInstr Instruction TestBlock
instr
TraceDrainingThePipe Nat n
n ->
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Draining the pipe, remaining messages: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Nat n -> String
forall a. Show a => a -> String
show Nat n
n
where
trace :: String -> m ()
trace = Tracer m String -> String -> String -> m ()
forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer (String
"ChainSyncClient " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
pid)
showInstr :: Instruction TestBlock -> String
showInstr :: Instruction TestBlock -> String
showInstr = \case
JumpInstruction (JumpTo JumpInfo TestBlock
ji) -> String
"JumpTo " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
ji
JumpInstruction (JumpToGoodPoint JumpInfo TestBlock
ji) -> String
"JumpToGoodPoint " String -> String -> String
forall a. [a] -> [a] -> [a]
++ JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
ji
Instruction TestBlock
RunNormally -> String
"RunNormally"
Instruction TestBlock
Restart -> String
"Restart"
terseJumpInfo :: JumpInfo TestBlock -> String
terseJumpInfo :: JumpInfo TestBlock -> String
terseJumpInfo JumpInfo TestBlock
ji = Point TestBlock -> String
tersePoint (Point (HeaderWithTime TestBlock) -> Point TestBlock
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (HeaderWithTime TestBlock) -> Point TestBlock)
-> Point (HeaderWithTime TestBlock) -> Point TestBlock
forall a b. (a -> b) -> a -> b
$ AnchoredFragment (HeaderWithTime TestBlock)
-> Point (HeaderWithTime TestBlock)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
headPoint (AnchoredFragment (HeaderWithTime TestBlock)
-> Point (HeaderWithTime TestBlock))
-> AnchoredFragment (HeaderWithTime TestBlock)
-> Point (HeaderWithTime TestBlock)
forall a b. (a -> b) -> a -> b
$ JumpInfo TestBlock -> AnchoredFragment (HeaderWithTime TestBlock)
forall blk. JumpInfo blk -> AnchoredFragment (HeaderWithTime blk)
jTheirFragment JumpInfo TestBlock
ji)
traceChainSyncClientTerminationEventTestBlockWith ::
PeerId ->
Tracer m String ->
TraceChainSyncClientTerminationEvent ->
m ()
traceChainSyncClientTerminationEventTestBlockWith :: forall (m :: * -> *).
PeerId
-> Tracer m String -> TraceChainSyncClientTerminationEvent -> m ()
traceChainSyncClientTerminationEventTestBlockWith PeerId
pid Tracer m String
tracer = \case
TraceChainSyncClientTerminationEvent
TraceExceededSizeLimitCS ->
String -> m ()
trace String
"Terminated because of size limit exceeded."
TraceChainSyncClientTerminationEvent
TraceExceededTimeLimitCS ->
String -> m ()
trace String
"Terminated because of time limit exceeded."
TraceChainSyncClientTerminationEvent
TraceTerminatedByGDDGovernor ->
String -> m ()
trace String
"Terminated by the GDD governor."
TraceChainSyncClientTerminationEvent
TraceTerminatedByLoP ->
String -> m ()
trace String
"Terminated by the limit on patience."
where
trace :: String -> m ()
trace = Tracer m String -> String -> String -> m ()
forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer (String
"ChainSyncClient " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
pid)
traceBlockFetchClientTerminationEventTestBlockWith ::
PeerId ->
Tracer m String ->
TraceBlockFetchClientTerminationEvent ->
m ()
traceBlockFetchClientTerminationEventTestBlockWith :: forall (m :: * -> *).
PeerId
-> Tracer m String -> TraceBlockFetchClientTerminationEvent -> m ()
traceBlockFetchClientTerminationEventTestBlockWith PeerId
pid Tracer m String
tracer = \case
TraceBlockFetchClientTerminationEvent
TraceExceededSizeLimitBF ->
String -> m ()
trace String
"Terminated because of size limit exceeded."
TraceBlockFetchClientTerminationEvent
TraceExceededTimeLimitBF ->
String -> m ()
trace String
"Terminated because of time limit exceeded."
where
trace :: String -> m ()
trace = Tracer m String -> String -> String -> m ()
forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer (String
"BlockFetchClient " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
pid)
traceChainSyncSendRecvEventTestBlockWith ::
Applicative m =>
PeerId ->
String ->
Tracer m String ->
TraceSendRecv (ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock)) ->
m ()
traceChainSyncSendRecvEventTestBlockWith :: forall (m :: * -> *).
Applicative m =>
PeerId
-> String
-> Tracer m String
-> TraceSendRecv
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
-> m ()
traceChainSyncSendRecvEventTestBlockWith PeerId
pid String
ptp Tracer m String
tracer = \case
TraceSendMsg AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
amsg -> String
-> AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
-> m ()
traceMsg String
"send" AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
amsg
TraceRecvMsg AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
amsg -> String
-> AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
-> m ()
traceMsg String
"recv" AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
amsg
where
trace :: String -> m ()
trace = (\PeerId
_ String
_ Tracer m String
_ -> m () -> String -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) PeerId
pid String
ptp Tracer m String
tracer
traceMsg :: String
-> AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
-> m ()
traceMsg String
kd AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
amsg =
String -> m ()
trace (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
String
kd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ case AnyMessage
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
amsg of
AnyMessage Message
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
st
st'
msg -> case Message
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
st
st'
msg of
Message
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
st
st'
R:MessageChainSyncfromto
(Header TestBlock) (Point TestBlock) (Tip TestBlock) st st'
MsgRequestNext -> String
"MsgRequestNext"
Message
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
st
st'
R:MessageChainSyncfromto
(Header TestBlock) (Point TestBlock) (Tip TestBlock) st st'
MsgAwaitReply -> String
"MsgAwaitReply"
MsgRollForward Header TestBlock
header Tip TestBlock
tip -> String
"MsgRollForward " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Header TestBlock -> String
terseHeader Header TestBlock
header String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tip TestBlock -> String
terseTip Tip TestBlock
tip
MsgRollBackward Point TestBlock
point Tip TestBlock
tip -> String
"MsgRollBackward " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
point String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tip TestBlock -> String
terseTip Tip TestBlock
tip
MsgFindIntersect [Point TestBlock]
points -> String
"MsgFindIntersect [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((Point TestBlock -> String) -> [Point TestBlock] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Point TestBlock -> String
tersePoint [Point TestBlock]
points) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
MsgIntersectFound Point TestBlock
point Tip TestBlock
tip -> String
"MsgIntersectFound " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
point String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tip TestBlock -> String
terseTip Tip TestBlock
tip
MsgIntersectNotFound Tip TestBlock
tip -> String
"MsgIntersectNotFound " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tip TestBlock -> String
terseTip Tip TestBlock
tip
Message
(ChainSync (Header TestBlock) (Point TestBlock) (Tip TestBlock))
st
st'
R:MessageChainSyncfromto
(Header TestBlock) (Point TestBlock) (Tip TestBlock) st st'
MsgDone -> String
"MsgDone"
traceDbjEventWith ::
Tracer m String ->
TraceEventDbf PeerId ->
m ()
traceDbjEventWith :: forall (m :: * -> *).
Tracer m String -> TraceEventDbf PeerId -> m ()
traceDbjEventWith Tracer m String
tracer =
Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer (String -> m ())
-> (TraceEventDbf PeerId -> String) -> TraceEventDbf PeerId -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
RotatedDynamo PeerId
old PeerId
new -> String
"Rotated dynamo from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
old String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
new
traceCsjEventWith ::
PeerId ->
Tracer m String ->
TraceEventCsj PeerId TestBlock ->
m ()
traceCsjEventWith :: forall (m :: * -> *).
PeerId -> Tracer m String -> TraceEventCsj PeerId TestBlock -> m ()
traceCsjEventWith PeerId
peer Tracer m String
tracer =
String -> m ()
f (String -> m ())
-> (TraceEventCsj PeerId TestBlock -> String)
-> TraceEventCsj PeerId TestBlock
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
BecomingObjector Maybe PeerId
mbOld -> String
"is now the Objector" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe PeerId -> String
replacing Maybe PeerId
mbOld
TraceEventCsj PeerId TestBlock
BlockedOnJump -> String
"is a happy Jumper blocked on the next CSJ instruction"
TraceEventCsj PeerId TestBlock
InitializedAsDynamo -> String
"initialized as the Dynamo"
NoLongerDynamo Maybe PeerId
mbNew TraceCsjReason
reason -> TraceCsjReason -> String
g TraceCsjReason
reason String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and so is no longer the Dynamo" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe PeerId -> String
replacedBy Maybe PeerId
mbNew
NoLongerObjector Maybe PeerId
mbNew TraceCsjReason
reason -> TraceCsjReason -> String
g TraceCsjReason
reason String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and so is no longer the Objector" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe PeerId -> String
replacedBy Maybe PeerId
mbNew
SentJumpInstruction Point TestBlock
p -> String
"instructed Jumpers to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint Point TestBlock
p
where
f :: String -> m ()
f = Tracer m String -> String -> String -> m ()
forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer (String
"CSJ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
peer)
g :: TraceCsjReason -> String
g = \case
TraceCsjReason
BecauseCsjDisconnect -> String
"disconnected"
TraceCsjReason
BecauseCsjDisengage -> String
"disengaged"
replacedBy :: Maybe PeerId -> String
replacedBy = \case
Maybe PeerId
Nothing -> String
""
Just PeerId
new -> String
", replaced by: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
new
replacing :: Maybe PeerId -> String
replacing = \case
Maybe PeerId
Nothing -> String
""
Just PeerId
old -> String
", replacing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
old
prettyDensityBounds :: [(PeerId, DensityBounds TestBlock)] -> [String]
prettyDensityBounds :: [(PeerId, DensityBounds TestBlock)] -> [String]
prettyDensityBounds [(PeerId, DensityBounds TestBlock)]
bounds =
[(PeerId, String)] -> [String]
showPeers ((DensityBounds TestBlock -> String)
-> (PeerId, DensityBounds TestBlock) -> (PeerId, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second DensityBounds TestBlock -> String
showBounds ((PeerId, DensityBounds TestBlock) -> (PeerId, String))
-> [(PeerId, DensityBounds TestBlock)] -> [(PeerId, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PeerId, DensityBounds TestBlock)]
bounds)
where
showBounds :: DensityBounds TestBlock -> String
showBounds
DensityBounds
{ AnchoredFragment (Header TestBlock)
clippedFragment :: AnchoredFragment (Header TestBlock)
clippedFragment :: forall blk. DensityBounds blk -> AnchoredFragment (Header blk)
clippedFragment
, Bool
offersMoreThanK :: Bool
offersMoreThanK :: forall blk. DensityBounds blk -> Bool
offersMoreThanK
, Word64
lowerBound :: Word64
lowerBound :: forall blk. DensityBounds blk -> Word64
lowerBound
, Word64
upperBound :: Word64
upperBound :: forall blk. DensityBounds blk -> Word64
upperBound
, Bool
hasBlockAfter :: Bool
hasBlockAfter :: forall blk. DensityBounds blk -> Bool
hasBlockAfter
, WithOrigin SlotNo
latestSlot :: WithOrigin SlotNo
latestSlot :: forall blk. DensityBounds blk -> WithOrigin SlotNo
latestSlot
, Bool
idling :: Bool
idling :: forall blk. DensityBounds blk -> Bool
idling
} =
Word64 -> String
forall a. Show a => a -> String
show Word64
lowerBound
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
upperBound
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"["
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
more
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"], "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lastPoint
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"latest: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ WithOrigin SlotNo -> String
showLatestSlot WithOrigin SlotNo
latestSlot
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
block
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
showIdling
where
more :: String
more = if Bool
offersMoreThanK then String
"+" else String
" "
block :: String
block = if Bool
hasBlockAfter then String
", has header after sgen" else String
" "
lastPoint :: String
lastPoint =
String
"point: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Point TestBlock -> String
tersePoint (forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint @(Header TestBlock) @TestBlock (AnchoredFragment (Header TestBlock) -> Point (Header TestBlock)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.lastPoint AnchoredFragment (Header TestBlock)
clippedFragment))
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", "
showLatestSlot :: WithOrigin SlotNo -> String
showLatestSlot = \case
WithOrigin SlotNo
Origin -> String
"unknown"
NotOrigin (SlotNo Word64
slot) -> Word64 -> String
forall a. Show a => a -> String
show Word64
slot
showIdling :: String
showIdling
| Bool
idling = String
", idling"
| Bool
otherwise = String
""
showPeers :: [(PeerId, String)] -> [String]
showPeers :: [(PeerId, String)] -> [String]
showPeers = ((PeerId, String) -> String) -> [(PeerId, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(PeerId
peer, String
v) -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PeerId -> String
forall a. Condense a => a -> String
condense PeerId
peer String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v)
terseGDDEvent :: TraceGDDEvent PeerId TestBlock -> String
terseGDDEvent :: TraceGDDEvent PeerId TestBlock -> String
terseGDDEvent = \case
TraceGDDDisconnected NonEmpty PeerId
peers -> String
"GDD | Disconnected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [PeerId] -> String
forall a. Show a => a -> String
show (NonEmpty PeerId -> [PeerId]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty PeerId
peers)
TraceGDDDebug
GDDDebugInfo
{ sgen :: forall peer blk. GDDDebugInfo peer blk -> GenesisWindow
sgen = GenesisWindow Word64
sgen
, AnchoredFragment (Header TestBlock)
curChain :: AnchoredFragment (Header TestBlock)
curChain :: forall peer blk.
GDDDebugInfo peer blk -> AnchoredFragment (Header blk)
curChain
, [(PeerId, DensityBounds TestBlock)]
bounds :: [(PeerId, DensityBounds TestBlock)]
bounds :: forall peer blk.
GDDDebugInfo peer blk -> [(peer, DensityBounds blk)]
bounds
, [(PeerId, AnchoredFragment (Header TestBlock))]
candidates :: [(PeerId, AnchoredFragment (Header TestBlock))]
candidates :: forall peer blk.
GDDDebugInfo peer blk -> [(peer, AnchoredFragment (Header blk))]
candidates
, [(PeerId, AnchoredFragment (Header TestBlock))]
candidateSuffixes :: [(PeerId, AnchoredFragment (Header TestBlock))]
candidateSuffixes :: forall peer blk.
GDDDebugInfo peer blk -> [(peer, AnchoredFragment (Header blk))]
candidateSuffixes
, [PeerId]
losingPeers :: [PeerId]
losingPeers :: forall peer blk. GDDDebugInfo peer blk -> [peer]
losingPeers
, Anchor (Header TestBlock)
loeHead :: Anchor (Header TestBlock)
loeHead :: forall peer blk. GDDDebugInfo peer blk -> Anchor (Header blk)
loeHead
} ->
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
"GDD | Window: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> Anchor (Header TestBlock) -> String
forall {block}. Word64 -> Anchor block -> String
window Word64
sgen Anchor (Header TestBlock)
loeHead
, String
" Selection: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredFragment (Header TestBlock) -> String
terseHFragment AnchoredFragment (Header TestBlock)
curChain
, String
" Candidates:"
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [(PeerId, String)] -> [String]
showPeers ((AnchoredFragment (Header TestBlock) -> String)
-> (PeerId, AnchoredFragment (Header TestBlock))
-> (PeerId, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Point TestBlock -> String
tersePoint (Point TestBlock -> String)
-> (AnchoredFragment (Header TestBlock) -> Point TestBlock)
-> AnchoredFragment (Header TestBlock)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point (Header TestBlock) -> Point TestBlock
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Header TestBlock) -> Point TestBlock)
-> (AnchoredFragment (Header TestBlock)
-> Point (Header TestBlock))
-> AnchoredFragment (Header TestBlock)
-> Point TestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment (Header TestBlock) -> Point (Header TestBlock)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint) ((PeerId, AnchoredFragment (Header TestBlock)) -> (PeerId, String))
-> [(PeerId, AnchoredFragment (Header TestBlock))]
-> [(PeerId, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PeerId, AnchoredFragment (Header TestBlock))]
candidates)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
" Candidate suffixes (bounds):"
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [(PeerId, String)] -> [String]
showPeers ((DensityBounds TestBlock -> String)
-> (PeerId, DensityBounds TestBlock) -> (PeerId, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AnchoredFragment (Header TestBlock) -> String
terseHFragment (AnchoredFragment (Header TestBlock) -> String)
-> (DensityBounds TestBlock -> AnchoredFragment (Header TestBlock))
-> DensityBounds TestBlock
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DensityBounds TestBlock -> AnchoredFragment (Header TestBlock)
forall blk. DensityBounds blk -> AnchoredFragment (Header blk)
clippedFragment) ((PeerId, DensityBounds TestBlock) -> (PeerId, String))
-> [(PeerId, DensityBounds TestBlock)] -> [(PeerId, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PeerId, DensityBounds TestBlock)]
bounds)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
" Density bounds:"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [(PeerId, DensityBounds TestBlock)] -> [String]
prettyDensityBounds [(PeerId, DensityBounds TestBlock)]
bounds
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
" New candidate tips:"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [(PeerId, String)] -> [String]
showPeers ((AnchoredFragment (Header TestBlock) -> String)
-> (PeerId, AnchoredFragment (Header TestBlock))
-> (PeerId, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Point TestBlock -> String
tersePoint (Point TestBlock -> String)
-> (AnchoredFragment (Header TestBlock) -> Point TestBlock)
-> AnchoredFragment (Header TestBlock)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point (Header TestBlock) -> Point TestBlock
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Header TestBlock) -> Point TestBlock)
-> (AnchoredFragment (Header TestBlock)
-> Point (Header TestBlock))
-> AnchoredFragment (Header TestBlock)
-> Point TestBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment (Header TestBlock) -> Point (Header TestBlock)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint) ((PeerId, AnchoredFragment (Header TestBlock)) -> (PeerId, String))
-> [(PeerId, AnchoredFragment (Header TestBlock))]
-> [(PeerId, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PeerId, AnchoredFragment (Header TestBlock))]
candidateSuffixes)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
" Losing peers: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PeerId] -> String
forall a. Show a => a -> String
show [PeerId]
losingPeers
, String
" Setting loeFrag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Anchor TestBlock -> String
terseAnchor (Anchor (Header TestBlock) -> Anchor TestBlock
forall a b. (HeaderHash a ~ HeaderHash b) => Anchor a -> Anchor b
AF.castAnchor Anchor (Header TestBlock)
loeHead)
]
where
window :: Word64 -> Anchor block -> String
window Word64
sgen Anchor block
loeHead =
Word64 -> String
forall a. Show a => a -> String
show Word64
winStart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
winEnd
where
winEnd :: Word64
winEnd = Word64
winStart Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
sgen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
SlotNo Word64
winStart = WithOrigin SlotNo -> SlotNo
forall t. (Bounded t, Enum t) => WithOrigin t -> t
succWithOrigin (Anchor block -> WithOrigin SlotNo
forall block. Anchor block -> WithOrigin SlotNo
AF.anchorToSlotNo Anchor block
loeHead)
prettyTime :: Time -> String
prettyTime :: Time -> String
prettyTime (Time DiffTime
time) =
let ps :: Integer
ps = DiffTime -> Integer
diffTimeToPicoseconds DiffTime
time
milliseconds :: Integer
milliseconds = Integer
ps Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
1_000_000_000
seconds :: Integer
seconds = Integer
milliseconds Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
1_000
minutes :: Integer
minutes = Integer
seconds Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
60
in String -> Integer -> Integer -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%02d:%02d.%03d" Integer
minutes (Integer
seconds Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
60) (Integer
milliseconds Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
1_000)
traceLinesWith ::
Tracer m String ->
[String] ->
m ()
traceLinesWith :: forall (m :: * -> *). Tracer m String -> [String] -> m ()
traceLinesWith Tracer m String
tracer = Tracer m String -> String -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m String
tracer (String -> m ()) -> ([String] -> String) -> [String] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n"
maxUnitLength :: Int
maxUnitLength :: Int
maxUnitLength = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"BlockFetchServer adversary 9"
padUnit :: String -> String
padUnit :: String -> String
padUnit String
unit = String
unit String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
maxUnitLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
unit) Char
' '
traceUnitLinesWith :: Tracer m String -> String -> [String] -> m ()
traceUnitLinesWith :: forall (m :: * -> *). Tracer m String -> String -> [String] -> m ()
traceUnitLinesWith Tracer m String
tracer String
unit [String]
msgs =
Tracer m String -> [String] -> m ()
forall (m :: * -> *). Tracer m String -> [String] -> m ()
traceLinesWith Tracer m String
tracer ([String] -> m ()) -> [String] -> m ()
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s | %s" (String -> String -> String) -> String -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
padUnit String
unit) [String]
msgs
traceUnitWith :: Tracer m String -> String -> String -> m ()
traceUnitWith :: forall (m :: * -> *). Tracer m String -> String -> String -> m ()
traceUnitWith Tracer m String
tracer String
unit String
msg = Tracer m String -> String -> [String] -> m ()
forall (m :: * -> *). Tracer m String -> String -> [String] -> m ()
traceUnitLinesWith Tracer m String
tracer String
unit [String
msg]