1
- {-# LANGUAGE CPP #-}
2
1
{-# LANGUAGE DeriveAnyClass #-}
3
2
{-# LANGUAGE StrictData #-}
4
3
5
- #if __GLASGOW_HASKELL__ >= 908
6
- {-# OPTIONS_GHC -Wno-x-partial #-}
7
- #endif
8
-
9
4
{-# OPTIONS_GHC -Wno-incomplete-patterns -Wno-name-shadowing #-}
10
- {-# OPTIONS_GHC -Wno-unused-imports -Wno-partial-fields -Wno-unused-matches -Wno-incomplete-record-updates #-}
11
5
12
- {- HLINT ignore "Avoid lambda" -}
13
6
{- HLINT ignore "Eta reduce" -}
14
- {- HLINT ignore "Use head" -}
15
7
16
8
module Cardano.Analysis.BlockProp
17
9
( summariseMultiBlockProp
@@ -25,42 +17,18 @@ module Cardano.Analysis.BlockProp
25
17
)
26
18
where
27
19
28
- import Prelude (String , (!!) , error , head , last , id , show , tail , read )
29
- import Cardano.Prelude hiding (head , show )
30
-
31
- import Control.Arrow ((***) , (&&&) )
32
- import Data.Aeson (ToJSON (.. ), FromJSON (.. ))
33
- import Data.Bifunctor
34
- import Data.Function (on )
35
- import Data.List (break , dropWhileEnd , intercalate , partition , span )
36
- import Data.Map.Strict (Map )
37
- import Data.Map.Strict qualified as Map
38
- import Data.Maybe (catMaybes , mapMaybe , isNothing )
39
- import Data.Set (Set )
40
- import Data.Set qualified as Set
41
- import Data.Text qualified as T
42
- import Data.Text.Short (toText )
43
- import Data.Tuple (swap )
44
- import Data.Tuple.Extra (both , fst3 , snd3 , thd3 )
45
- import Data.Vector (Vector )
46
- import Data.Vector qualified as Vec
47
-
48
- import Data.Time.Clock (NominalDiffTime , UTCTime , addUTCTime , diffUTCTime )
49
-
50
- import Text.Printf (printf )
51
-
52
- import Cardano.Slotting.Slot (EpochNo (.. ), SlotNo (.. ))
53
- import Ouroboros.Network.Block (BlockNo (.. ))
54
-
55
- import Data.Accum
56
- import Data.CDF
20
+ import Cardano.Analysis.API
21
+ import Cardano.Prelude hiding (head , show )
22
+ import Cardano.Unlog.LogObject
23
+ import Cardano.Util
57
24
58
- import Cardano.Render
59
- import Cardano.Unlog.LogObject
60
- import Cardano.Unlog.Resources
61
- import Cardano.Util
25
+ import Prelude (id , read , show )
62
26
63
- import Cardano.Analysis.API
27
+ import Data.List (partition )
28
+ import qualified Data.Map.Strict as Map
29
+ import qualified Data.Set as Set
30
+ import qualified Data.Text as T
31
+ import Data.Tuple.Extra (both , fst3 , snd3 , thd3 )
64
32
65
33
66
34
summariseMultiBlockProp :: [Centile ] -> [BlockPropOne ] -> Either CDFError MultiBlockProp
@@ -300,7 +268,7 @@ blockEventsAcceptance :: Genesis -> [ChainFilter] -> BlockEvents -> [(ChainFilte
300
268
blockEventsAcceptance genesis flts be = flts <&> (id &&& testBlockEvents genesis be)
301
269
302
270
rebuildChain :: Run -> [ChainFilter ] -> [FilterName ] -> [(LogObjectSource , MachView )] -> Chain
303
- rebuildChain run @ Run {genesis} flts fltNames xs @ (fmap snd -> machViews) =
271
+ rebuildChain Run {genesis} flts _fltNames (fmap snd -> machViews) =
304
272
Chain
305
273
{ cDomSlots = DataDomain
306
274
(Interval (blk0 & beSlotNo) (blkL & beSlotNo) <&> I )
@@ -406,7 +374,7 @@ rebuildChain run@Run{genesis} flts fltNames xs@(fmap snd -> machViews) =
406
374
[ " No forger for hash " , show hash
407
375
, " \n Errors:\n "
408
376
] ++ intercalate " \n " (show <$> ers)
409
- blkEvs @ (forgerEv: _, oEvs, ers) ->
377
+ (forgerEv: _, oEvs, ers) ->
410
378
go (bfePrevBlock forgerEv) (liftBlockEvents forgerEv oEvs ers : acc)
411
379
412
380
liftBlockEvents :: ForgerEvents NominalDiffTime -> [ObserverEvents NominalDiffTime ] -> [BPError ] -> BlockEvents
@@ -536,7 +504,7 @@ renderBlockPropError = \case
536
504
rejs
537
505
538
506
blockProp :: Run -> Chain -> Either BlockPropError BlockPropOne
539
- blockProp run @ Run {genesis} Chain {.. } = do
507
+ blockProp _ Chain {.. } = do
540
508
(c :: [BlockEvents ]) <-
541
509
case filter (all snd . beAcceptance) cMainChain of
542
510
[] -> Left $
@@ -626,7 +594,7 @@ blockProp run@Run{genesis} Chain{..} = do
626
594
627
595
-- | Given a single machine's log object stream, recover its block map.
628
596
blockEventMapsFromLogObjects :: Run -> (LogObjectSource , [LogObject ]) -> MachView
629
- blockEventMapsFromLogObjects run (f, [] ) =
597
+ blockEventMapsFromLogObjects _ (f, [] ) =
630
598
error $ mconcat [" 0 LogObjects in " , logObjectSourceFile f]
631
599
blockEventMapsFromLogObjects run (f, xs@ (x: _)) =
632
600
foldl' (blockPropMachEventsStep run f) initial xs
@@ -645,7 +613,7 @@ blockEventMapsFromLogObjects run (f, xs@(x:_)) =
645
613
}
646
614
647
615
blockPropMachEventsStep :: Run -> LogObjectSource -> MachView -> LogObject -> MachView
648
- blockPropMachEventsStep run @ Run {genesis} _ mv@ MachView {.. } lo = case lo of
616
+ blockPropMachEventsStep Run {genesis} _ mv@ MachView {.. } lo = case lo of
649
617
-- 0. Notice (observer only)
650
618
LogObject {loAt, loHost, loBody= LOChainSyncClientSeenHeader {loBlock,loBlockNo,loSlotNo}} ->
651
619
let mbe0 = getBlock loBlock
0 commit comments