Merge pull request #5515 from input-output-hk/jordan/remove-all-calls…

…-to-rewriteObject

Factor out file creation for SPO

cardano-testnet/src/Cardano/Testnet.hs

@@ -15,7 +15,7 @@ module Cardano.Testnet (
   -- * Configuration
   Conf(..),
   TmpAbsolutePath(..),
-  YamlFilePath(..),
+  NodeConfigurationYaml(..),
   mkConf,
   makeLogDir,
   makeSocketDir,

cardano-testnet/src/Parsers/Cardano.hs

@@ -1,6 +1,5 @@
 module Parsers.Cardano
-  ( CardanoOptions(..)
-  , cmdCardano
+  ( cmdCardano
   ) where
 
 import           Cardano.CLI.Environment
@@ -17,14 +16,13 @@ import           Testnet.Process.Cli
 import           Testnet.Property.Utils
 import           Testnet.Runtime (readNodeLoggingFormat)
 import           Testnet.Start.Cardano
+import           Testnet.Start.Types
 
-newtype CardanoOptions = CardanoOptions
-  { testnetOptions :: CardanoTestnetOptions
-  } deriving (Eq, Show)
 
 optsTestnet :: EnvCli -> Parser CardanoTestnetOptions
 optsTestnet envCli = CardanoTestnetOptions
-  <$> pNumBftAndSpoNodes
+  -- TODO <$> (OA.many pSpo <|> pNumSpoNodes)
+  <$> pNumSpoNodes
   <*> pLegacyCardanoEra envCli
   <*> OA.option auto
       (   OA.long "epoch-length"
@@ -64,19 +62,41 @@ optsTestnet envCli = CardanoTestnetOptions
       <>  OA.value (cardanoNodeLoggingFormat cardanoDefaultTestnetOptions)
       )
 
-pNumBftAndSpoNodes :: Parser [TestnetNodeOptions]
-pNumBftAndSpoNodes =
+pNumSpoNodes :: Parser [TestnetNodeOptions]
+pNumSpoNodes =
   OA.option
-    ((`L.replicate` SpoTestnetNodeOptions []) <$> auto)
-    (   OA.long "num-pool-nodes"
-    <>  OA.help "Number of pool nodes"
-    <>  OA.metavar "COUNT"
-    <>  OA.showDefault
-    <>  OA.value (cardanoNodes cardanoDefaultTestnetOptions)
+     ((`L.replicate` SpoTestnetNodeOptions Nothing []) <$> auto)
+     (   OA.long "num-pool-nodes"
+     <>  OA.help "Number of pool nodes. Note this uses a default node configuration for all nodes."
+     <>  OA.metavar "COUNT"
+     <>  OA.showDefault
+     <>  OA.value (cardanoNodes cardanoDefaultTestnetOptions)
+     )
+
+
+_pSpo :: Parser TestnetNodeOptions
+_pSpo =
+  SpoTestnetNodeOptions . Just
+    <$> parseNodeConfigFile
+    <*> pure [] -- TODO: Consider adding support for extra args
+
+parseNodeConfigFile :: Parser NodeConfigurationYaml
+parseNodeConfigFile = NodeConfigurationYaml <$>
+  strOption
+    (mconcat
+       [ long "configuration-file"
+       , metavar "NODE-CONFIGURATION"
+       , help helpText
+       , completer (bashCompleter "file")
+       ]
     )
+ where
+   helpText = unwords
+               [ "Configuration file for the cardano-node(s)."
+               , "Specify a configuration file per node you want to have in the cluster."
+               , "Or use num-pool-nodes to use cardano-testnet's default configuration."
+               ]
 
-optsCardano :: EnvCli -> Parser CardanoOptions
-optsCardano envCli = CardanoOptions <$> optsTestnet envCli
 
-cmdCardano :: EnvCli -> Mod CommandFields CardanoOptions
-cmdCardano envCli = command' "cardano" "Start a testnet in any era" (optsCardano envCli)
+cmdCardano :: EnvCli -> Mod CommandFields CardanoTestnetOptions
+cmdCardano envCli = command' "cardano" "Start a testnet in any era" (optsTestnet envCli)

cardano-testnet/src/Parsers/Run.hs

@@ -30,7 +30,7 @@ opts envCli = Opt.info (commands envCli <**> helper) idm
 -- by allowing the user to start testnets in any era (excluding Byron)
 -- via StartCardanoTestnet
 data CardanoTestnetCommands
-  = StartCardanoTestnet CardanoOptions
+  = StartCardanoTestnet CardanoTestnetOptions
   | GetVersion VersionOptions
   | Help ParserPrefs (ParserInfo CardanoTestnetCommands) HelpOptions
 
@@ -50,6 +50,6 @@ runTestnetCmd = \case
   Help pPrefs pInfo cmdOpts -> runHelpOptions pPrefs pInfo cmdOpts
 
 
-runCardanoOptions :: CardanoOptions -> IO ()
+runCardanoOptions :: CardanoTestnetOptions -> IO ()
 runCardanoOptions options =
-  runTestnet $ cardanoTestnet (testnetOptions options)
+  runTestnet $ cardanoTestnet options

cardano-testnet/src/Testnet/Components/Configuration.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-
+{-# LANGUAGE TypeApplications #-}
 
 module Testnet.Components.Configuration
   ( createConfigYaml
+  , createSPOGenesisAndFiles
   , mkTopologyConfig
   ) where
 
@@ -15,29 +16,40 @@ import           Cardano.Node.Types
 import           Ouroboros.Network.PeerSelection.LedgerPeers
 import           Ouroboros.Network.PeerSelection.State.LocalRootPeers
 
+import           Control.Monad
+import           Control.Monad.Catch (MonadCatch)
 import           Control.Monad.IO.Class (MonadIO)
+import           Data.Aeson
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.HashMap.Lazy as HM
 import qualified Data.List as List
 import           Data.String
+import           Data.Time
 import           GHC.Stack (HasCallStack)
 import qualified GHC.Stack as GHC
 import           System.FilePath.Posix ((</>))
 
 import           Hedgehog
+import qualified Hedgehog as H
+import qualified Hedgehog.Extras.Stock.Aeson as J
+import qualified Hedgehog.Extras.Stock.Time as DTC
+import qualified Hedgehog.Extras.Test.Base as H
+import qualified Hedgehog.Extras.Test.File as H
 
 import           Testnet.Defaults
 import           Testnet.Filepath
+import           Testnet.Process.Run (execCli_)
 import           Testnet.Property.Utils
+import           Testnet.Start.Types
+
 
 createConfigYaml
   :: (MonadTest m, MonadIO m, HasCallStack)
   => TmpAbsolutePath
   -> AnyCardanoEra
   -> m LBS.ByteString
-createConfigYaml tempAbsPath anyCardanoEra' = GHC.withFrozenCallStack $ do
-  let tempAbsPath' = unTmpAbsPath tempAbsPath
-
+createConfigYaml (TmpAbsolutePath tempAbsPath') anyCardanoEra' = GHC.withFrozenCallStack $ do
   -- Add Byron, Shelley and Alonzo genesis hashes to node configuration
   -- TODO: These genesis filepaths should not be hardcoded. Using the cli as a library
   -- rather as an executable will allow us to get the genesis files paths in a more
@@ -58,6 +70,79 @@ createConfigYaml tempAbsPath anyCardanoEra' = GHC.withFrozenCallStack $ do
               ]
 
 
+createSPOGenesisAndFiles
+  :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
+  => CardanoTestnetOptions
+  -> UTCTime -- ^ Start time
+  -> TmpAbsolutePath
+  -> m FilePath -- ^ Shelley genesis directory
+createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath') = do
+  let testnetMagic = cardanoTestnetMagic testnetOptions
+      numPoolNodes = length $ cardanoNodes testnetOptions
+      -- TODO: Even this is cumbersome. You need to know where to put the initial
+      -- shelley genesis for create-staked to use.
+      createStakedInitialGenesisFile = tempAbsPath' </> "genesis.spec.json"
+
+  -- TODO: We need to read the genesis files into Haskell and modify them
+  -- based on cardano-testnet's cli parameters
+
+  -- We create the initial genesis file to avoid having to re-write the genesis file later
+  -- with the parameters we want. The user must provide genesis files or we will use a default.
+  -- We should *never* be modifying the genesis file after cardano-testnet is run because this
+  -- is sure to be a source of confusion if users provide genesis files and we are mutating them
+  -- without their knowledge.
+  let shelleyGenesis :: LBS.ByteString
+      shelleyGenesis = encode $ defaultShelleyGenesis startTime testnetOptions
+
+  H.evalIO $ LBS.writeFile createStakedInitialGenesisFile shelleyGenesis
+
+  -- TODO: Remove this rewrite.
+ -- 50 second epochs
+ -- Epoch length should be "10 * k / f" where "k = securityParam, f = activeSlotsCoeff"
+  H.rewriteJsonFile createStakedInitialGenesisFile $ J.rewriteObject
+      ( HM.insert "securityParam"          (toJSON @Int 5)    -- TODO: USE config p arameter
+      . HM.adjust
+          (J.rewriteObject
+              $ HM.adjust
+                (J.rewriteObject (HM.insert "major" (toJSON @Int 8)))
+                "protocolVersion"
+          )   "protocolParams"
+      . HM.insert "rho"                    (toJSON @Double 0.1)
+      . HM.insert "tau"                    (toJSON @Double 0.1)
+      . HM.insert "updateQuorum"           (toJSON @Int 2)
+      )
+
+  execCli_
+    [ "genesis", "create-staked"
+    , "--genesis-dir", tempAbsPath'
+    , "--testnet-magic", show @Int testnetMagic
+    , "--gen-pools", show @Int numPoolNodes
+    , "--supply", "1000000000000"
+    , "--supply-delegated", "1000000000000"
+    , "--gen-stake-delegs", "3"
+    , "--gen-utxo-keys", "3"
+    , "--start-time", DTC.formatIso8601 startTime
+    ]
+
+  -- Here we move all of the keys etc generated by create-staked
+  -- for the nodes to use
+
+  -- Move all genesis related files
+
+  genesisByronDir <- H.createDirectoryIfMissing $ tempAbsPath' </> "byron"
+  genesisShelleyDir <- H.createDirectoryIfMissing $ tempAbsPath' </> "shelley"
+
+  files <- H.listDirectory tempAbsPath'
+  forM_ files $ \file -> do
+    H.note file
+
+  H.renameFile (tempAbsPath' </> "byron-gen-command/genesis.json") (genesisByronDir </> "genesis.json")
+  H.renameFile (tempAbsPath' </> "genesis.alonzo.json") (genesisShelleyDir </> "genesis.alonzo.json")
+  H.renameFile (tempAbsPath' </> "genesis.conway.json") (genesisShelleyDir </> "genesis.conway.json")
+  H.renameFile (tempAbsPath' </> "genesis.json") (genesisShelleyDir </> "genesis.json")
+
+  return genesisShelleyDir
+
 ifaceAddress :: String
 ifaceAddress = "127.0.0.1"
 

cardano-testnet/src/Testnet/Defaults.hs

@@ -8,6 +8,7 @@ module Testnet.Defaults
   , defaultByronProtocolParamsJsonValue
   , defaultYamlConfig
   , defaultConwayGenesis
+  , defaultShelleyGenesis
   , defaultYamlHardforkViaConfig
   , defaultMainnetTopology
   ) where
@@ -22,6 +23,7 @@ import           Cardano.Ledger.BaseTypes
 import           Cardano.Ledger.Coin
 import           Cardano.Ledger.Conway.Genesis
 import           Cardano.Ledger.Crypto (StandardCrypto)
+import           Cardano.Ledger.Shelley.Genesis
 import           Cardano.Node.Configuration.Topology
 import           Cardano.Tracing.Config
 
@@ -37,9 +39,12 @@ import qualified Data.Map.Strict as Map
 import           Data.Proxy
 import           Data.Ratio
 import           Data.Scientific
+import           Data.Time (UTCTime)
 import qualified Data.Vector as Vector
 import           Data.Word
 
+import           Testnet.Start.Types
+
 
 instance Api.Error AlonzoGenesisError where
   displayError (AlonzoGenErrCostModels e) =
@@ -401,6 +406,23 @@ defaultByronProtocolParamsJsonValue =
     , "updateVoteThd" .= toJSON @String "1000000000000"
     ]
 
+defaultShelleyGenesis
+  :: UTCTime
+  -> CardanoTestnetOptions
+  -> Api.ShelleyGenesis StandardCrypto
+defaultShelleyGenesis startTime testnetOptions =
+  let testnetMagic = cardanoTestnetMagic testnetOptions
+      slotLength = cardanoSlotLength testnetOptions
+      epochLength = cardanoEpochLength testnetOptions
+      maxLovelaceLovelaceSupply = cardanoMaxSupply testnetOptions
+  in Api.shelleyGenesisDefaults
+        { Api.sgNetworkMagic = fromIntegral testnetMagic
+        , Api.sgSlotLength = secondsToNominalDiffTimeMicro $ realToFrac slotLength
+        , Api.sgEpochLength = EpochSize $ fromIntegral epochLength
+        , Api.sgMaxLovelaceSupply = maxLovelaceLovelaceSupply
+        , Api.sgSystemStart = startTime
+        }
+
 defaultMainnetTopology :: NetworkTopology
 defaultMainnetTopology =
   let single = RemoteAddress