Merge #2122

2122: Flag to launch non-Byron-only testnet with custom activeSlotCoeff r=newhoggy a=newhoggy



Co-authored-by: John Ky <[email protected]>

cardano-node-chairman/src/Testnet/ByronShelley.hs

@@ -10,18 +10,18 @@
 #endif
 
 module Testnet.ByronShelley
-  ( testnet
+  ( TestnetOptions(..)
+  , emptyTestnetOptions
+
+  , testnet
   ) where
 
 #ifdef UNIX
 import           Prelude (map)
 #endif
 
 import           Control.Monad
-import           Control.Monad.IO.Class
 import           Data.Aeson ((.=))
-import           Data.Bool
-import           Data.Either
 import           Data.Eq
 import           Data.Function
 import           Data.Functor
@@ -31,17 +31,12 @@ import           Data.Maybe
 import           Data.Ord
 import           Data.Semigroup
 import           Data.String
-import           Data.Time
 import           GHC.Float
 import           GHC.Num
 import           GHC.Real
-import           Hedgehog (Property, discover, (===))
 import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
 import           Hedgehog.Extras.Stock.Time
-import           System.Exit (ExitCode (..))
 import           System.FilePath.Posix ((</>))
-import           System.IO (IO)
-import           Text.Read
 import           Text.Show
 
 import qualified Data.Aeson as J
@@ -54,7 +49,6 @@ import qualified Hedgehog.Extras.Stock.Aeson as J
 import qualified Hedgehog.Extras.Stock.IO.File as IO
 import qualified Hedgehog.Extras.Stock.IO.Network.Socket as IO
 import qualified Hedgehog.Extras.Stock.IO.Network.Sprocket as IO
-import qualified Hedgehog.Extras.Stock.OS as OS
 import qualified Hedgehog.Extras.Stock.String as S
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.Concurrent as H
@@ -63,28 +57,34 @@ import qualified Hedgehog.Extras.Test.Network as H
 import qualified Hedgehog.Extras.Test.Process as H
 import qualified System.Directory as IO
 import qualified System.Environment as IO
-import qualified System.FilePath.Posix as FP
 import qualified System.Info as OS
 import qualified System.IO as IO
 #ifdef UNIX
 import           System.Posix.Files
 #endif
 import qualified System.Process as IO
-import qualified System.Random as IO
 import qualified Test.Process as H
 import qualified Testnet.Conf as H
 
 {- HLINT ignore "Reduce duplication" -}
 {- HLINT ignore "Redundant <&>" -}
 {- HLINT ignore "Redundant flip" -}
 
+newtype TestnetOptions = TestnetOptions
+  { maybeActiveSlotsCoeff :: Maybe Double
+  } deriving (Eq, Show)
+
+emptyTestnetOptions :: TestnetOptions
+emptyTestnetOptions = TestnetOptions
+  { maybeActiveSlotsCoeff = Nothing
+  }
 
 ifaceAddress :: String
 ifaceAddress = "127.0.0.1"
 
 
-testnet :: H.Conf -> H.Integration [String]
-testnet H.Conf {..} = do
+testnet :: TestnetOptions -> H.Conf -> H.Integration [String]
+testnet testnetOptions H.Conf {..} = do
   -- This script sets up a cluster that starts out in Byron, and can transition to Shelley.
   --
   -- The script generates all the files needed for the setup, and prints commands
@@ -332,7 +332,7 @@ testnet H.Conf {..} = do
   -- cycling KES keys
   H.rewriteJsonFile (tempAbsPath </> "shelley/genesis.spec.json") . J.rewriteObject
     $ HM.insert "slotLength" (J.toJSON @Double 0.2)
-    . HM.insert "activeSlotsCoeff" (J.toJSON @Double 0.1)
+    . HM.insert "activeSlotsCoeff" (J.toJSON @Double (fromMaybe 0.1 (maybeActiveSlotsCoeff testnetOptions)))
     . HM.insert "securityParam" (J.toJSON @Int 10)
     . HM.insert "epochLength" (J.toJSON @Int 1500)
     . HM.insert "slotLength" (J.toJSON @Double 0.2)

cardano-node-chairman/src/Testnet/Shelley.hs

@@ -8,7 +8,10 @@
 #endif
 
 module Testnet.Shelley
-  ( testnet
+  ( TestnetOptions(..)
+  , emptyTestnetOptions
+
+  , testnet
   , hprop_testnet
   , hprop_testnet_pause
   ) where
@@ -21,6 +24,7 @@ import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Resource
 import           Data.Aeson
+import           Data.Eq
 import           Data.Function
 import           Data.Functor
 import           Data.Int
@@ -67,13 +71,22 @@ import qualified Testnet.Conf as H
 {- HLINT ignore "Redundant <&>" -}
 {- HLINT ignore "Redundant flip" -}
 
+newtype TestnetOptions = TestnetOptions
+  { maybeActiveSlotsCoeff :: Maybe Double
+  } deriving (Eq, Show)
+
+emptyTestnetOptions :: TestnetOptions
+emptyTestnetOptions = TestnetOptions
+  { maybeActiveSlotsCoeff = Nothing
+  }
+
 ifaceAddress :: String
 ifaceAddress = "127.0.0.1"
 
-rewriteGenesisSpec :: UTCTime -> Int -> Value -> Value
-rewriteGenesisSpec startTime supply =
+rewriteGenesisSpec :: TestnetOptions -> UTCTime -> Int -> Value -> Value
+rewriteGenesisSpec testnetOptions startTime supply =
   rewriteObject
-    $ HM.insert "activeSlotsCoeff" (toJSON @Double 0.1)
+    $ HM.insert "activeSlotsCoeff" (toJSON @Double (fromMaybe 0.1 (maybeActiveSlotsCoeff testnetOptions)))
     . HM.insert "securityParam" (toJSON @Int 10)
     . HM.insert "epochLength" (toJSON @Int 1000)
     . HM.insert "slotLength" (toJSON @Double 0.2)
@@ -83,8 +96,8 @@ rewriteGenesisSpec startTime supply =
       ( rewriteObject (HM.insert "decentralisationParam" (toJSON @Double 0.7))
       )
 
-testnet :: H.Conf -> H.Integration [String]
-testnet H.Conf {..} = do
+testnet :: TestnetOptions -> H.Conf -> H.Integration [String]
+testnet testOptions H.Conf {..} = do
   void $ H.note OS.os
 
   let praosNodes = ["node-praos1", "node-praos2"] :: [String]
@@ -119,8 +132,8 @@ testnet H.Conf {..} = do
   -- We're going to use really quick epochs (300 seconds), by using short slots 0.2s
   -- and K=10, but we'll keep long KES periods so we don't have to bother
   -- cycling KES keys
-  H.rewriteJsonFile (tempAbsPath </> "genesis.spec.json") (rewriteGenesisSpec startTime supply)
-  H.rewriteJsonFile (tempAbsPath </> "genesis.json"     ) (rewriteGenesisSpec startTime supply)
+  H.rewriteJsonFile (tempAbsPath </> "genesis.spec.json") (rewriteGenesisSpec testOptions startTime supply)
+  H.rewriteJsonFile (tempAbsPath </> "genesis.json"     ) (rewriteGenesisSpec testOptions startTime supply)
 
   H.assertIsJsonFile $ tempAbsPath </> "genesis.spec.json"
 
@@ -407,7 +420,7 @@ hprop_testnet = H.integration . H.runFinallies . H.workspace "chairman" $ \tempA
 
   void . liftResourceT . resourceForkIO . forever . liftIO $ IO.threadDelay 10000000
 
-  void $ testnet conf
+  void $ testnet emptyTestnetOptions conf
 
   H.failure -- Intentional failure to force failure report
 

cardano-node-chairman/test/Spec/Chairman/ByronShelley.hs

@@ -22,6 +22,6 @@ hprop_chairman :: H.Property
 hprop_chairman = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAbsPath' -> do
   conf <- H.mkConf tempAbsPath' Nothing
 
-  allNodes <- H.testnet conf
+  allNodes <- H.testnet H.emptyTestnetOptions conf
 
   chairmanOver 120 52 conf allNodes

cardano-node-chairman/test/Spec/Chairman/Shelley.hs

@@ -22,6 +22,6 @@ hprop_chairman :: H.Property
 hprop_chairman = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAbsPath' -> do
   conf <- H.mkConf tempAbsPath' Nothing
 
-  allNodes <- H.testnet conf
+  allNodes <- H.testnet H.emptyTestnetOptions conf
 
   chairmanOver 120 21 conf allNodes

cardano-node-chairman/testnet/Testnet/Commands/ByronShelley.hs

@@ -17,10 +17,21 @@ import           Text.Show
 
 import qualified Options.Applicative as OA
 
-newtype ByronShelleyOptions = ByronShelleyOptions
-  { testnetMagic :: Maybe Int
+data ByronShelleyOptions = ByronShelleyOptions
+  { maybeTestnetMagic :: Maybe Int
+  , testnetOptions :: TestnetOptions
   } deriving (Eq, Show)
 
+optsTestnet :: Parser TestnetOptions
+optsTestnet = TestnetOptions
+  <$> optional
+      ( OA.option auto
+        (   long "active-slots-coeff"
+        <>  help "Active slots co-efficient"
+        <>  metavar "DOUBLE"
+        )
+      )
+
 optsByronShelley :: Parser ByronShelleyOptions
 optsByronShelley = ByronShelleyOptions
   <$> optional
@@ -30,9 +41,11 @@ optsByronShelley = ByronShelleyOptions
         <>  metavar "INT"
         )
       )
+  <*> optsTestnet
 
 runByronShelleyOptions :: ByronShelleyOptions -> IO ()
-runByronShelleyOptions (ByronShelleyOptions maybeTestnetMagic) = runTestnet maybeTestnetMagic Testnet.ByronShelley.testnet
+runByronShelleyOptions options = runTestnet (maybeTestnetMagic options) $
+  Testnet.ByronShelley.testnet (testnetOptions options)
 
 cmdByronShelley :: Mod CommandFields (IO ())
 cmdByronShelley = command "byron-shelley"  $ flip info idm $ runByronShelleyOptions <$> optsByronShelley

cardano-node-chairman/testnet/Testnet/Commands/Shelley.hs

@@ -18,10 +18,21 @@ import           Text.Show
 
 import qualified Options.Applicative as OA
 
-newtype ShelleyOptions = ShelleyOptions
-  { testnetMagic :: Maybe Int
+data ShelleyOptions = ShelleyOptions
+  { maybeTestnetMagic :: Maybe Int
+  , testnetOptions :: TestnetOptions
   } deriving (Eq, Show)
 
+optsTestnet :: Parser TestnetOptions
+optsTestnet = TestnetOptions
+  <$> optional
+      ( OA.option auto
+        (   long "active-slots-coeff"
+        <>  help "Active slots co-efficient"
+        <>  metavar "DOUBLE"
+        )
+      )
+
 optsShelley :: Parser ShelleyOptions
 optsShelley = ShelleyOptions
   <$> optional
@@ -31,9 +42,11 @@ optsShelley = ShelleyOptions
         <>  metavar "INT"
         )
       )
+  <*> optsTestnet
 
 runShelleyOptions :: ShelleyOptions -> IO ()
-runShelleyOptions (ShelleyOptions maybeTestnetMagic) = runTestnet maybeTestnetMagic Testnet.Shelley.testnet
+runShelleyOptions options = runTestnet (maybeTestnetMagic options) $
+  Testnet.Shelley.testnet (testnetOptions options)
 
 cmdShelley :: Mod CommandFields (IO ())
 cmdShelley = command "shelley"  $ flip info idm $ runShelleyOptions <$> optsShelley