Leadership slots

IntersectMBO · Jun 24, 2022 · 050bba9 · 050bba9
1 parent 67a2af5
commit 050bba9
Show file tree

Hide file tree

Showing 3 changed files with 197 additions and 126 deletions.
diff --git a/cabal.project b/cabal.project
@@ -168,7 +168,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/hedgehog-extras
-  tag: 967d79533c21e33387d0227a5f6cc185203fe658
+  tag: 5e70bbbb8b13a6dccc87e383d33cf1709a64e991
   --sha256: 0rbqb7a64aya1qizlr3im06hdydg9zr6sl3i8bvqqlf7kpa647sd
 
 source-repository-package
@@ -330,6 +330,12 @@ source-repository-package
   tag: ee59880f47ab835dbd73bea0847dab7869fc20d8
   --sha256: 1lrzknw765pz2j97nvv9ip3l1mcpf2zr4n56hwlz0rk7wq7ls4cm
 
+source-repository-package
+  type: git
+  location: https://github.com/haskell-works/hw-aeson
+  tag: fe7d7753123794df2dd858095e4978af5e9a6829
+  --sha256: 0i0f7rnbr49rk59fzap9433b00hklgiq26aq9vqgmw9dmafv43i3
+
 constraints:
     hedgehog >= 1.0
   , bimap >= 0.4.0

diff --git a/cardano-testnet/src/Testnet/Cardano.hs b/cardano-testnet/src/Testnet/Cardano.hs
@@ -33,8 +33,8 @@ import           Data.Eq (Eq)
 import           Data.Function (($), (.), flip, id)
 import           Data.Functor ((<$>), (<&>))
 import           Data.Int (Int)
-import           Data.List (length, replicate, unzip5, zip, zipWith6, (\\))
-import           Data.Maybe (Maybe(Just), fromJust)
+import           Data.List (length, replicate, unzip5, zip, (\\))
+import           Data.Maybe (Maybe(..), fromJust)
 import           Data.Ord (Ord((<=)))
 import           Data.Semigroup (Semigroup((<>)))
 import           Data.String (IsString(fromString), String)
@@ -126,6 +126,7 @@ defaultTestnetNodeOptions = TestnetNodeOptions
 
 data TestnetRuntime = TestnetRuntime
   { configurationFile :: FilePath
+  , shelleyGenesisFile :: FilePath
   , testnetMagic :: Int
   , bftNodes :: [TestnetNode]
   , poolNodes :: [TestnetNode]
@@ -145,6 +146,8 @@ data TestnetNode = TestnetNode
   , nodeStdout :: FilePath
   , nodeStderr :: FilePath
   , nodeProcessHandle :: IO.ProcessHandle
+  , nodeVrfVkey :: Maybe String
+  , nodeVrfSkey :: Maybe String
   }
 
 data Wallet = Wallet
@@ -492,19 +495,24 @@ testnet testnetOptions H.Conf {..} = do
 
   -- Make the pool operator cold keys
   -- This was done already for the BFT nodes as part of the genesis creation
-  forM_ poolNodeNames $ \node -> do
+  (poolVrfVkeys, poolVrfSkeys) <- fmap L.unzip $ forM poolNodeNames $ \node -> do
     void $ H.execCli
       [ "node", "key-gen"
       , "--cold-verification-key-file", tempAbsPath </> node </> "shelley/operator.vkey"
       , "--cold-signing-key-file", tempAbsPath </> node </> "shelley/operator.skey"
       , "--operational-certificate-issue-counter-file", tempAbsPath </> node </> "shelley/operator.counter"
       ]
 
+    let nodeVrfVkey = tempAbsPath </> node </> "shelley/vrf.vkey"
+    let nodeVrfSkey = tempAbsPath </> node </> "shelley/vrf.skey"
+
     void $ H.execCli
       [ "node", "key-gen-VRF"
-      , "--verification-key-file", tempAbsPath </> node </> "shelley/vrf.vkey"
-      , "--signing-key-file", tempAbsPath </> node </> "shelley/vrf.skey"
+      , "--verification-key-file", nodeVrfVkey
+      , "--signing-key-file", nodeVrfSkey
       ]
+
+    return (nodeVrfVkey, nodeVrfSkey)
 
   -- Symlink the BFT operator keys from the genesis delegates, for uniformity
   forM_ bftNodesN $ \n -> do
@@ -841,20 +849,41 @@ testnet testnetOptions H.Conf {..} = do
 
   return TestnetRuntime
     { configurationFile
+    , shelleyGenesisFile = tempAbsPath </> "shelley/genesis.json"
     , testnetMagic
-    , bftNodes = zipWith6 TestnetNode
+    , bftNodes = zipWith8 TestnetNode
         bftNodeNames
         bftSprockets'
         bftStdins
         bftStdouts
         bftStderrs
         bftProcessHandles
-    , poolNodes = zipWith6 TestnetNode
+        (L.repeat Nothing)
+        (L.repeat Nothing)
+    , poolNodes = zipWith8 TestnetNode
         poolNodeNames
         poolSprockets
         poolStdins
         poolStdouts
         poolStderrs
         poolProcessHandles
+        (Just <$> poolVrfVkeys)
+        (Just <$> poolVrfSkeys)
     , wallets
     }
+
+zipWith8 :: ()
+  => (a -> b -> c -> d -> e -> f -> g -> h -> z)
+  -> [a]
+  -> [b]
+  -> [c]
+  -> [d]
+  -> [e]
+  -> [f]
+  -> [g]
+  -> [h]
+  -> [z]
+zipWith8 fun (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) (h:hs) =
+  fun a b c d e f g h:zipWith8 fun as bs cs ds es fs gs hs
+zipWith8 fun _ _ _ _ _ _ _ _ =
+  []