-
Notifications
You must be signed in to change notification settings - Fork 721
/
chairman.hs
162 lines (139 loc) · 4.82 KB
/
chairman.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Cardano.Prelude hiding (option)
import Control.Applicative (some)
import Control.Monad.Class.MonadTime (DiffTime)
import Control.Tracer (stdoutTracer)
import Options.Applicative
import qualified Options.Applicative as Opt
import Cardano.Chain.Slotting (EpochSlots (..))
import Ouroboros.Consensus.BlockchainTime (SlotLength, slotLengthFromSec)
import Ouroboros.Consensus.Cardano (SecurityParam (..))
import Ouroboros.Network.Block (BlockNo)
import Cardano.Api.Protocol.Byron
import Cardano.Api.Protocol.Cardano
import Cardano.Api.Protocol.Shelley
import Cardano.Api.Protocol.Types
import Cardano.Api.Typed (NetworkMagic (..))
import Cardano.Chairman (chairmanTest)
import Cardano.Node.Protocol.Types (Protocol (..))
import Cardano.Node.Types
main :: IO ()
main = do
ChairmanArgs { caRunningTime
, caMinProgress
, caSocketPaths
, caConfigYaml
, caSlotLength
, caSecurityParam
, caNetworkMagic
} <- execParser opts
--nc <- liftIO $ parseNodeConfigurationFP caConfigYaml
let someNodeClientProtocol = mkNodeClientProtocol $ ncProtocol (panic $ show caConfigYaml)
chairmanTest
stdoutTracer
caSlotLength
caSecurityParam
caRunningTime
caMinProgress
caSocketPaths
someNodeClientProtocol
caNetworkMagic
--TODO: replace this with the new stuff from Cardano.Api.Protocol
mkNodeClientProtocol :: Protocol -> SomeNodeClientProtocol
mkNodeClientProtocol protocol =
case protocol of
ByronProtocol ->
mkSomeNodeClientProtocolByron
(EpochSlots 21600)
ShelleyProtocol ->
mkSomeNodeClientProtocolShelley
CardanoProtocol ->
mkSomeNodeClientProtocolCardano
(EpochSlots 21600)
data ChairmanArgs = ChairmanArgs {
-- | Stop the test after given number of seconds. The chairman will
-- observe only for the given period of time, and check the consensus
-- and progress conditions at the end.
--
caRunningTime :: !DiffTime
-- | Expect this amount of progress (chain growth) by the end of the test.
, caMinProgress :: !(Maybe BlockNo)
, caSocketPaths :: ![SocketPath]
, caConfigYaml :: !ConfigYamlFilePath
, caSlotLength :: !SlotLength
, caSecurityParam :: !SecurityParam
, caNetworkMagic :: !NetworkMagic
}
parseConfigFile :: Parser FilePath
parseConfigFile =
strOption
( long "config"
<> metavar "NODE-CONFIGURATION"
<> help "Configuration file for the cardano-node"
<> completer (bashCompleter "file")
)
parseSocketPath :: Text -> Parser SocketPath
parseSocketPath helpMessage =
SocketPath <$> strOption
( long "socket-path"
<> help (toS helpMessage)
<> completer (bashCompleter "file")
<> metavar "FILEPATH"
)
parseRunningTime :: Parser DiffTime
parseRunningTime =
option ((fromIntegral :: Int -> DiffTime) <$> auto) (
long "timeout"
<> short 't'
<> metavar "Time"
<> help "Run the chairman for this length of time in seconds."
)
parseSlotLength :: Parser SlotLength
parseSlotLength =
option (slotLengthFromSec <$> Opt.auto)
( long "slot-length"
<> metavar "INT"
<> help "Slot length in seconds."
)
parseSecurityParam :: Parser SecurityParam
parseSecurityParam =
option (SecurityParam <$> Opt.auto)
( long "security-parameter"
<> metavar "INT"
<> help "Security parameter"
)
parseTestnetMagic :: Parser NetworkMagic
parseTestnetMagic =
NetworkMagic <$>
Opt.option Opt.auto
( Opt.long "testnet-magic"
<> Opt.metavar "INT"
<> Opt.help "The testnet network magic number"
)
parseProgress :: Parser BlockNo
parseProgress =
option ((fromIntegral :: Int -> BlockNo) <$> auto) (
long "require-progress"
<> short 'p'
<> metavar "Blocks"
<> help "Require this much chain-growth progress, in blocks."
)
parseChairmanArgs :: Parser ChairmanArgs
parseChairmanArgs =
ChairmanArgs
<$> parseRunningTime
<*> optional parseProgress
<*> some (parseSocketPath "Path to a cardano-node socket")
<*> fmap ConfigYamlFilePath parseConfigFile
<*> parseSlotLength
<*> parseSecurityParam
<*> parseTestnetMagic
opts :: ParserInfo ChairmanArgs
opts = info (parseChairmanArgs <**> helper)
( fullDesc
<> progDesc "Chairman checks Cardano clusters for progress and consensus."
<> header "Chairman sits in a room full of Shelley nodes, and checks \
\if they are all behaving ...")