Merge pull request #5722 from IntersectMBO/smelc/testnet-forward-cust…

…om-genesis-to-create-testnet-data

testnet: fix that custom genesis files were not passed to create-testnet-data

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

@@ -6,9 +6,10 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Testnet.Components.Configuration
-  ( convertToEraString
+  ( anyEraToString
   , createConfigYaml
   , createSPOGenesisAndFiles
+  , eraToString
   , mkTopologyConfig
   , numSeededUTxOKeys
   , NumPools
@@ -18,6 +19,8 @@ module Testnet.Components.Configuration
 import           Cardano.Api.Ledger (StandardCrypto)
 import           Cardano.Api.Shelley hiding (Value, cardanoEra)
 
+import           Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis)
+import           Cardano.Ledger.Conway.Genesis (ConwayGenesis)
 import qualified Cardano.Node.Configuration.Topology as NonP2P
 import qualified Cardano.Node.Configuration.TopologyP2P as P2P
 import           Ouroboros.Network.PeerSelection.Bootstrap
@@ -29,53 +32,51 @@ import           Control.Monad
 import           Control.Monad.Catch (MonadCatch)
 import           Data.Aeson
 import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.KeyMap as Aeson
 import qualified Data.Aeson.Lens as L
-import           Data.Bifunctor
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.List as List
 import           Data.String
+import qualified Data.Text as Text
 import           GHC.Stack (HasCallStack)
 import qualified GHC.Stack as GHC
 import           Lens.Micro
-import           System.FilePath.Posix (takeDirectory, (</>))
+import           System.FilePath.Posix (takeDirectory, takeFileName, (</>))
 
 import           Testnet.Defaults
 import           Testnet.Filepath
 import           Testnet.Process.Run (execCli_)
 import           Testnet.Property.Utils
-import           Testnet.Start.Types (CardanoTestnetOptions (..))
+import           Testnet.Start.Types (CardanoTestnetOptions (..), anyEraToString, eraToString)
 
 import           Hedgehog
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras.Stock.Time as DTC
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 
-createConfigYaml
-  :: (MonadTest m, MonadIO m, HasCallStack)
+-- | Returns JSON encoded hashes of the era, as well as the hard fork configuration toggle.
+createConfigYaml :: ()
+  => (MonadTest m, MonadIO m, HasCallStack)
   => TmpAbsolutePath
-  -> AnyCardanoEra
+  -> AnyCardanoEra -- ^ The era used for generating the hard fork configuration toggle
   -> m LBS.ByteString
-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
-  -- direct fashion.
-
-  byronGenesisHash <- getByronGenesisHash $ tempAbsPath' </> "byron/genesis.json"
-  shelleyGenesisHash <- getShelleyGenesisHash (tempAbsPath' </> defaultShelleyGenesisFp) "ShelleyGenesisHash"
-  alonzoGenesisHash <- getShelleyGenesisHash (tempAbsPath' </> "shelley/genesis.alonzo.json") "AlonzoGenesisHash"
-  conwayGenesisHash <- getShelleyGenesisHash (tempAbsPath' </> "shelley/genesis.conway.json") "ConwayGenesisHash"
-
+createConfigYaml (TmpAbsolutePath tempAbsPath) era = GHC.withFrozenCallStack $ do
+  byronGenesisHash <- getByronGenesisHash $ tempAbsPath </> "byron/genesis.json"
+  shelleyGenesisHash <- getHash ShelleyEra "ShelleyGenesisHash"
+  alonzoGenesisHash  <- getHash AlonzoEra  "AlonzoGenesisHash"
+  conwayGenesisHash  <- getHash ConwayEra  "ConwayGenesisHash"
 
   return . Aeson.encode . Aeson.Object
     $ mconcat [ byronGenesisHash
               , shelleyGenesisHash
               , alonzoGenesisHash
               , conwayGenesisHash
-              , defaultYamlHardforkViaConfig anyCardanoEra'
+              , defaultYamlHardforkViaConfig era
               ]
-
+   where
+    getHash :: (MonadTest m, MonadIO m) => CardanoEra a -> Text.Text -> m (Aeson.KeyMap Aeson.Value)
+    getHash e = getShelleyGenesisHash (tempAbsPath </> defaultGenesisFilepath e)
 
 numSeededUTxOKeys :: Int
 numSeededUTxOKeys = 3
@@ -90,19 +91,18 @@ createSPOGenesisAndFiles
   => NumPools -- ^ The number of pools to make
   -> AnyCardanoEra -- ^ The era to use
   -> ShelleyGenesis StandardCrypto -- ^ The shelley genesis to use.
+  -> AlonzoGenesis -- ^ The alonzo genesis to use, for example 'getDefaultAlonzoGenesis' from this module.
+  -> ConwayGenesis StandardCrypto -- ^ The conway genesis to use, for example 'Defaults.defaultConwayGenesis'.
   -> TmpAbsolutePath
   -> m FilePath -- ^ Shelley genesis directory
-createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis (TmpAbsolutePath tempAbsPath') = do
-  let genesisShelleyFpAbs = tempAbsPath' </> defaultShelleyGenesisFp
+createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis alonzoGenesis conwayGenesis (TmpAbsolutePath tempAbsPath) = do
+  let genesisShelleyFpAbs = tempAbsPath </> defaultGenesisFilepath ShelleyEra
       genesisShelleyDirAbs = takeDirectory genesisShelleyFpAbs
   genesisShelleyDir <- H.createDirectoryIfMissing genesisShelleyDirAbs
   let testnetMagic = sgNetworkMagic shelleyGenesis
       numStakeDelegators = 3 :: Int
       startTime = sgSystemStart shelleyGenesis
 
-  -- 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 @cardanoTestnet@ is run because this
@@ -129,7 +129,7 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis (TmpAbsolute
   H.note_ $ "Number of seeded UTxO keys: " <> show numSeededUTxOKeys
 
   execCli_
-    [ convertToEraString era, "genesis", "create-testnet-data"
+    [ anyEraToString era, "genesis", "create-testnet-data"
     , "--spec-shelley", genesisShelleyFpAbs
     , "--testnet-magic", show testnetMagic
     , "--pools", show numPoolNodes
@@ -139,39 +139,42 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis (TmpAbsolute
     , "--utxo-keys", show numSeededUTxOKeys
     , "--drep-keys", "3"
     , "--start-time", DTC.formatIso8601 startTime
-    , "--out-dir", tempAbsPath'
+    , "--out-dir", tempAbsPath
     ]
 
   -- Here we move all of the keys etc generated by create-testnet-data
   -- for the nodes to use
 
   -- Move all genesis related files
 
-  genesisByronDir <- H.createDirectoryIfMissing $ tempAbsPath' </> "byron"
+  genesisByronDir <- H.createDirectoryIfMissing $ tempAbsPath </> "byron"
 
-  files <- H.listDirectory tempAbsPath'
+  files <- H.listDirectory tempAbsPath
   forM_ files $ \file -> do
     H.note file
 
-  -- TODO: This conway and alonzo genesis creation should be ultimately moved to create-testnet-data
-  alonzoConwayTestGenesisJsonTargetFile <- H.noteShow (genesisShelleyDir </> "genesis.alonzo.json")
-  gen <- H.evalEither $ first prettyError defaultAlonzoGenesis
-  H.evalIO $ LBS.writeFile alonzoConwayTestGenesisJsonTargetFile $ Aeson.encode gen
-
-  conwayConwayTestGenesisJsonTargetFile <- H.noteShow (genesisShelleyDir </> "genesis.conway.json")
-  H.evalIO $ LBS.writeFile conwayConwayTestGenesisJsonTargetFile $ Aeson.encode defaultConwayGenesis
+  -- TODO: This conway and alonzo genesis creation can be removed,
+  -- as this will be done by create-testenet-data when cardano-cli is upgraded above 8.20.3.0.
+  writeGenesisFile genesisShelleyDir AlonzoEra alonzoGenesis
+  writeGenesisFile genesisShelleyDir ConwayEra conwayGenesis
 
-  H.renameFile (tempAbsPath' </> "byron-gen-command" </> "genesis.json") (genesisByronDir </> "genesis.json")
+  H.renameFile (tempAbsPath </> "byron-gen-command" </> "genesis.json") (genesisByronDir </> "genesis.json")
   -- TODO: create-testnet-data outputs the new shelley genesis to genesis.json
-  H.renameFile (tempAbsPath' </> "genesis.json") (genesisShelleyDir </> "genesis.shelley.json")
+  H.renameFile (tempAbsPath </> "genesis.json") (genesisShelleyDir </> "genesis.shelley.json")
 
-  -- TODO: move this to create-testnet-data
   -- For some reason when setting "--total-supply 10E16" in create-testnet-data, we're getting negative
-  -- treasury
+  -- treasury. TODO: This should be fixed by https://github.com/IntersectMBO/cardano-cli/pull/644
+  -- So this can be removed when cardano-cli is upgraded above 8.20.3.0.
   H.rewriteJsonFile @Value (genesisShelleyDir </> "genesis.shelley.json") $ \o -> o
     & L.key "maxLovelaceSupply" . L._Integer .~ 10_000_000_000_000_000
 
   return genesisShelleyDir
+  where
+    writeGenesisFile :: (MonadTest m, MonadIO m, HasCallStack) => ToJSON b => FilePath -> CardanoEra a -> b -> m ()
+    writeGenesisFile dir era' toWrite = GHC.withFrozenCallStack $ do
+      let filename = takeFileName $ defaultGenesisFilepath era'
+      targetJsonFile <- H.noteShow (dir </> filename)
+      H.evalIO $ LBS.writeFile targetJsonFile $ Aeson.encode toWrite
 
 ifaceAddress :: String
 ifaceAddress = "127.0.0.1"

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

@@ -157,7 +157,7 @@ createScriptStakeRegistrationCertificate tempAbsP anyCEra scriptFile deposit out
     let tempAbsPath' = unTmpAbsPath tempAbsP
 
     void $ execCli
-      [ convertToEraString anyCEra
+      [ anyEraToString anyCEra
       , "stake-address", "registration-certificate"
       , "--stake-script-file", scriptFile
       , "--key-reg-deposit-amt", show deposit
@@ -168,15 +168,7 @@ createScriptStakeRegistrationCertificate tempAbsP anyCEra scriptFile deposit out
 -- TODO: Remove me and replace with new era based commands
 -- i.e "conway", "babbage" etc
 convertToEraFlag :: AnyCardanoEra -> String
-convertToEraFlag (AnyCardanoEra e) =
-  case e of
-    ConwayEra -> "--conway-era"
-    BabbageEra -> "--babbage-era"
-    AlonzoEra -> "--alonzo-era"
-    MaryEra -> "--mary-era"
-    AllegraEra -> "--allegra-era"
-    ShelleyEra -> "--shelley-era"
-    ByronEra -> "--byron-era"
+convertToEraFlag era = "--" <> anyEraToString era  <> "-era"
 
 -- | Related documentation: https://github.com/input-output-hk/cardano-node-wiki/blob/main/docs/stake-pool-operations/8_register_stakepool.md
 registerSingleSpo

cardano-testnet/src/Testnet/Defaults.hs

@@ -15,7 +15,7 @@ module Testnet.Defaults
   , defaultYamlConfig
   , defaultConwayGenesis
   , defaultShelleyGenesis
-  , defaultShelleyGenesisFp
+  , defaultGenesisFilepath
   , defaultYamlHardforkViaConfig
   , defaultMainnetTopology
   , plutusV3NonSpendingScript
@@ -64,6 +64,7 @@ import           Data.Word
 import           GHC.Stack
 import           Lens.Micro
 import           Numeric.Natural
+import           System.FilePath.Posix ((</>))
 
 import           Test.Cardano.Ledger.Core.Rational
 import           Testnet.Start.Types
@@ -434,9 +435,9 @@ defaultYamlConfig =
 
     -- Genesis filepaths
     , ("ByronGenesisFile", "byron/genesis.json")
-    , ("ShelleyGenesisFile", Aeson.String $ Text.pack defaultShelleyGenesisFp)
-    , ("AlonzoGenesisFile", "shelley/genesis.alonzo.json")
-    , ("ConwayGenesisFile", "shelley/genesis.conway.json")
+    , ("ShelleyGenesisFile", genesisPath ShelleyEra)
+    , ("AlonzoGenesisFile",  genesisPath AlonzoEra)
+    , ("ConwayGenesisFile",  genesisPath ConwayEra)
 
     -- See: https://github.com/input-output-hk/cardano-ledger/blob/master/eras/byron/ledger/impl/doc/network-magic.md
     , ("RequiresNetworkMagic", "RequiresMagic")
@@ -452,6 +453,8 @@ defaultYamlConfig =
     , ("defaultBackends", Aeson.Array $ Vector.fromList ["KatipBK"])
     , ("options", Aeson.object mempty)
     ]
+  where
+    genesisPath era = Aeson.String $ Text.pack $ defaultGenesisFilepath era
 
 -- | We need a Byron genesis in order to be able to hardfork to the later Shelley based eras.
 -- The values here don't matter as the testnet conditions are ultimately determined
@@ -548,13 +551,8 @@ defaultMainnetTopology =
          }
   in RealNodeTopology [single]
 
--- TODO: These filepaths should really be decoded from the output of
--- create-testnet-data. We are still deciding the best way to pass this information
--- to cardano-testnet.
-
-defaultShelleyGenesisFp :: FilePath
-defaultShelleyGenesisFp = "shelley/genesis.shelley.json"
-
+defaultGenesisFilepath :: CardanoEra a -> FilePath
+defaultGenesisFilepath era = "shelley" </> ("genesis." <> eraToString era <> ".json")
 
 -- TODO: We should not hardcode a script like this. We need to move
 -- plutus-example from plutus apps to cardano-node-testnet. This will

cardano-testnet/src/Testnet/Property/Utils.hs

@@ -18,7 +18,6 @@ module Testnet.Property.Utils
   , getByronGenesisHash
   , getShelleyGenesisHash
 
-  , convertToEraString
   , decodeEraUTxO
   ) where
 
@@ -36,7 +35,6 @@ import qualified Data.Aeson as Aeson
 import           Data.Aeson.Key
 import           Data.Aeson.KeyMap hiding (map)
 import qualified Data.ByteString as BS
-import           Data.Char (toLower)
 import           Data.Text (Text)
 import           Data.Word
 import           GHC.Stack
@@ -122,8 +120,5 @@ runInBackground act = void . H.evalM $ allocate (H.async act) cleanUp
     cleanUp :: H.Async a -> IO ()
     cleanUp a = H.cancel a >> void (H.link a)
 
-convertToEraString :: AnyCardanoEra -> String
-convertToEraString = map toLower . docToString . pretty
-
 decodeEraUTxO :: (IsShelleyBasedEra era, MonadTest m) => ShelleyBasedEra era -> Aeson.Value -> m (UTxO era)
 decodeEraUTxO _ = H.jsonErrorFail . Aeson.fromJSON

cardano-testnet/src/Testnet/Start/Cardano.hs

@@ -178,10 +178,6 @@ requestAvailablePortNumbers numberOfPorts
 -- > │   ├── genesis{1,2,3}
 -- > │   │   └── key.{skey,vkey}
 -- > │   └── README.md
--- > ├── logs
--- > │   └── pool3
--- > │       └── {stderr,stdout}.log
--- > ├── module
 -- > ├── pools-keys
 -- > │   ├── pool{1,2,3}
 -- > │   │   ├── byron-delegate.key
@@ -271,7 +267,7 @@ cardanoTestnet
 
     configurationFile <- H.noteShow $ tmpAbsPath </> "configuration.yaml"
 
-    _ <- createSPOGenesisAndFiles nbPools era shelleyGenesis (TmpAbsolutePath tmpAbsPath)
+    _ <- createSPOGenesisAndFiles nbPools era shelleyGenesis alonzoGenesis conwayGenesis (TmpAbsolutePath tmpAbsPath)
 
     poolKeys <- H.noteShow $ flip fmap [1..numPoolNodes] $ \n ->
       PoolNodeKeys
@@ -393,7 +389,7 @@ cardanoTestnet
 
       let runtime = TestnetRuntime
             { configurationFile
-            , shelleyGenesisFile = tmpAbsPath </> Defaults.defaultShelleyGenesisFp
+            , shelleyGenesisFile = tmpAbsPath </> Defaults.defaultGenesisFilepath ShelleyEra
             , testnetMagic
             , poolNodes
             , wallets = wallets
@@ -423,7 +419,7 @@ cardanoTestnet
 
       pure runtime
   where
-    writeGenesisSpecFile :: (MonadTest m, MonadIO m, HasCallStack) => ToJSON a => FilePath -> a -> m ()
+    writeGenesisSpecFile :: (MonadTest m, MonadIO m, HasCallStack) => ToJSON a => String -> a -> m ()
     writeGenesisSpecFile eraName toWrite = GHC.withFrozenCallStack $ do
       genesisJsonFile <- H.noteShow $ tmpAbsPath </> "genesis." <> eraName <> ".spec.json"
       H.evalIO $ LBS.writeFile genesisJsonFile $ Aeson.encode toWrite

cardano-testnet/src/Testnet/Start/Types.hs

@@ -6,6 +6,9 @@ module Testnet.Start.Types
   ( CardanoTestnetOptions(..)
   , cardanoDefaultTestnetOptions
 
+  , anyEraToString
+  , eraToString
+
   , TestnetNodeOptions(..)
   , extraSpoNodeCliArgs
   , cardanoDefaultTestnetNodeOptions
@@ -20,6 +23,7 @@ import           Cardano.Api hiding (cardanoEra)
 
 import           Prelude
 
+import           Data.Char (toLower)
 import           Data.Word
 import           GHC.Stack
 import           System.FilePath (addTrailingPathSeparator)
@@ -94,4 +98,10 @@ mkConf tempAbsPath' = withFrozenCallStack $ do
     { tempAbsPath = TmpAbsolutePath (addTrailingPathSeparator tempAbsPath')
     }
 
+-- | @anyEraToString (AnyCardanoEra ByronEra)@ returns @"byron"@
+anyEraToString :: AnyCardanoEra -> String
+anyEraToString (AnyCardanoEra e) = eraToString e
 
+-- | @eraToString ByronEra@ returns @"byron"@
+eraToString :: CardanoEra a -> String
+eraToString = map toLower . docToString . pretty