From 3de04f4e87d9e10ccf5af2a97098a92d8ab7ce35 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 12 Jul 2024 15:20:50 +0200 Subject: [PATCH] reorganized and stubbed eras --- cardano-cli/cardano-cli.cabal | 3 +- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 7 +- .../Cardano/CLI/EraBased/Options/Genesis.hs | 8 +- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 58 +++---- .../CLI/EraBased/Run/Genesis/Common.hs | 156 ++++++++++++++++++ .../Run/{ => Genesis}/CreateTestnetData.hs | 66 +------- .../src/Cardano/CLI/EraBased/Run/Query.hs | 4 +- .../src/Cardano/CLI/Legacy/Run/Genesis.hs | 5 +- .../CLI/Types/Errors/GenesisCmdError.hs | 34 ++-- 9 files changed, 213 insertions(+), 128 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/Common.hs rename cardano-cli/src/Cardano/CLI/EraBased/Run/{ => Genesis}/CreateTestnetData.hs (92%) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index b1a1fe106f..f3c826204c 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -96,8 +96,9 @@ library Cardano.CLI.EraBased.Run Cardano.CLI.EraBased.Run.Address Cardano.CLI.EraBased.Run.Address.Info - Cardano.CLI.EraBased.Run.CreateTestnetData Cardano.CLI.EraBased.Run.Genesis + Cardano.CLI.EraBased.Run.Genesis.Common + Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData Cardano.CLI.EraBased.Run.Governance Cardano.CLI.EraBased.Run.Governance.Actions Cardano.CLI.EraBased.Run.Governance.Committee diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index bd4858cb19..7cb2efac9f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -28,7 +28,7 @@ import Data.Text (Text) data GenesisCmds era = GenesisCreate !GenesisCreateCmdArgs | GenesisCreateCardano !GenesisCreateCardanoCmdArgs - | GenesisCreateStaked !GenesisCreateStakedCmdArgs + | GenesisCreateStaked !(GenesisCreateStakedCmdArgs era) | GenesisCreateTestNetData !(GenesisCreateTestNetDataCmdArgs era) | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs | GenesisKeyGenDelegate !GenesisKeyGenDelegateCmdArgs @@ -67,8 +67,9 @@ data GenesisCreateCardanoCmdArgs = GenesisCreateCardanoCmdArgs , mNodeConfigTemplate :: !(Maybe FilePath) } deriving Show -data GenesisCreateStakedCmdArgs = GenesisCreateStakedCmdArgs - { keyOutputFormat :: !KeyOutputFormat +data GenesisCreateStakedCmdArgs era = GenesisCreateStakedCmdArgs + { eon :: !(CardanoEra era) + , keyOutputFormat :: !KeyOutputFormat , genesisDir :: !GenesisDir , numGenesisKeys :: !Word , numUTxOKeys :: !Word diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index 5ae1be60f7..9324e88a23 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -80,7 +80,7 @@ pGenesisCmds era envCli = ] , Just $ subParser "create-staked" - $ Opt.info (pGenesisCreateStaked envCli) + $ Opt.info (pGenesisCreateStaked era envCli) $ Opt.progDesc $ mconcat [ "Create a staked Shelley genesis file from a genesis " @@ -180,9 +180,9 @@ pGenesisCreate envCli = <*> pInitialSupplyNonDelegated <*> pNetworkId envCli -pGenesisCreateStaked :: EnvCli -> Parser (GenesisCmds era) -pGenesisCreateStaked envCli = - fmap GenesisCreateStaked $ GenesisCreateStakedCmdArgs +pGenesisCreateStaked :: CardanoEra era -> EnvCli -> Parser (GenesisCmds era) +pGenesisCreateStaked era envCli = + fmap GenesisCreateStaked $ GenesisCreateStakedCmdArgs era <$> pKeyOutputFormat <*> pGenesisDir <*> pGenesisNumGenesisKeys diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 2af1581217..fa49e3d8c5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -50,7 +50,8 @@ import Cardano.CLI.Byron.Genesis as Byron import qualified Cardano.CLI.Byron.Key as Byron import Cardano.CLI.EraBased.Commands.Genesis as Cmd import qualified Cardano.CLI.EraBased.Commands.Node as Cmd -import qualified Cardano.CLI.EraBased.Run.CreateTestnetData as TN +import Cardano.CLI.EraBased.Run.Genesis.Common +import qualified Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData as TN import Cardano.CLI.EraBased.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd, runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd) import Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd) @@ -250,8 +251,8 @@ runGenesisCreateCmd createDirectoryIfMissing False utxodir template <- readShelleyGenesisWithDefault (rootdir "genesis.spec.json") adjustTemplate - alonzoGenesis <- readAlonzoGenesis (rootdir "genesis.alonzo.spec.json") - conwayGenesis <- readConwayGenesis (rootdir "genesis.conway.spec.json") + alonzoGenesis <- decodeAlonzoGenesisFile undefined $ rootdir "genesis.alonzo.spec.json" -- FIXME!!! + conwayGenesis <- decodeConwayGenesisFile $ rootdir "genesis.conway.spec.json" forM_ [ 1 .. numGenesisKeys ] $ \index -> do createGenesisKeys gendir index @@ -262,7 +263,7 @@ runGenesisCreateCmd genDlgs <- readGenDelegsMap gendir deldir utxoAddrs <- readInitialFundAddresses utxodir network - start <- maybe (SystemStart <$> TN.getCurrentTimePlus30) pure mSystemStart + start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart let shelleyGenesis = updateTemplate @@ -364,7 +365,7 @@ runGenesisCreateCardanoCmd , Cmd.conwayGenesisTemplate , Cmd.mNodeConfigTemplate } = do - start <- maybe (SystemStart <$> TN.getCurrentTimePlus30) pure mSystemStart + start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart (byronGenesis', byronSecrets) <- convertToShelleyError $ Byron.mkGenesis $ byronParams start let byronGenesis = byronGenesis' @@ -403,9 +404,9 @@ runGenesisCreateCardanoCmd , sgSystemStart = getSystemStart start , sgSlotLength = L.secondsToNominalDiffTimeMicro $ MkFixed (fromIntegral slotLength) * 1_000 } - shelleyGenesisTemplate' <- overrideShelleyGenesis <$> TN.readAndDecodeGenesisFile shelleyGenesisTemplate - alonzoGenesis <- readAlonzoGenesis alonzoGenesisTemplate - conwayGenesis <- readConwayGenesis conwayGenesisTemplate + shelleyGenesisTemplate' <- overrideShelleyGenesis <$> decodeShelleyGenesisFile shelleyGenesisTemplate + alonzoGenesis <- decodeAlonzoGenesisFile undefined alonzoGenesisTemplate -- FIXME!!! + conwayGenesis <- decodeConwayGenesisFile conwayGenesisTemplate (delegateMap, vrfKeys, kesKeys, opCerts) <- liftIO $ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys let shelleyGenesis :: ShelleyGenesis L.StandardCrypto @@ -510,11 +511,12 @@ runGenesisCreateCardanoCmd dlgCertMap byronGenesis = Genesis.unGenesisDelegation $ Genesis.gdHeavyDelegation byronGenesis runGenesisCreateStakedCmd - :: GenesisCreateStakedCmdArgs + :: GenesisCreateStakedCmdArgs era -> ExceptT GenesisCmdError IO () runGenesisCreateStakedCmd Cmd.GenesisCreateStakedCmdArgs - { Cmd.keyOutputFormat + { eon = era + , Cmd.keyOutputFormat , Cmd.genesisDir , Cmd.numGenesisKeys , Cmd.numUTxOKeys @@ -545,8 +547,8 @@ runGenesisCreateStakedCmd createDirectoryIfMissing False utxodir template <- readShelleyGenesisWithDefault (rootdir "genesis.spec.json") adjustTemplate - alonzoGenesis <- readAlonzoGenesis (rootdir "genesis.alonzo.spec.json") - conwayGenesis <- readConwayGenesis (rootdir "genesis.conway.spec.json") + alonzoGenesis <- decodeAlonzoGenesisFile (Just era) $ rootdir "genesis.alonzo.spec.json" + conwayGenesis <- decodeConwayGenesisFile $ rootdir "genesis.conway.spec.json" forM_ [ 1 .. numGenesisKeys ] $ \index -> do createGenesisKeys gendir index @@ -555,11 +557,11 @@ runGenesisCreateStakedCmd forM_ [ 1 .. numUTxOKeys ] $ \index -> createUtxoKeys utxodir index - mayStakePoolRelays <- forM mStakePoolRelaySpecFile TN.readRelays + mStakePoolRelays <- forM mStakePoolRelaySpecFile readRelays poolParams <- forM [ 1 .. numPools ] $ \index -> do createPoolCredentials keyOutputFormat pooldir index - buildPoolParams networkId pooldir (Just index) (fromMaybe mempty mayStakePoolRelays) + buildPoolParams networkId pooldir (Just index) (fromMaybe mempty mStakePoolRelays) when (numBulkPoolCredFiles * numBulkPoolsPerFile > numPools) $ left $ GenesisCmdTooFewPoolsForBulkCreds numPools numBulkPoolCredFiles numBulkPoolsPerFile @@ -590,10 +592,10 @@ runGenesisCreateStakedCmd genDlgs <- readGenDelegsMap gendir deldir nonDelegAddrs <- readInitialFundAddresses utxodir networkId - start <- maybe (SystemStart <$> TN.getCurrentTimePlus30) pure mSystemStart + start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart let network = toShelleyNetwork networkId - stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ TN.genStuffedAddress network + stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ genStuffedAddress network let stake = second L.ppId . mkDelegationMapEntry <$> delegations stakePools = [ (L.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ] @@ -860,7 +862,7 @@ writeBulkPoolCredentials dir bulkIx poolIxs = do readEnvelope fp = do content <- handleIOExceptT (GenesisCmdFileError . FileIOError fp) $ BS.readFile fp - firstExceptT (GenesisCmdAesonDecodeError fp . Text.pack) . hoistEither $ + firstExceptT (GenesisCmdFileDecodeError fp . Text.pack) . hoistEither $ Aeson.eitherDecodeStrict' content -- | This function should only be used for testing purposes. @@ -875,7 +877,7 @@ computeInsecureDelegation g0 nw pool = do (stakeVK , g2) <- first getVerificationKey <$> generateInsecureSigningKey g1 AsStakeKey let stakeAddressReference = StakeAddressByValue . StakeCredentialByKey . verificationKeyHash $ stakeVK - let initialUtxoAddr = makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash paymentVK)) stakeAddressReference + initialUtxoAddr = makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash paymentVK)) stakeAddressReference delegation = Delegation { dInitialUtxoAddr = shelleyAddressInEra ShelleyBasedEraShelley initialUtxoAddr @@ -892,10 +894,10 @@ readShelleyGenesisWithDefault -> (ShelleyGenesis L.StandardCrypto -> ShelleyGenesis L.StandardCrypto) -> ExceptT GenesisCmdError IO (ShelleyGenesis L.StandardCrypto) readShelleyGenesisWithDefault fpath adjustDefaults = do - TN.readAndDecodeGenesisFile fpath + decodeShelleyGenesisFile fpath `catchError` \err -> case err of - GenesisCmdGenesisFileReadError (FileIOError _ ioe) + GenesisCmdGenesisFileError (FileIOError _ ioe) | isDoesNotExistError ioe -> writeDefault _ -> left err where @@ -1150,22 +1152,6 @@ runGenesisHashFileCmd (GenesisFile fpath) = do gh = Crypto.hashWith id content liftIO $ Text.putStrLn (Crypto.hashToTextAsHex gh) -readAlonzoGenesis - :: FilePath - -> ExceptT GenesisCmdError IO L.AlonzoGenesis -readAlonzoGenesis fpath = do - lbs <- handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (GenesisCmdAesonDecodeError fpath . Text.pack) - . hoistEither $ Aeson.eitherDecode' lbs - -readConwayGenesis - :: FilePath - -> ExceptT GenesisCmdError IO (L.ConwayGenesis L.StandardCrypto) -readConwayGenesis fpath = do - lbs <- handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (GenesisCmdAesonDecodeError fpath . Text.pack) - . hoistEither $ Aeson.eitherDecode' lbs - -- Protocol Parameters --TODO: eliminate this and get only the necessary params, and get them in a more diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/Common.hs new file mode 100644 index 0000000000..c8152262f0 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/Common.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +module Cardano.CLI.EraBased.Run.Genesis.Common + ( decodeShelleyGenesisFile + , decodeAlonzoGenesisFile + , decodeConwayGenesisFile + , readAndDecodeGenesisFileWith + , genStuffedAddress + , getCurrentTimePlus30 + , readRelays + ) where + +import Cardano.Api hiding (ConwayEra) +import Cardano.Api.Ledger (StrictMaybe (SNothing), StandardCrypto, AlonzoGenesis, ConwayGenesis) +import qualified Cardano.Api.Ledger as L +import Cardano.Api.Shelley (Address (ShelleyAddress), + Hash (DRepKeyHash, GenesisDelegateKeyHash, GenesisKeyHash, StakeKeyHash, VrfKeyHash), + KESPeriod (KESPeriod), + OperationalCertificateIssueCounter (OperationalCertificateIssueCounter), + ShelleyGenesis (ShelleyGenesis, sgGenDelegs, sgInitialFunds, sgMaxLovelaceSupply, sgNetworkMagic, sgProtocolParams, sgStaking, sgSystemStart), + StakeCredential (StakeCredentialByKey), VerificationKey (VrfVerificationKey), + 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 +import qualified Cardano.CLI.EraBased.Commands.Node as Cmd +import Cardano.CLI.EraBased.Run.Address (generateAndWriteKeyFiles) +import qualified Cardano.CLI.EraBased.Run.Governance.DRep as DRep +import qualified Cardano.CLI.EraBased.Run.Key as Key +import Cardano.CLI.EraBased.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd, + runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd) +import Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd) +import qualified Cardano.CLI.IO.Lazy as Lazy +import Cardano.CLI.Types.Common +import Cardano.CLI.Types.Errors.GenesisCmdError +import Cardano.CLI.Types.Errors.NodeCmdError +import Cardano.CLI.Types.Errors.StakePoolCmdError +import Cardano.CLI.Types.Key +import Cardano.Crypto.Hash (HashAlgorithm) +import qualified Cardano.Crypto.Hash as Hash +import qualified Cardano.Crypto.Random as Crypto +import Ouroboros.Consensus.Shelley.Node (ShelleyGenesisStaking (..)) + +import Control.DeepSeq (NFData, deepseq) +import Control.Monad (forM, forM_, unless, void, when) +import qualified Data.Aeson as Aeson +import Data.Bifunctor (Bifunctor (..)) +import qualified Data.Binary.Get as Bin +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.Coerce (coerce) +import Data.Data (Proxy (..)) +import Data.ListMap (ListMap (..)) +import qualified Data.ListMap as ListMap +import Data.Map.Strict (Map, fromList, toList) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe) +import qualified Data.Sequence.Strict as Seq +import Data.String (fromString) +import qualified Data.Text as Text +import Data.Time (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime) +import Data.Tuple (swap) +import Data.Word (Word64) +import GHC.Generics (Generic) +import GHC.Num (Natural) +import Lens.Micro ((^.)) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (()) +import qualified System.Random as Random +import System.Random (StdGen) + +import Crypto.Random (getRandomBytes) + + +decodeShelleyGenesisFile + :: MonadIOTransError GenesisCmdError t m + => FilePath + -> t m (ShelleyGenesis StandardCrypto) +decodeShelleyGenesisFile = readAndDecodeGenesisFile + +decodeAlonzoGenesisFile + :: MonadIOTransError GenesisCmdError t m + => Maybe (CardanoEra era) + -> FilePath + -> t m AlonzoGenesis +decodeAlonzoGenesisFile mEra = readAndDecodeGenesisFileWith (runExcept . decodeAlonzoGenesis mEra) + +decodeConwayGenesisFile + :: MonadIOTransError GenesisCmdError t m + => FilePath + -> t m (ConwayGenesis StandardCrypto) +decodeConwayGenesisFile = readAndDecodeGenesisFile + +readAndDecodeGenesisFile + :: MonadIOTransError GenesisCmdError t m + => FromJSON a => FilePath -> t m a +readAndDecodeGenesisFile = readAndDecodeGenesisFileWith Aeson.eitherDecode + +readAndDecodeGenesisFileWith + :: MonadIOTransError GenesisCmdError t m + => (LBS.ByteString -> Either String a) -> FilePath -> t m a +readAndDecodeGenesisFileWith decode' fpath = do + lbs <- handleIOExceptionsLiftWith (GenesisCmdGenesisFileError . FileIOError fpath) . liftIO $ LBS.readFile fpath + modifyError (GenesisCmdGenesisFileDecodeError fpath . Text.pack) + . hoistEither $ decode' lbs + +genStuffedAddress :: L.Network -> IO (AddressInEra ShelleyEra) +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) + . Bin.runGet Bin.getWord64le . LBS.fromStrict + + mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash.Hash h a + mkDummyHash _ = coerce . L.hashWithSerialiser @h L.toCBOR + + mkKeyHash :: forall c discriminator. L.Crypto c => Int -> L.KeyHash discriminator c + mkKeyHash = L.KeyHash . mkDummyHash (Proxy @(L.ADDRHASH c)) + + +-- | Current UTCTime plus 30 seconds +getCurrentTimePlus30 :: MonadIO m => m UTCTime +getCurrentTimePlus30 = + plus30sec <$> liftIO getCurrentTime + where + plus30sec :: UTCTime -> UTCTime + plus30sec = addUTCTime (30 :: NominalDiffTime) + + +-- @readRelays fp@ reads the relays specification from a file +readRelays :: () + => MonadIO m + => FilePath -- ^ The file to read from + -> ExceptT GenesisCmdError m (Map Word [L.StakePoolRelay]) +readRelays fp = do + relaySpecJsonBs <- + handleIOExceptT (GenesisCmdStakePoolRelayFileError fp) (LBS.readFile fp) + firstExceptT (GenesisCmdStakePoolRelayJsonDecodeError fp) + . hoistEither $ Aeson.eitherDecode relaySpecJsonBs diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs similarity index 92% rename from cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs rename to cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs index 3be044f9bf..1ca6add355 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs @@ -12,12 +12,8 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -module Cardano.CLI.EraBased.Run.CreateTestnetData - ( genStuffedAddress - , getCurrentTimePlus30 - , readRelays - , readAndDecodeGenesisFile - , runGenesisKeyGenUTxOCmd +module Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData + ( runGenesisKeyGenUTxOCmd , runGenesisKeyGenGenesisCmd , runGenesisKeyGenDelegateCmd , runGenesisCreateTestNetDataCmd @@ -85,6 +81,7 @@ import qualified System.Random as Random import System.Random (StdGen) import Crypto.Random (getRandomBytes) +import Cardano.CLI.EraBased.Run.Genesis.Common runGenesisKeyGenGenesisCmd :: GenesisKeyGenGenesisCmdArgs @@ -103,7 +100,6 @@ runGenesisKeyGenGenesisCmd skeyDesc :: TextEnvelopeDescr skeyDesc = "Genesis Signing Key" - runGenesisKeyGenDelegateCmd :: GenesisKeyGenDelegateCmdArgs -> ExceptT GenesisCmdError IO () @@ -198,10 +194,9 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs , outputDir } = do liftIO $ createDirectoryIfMissing False outputDir - shelleyGenesisInit <- maybeReadAndDecodeGenesisFileSpec specShelley shelleyGenesisDefaults - alonzoGenesis <- fromMaybe (alonzoGenesisDefaults era) <$> - traverse (readAndDecodeGenesisFileWith (runExcept . decodeAlonzoGenesis (Just era))) specAlonzo - conwayGenesis <- maybeReadAndDecodeGenesisFileSpec specConway conwayGenesisDefaults + shelleyGenesisInit <- fromMaybe shelleyGenesisDefaults <$> traverse decodeShelleyGenesisFile specShelley + alonzoGenesis <- fromMaybe (alonzoGenesisDefaults era) <$> traverse (decodeAlonzoGenesisFile (Just era)) specAlonzo + conwayGenesis <- fromMaybe conwayGenesisDefaults <$> traverse decodeConwayGenesisFile specConway -- Read NetworkId either from file or from the flag. Flag overrides template file. let actualNetworkId = @@ -416,22 +411,6 @@ mkPaths numKeys dir segment filename = fromList [(fromIntegral idx, dir (segment <> show idx) filename) | idx <- [1 .. numKeys]] -genStuffedAddress :: L.Network -> IO (AddressInEra ShelleyEra) -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) - . Bin.runGet Bin.getWord64le . LBS.fromStrict - - mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash.Hash h a - mkDummyHash _ = coerce . L.hashWithSerialiser @h L.toCBOR - - mkKeyHash :: forall c discriminator. L.Crypto c => Int -> L.KeyHash discriminator c - mkKeyHash = L.KeyHash . mkDummyHash (Proxy @(L.ADDRHASH c)) - createDelegateKeys :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO () createDelegateKeys fmt dir = do liftIO $ createDirectoryIfMissing True dir @@ -674,39 +653,6 @@ updateOutputTemplate unLovelace :: Integral a => L.Coin -> a unLovelace (L.Coin coin) = fromIntegral coin -maybeReadAndDecodeGenesisFileSpec :: (FromJSON a) => Maybe FilePath -> a -> ExceptT GenesisCmdError IO a -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 $ decode' lbs - --- @readRelays fp@ reads the relays specification from a file -readRelays :: () - => MonadIO m - => FilePath -- ^ The file to read from - -> ExceptT GenesisCmdError m (Map Word [L.StakePoolRelay]) -readRelays fp = do - relaySpecJsonBs <- - handleIOExceptT (GenesisCmdStakePoolRelayFileError fp) (LBS.readFile fp) - firstExceptT (GenesisCmdStakePoolRelayJsonDecodeError fp) - . hoistEither $ Aeson.eitherDecode relaySpecJsonBs - --- | Current UTCTime plus 30 seconds -getCurrentTimePlus30 :: MonadIO m => m UTCTime -getCurrentTimePlus30 = - plus30sec <$> liftIO getCurrentTime - where - plus30sec :: UTCTime -> UTCTime - plus30sec = addUTCTime (30 :: NominalDiffTime) - readGenDelegsMap :: Map Int FilePath -> Map Int FilePath -> Map Int FilePath diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index 114bb6ccf9..af9013b76b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -47,7 +47,7 @@ import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) import qualified Cardano.CLI.EraBased.Commands.Query as Cmd -import Cardano.CLI.EraBased.Run.CreateTestnetData (readAndDecodeGenesisFile) +import Cardano.CLI.EraBased.Run.Genesis.Common import Cardano.CLI.Helpers import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.NodeEraMismatchError @@ -1295,7 +1295,7 @@ runQueryLeadershipScheduleCmd readFileTextEnvelope (AsSigningKey AsVrfKey) vrkSkeyFp shelleyGenesis <- modifyError QueryCmdGenesisReadError $ - readAndDecodeGenesisFile @(ShelleyGenesis StandardCrypto) genFile + decodeShelleyGenesisFile genFile join $ lift ( executeLocalStateQueryExpr localNodeConnInfo target $ runExceptT $ do diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index 2068141d0f..f2f65757b9 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -16,7 +16,7 @@ import Cardano.Chain.Common (BlockCount) import Cardano.CLI.EraBased.Commands.Genesis (GenesisKeyGenGenesisCmdArgs (GenesisKeyGenGenesisCmdArgs)) import qualified Cardano.CLI.EraBased.Commands.Genesis as Cmd -import qualified Cardano.CLI.EraBased.Run.CreateTestnetData as CreateTestnetData +import qualified Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData as CreateTestnetData import Cardano.CLI.EraBased.Run.Genesis import Cardano.CLI.Legacy.Commands.Genesis import Cardano.CLI.Types.Common @@ -198,7 +198,8 @@ runLegacyGenesisCreateStakedCmd mStakePoolRelaySpecFile = runGenesisCreateStakedCmd Cmd.GenesisCreateStakedCmdArgs - { Cmd.keyOutputFormat = keyOutputFormat + { Cmd.eon = undefined -- FIXME!!! + , Cmd.keyOutputFormat = keyOutputFormat , Cmd.genesisDir = genesisDir , Cmd.numGenesisKeys = numGenesisKeys , Cmd.numUTxOKeys = numUTxOKeys diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GenesisCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GenesisCmdError.hs index 8ea416f6fa..d60868e293 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GenesisCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GenesisCmdError.hs @@ -18,34 +18,30 @@ import Control.Exception (IOException) import Data.Text (Text) data GenesisCmdError - = GenesisCmdAesonDecodeError !FilePath !Text - | GenesisCmdGenesisFileReadError !(FileError IOException) + = GenesisCmdAddressCmdError !AddressCmdError + | GenesisCmdByronError !ByronGenesisError + | GenesisCmdCostModelsError !FilePath + | GenesisCmdDelegatedSupplyExceedsTotalSupply !Integer !Integer -- ^ First @Integer@ is the delegate supply, second @Integer@ is the total supply + | GenesisCmdFileError !(FileError ()) + | GenesisCmdFileDecodeError !FilePath !Text + | GenesisCmdFilesDupIndex [FilePath] + | GenesisCmdFilesNoIndex [FilePath] | GenesisCmdGenesisFileDecodeError !FilePath !Text | GenesisCmdGenesisFileError !(FileError ()) - | GenesisCmdFileError !(FileError ()) | GenesisCmdMismatchedGenesisKeyFiles [Int] [Int] [Int] - | GenesisCmdFilesNoIndex [FilePath] - | GenesisCmdFilesDupIndex [FilePath] - | GenesisCmdTextEnvReadFileError !(FileError TextEnvelopeError) - | GenesisCmdUnexpectedAddressVerificationKey !(VerificationKeyFile In) !Text !SomeAddressVerificationKey - | GenesisCmdTooFewPoolsForBulkCreds !Word !Word !Word - | GenesisCmdAddressCmdError !AddressCmdError | GenesisCmdNodeCmdError !NodeCmdError | GenesisCmdStakeAddressCmdError !StakeAddressCmdError | GenesisCmdStakePoolCmdError !StakePoolCmdError - | GenesisCmdCostModelsError !FilePath - | GenesisCmdByronError !ByronGenesisError - | GenesisCmdTooManyRelaysError !FilePath !Int !Int -- ^ First @Int@ is the number of SPOs, second @Int@ is number of relays | GenesisCmdStakePoolRelayFileError !FilePath !IOException | GenesisCmdStakePoolRelayJsonDecodeError !FilePath !String - | GenesisCmdFileInputDecodeError !(FileError InputDecodeError) - | GenesisCmdDelegatedSupplyExceedsTotalSupply !Integer !Integer -- ^ First @Integer@ is the delegate supply, second @Integer@ is the total supply + | GenesisCmdTextEnvReadFileError !(FileError TextEnvelopeError) + | GenesisCmdTooFewPoolsForBulkCreds !Word !Word !Word + | GenesisCmdTooManyRelaysError !FilePath !Int !Int -- ^ First @Int@ is the number of SPOs, second @Int@ is number of relays + | GenesisCmdUnexpectedAddressVerificationKey !(VerificationKeyFile In) !Text !SomeAddressVerificationKey deriving Show instance Error GenesisCmdError where prettyError = \case - GenesisCmdAesonDecodeError fp decErr -> - "Error while decoding Shelley genesis at: " <> pretty fp <> " Error: " <> pretty decErr GenesisCmdGenesisFileError fe -> prettyError fe GenesisCmdFileError fe -> @@ -61,6 +57,8 @@ instance Error GenesisCmdError where GenesisCmdFilesDupIndex files -> "The genesis keys files are expected to have a unique numeric index but these do not:\n" <> vsep (fmap pretty files) + GenesisCmdFileDecodeError path errorTxt -> + "Cannot decode file:" <+> pretty path <+> "\nError:" <+> pretty errorTxt GenesisCmdTextEnvReadFileError fileErr -> prettyError fileErr GenesisCmdUnexpectedAddressVerificationKey (File file) expect got -> @@ -87,8 +85,6 @@ instance Error GenesisCmdError where GenesisCmdGenesisFileDecodeError fp e -> "Error while decoding Shelley genesis at: " <> pretty fp <> " Error: " <> pretty e - GenesisCmdGenesisFileReadError e -> - prettyError e GenesisCmdByronError e -> pshow e GenesisCmdTooManyRelaysError fp nbSPOs nbRelays -> pretty fp <> " specifies " <> pretty nbRelays <> " relays, but only " <> pretty nbSPOs <> " SPOs have been specified." <> @@ -99,8 +95,6 @@ instance Error GenesisCmdError where GenesisCmdStakePoolRelayJsonDecodeError fp e -> "Error occurred while decoding the stake pool relay specification file: " <> pretty fp <> " Error: " <> pretty e - GenesisCmdFileInputDecodeError ide -> - "Error occured while decoding a file: " <> pshow ide GenesisCmdDelegatedSupplyExceedsTotalSupply delegated total -> "Provided delegated supply is " <> pretty delegated <> ", which is greater than the specified total supply: " <> pretty total <> "." <> "This is incorrect: the delegated supply should be less or equal to the total supply." <>