Make alonzo genesis creation era sensisitve

cardano-cli/src/Cardano/CLI/EraBased/Commands.hs

@@ -116,7 +116,7 @@ pCmds era envCli =
   asum $ catMaybes
     [ fmap AddressCmds      <$> pAddressCmds (toCardanoEra era) envCli
     , fmap KeyCmds          <$> pKeyCmds
-    , fmap GenesisCmds      <$> pGenesisCmds envCli
+    , fmap GenesisCmds      <$> pGenesisCmds (toCardanoEra era) envCli
     , fmap GovernanceCmds   <$> pGovernanceCmds (toCardanoEra era)
     , fmap NodeCmds         <$> pNodeCmds
     , fmap QueryCmds        <$> pQueryCmds (toCardanoEra era) envCli

cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs

@@ -29,7 +29,7 @@ data GenesisCmds era
   = GenesisCreate !GenesisCreateCmdArgs
   | GenesisCreateCardano !GenesisCreateCardanoCmdArgs
   | GenesisCreateStaked !GenesisCreateStakedCmdArgs
-  | GenesisCreateTestNetData !GenesisCreateTestNetDataCmdArgs
+  | GenesisCreateTestNetData !(GenesisCreateTestNetDataCmdArgs era)
   | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs
   | GenesisKeyGenDelegate !GenesisKeyGenDelegateCmdArgs
   | GenesisKeyGenUTxO !GenesisKeyGenUTxOCmdArgs
@@ -84,8 +84,9 @@ data GenesisCreateStakedCmdArgs = GenesisCreateStakedCmdArgs
   , mStakePoolRelaySpecFile :: !(Maybe FilePath) -- ^ Relay specification filepath
   } deriving Show
 
-data GenesisCreateTestNetDataCmdArgs = GenesisCreateTestNetDataCmdArgs
-  { specShelley :: !(Maybe FilePath) -- ^ Path to the @genesis-shelley@ file to use. If unspecified, a default one will be used.
+data GenesisCreateTestNetDataCmdArgs era = GenesisCreateTestNetDataCmdArgs
+  { eon :: !(CardanoEra era)
+  , specShelley :: !(Maybe FilePath) -- ^ Path to the @genesis-shelley@ file to use. If unspecified, a default one will be used.
   , specAlonzo :: !(Maybe FilePath) -- ^ Path to the @genesis-alonzo@ file to use. If unspecified, a default one will be used.
   , specConway :: !(Maybe FilePath) -- ^ Path to the @genesis-conway@ file to use. If unspecified, a default one will be used.
   , numGenesisKeys :: !Word -- ^ The number of genesis keys credentials to create and write to disk.

cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs

@@ -23,13 +23,11 @@ import           Data.Word (Word64)
 import           Options.Applicative hiding (help, str)
 import qualified Options.Applicative as Opt
 
-{- HLINT ignore "Use <$>" -}
-{- HLINT ignore "Move brackets to avoid $" -}
-
 pGenesisCmds :: ()
-  => EnvCli
+  => CardanoEra era
+  -> EnvCli
   -> Maybe (Parser (GenesisCmds era))
-pGenesisCmds envCli =
+pGenesisCmds era envCli =
   subInfoParser "genesis"
     ( Opt.progDesc
         $ mconcat
@@ -90,7 +88,7 @@ pGenesisCmds envCli =
             ]
     , Just
         $ subParser "create-testnet-data"
-        $ Opt.info (pGenesisCreateTestNetData envCli)
+        $ Opt.info (pGenesisCreateTestNetData era envCli)
         $ Opt.progDesc
         $ mconcat
             [ "Create data to use for starting a testnet."
@@ -209,12 +207,12 @@ pGenesisCreateStaked envCli =
         , Opt.completer (Opt.bashCompleter "file")
         ]
 
-pGenesisCreateTestNetData :: EnvCli -> Parser (GenesisCmds era)
-pGenesisCreateTestNetData envCli =
-  fmap GenesisCreateTestNetData $ GenesisCreateTestNetDataCmdArgs
-    <$> (optional $ pSpecFile "shelley")
-    <*> (optional $ pSpecFile "alonzo")
-    <*> (optional $ pSpecFile "conway")
+pGenesisCreateTestNetData :: CardanoEra era -> EnvCli -> Parser (GenesisCmds era)
+pGenesisCreateTestNetData era envCli =
+  fmap GenesisCreateTestNetData $ GenesisCreateTestNetDataCmdArgs era
+    <$> optional (pSpecFile "shelley")
+    <*> optional (pSpecFile "alonzo")
+    <*> optional (pSpecFile "conway")
     <*> pNumGenesisKeys
     <*> pNumPools
     <*> pNumStakeDelegs
@@ -223,15 +221,15 @@ pGenesisCreateTestNetData envCli =
     <*> pNumUtxoKeys
     <*> pSupply
     <*> pSupplyDelegated
-    <*> (optional $ pNetworkIdForTestnetData envCli)
+    <*> optional (pNetworkIdForTestnetData envCli)
     <*> Opt.optional pRelays
     <*> pMaybeSystemStart
     <*> pOutputDir
   where
-    pSpecFile era = Opt.strOption $ mconcat
-      [ Opt.long $ "spec-" <> era
+    pSpecFile eraStr = Opt.strOption $ mconcat
+      [ Opt.long $ "spec-" <> eraStr
       , Opt.metavar "FILE"
-      , Opt.help $ "The " <> era <> " specification file to use as input. A default one is generated if omitted."
+      , Opt.help $ "The " <> eraStr <> " specification file to use as input. A default one is generated if omitted."
       ]
     pNumGenesisKeys = Opt.option Opt.auto $ mconcat
       [ Opt.long "genesis-keys"
@@ -255,7 +253,7 @@ pGenesisCreateTestNetData envCli =
         pDReps :: CredentialGenerationMode -> String -> String -> Parser DRepCredentials
         pDReps mode modeOptionName modeExplanation =
           DRepCredentials mode <$>
-              (Opt.option Opt.auto $ mconcat
+              Opt.option Opt.auto (mconcat
                  [ Opt.long modeOptionName
                  , Opt.help $ "The number of DRep credentials to make (default is 0). " <> modeExplanation
                  , Opt.metavar "INT", Opt.value 0
@@ -268,7 +266,7 @@ pGenesisCreateTestNetData envCli =
         pStakeDelegators :: CredentialGenerationMode -> String -> String -> Parser StakeDelegators
         pStakeDelegators mode modeOptionName modeExplanation =
           StakeDelegators mode <$>
-              (Opt.option Opt.auto $ mconcat
+              Opt.option Opt.auto (mconcat
                  [ Opt.long modeOptionName
                  , Opt.help $ "The number of stake delegator credential sets to make (default is 0). " <> modeExplanation
                  , Opt.metavar "INT", Opt.value 0

cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs

@@ -12,19 +12,16 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
-{- HLINT ignore "Redundant <$>" -}
-{- HLINT ignore "Use let" -}
-
 module Cardano.CLI.EraBased.Run.CreateTestnetData
   ( genStuffedAddress
-    , getCurrentTimePlus30
-    , readRelays
-    , readAndDecodeGenesisFile
-    , runGenesisKeyGenUTxOCmd
-    , runGenesisKeyGenGenesisCmd
-    , runGenesisKeyGenDelegateCmd
-    , runGenesisCreateTestNetDataCmd
-    , runGenesisKeyGenDelegateVRF
+  , getCurrentTimePlus30
+  , readRelays
+  , readAndDecodeGenesisFile
+  , runGenesisKeyGenUTxOCmd
+  , runGenesisKeyGenGenesisCmd
+  , runGenesisKeyGenDelegateCmd
+  , runGenesisCreateTestNetDataCmd
+  , runGenesisKeyGenDelegateVRF
   ) where
 
 import           Cardano.Api hiding (ConwayEra)
@@ -36,8 +33,8 @@ import           Cardano.Api.Shelley (Address (ShelleyAddress),
                    OperationalCertificateIssueCounter (OperationalCertificateIssueCounter),
                    ShelleyGenesis (ShelleyGenesis, sgGenDelegs, sgInitialFunds, sgMaxLovelaceSupply, sgNetworkMagic, sgProtocolParams, sgStaking, sgSystemStart),
                    StakeCredential (StakeCredentialByKey), VerificationKey (VrfVerificationKey),
-                   VrfKey, alonzoGenesisDefaults, conwayGenesisDefaults, shelleyGenesisDefaults,
-                   toShelleyAddr, toShelleyNetwork, toShelleyStakeAddr)
+                   VrfKey, alonzoGenesisDefaults, conwayGenesisDefaults, decodeAlonzoGenesis,
+                   shelleyGenesisDefaults, toShelleyAddr, toShelleyNetwork, toShelleyStakeAddr)
 
 import           Cardano.CLI.EraBased.Commands.Genesis as Cmd
 import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as DRep
@@ -176,10 +173,11 @@ runGenesisKeyGenUTxOCmd
     vkeyDesc = "Genesis Initial UTxO Verification Key"
 
 runGenesisCreateTestNetDataCmd
-  :: GenesisCreateTestNetDataCmdArgs
+  :: GenesisCreateTestNetDataCmdArgs era
   -> ExceptT GenesisCmdError IO ()
 runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
-  { networkId
+  { eon = era
+  , networkId
   , specShelley
   , specAlonzo
   , specConway
@@ -195,13 +193,14 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
   , numUtxoKeys
   , totalSupply
   , delegatedSupply
-   , relays
+  , relays
   , systemStart
   , outputDir
   } = do
   liftIO $ createDirectoryIfMissing False outputDir
   shelleyGenesisInit <- maybeReadAndDecodeGenesisFileSpec specShelley shelleyGenesisDefaults
-  alonzoGenesis <- maybeReadAndDecodeGenesisFileSpec specAlonzo alonzoGenesisDefaults
+  alonzoGenesis <- fromMaybe (alonzoGenesisDefaults era) <$>
+    traverse (readAndDecodeGenesisFileWith (runExcept . decodeAlonzoGenesis (Just era))) specAlonzo
   conwayGenesis <- maybeReadAndDecodeGenesisFileSpec specConway conwayGenesisDefaults
 
   -- Read NetworkId either from file or from the flag. Flag overrides template file.
@@ -418,13 +417,10 @@ mkPaths numKeys dir segment filename =
             | idx <- [1 .. numKeys]]
 
 genStuffedAddress :: L.Network -> IO (AddressInEra ShelleyEra)
-genStuffedAddress network =
-  shelleyAddressInEra ShelleyBasedEraShelley <$>
-  (ShelleyAddress
-   <$> pure network
-   <*> (L.KeyHashObj . mkKeyHash . read64BitInt
-         <$> Crypto.runSecureRandom (getRandomBytes 8))
-   <*> pure L.StakeRefNull)
+genStuffedAddress network = do
+  paymentCredential <- L.KeyHashObj . mkKeyHash . read64BitInt <$> Crypto.runSecureRandom (getRandomBytes 8)
+  pure . shelleyAddressInEra ShelleyBasedEraShelley $
+    ShelleyAddress network paymentCredential L.StakeRefNull
    where
     read64BitInt :: ByteString -> Int
     read64BitInt = (fromIntegral :: Word64 -> Int)
@@ -679,19 +675,18 @@ updateOutputTemplate
     unLovelace (L.Coin coin) = fromIntegral coin
 
 maybeReadAndDecodeGenesisFileSpec :: (FromJSON a) => Maybe FilePath -> a -> ExceptT GenesisCmdError IO a
-maybeReadAndDecodeGenesisFileSpec spec defaultSpec =
-  case spec of
-    Just specPath ->
-      newExceptT $ readAndDecodeGenesisFile specPath
-    Nothing ->
-      -- No template given: a default file is created
-      pure defaultSpec
-
-readAndDecodeGenesisFile :: (FromJSON a) => FilePath -> IO (Either GenesisCmdError a)
-readAndDecodeGenesisFile fpath = runExceptT $ do
+maybeReadAndDecodeGenesisFileSpec mSpecFile defaultSpec =
+  fromMaybe defaultSpec <$>
+    traverse readAndDecodeGenesisFile mSpecFile
+
+readAndDecodeGenesisFile :: (FromJSON a) => FilePath -> ExceptT GenesisCmdError IO a
+readAndDecodeGenesisFile = readAndDecodeGenesisFileWith Aeson.eitherDecode
+
+readAndDecodeGenesisFileWith :: (LBS.ByteString -> Either String a) -> FilePath -> ExceptT GenesisCmdError IO a
+readAndDecodeGenesisFileWith decode' fpath = do
   lbs <- handleIOExceptT (GenesisCmdGenesisFileReadError . FileIOError fpath) $ LBS.readFile fpath
   firstExceptT (GenesisCmdGenesisFileDecodeError fpath . Text.pack)
-    . hoistEither $ Aeson.eitherDecode' lbs
+    . hoistEither $ decode' lbs
 
 -- @readRelays fp@ reads the relays specification from a file
 readRelays :: ()
@@ -705,7 +700,7 @@ readRelays fp = do
     . hoistEither $ Aeson.eitherDecode relaySpecJsonBs
 
 -- | Current UTCTime plus 30 seconds
-getCurrentTimePlus30 :: ExceptT a IO UTCTime
+getCurrentTimePlus30 :: MonadIO m => m UTCTime
 getCurrentTimePlus30 =
     plus30sec <$> liftIO getCurrentTime
   where

cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs

@@ -6,20 +6,14 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-
-{- HLINT ignore "Replace case with maybe" -}
-{- HLINT ignore "Reduce duplication" -}
-{- HLINT ignore "Redundant <$>" -}
-{- HLINT ignore "Use let" -}
 
 module Cardano.CLI.EraBased.Run.Genesis
   ( runGenesisCmds
@@ -75,6 +69,7 @@ import           Cardano.Slotting.Slot (EpochSize (EpochSize))
 import           Ouroboros.Consensus.Shelley.Node (ShelleyGenesisStaking (..))
 
 import           Control.DeepSeq (NFData, force)
+import           Control.Exception (evaluate)
 import           Control.Monad (forM, forM_, unless, when)
 import           Data.Aeson hiding (Key)
 import qualified Data.Aeson as Aeson
@@ -85,7 +80,6 @@ import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import           Data.Char (isDigit)
-import           Data.Either (fromRight)
 import           Data.Fixed (Fixed (MkFixed))
 import           Data.Function (on)
 import           Data.Functor (void)
@@ -401,15 +395,15 @@ runGenesisCreateCardanoCmd
     overrideShelleyGenesis t = t
       { sgNetworkMagic = unNetworkMagic (toNetworkMagic network)
       , sgNetworkId = toShelleyNetwork network
-      , sgActiveSlotsCoeff = fromMaybe (error $ "Could not convert from Rational: " ++ show slotCoeff) $ L.boundRational slotCoeff
+      , sgActiveSlotsCoeff = unsafeBoundedRational slotCoeff
       , sgSecurityParam = unBlockCount security
       , sgUpdateQuorum = fromIntegral $ ((numGenesisKeys `div` 3) * 2) + 1
       , sgEpochLength = EpochSize $ floor $ (fromIntegral (unBlockCount security) * 10) / slotCoeff
       , sgMaxLovelaceSupply = 45_000_000_000_000_000
       , sgSystemStart = getSystemStart start
-      , sgSlotLength = L.secondsToNominalDiffTimeMicro $ MkFixed (fromIntegral slotLength) * 1000
+      , sgSlotLength = L.secondsToNominalDiffTimeMicro $ MkFixed (fromIntegral slotLength) * 1_000
       }
-  shelleyGenesisTemplate' <- liftIO $ overrideShelleyGenesis . fromRight (error "shelley genesis template not found") <$> TN.readAndDecodeGenesisFile shelleyGenesisTemplate
+  shelleyGenesisTemplate' <- overrideShelleyGenesis <$> TN.readAndDecodeGenesisFile shelleyGenesisTemplate
   alonzoGenesis <- readAlonzoGenesis alonzoGenesisTemplate
   conwayGenesis <- readConwayGenesis conwayGenesisTemplate
   (delegateMap, vrfKeys, kesKeys, opCerts) <- liftIO $ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys
@@ -883,13 +877,13 @@ computeInsecureDelegation g0 nw pool = do
     let stakeAddressReference = StakeAddressByValue . StakeCredentialByKey . verificationKeyHash $ stakeVK
     let initialUtxoAddr = makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash paymentVK)) stakeAddressReference
 
-    delegation <- pure $ force Delegation
-      { dInitialUtxoAddr = shelleyAddressInEra ShelleyBasedEraShelley initialUtxoAddr
-      , dDelegStaking = L.hashKey (unStakeVerificationKey stakeVK)
-      , dPoolParams = pool
-      }
+        delegation = Delegation
+          { dInitialUtxoAddr = shelleyAddressInEra ShelleyBasedEraShelley initialUtxoAddr
+          , dDelegStaking = L.hashKey (unStakeVerificationKey stakeVK)
+          , dPoolParams = pool
+          }
 
-    pure (g2, delegation)
+    evaluate . force $ (g2, delegation)
 
 -- | Attempts to read Shelley genesis from disk
 -- and if not found creates a default Shelley genesis.
@@ -898,7 +892,7 @@ readShelleyGenesisWithDefault
   -> (ShelleyGenesis L.StandardCrypto -> ShelleyGenesis L.StandardCrypto)
   -> ExceptT GenesisCmdError IO (ShelleyGenesis L.StandardCrypto)
 readShelleyGenesisWithDefault fpath adjustDefaults = do
-    newExceptT (TN.readAndDecodeGenesisFile fpath)
+    TN.readAndDecodeGenesisFile fpath
       `catchError` \err ->
         case err of
           GenesisCmdGenesisFileReadError (FileIOError _ ioe)

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs

@@ -163,11 +163,8 @@ runGovernanceDRepMetadataHashCmd
       { metadataFile
       , mOutFile
       } = do
-  metadataBytes <- firstExceptT ReadFileError $ newExceptT (readByteStringFile metadataFile)
-  (_metadata, metadataHash) <-
-    firstExceptT GovernanceCmdDRepMetadataValidationError
-     . hoistEither
-     $ validateAndHashDRepMetadata metadataBytes
+  metadataBytes <- firstExceptT ReadFileError . newExceptT $ readByteStringFile metadataFile
+  let (_metadata, metadataHash) = hashDRepMetadata metadataBytes
   firstExceptT WriteFileError
     . newExceptT
     . writeByteStringOutput mOutFile

cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs

@@ -173,8 +173,8 @@ runQueryProtocolParametersCmd
   AnyCardanoEra era <- firstExceptT QueryCmdAcquireFailure $ determineEra localNodeConnInfo
   sbe <- forEraInEon @ShelleyBasedEra era (left QueryCmdByronEra) pure
   let qInMode = QueryInEra $ QueryInShelleyBasedEra sbe Api.QueryProtocolParameters
-  pp <- firstExceptT QueryCmdConvenienceError
-          $ executeQueryAnyMode localNodeConnInfo qInMode
+  pp <- executeQueryAnyMode localNodeConnInfo qInMode
+          & modifyError QueryCmdConvenienceError
   writeProtocolParameters sbe mOutFile pp
   where
     writeProtocolParameters
@@ -654,7 +654,8 @@ runQueryTxMempoolCmd
 
   localQuery <- case query of
       TxMempoolQueryTxExists tx -> do
-        AnyCardanoEra era <- modifyError QueryCmdAcquireFailure (determineEra localNodeConnInfo)
+        AnyCardanoEra era <- determineEra localNodeConnInfo
+          & modifyError QueryCmdAcquireFailure
         pure $ LocalTxMonitoringQueryTx $ TxIdInMode era tx
       TxMempoolQueryNextTx -> pure LocalTxMonitoringSendNextTx
       TxMempoolQueryInfo -> pure LocalTxMonitoringMempoolInformation
@@ -1293,7 +1294,7 @@ runQueryLeadershipScheduleCmd
   vrkSkey <- modifyError QueryCmdTextEnvelopeReadError . hoistIOEither $
     readFileTextEnvelope (AsSigningKey AsVrfKey) vrkSkeyFp
 
-  shelleyGenesis <- modifyError QueryCmdGenesisReadError . hoistIOEither $
+  shelleyGenesis <- modifyError QueryCmdGenesisReadError $
     readAndDecodeGenesisFile @(ShelleyGenesis StandardCrypto) genFile
 
   join $ lift

cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs

@@ -50,7 +50,6 @@ data GovernanceCmdError
   | GovernanceCmdDecoderError !DecoderError
   | GovernanceCmdVerifyPollError !GovernancePollError
   | GovernanceCmdWriteFileError !(FileError ())
-  | GovernanceCmdDRepMetadataValidationError !DRepMetadataValidationError
   -- Legacy - remove me after cardano-cli transitions to new era based structure
   | GovernanceCmdMIRCertNotSupportedInConway
   | GovernanceCmdGenesisDelegationNotSupportedInConway
@@ -108,8 +107,6 @@ instance Error GovernanceCmdError where
       pretty $ renderGovernancePollError pollError
     GovernanceCmdWriteFileError fileError ->
       "Cannot write file: " <> prettyError fileError
-    GovernanceCmdDRepMetadataValidationError e ->
-      "DRep metadata validation error: " <> prettyError e
     GovernanceCmdMIRCertNotSupportedInConway ->
       "MIR certificates are not supported in Conway era onwards."
     GovernanceCmdGenesisDelegationNotSupportedInConway ->