@@ -35,7 +35,6 @@ import qualified Ouroboros.Network.Block as Block
3535import Ouroboros.Network.Protocol.ChainSync.Client
3636
3737import Cardano.Api
38- import Cardano.Api.Byron
3938import Cardano.Api.Shelley
4039
4140-- | The chairman checks for consensus and progress.
@@ -51,17 +50,16 @@ import Cardano.Api.Shelley
5150-- The consensus condition is checked incrementally as well as at the end, so
5251-- that failures can be detected as early as possible. The progress condition
5352-- is only checked at the end.
54- chairmanTest
55- :: Tracer IO String
53+ chairmanTest :: ()
54+ => Tracer IO String
5655 -> NetworkId
5756 -> DiffTime
5857 -> BlockNo
5958 -> [SocketPath ]
60- -> AnyConsensusModeParams
59+ -> ConsensusModeParams CardanoMode
6160 -> SecurityParam
6261 -> IO ()
63- chairmanTest tracer nw runningTime progressThreshold socketPaths
64- (AnyConsensusModeParams cModeParams) secParam = do
62+ chairmanTest tracer nw runningTime progressThreshold socketPaths cModeParams secParam = do
6563 traceWith tracer (" Will observe nodes for " ++ show runningTime)
6664 traceWith tracer (" Will require chain growth of " ++ show progressThreshold)
6765
@@ -110,11 +108,11 @@ instance Exception ConsensusFailure where
110108-- | For this test we define consensus as follows: for all pairs of chains,
111109-- the intersection of each pair is within K blocks of each tip.
112110
113- consensusCondition
114- :: ConsensusBlockForMode mode ~ blk
111+ consensusCondition :: ()
112+ => ConsensusBlockForMode CardanoMode ~ blk
115113 => HasHeader (Header blk )
116114 => ConvertRawHash blk
117- => ConsensusMode mode
115+ => ConsensusMode CardanoMode
118116 -> Map PeerId (AnchoredFragment (Header blk ))
119117 -> SecurityParam
120118 -> Either ConsensusFailure ConsensusSuccess
@@ -246,9 +244,9 @@ progressCondition minBlockNo (ConsensusSuccess _ tips) = do
246244 getBlockNo (ChainTip _ _ bNum) = bNum
247245 getBlockNo ChainTipAtGenesis = 0
248246
249- runChairman
250- :: forall mode blk . ConsensusBlockForMode mode ~ blk
251- => GetHeader (ConsensusBlockForMode mode )
247+ runChairman :: forall blk . ()
248+ => ConsensusBlockForMode CardanoMode ~ blk
249+ => GetHeader (ConsensusBlockForMode CardanoMode )
252250 => Tracer IO String
253251 -> NetworkId
254252 -- ^ Security parameter, if a fork is deeper than it 'runChairman'
@@ -257,7 +255,7 @@ runChairman
257255 -- ^ Run for this much time.
258256 -> [SocketPath ]
259257 -- ^ Local socket directory
260- -> ConsensusModeParams mode
258+ -> ConsensusModeParams CardanoMode
261259 -> SecurityParam
262260 -> IO (Map SocketPath
263261 (AF. AnchoredSeq
@@ -312,41 +310,41 @@ addBlock sockPath chainsVar blk =
312310
313311-- | Rollback a single block. If the rollback point is not found, we simply
314312-- error. It should never happen if the security parameter is set up correctly.
315- rollback
316- :: forall mode blk . ConsensusBlockForMode mode ~ blk
313+ rollback :: forall blk . ()
314+ => ConsensusBlockForMode CardanoMode ~ blk
317315 => HasHeader (Header blk )
318316 => SocketPath
319- -> StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode mode ))))
320- -> ConsensusMode mode
317+ -> StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode CardanoMode ))))
318+ -> ConsensusMode CardanoMode
321319 -> ChainPoint
322320 -> STM IO ()
323321rollback sockPath chainsVar cMode p =
324322 modifyTVar chainsVar (Map. adjust fn sockPath)
325323 where
326- p' :: Point (Header (ConsensusBlockForMode mode ))
324+ p' :: Point (Header (ConsensusBlockForMode CardanoMode ))
327325 p' = coerce $ toConsensusPointInMode cMode p
328326
329- fn :: AnchoredFragment (Header (ConsensusBlockForMode mode ))
330- -> AnchoredFragment (Header (ConsensusBlockForMode mode ))
327+ fn :: AnchoredFragment (Header (ConsensusBlockForMode CardanoMode ))
328+ -> AnchoredFragment (Header (ConsensusBlockForMode CardanoMode ))
331329 fn cf = case AF. rollback p' cf of
332330 Nothing -> error " rollback error: rollback beyond chain fragment"
333331 Just cf' -> cf'
334332
335333-- Chain-Sync client
336334type ChairmanTrace' = ConsensusSuccess
337335
338- type ChainVar mode = StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode mode ))))
336+ type ChainVar = StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode CardanoMode ))))
339337
340338-- | 'chainSyncClient which build chain fragment; on every roll forward it will
341339-- check if there is consensus on immutable chain.
342340chainSyncClient
343- :: forall mode . GetHeader (ConsensusBlockForMode mode )
341+ :: GetHeader (ConsensusBlockForMode CardanoMode )
344342 => Tracer IO ChairmanTrace'
345343 -> SocketPath
346- -> ChainVar mode
347- -> ConsensusModeParams mode
344+ -> ChainVar
345+ -> ConsensusModeParams CardanoMode
348346 -> SecurityParam
349- -> ChainSyncClient (BlockInMode mode ) ChainPoint ChainTip IO ()
347+ -> ChainSyncClient (BlockInMode CardanoMode ) ChainPoint ChainTip IO ()
350348chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pure $
351349 -- Notify the core node about the our latest points at which we are
352350 -- synchronised. This client is not persistent and thus it just
@@ -359,10 +357,10 @@ chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pu
359357 , recvMsgIntersectNotFound = \ _ -> ChainSyncClient $ pure clientStIdle
360358 }
361359 where
362- clientStIdle :: ClientStIdle (BlockInMode mode ) ChainPoint ChainTip IO ()
360+ clientStIdle :: ClientStIdle (BlockInMode CardanoMode ) ChainPoint ChainTip IO ()
363361 clientStIdle = SendMsgRequestNext clientStNext (pure clientStNext)
364362
365- clientStNext :: ClientStNext (BlockInMode mode ) ChainPoint ChainTip IO ()
363+ clientStNext :: ClientStNext (BlockInMode CardanoMode ) ChainPoint ChainTip IO ()
366364 clientStNext = ClientStNext
367365 { recvMsgRollForward = \ blk _tip -> ChainSyncClient $ do
368366 -- add block & check if there is consensus on immutable chain
@@ -384,33 +382,27 @@ chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pu
384382-- Helpers
385383
386384obtainHasHeader
387- :: ConsensusBlockForMode mode ~ blk
388- => ConsensusMode mode
389- -> ((HasHeader (Header blk ), ConvertRawHash (ConsensusBlockForMode mode )) => a )
385+ :: ConsensusBlockForMode CardanoMode ~ blk
386+ => ConsensusMode CardanoMode
387+ -> ((HasHeader (Header blk ), ConvertRawHash (ConsensusBlockForMode CardanoMode )) => a )
390388 -> a
391- obtainHasHeader ByronMode f = f
392- obtainHasHeader ShelleyMode f = f
393389obtainHasHeader CardanoMode f = f
394390
395391obtainGetHeader
396- :: ConsensusMode mode
397- -> ( (GetHeader (ConsensusBlockForMode mode )
392+ :: ConsensusMode CardanoMode
393+ -> ( (GetHeader (ConsensusBlockForMode CardanoMode )
398394 ) => a )
399395 -> a
400- obtainGetHeader ByronMode f = f
401- obtainGetHeader ShelleyMode f = f
402396obtainGetHeader CardanoMode f = f
403397
404398-- | Check that all nodes agree with each other, within the security parameter.
405399checkConsensus
406- :: HasHeader (Header (ConsensusBlockForMode mode ))
407- => ConvertRawHash (ConsensusBlockForMode mode )
408- => ConsensusMode mode
409- -> ChainVar mode
400+ :: HasHeader (Header (ConsensusBlockForMode CardanoMode ))
401+ => ConvertRawHash (ConsensusBlockForMode CardanoMode )
402+ => ConsensusMode CardanoMode
403+ -> ChainVar
410404 -> SecurityParam
411405 -> STM IO ConsensusSuccess
412406checkConsensus cMode chainsVar secParam = do
413407 chainsSnapshot <- readTVar chainsVar
414408 either throwIO return $ consensusCondition cMode chainsSnapshot secParam
415-
416-
0 commit comments