← Back to branch summary

~zinigor/cardano-node/trunk

« back to all changes in this revision

Viewing changes to cardano-node-chairman/src/Testnet/Byron.hs

  • Committer: Igor Zinovyev
  • Date: 2021-08-13 19:12:27 UTC
  • Revision ID: zinigor@gmail.com-20210813191227-stlnsj3mc5ypwn0c
Tags: upstream-1.27.0
Import upstream version 1.27.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
cardano-node-chairman/src/Testnet/Byron.hs
 
1
{-# LANGUAGE OverloadedStrings #-}
 
2
{-# LANGUAGE RecordWildCards #-}
 
3
{-# LANGUAGE TypeApplications #-}
 
4
 
 
5
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-local-binds -Wno-unused-matches #-}
 
6
 
 
7
module Testnet.Byron
 
8
  ( testnet
 
9
 
 
10
  , TestnetOptions(..)
 
11
  , defaultTestnetOptions
 
12
  ) where
 
13
 
 
14
import           Control.Monad
 
15
import           Data.Aeson (Value, (.=))
 
16
import           Data.Eq
 
17
import           Data.Function
 
18
import           Data.Functor
 
19
import           Data.Int
 
20
import           Data.Maybe
 
21
import           Data.Ord
 
22
import           Data.Semigroup
 
23
import           Data.String
 
24
import           GHC.Num
 
25
import           Hedgehog.Extras.Stock.Aeson (rewriteObject)
 
26
import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
 
27
import           Hedgehog.Extras.Stock.Time
 
28
import           System.FilePath.Posix ((</>))
 
29
import           Text.Show
 
30
 
 
31
import qualified Data.Aeson as J
 
32
import qualified Data.HashMap.Lazy as HM
 
33
import qualified Data.List as L
 
34
import qualified Data.Text as T
 
35
import qualified Data.Time.Clock as DTC
 
36
import qualified Hedgehog as H
 
37
import qualified Hedgehog.Extras.Stock.IO.File as IO
 
38
import qualified Hedgehog.Extras.Stock.IO.Network.Socket as IO
 
39
import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
 
40
import qualified Hedgehog.Extras.Stock.String as S
 
41
import qualified Hedgehog.Extras.Test.Base as H
 
42
import qualified Hedgehog.Extras.Test.File as H
 
43
import qualified Hedgehog.Extras.Test.Network as H
 
44
import qualified Hedgehog.Extras.Test.Process as H
 
45
import qualified System.Info as OS
 
46
import qualified System.IO as IO
 
47
import qualified System.Process as IO
 
48
import qualified Test.Process as H
 
49
import qualified Testnet.Conf as H
 
50
import qualified Testnet.List as L
 
51
 
 
52
{- HLINT ignore "Reduce duplication" -}
 
53
{- HLINT ignore "Redundant <&>" -}
 
54
{- HLINT ignore "Redundant flip" -}
 
55
{- HLINT ignore "Use head" -}
 
56
 
 
57
data TestnetOptions = TestnetOptions
 
58
  { numBftNodes :: Int
 
59
  , slotDuration :: Int
 
60
  , securityParam :: Int
 
61
  , nPoorAddresses :: Int
 
62
  , totalBalance :: Int
 
63
  } deriving (Eq, Show)
 
64
 
 
65
defaultTestnetOptions :: TestnetOptions
 
66
defaultTestnetOptions = TestnetOptions
 
67
  { numBftNodes = 3
 
68
  , slotDuration = 2000
 
69
  , securityParam = 10
 
70
  , nPoorAddresses = 128
 
71
  , totalBalance = 8000000000000000
 
72
  }
 
73
 
 
74
replaceNodeLog :: Int -> String -> String
 
75
replaceNodeLog n s = T.unpack (T.replace "logs/node-0.log" replacement (T.pack s))
 
76
  where replacement = T.pack ("logs/node-" <> show @Int n <> ".log")
 
77
 
 
78
-- | Rewrite a line in the configuration file
 
79
rewriteConfiguration :: Int -> String -> String
 
80
rewriteConfiguration _ "TraceBlockchainTime: False" = "TraceBlockchainTime: True"
 
81
rewriteConfiguration n s | "logs/node-0.log" `L.isInfixOf` s = replaceNodeLog n s
 
82
rewriteConfiguration _ s = s
 
83
 
 
84
rewriteParams :: TestnetOptions -> Value -> Value
 
85
rewriteParams testnetOptions = rewriteObject
 
86
  $ HM.insert "slotDuration" (J.toJSON @String (show @Int (slotDuration testnetOptions)))
 
87
 
 
88
testnet :: TestnetOptions -> H.Conf -> H.Integration [String]
 
89
testnet testnetOptions H.Conf {..} = do
 
90
  void $ H.note OS.os
 
91
  baseConfig <- H.noteShow $ base </> "configuration/chairman/defaults/simpleview"
 
92
  currentTime <- H.noteShowIO DTC.getCurrentTime
 
93
  startTime <- H.noteShow $ DTC.addUTCTime 15 currentTime -- 15 seconds into the future
 
94
  allPorts <- H.noteShowIO $ IO.allocateRandomPorts (numBftNodes testnetOptions)
 
95
 
 
96
  H.copyRewriteJsonFile
 
97
    (base </> "scripts/protocol-params.json")
 
98
    (tempAbsPath </> "protocol-params.json")
 
99
    (rewriteParams testnetOptions)
 
100
 
 
101
  -- Generate keys
 
102
  void $ H.execCli
 
103
    [ "byron"
 
104
    , "genesis"
 
105
    , "genesis"
 
106
    , "--genesis-output-dir", tempAbsPath </> "genesis"
 
107
    , "--start-time", showUTCTimeSeconds startTime
 
108
    , "--protocol-parameters-file", tempAbsPath </> "protocol-params.json"
 
109
    , "--k", show @Int (securityParam testnetOptions)
 
110
    , "--protocol-magic", show @Int testnetMagic
 
111
    , "--n-poor-addresses", show @Int (nPoorAddresses testnetOptions)
 
112
    , "--n-delegate-addresses", show @Int (numBftNodes testnetOptions)
 
113
    , "--total-balance", show @Int (totalBalance testnetOptions)
 
114
    , "--avvm-entry-count", "128"
 
115
    , "--avvm-entry-balance", "10000000000000"
 
116
    , "--delegate-share", "0.9"
 
117
    , "--secret-seed", "2718281828"
 
118
    ]
 
119
 
 
120
  H.writeFile (tempAbsPath </> "genesis/GENHASH") . S.lastLine =<< H.execCli
 
121
    [ "print-genesis-hash"
 
122
    , "--genesis-json"
 
123
    , tempAbsPath </> "genesis/genesis.json"
 
124
    ]
 
125
 
 
126
  let nodeIndexes = [0..numBftNodes testnetOptions - 1]
 
127
  let allNodes = fmap (\i -> "node-" <> show @Int i) nodeIndexes
 
128
 
 
129
  H.createDirectoryIfMissing logDir
 
130
 
 
131
  -- Launch cluster of three nodes
 
132
  forM_ nodeIndexes $ \i -> do
 
133
    si <- H.noteShow $ show @Int i
 
134
    dbDir <- H.noteShow $ tempAbsPath </> "db/node-" <> si
 
135
    nodeStdoutFile <- H.noteTempFile tempAbsPath $ "cardano-node-" <> si <> ".stdout.log"
 
136
    nodeStderrFile <- H.noteTempFile tempAbsPath $ "cardano-node-" <> si <> ".stderr.log"
 
137
    sprocket <- H.noteShow $ Sprocket tempBaseAbsPath (socketDir </> "node-" <> si)
 
138
    portString <- H.note $ show @Int (allPorts L.!! i)
 
139
    topologyFile <- H.noteShow $ tempAbsPath </> "topology-node-" <> si <> ".json"
 
140
    configFile <- H.noteShow $ tempAbsPath </> "config-" <> si <> ".yaml"
 
141
    signingKeyFile <- H.noteShow $ tempAbsPath </> "genesis/delegate-keys.00" <> si <> ".key"
 
142
    delegationCertificateFile <- H.noteShow $ tempAbsPath </> "genesis/delegation-cert.00" <> si <> ".json"
 
143
 
 
144
    H.createDirectoryIfMissing dbDir
 
145
    H.createDirectoryIfMissing $ tempBaseAbsPath </> "" <> socketDir
 
146
 
 
147
    otherPorts <- H.noteShow $ L.dropNth i allPorts
 
148
 
 
149
    H.lbsWriteFile (tempAbsPath </> "topology-node-" <> si <> ".json") $ J.encode $
 
150
      J.object
 
151
      [ ( "Producers"
 
152
        , J.toJSON $ flip fmap [0 .. numBftNodes testnetOptions - 2] $ \j -> J.object
 
153
          [ ("addr", "127.0.0.1")
 
154
          , ("valency", J.toJSON @Int 1)
 
155
          , ("port", J.toJSON (otherPorts L.!! j))
 
156
          ]
 
157
        )
 
158
      ]
 
159
 
 
160
    H.writeFile (tempAbsPath </> "config-" <> si <> ".yaml") . L.unlines . fmap (rewriteConfiguration i) . L.lines =<<
 
161
      H.readFile (baseConfig </> "config-0.yaml")
 
162
 
 
163
    hNodeStdout <- H.openFile nodeStdoutFile IO.WriteMode
 
164
    hNodeStderr <- H.openFile nodeStderrFile IO.WriteMode
 
165
 
 
166
    H.diff (L.length (IO.sprocketArgumentName sprocket)) (<=) IO.maxSprocketArgumentNameLength
 
167
 
 
168
    void $ H.createProcess =<<
 
169
      ( H.procNode
 
170
        [ "run"
 
171
        , "--database-path", dbDir
 
172
        , "--socket-path", IO.sprocketArgumentName sprocket
 
173
        , "--port", portString
 
174
        , "--topology", topologyFile
 
175
        , "--config", configFile
 
176
        , "--signing-key", signingKeyFile
 
177
        , "--delegation-certificate", delegationCertificateFile
 
178
        , "--shutdown-ipc", "0"
 
179
        ] <&>
 
180
        ( \cp -> cp
 
181
          { IO.std_in = IO.CreatePipe
 
182
          , IO.std_out = IO.UseHandle hNodeStdout
 
183
          , IO.std_err = IO.UseHandle hNodeStderr
 
184
          , IO.cwd = Just tempBaseAbsPath
 
185
          }
 
186
        )
 
187
      )
 
188
 
 
189
    when (OS.os `L.elem` ["darwin", "linux"]) $ do
 
190
      H.onFailure . H.noteIO_ $ IO.readProcess "lsof" ["-iTCP:" <> portString, "-sTCP:LISTEN", "-n", "-P"] ""
 
191
 
 
192
  now <- H.noteShowIO DTC.getCurrentTime
 
193
  deadline <- H.noteShow $ DTC.addUTCTime 90 now
 
194
 
 
195
  forM_ nodeIndexes $ \i -> do
 
196
    si <- H.noteShow $ show @Int i
 
197
    sprocket <- H.noteShow $ Sprocket tempBaseAbsPath (socketDir </> "node-" <> si)
 
198
    _spocketSystemNameFile <- H.noteShow $ IO.sprocketSystemName sprocket
 
199
    H.waitByDeadlineM deadline $ H.doesSprocketExist sprocket
 
200
 
 
201
  forM_ nodeIndexes $ \i -> do
 
202
    si <- H.noteShow $ show @Int i
 
203
    nodeStdoutFile <- H.noteTempFile tempAbsPath $ "cardano-node-" <> si <> ".stdout.log"
 
204
    H.assertByDeadlineIO deadline $ IO.fileContains "until genesis start time at" nodeStdoutFile
 
205
 
 
206
  H.copyFile (tempAbsPath </> "config-1.yaml") (tempAbsPath </> "configuration.yaml")
 
207
 
 
208
  return allNodes