-
Notifications
You must be signed in to change notification settings - Fork 15
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
50b5133
commit 3de04f4
Showing
9 changed files
with
213 additions
and
128 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
156 changes: 156 additions & 0 deletions
156
cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/Common.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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 |
Oops, something went wrong.