diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 978c27e68f2..3ad424aaa65 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -26,8 +26,12 @@ common project-config -Wredundant-constraints -Wunused-packages +common maybe-unix + if !os(windows) + build-depends: unix + library - import: base, project-config + import: base, project-config, maybe-unix hs-source-dirs: src @@ -42,6 +46,7 @@ library -- we create wrapper types for the ledger types -- in this module Cardano.Api.Orphans + Cardano.Api.SerialiseTextEnvelope other-modules: -- Splitting up the big Typed module: @@ -75,7 +80,6 @@ library Cardano.Api.SerialiseJSON Cardano.Api.SerialiseLedgerCddl Cardano.Api.SerialiseRaw - Cardano.Api.SerialiseTextEnvelope Cardano.Api.SerialiseUsing Cardano.Api.Shelley.Genesis Cardano.Api.SpecialByron @@ -124,6 +128,7 @@ library , memory , network , nothunks + , optparse-applicative-fork , ouroboros-consensus , ouroboros-consensus-byron , ouroboros-consensus-cardano diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index f8137e95168..506997a70c8 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -559,7 +559,7 @@ module Cardano.Api ( mkLocalNodeClientParams, LocalChainSyncClient(..), CardanoMode, --- connectToRemoteNode, + -- connectToRemoteNode, -- *** Chain sync protocol -- | To construct a @ChainSyncClient@ see @Cardano.Api.Client@ or @@ -663,7 +663,9 @@ module Cardano.Api ( chainPointToSlotNo, chainPointToHeaderHash, - makeChainTip + makeChainTip, + parseFilePath, + writeSecrets ) where diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs index 8666fe1af24..9c3c4e8cd23 100644 --- a/cardano-api/src/Cardano/Api/Utils.hs +++ b/cardano-api/src/Cardano/Api/Utils.hs @@ -1,24 +1,44 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE CPP #-} + +#if !defined(mingw32_HOST_OS) +#define UNIX +#endif + -- | Internal utils for the other Api modules -- module Cardano.Api.Utils ( (?!) , (?!.) , formatParsecError - , noInlineMaybeToStrictMaybe - , runParsecParser , failEither , failEitherWith + , noInlineMaybeToStrictMaybe + , note + , parseFilePath + , runParsecParser + , writeSecrets ) where import Prelude +import Control.Monad (forM_) import qualified Data.Aeson.Types as Aeson +import qualified Data.ByteString as BS import Data.Maybe.Strict import Data.Text (Text) import qualified Data.Text as Text import qualified Text.Parsec as Parsec import qualified Text.Parsec.String as Parsec import qualified Text.ParserCombinators.Parsec.Error as Parsec +import Text.Printf (printf) +import qualified Options.Applicative as Opt +import System.FilePath (()) +#ifdef UNIX +import System.Posix.Files (ownerReadMode, setFileMode) +#else +import System.Directory (emptyPermissions, readable, setPermissions) +#endif (?!) :: Maybe a -> e -> Either e a Nothing ?! e = Left e @@ -50,3 +70,29 @@ failEither = either fail pure failEitherWith :: MonadFail m => (e -> String) -> Either e a -> m a failEitherWith f = either (fail . f) pure + +note :: MonadFail m => String -> Maybe a -> m a +note msg = \case + Nothing -> fail msg + Just a -> pure a + +parseFilePath :: String -> String -> Opt.Parser FilePath +parseFilePath optname desc = + Opt.strOption + ( Opt.long optname + <> Opt.metavar "FILEPATH" + <> Opt.help desc + <> Opt.completer (Opt.bashCompleter "file") + ) + +writeSecrets :: FilePath -> [Char] -> [Char] -> (a -> BS.ByteString) -> [a] -> IO () +writeSecrets outDir prefix suffix secretOp xs = + forM_ (zip xs [0::Int ..]) $ + \(secret, nr)-> do + let filename = outDir prefix <> "." <> printf "%03d" nr <> "." <> suffix + BS.writeFile filename $ secretOp secret +#ifdef UNIX + setFileMode filename ownerReadMode +#else + setPermissions filename (emptyPermissions {readable = True}) +#endif diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 726a58fc63f..0607c08cc74 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -42,7 +42,6 @@ common maybe-Win32 library import: base, project-config - , maybe-unix , maybe-Win32 if flag(unexpected_thunks) @@ -102,6 +101,7 @@ library , binary , bytestring , base16-bytestring >= 1.0 + , canonical-json , cardano-api , cardano-binary , cardano-git-rev diff --git a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs index 802682134e4..d4dbfbe236a 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs @@ -1,9 +1,5 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} -#if !defined(mingw32_HOST_OS) -#define UNIX -#endif module Cardano.CLI.Byron.Genesis ( ByronGenesisError(..) @@ -20,22 +16,14 @@ import Cardano.Prelude hiding (option, show, trace) import Prelude (String) import Control.Monad.Trans.Except.Extra (firstExceptT, left, right) -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LB import qualified Data.Map.Strict as Map import Data.Text.Lazy.Builder (toLazyText) import Data.Time (UTCTime) import Formatting.Buildable -import Text.Printf (printf) import System.Directory (createDirectory, doesPathExist) -import System.FilePath (()) -#ifdef UNIX -import System.Posix.Files (ownerReadMode, setFileMode) -#else -import System.Directory (emptyPermissions, readable, setPermissions) -#endif -import Cardano.Api (Key (..), NetworkId) +import Cardano.Api (Key (..), NetworkId, writeSecrets) import Cardano.Api.Byron (ByronKey, SerialiseAsRawBytes (..), SigningKey (..), toByronRequiresNetworkMagic) @@ -217,15 +205,3 @@ dumpGenesis (NewDirectory outDir) genesisData gs = do wOut :: String -> String -> (a -> ByteString) -> [a] -> IO () wOut = writeSecrets outDir - -writeSecrets :: FilePath -> String -> String -> (a -> ByteString) -> [a] -> IO () -writeSecrets outDir prefix suffix secretOp xs = - forM_ (zip xs [0::Int ..]) $ - \(secret, nr)-> do - let filename = outDir prefix <> "." <> printf "%03d" nr <> "." <> suffix - BS.writeFile filename $ secretOp secret -#ifdef UNIX - setFileMode filename ownerReadMode -#else - setPermissions filename (emptyPermissions {readable = True}) -#endif diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs index c7a16c9a96f..d7364b58c05 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs @@ -744,15 +744,6 @@ readDouble = do when (f > 1) $ readerError "fraction must be <= 1" return f -parseFilePath :: String -> String -> Parser FilePath -parseFilePath optname desc = - strOption - ( long optname - <> metavar "FILEPATH" - <> help desc - <> completer (bashCompleter "file") - ) - parseSigningKeyFile :: String -> String -> Parser SigningKeyFile parseSigningKeyFile opt desc = SigningKeyFile <$> parseFilePath opt desc diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index 0da1a6629ce..09719acc875 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -58,6 +58,7 @@ import Cardano.CLI.Shelley.Key (PaymentVerifier, StakeVerifier, Verifi import Cardano.CLI.Types import Cardano.Ledger.Shelley.TxBody (MIRPot) +import Cardano.Chain.Common (BlockCount) -- -- Shelley CLI command data types -- @@ -416,6 +417,7 @@ renderTextViewCmd (TextViewInfo _ _) = "text-view decode-cbor" data GenesisCmd = GenesisCreate GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) NetworkId + | GenesisCreateCardano GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) BlockCount Word Rational NetworkId FilePath FilePath FilePath (Maybe FilePath) | GenesisCreateStaked GenesisDir Word Word Word Word (Maybe SystemStart) (Maybe Lovelace) Lovelace NetworkId Word Word Word | GenesisKeyGenGenesis VerificationKeyFile SigningKeyFile | GenesisKeyGenDelegate VerificationKeyFile SigningKeyFile OpCertCounterFile @@ -431,6 +433,7 @@ renderGenesisCmd :: GenesisCmd -> Text renderGenesisCmd cmd = case cmd of GenesisCreate {} -> "genesis create" + GenesisCreateCardano {} -> "genesis create-cardano" GenesisCreateStaked {} -> "genesis create-staked" GenesisKeyGenGenesis {} -> "genesis key-gen-genesis" GenesisKeyGenDelegate {} -> "genesis key-gen-delegate" diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 4d54935b048..c6b07a875a9 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -54,6 +54,7 @@ import Cardano.CLI.Shelley.Key (InputFormat (..), PaymentVerifier (..) StakeVerifier (..), VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..), VerificationKeyTextOrFile (..), deserialiseInput, renderInputDecodeError) import Cardano.CLI.Types +import Cardano.Chain.Common (BlockCount(BlockCount)) {- HLINT ignore "Use <$>" -} @@ -1101,6 +1102,10 @@ pGenesisCmd = , subParser "initial-txin" (Opt.info pGenesisTxIn $ Opt.progDesc "Get the TxIn for an initial UTxO based on the verification key") + , subParser "create-cardano" + (Opt.info pGenesisCreateCardano $ + Opt.progDesc ("Create a Byron and Shelley genesis file from a genesis " + ++ "template and genesis/delegation/spending keys.")) , subParser "create" (Opt.info pGenesisCreate $ Opt.progDesc ("Create a Shelley genesis file from a genesis " @@ -1144,6 +1149,28 @@ pGenesisCmd = pGenesisTxIn = GenesisTxIn <$> pVerificationKeyFile Input <*> pNetworkId <*> pMaybeOutputFile + pGenesisCreateCardano :: Parser GenesisCmd + pGenesisCreateCardano = + GenesisCreateCardano <$> pGenesisDir + <*> pGenesisNumGenesisKeys + <*> pGenesisNumUTxOKeys + <*> pMaybeSystemStart + <*> pInitialSupplyNonDelegated + <*> (BlockCount <$> pSecurityParam) + <*> pSlotLength + <*> pSlotCoefficient + <*> pNetworkId + <*> parseFilePath + "byron-template" + "JSON file with genesis defaults for each byron." + <*> parseFilePath + "shelley-template" + "JSON file with genesis defaults for each shelley." + <*> parseFilePath + "alonzo-template" + "JSON file with genesis defaults for each alonzo." + <*> pNodeConfigTemplate + pGenesisCreate :: Parser GenesisCmd pGenesisCreate = GenesisCreate <$> pGenesisDir @@ -1197,10 +1224,13 @@ pGenesisCmd = Opt.option Opt.auto ( Opt.long "gen-genesis-keys" <> Opt.metavar "INT" - <> Opt.help "The number of genesis keys to make [default is 0]." - <> Opt.value 0 + <> Opt.help "The number of genesis keys to make [default is 3]." + <> Opt.value 3 ) + pNodeConfigTemplate :: Parser (Maybe FilePath) + pNodeConfigTemplate = optional $ parseFilePath "node-config-template" "the node config template" + pGenesisNumUTxOKeys :: Parser Word pGenesisNumUTxOKeys = Opt.option Opt.auto @@ -1261,6 +1291,34 @@ pGenesisCmd = <> Opt.value 0 ) + pSecurityParam :: Parser Word64 + pSecurityParam = + Opt.option Opt.auto + ( Opt.long "security-param" + <> Opt.metavar "INT" + <> Opt.help "Security parameter for genesis file [default is 108]." + <> Opt.value 108 + ) + + pSlotLength :: Parser Word + pSlotLength = + Opt.option Opt.auto + ( Opt.long "slot-length" + <> Opt.metavar "INT" + <> Opt.help "slot length (ms) parameter for genesis file [default is 1000]." + <> Opt.value 1000 + ) + + + pSlotCoefficient :: Parser Rational + pSlotCoefficient = + Opt.option readRationalUnitInterval + ( Opt.long "slot-coefficient" + <> Opt.metavar "RATIONAL" + <> Opt.help "Slot Coefficient for genesis file [default is .05]." + <> Opt.value 0.05 + ) + pBulkPoolCredFiles :: Parser Word pBulkPoolCredFiles = Opt.option Opt.auto diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs index 8c5e6e01785..cd3e4239b30 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs @@ -16,10 +16,11 @@ module Cardano.CLI.Shelley.Run.Genesis ) where import Cardano.Prelude hiding (unlines) -import Prelude (id, unlines) +import Prelude (id, unlines, zip3, error) import Data.Aeson hiding (Key) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as Aeson import Data.Aeson.Encode.Pretty (encodePretty) import qualified Data.Binary.Get as Bin import qualified Data.ByteString.Char8 as BS @@ -33,13 +34,14 @@ import qualified Data.Sequence.Strict as Seq import Data.String (fromString) import qualified Data.Text as Text import qualified Data.Text.IO as Text -import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime) +import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime, secondsToNominalDiffTime) -import Cardano.Binary (ToCBOR (..)) +import Cardano.Binary (ToCBOR (..), Annotated(Annotated)) import Cardano.Crypto.Hash (HashAlgorithm) import qualified Cardano.Crypto.Hash as Hash import qualified Cardano.Crypto.Random as Crypto +import qualified Cardano.Crypto as CC import Crypto.Random as Crypto import System.Directory (createDirectoryIfMissing, listDirectory) @@ -53,6 +55,7 @@ import qualified Cardano.Crypto.Hash as Crypto import Cardano.Api import Cardano.Api.Shelley +import Cardano.Api.Byron (toByronRequiresNetworkMagic, toByronProtocolMagicId, toByronLovelace) import Ouroboros.Consensus.BlockchainTime (SystemStart (..)) import Ouroboros.Consensus.Shelley.Eras (StandardShelley) @@ -80,6 +83,24 @@ import Cardano.CLI.Shelley.Run.StakeAddress (ShelleyStakeAddressCmdErr renderShelleyStakeAddressCmdError, runStakeAddressKeyGen) import Cardano.CLI.Types +import Cardano.CLI.Byron.Delegation +import qualified Cardano.CLI.Byron.Key as Byron +import qualified Cardano.Crypto.Signing as Byron +import Cardano.CLI.Byron.Genesis as Byron +import Cardano.Chain.Genesis (FakeAvvmOptions (..), TestnetBalanceOptions (..), gsDlgIssuersSecrets, gsRichSecrets, gsPoorSecrets, gdProtocolParameters) +import qualified Cardano.Chain.Common as Byron (rationalToLovelacePortion, mkKnownLovelace, KeyHash) + +import Cardano.Chain.Common (BlockCount(unBlockCount)) +import qualified Cardano.Chain.Genesis as Genesis +import Cardano.Chain.Delegation (delegateVK) +import Cardano.Api.SerialiseTextEnvelope (textEnvelopeToJSON) +import qualified Cardano.Chain.Delegation as Dlg +import Cardano.Slotting.Slot (EpochSize(EpochSize)) +import Cardano.Chain.Update +import Data.Fixed (Fixed(MkFixed)) +import qualified Data.Yaml as Yaml +import Text.JSON.Canonical (parseCanonicalJSON, renderCanonicalJSON) + {- HLINT ignore "Reduce duplication" -} data ShelleyGenesisCmdError @@ -99,6 +120,7 @@ data ShelleyGenesisCmdError | ShelleyGenesisCmdPoolCmdError !ShelleyPoolCmdError | ShelleyGenesisCmdStakeAddressCmdError !ShelleyStakeAddressCmdError | ShelleyGenesisCmdCostModelsError !FilePath + | ShelleyGenesisCmdByronError !ByronGenesisError deriving Show instance Error ShelleyGenesisCmdError where @@ -138,6 +160,7 @@ instance Error ShelleyGenesisCmdError where "Error while decoding Shelley genesis at: " <> fp <> " Error: " <> Text.unpack e ShelleyGenesisCmdGenesisFileReadError e -> displayError e + ShelleyGenesisCmdByronError e -> show e runGenesisCmd :: GenesisCmd -> ExceptT ShelleyGenesisCmdError IO () runGenesisCmd (GenesisKeyGenGenesis vk sk) = runGenesisKeyGenGenesis vk sk @@ -148,6 +171,7 @@ runGenesisCmd (GenesisVerKey vk sk) = runGenesisVerKey vk sk runGenesisCmd (GenesisTxIn vk nw mOutFile) = runGenesisTxIn vk nw mOutFile runGenesisCmd (GenesisAddr vk nw mOutFile) = runGenesisAddr vk nw mOutFile runGenesisCmd (GenesisCreate gd gn un ms am nw) = runGenesisCreate gd gn un ms am nw +runGenesisCmd (GenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag mNodeCfg) = runGenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag mNodeCfg runGenesisCmd (GenesisCreateStaked gd gn gp gl un ms am ds nw bf bp su) = runGenesisCreateStaked gd gn gp gl un ms am ds nw bf bp su runGenesisCmd (GenesisHashFile gf) = runGenesisHashFile gf @@ -369,6 +393,246 @@ runGenesisCreate (GenesisDir rootdir) deldir = rootdir "delegate-keys" utxodir = rootdir "utxo-keys" + +toSKeyJSON :: Key a => SigningKey a -> ByteString +toSKeyJSON = LBS.toStrict . textEnvelopeToJSON Nothing + +toVkeyJSON :: Key a => SigningKey a -> ByteString +toVkeyJSON = LBS.toStrict . textEnvelopeToJSON Nothing . getVerificationKey + +toVkeyJSON' :: Key a => VerificationKey a -> ByteString +toVkeyJSON' = LBS.toStrict . textEnvelopeToJSON Nothing + +toOpCert :: (OperationalCertificate, OperationalCertificateIssueCounter) -> ByteString +toOpCert = LBS.toStrict . textEnvelopeToJSON Nothing . fst + +toCounter :: (OperationalCertificate, OperationalCertificateIssueCounter) -> ByteString +toCounter = LBS.toStrict . textEnvelopeToJSON Nothing . snd + +generateShelleyNodeSecrets :: [SigningKey GenesisDelegateExtendedKey] -> [VerificationKey GenesisKey] + -> IO (Map (Hash GenesisKey) + ( Hash GenesisDelegateKey, Hash VrfKey) + , [SigningKey VrfKey] + , [SigningKey KesKey] + , [(OperationalCertificate, OperationalCertificateIssueCounter)]) +generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys = do + let + shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey] + shelleyDelegatevkeys = map (castVerificationKey . getVerificationKey) shelleyDelegateKeys + vrfKeys <- forM shelleyDelegateKeys $ \_ -> generateSigningKey AsVrfKey + kesKeys <- forM shelleyDelegateKeys $ \_ -> generateSigningKey AsKesKey + + let + opCertInputs :: [(VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)] + opCertInputs = zip (map getVerificationKey kesKeys) shelleyDelegateKeys + createOpCert :: (VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey) -> (OperationalCertificate, OperationalCertificateIssueCounter) + createOpCert (kesKey, delegateKey) = either (error . show) identity eResult + where + eResult = issueOperationalCertificate kesKey (Right delegateKey) (KESPeriod 0) counter + counter = OperationalCertificateIssueCounter 0 (convert . getVerificationKey $ delegateKey) + convert :: VerificationKey GenesisDelegateExtendedKey + -> VerificationKey StakePoolKey + convert = (castVerificationKey :: VerificationKey GenesisDelegateKey + -> VerificationKey StakePoolKey) + . (castVerificationKey :: VerificationKey GenesisDelegateExtendedKey + -> VerificationKey GenesisDelegateKey) + + opCerts :: [(OperationalCertificate, OperationalCertificateIssueCounter)] + opCerts = map createOpCert opCertInputs + + vrfvkeys = map getVerificationKey vrfKeys + combinedMap :: [ ( VerificationKey GenesisKey + , VerificationKey GenesisDelegateKey + , VerificationKey VrfKey + ) + ] + combinedMap = zip3 shelleyGenesisvkeys shelleyDelegatevkeys vrfvkeys + hashKeys :: (VerificationKey GenesisKey, VerificationKey GenesisDelegateKey, VerificationKey VrfKey) -> (Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey)) + hashKeys (genesis,delegate,vrf) = (verificationKeyHash genesis, (verificationKeyHash delegate, verificationKeyHash vrf)); + delegateMap :: Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) + delegateMap = Map.fromList . map hashKeys $ combinedMap + + return (delegateMap, vrfKeys, kesKeys, opCerts) + +-- +-- Create Genesis Cardano command implementation +-- + +runGenesisCreateCardano :: GenesisDir + -> Word -- ^ num genesis & delegate keys to make + -> Word -- ^ num utxo keys to make + -> Maybe SystemStart + -> Maybe Lovelace + -> BlockCount + -> Word -- ^ slot length in ms + -> Rational + -> NetworkId + -> FilePath -- ^ Byron Genesis + -> FilePath -- ^ Shelley Genesis + -> FilePath -- ^ Alonzo Genesis + -> Maybe FilePath + -> ExceptT ShelleyGenesisCmdError IO () +runGenesisCreateCardano (GenesisDir rootdir) + genNumGenesisKeys _genNumUTxOKeys + mStart mAmount mSecurity slotLength mSlotCoeff + network byronGenesisT shelleyGenesisT alonzoGenesisT mNodeCfg = do + start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart + (byronGenesis', byronSecrets) <- convertToShelleyError $ Byron.mkGenesis $ byronParams start + let + byronGenesis = byronGenesis' + { gdProtocolParameters = (gdProtocolParameters byronGenesis') { + ppSlotDuration = floor ( toRational slotLength * recip mSlotCoeff ) + } + } + + genesisKeys = gsDlgIssuersSecrets byronSecrets + byronGenesisKeys = map ByronSigningKey genesisKeys + shelleyGenesisKeys = map convertGenesisKey genesisKeys + shelleyGenesisvkeys :: [VerificationKey GenesisKey] + shelleyGenesisvkeys = map (castVerificationKey . getVerificationKey) shelleyGenesisKeys + + delegateKeys = gsRichSecrets byronSecrets + byronDelegateKeys = map ByronSigningKey delegateKeys + shelleyDelegateKeys :: [SigningKey GenesisDelegateExtendedKey] + shelleyDelegateKeys = map convertDelegate delegateKeys + shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey] + shelleyDelegatevkeys = map (castVerificationKey . getVerificationKey) shelleyDelegateKeys + + utxoKeys = gsPoorSecrets byronSecrets + byronUtxoKeys = map (ByronSigningKey . Genesis.poorSecretToKey) utxoKeys + shelleyUtxoKeys = map (convertPoor . Genesis.poorSecretToKey) utxoKeys + + dlgCerts <- convertToShelleyError $ mapM (findDelegateCert byronGenesis) byronDelegateKeys + let + overrideShelleyGenesis t = t + { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) + , sgNetworkId = toShelleyNetwork network + , sgActiveSlotsCoeff = fromMaybe (error $ "Could not convert from Rational: " ++ show mSlotCoeff) $ Ledger.boundRational mSlotCoeff + , sgSecurityParam = unBlockCount mSecurity + , sgUpdateQuorum = fromIntegral $ ((genNumGenesisKeys `div` 3) * 2) + 1 + , sgEpochLength = EpochSize $ floor $ (fromIntegral (unBlockCount mSecurity) * 10) / mSlotCoeff + , sgMaxLovelaceSupply = 45000000000000000 + , sgSystemStart = getSystemStart start + , sgSlotLength = secondsToNominalDiffTime $ MkFixed (fromIntegral slotLength) * 1000000000 + } + shelleyGenesisTemplate <- liftIO $ overrideShelleyGenesis . fromRight (error "shelley genesis template not found") <$> readAndDecodeShelleyGenesis shelleyGenesisT + alonzoGenesis <- readAlonzoGenesis alonzoGenesisT + (delegateMap, vrfKeys, kesKeys, opCerts) <- liftIO $ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys + let + shelleyGenesis :: ShelleyGenesis StandardShelley + shelleyGenesis = updateTemplate start delegateMap Nothing [] mempty 0 [] [] shelleyGenesisTemplate + + liftIO $ do + createDirectoryIfMissing False rootdir + createDirectoryIfMissing False gendir + createDirectoryIfMissing False deldir + createDirectoryIfMissing False utxodir + + writeSecrets gendir "byron" "key" serialiseToRawBytes byronGenesisKeys + writeSecrets gendir "shelley" "skey" toSKeyJSON shelleyGenesisKeys + writeSecrets gendir "shelley" "vkey" toVkeyJSON shelleyGenesisKeys + + writeSecrets deldir "byron" "key" serialiseToRawBytes byronDelegateKeys + writeSecrets deldir "shelley" "skey" toSKeyJSON shelleyDelegateKeys + writeSecrets deldir "shelley" "vkey" toVkeyJSON' shelleyDelegatevkeys + writeSecrets deldir "shelley" "vrf.skey" toSKeyJSON vrfKeys + writeSecrets deldir "shelley" "vrf.vkey" toVkeyJSON vrfKeys + writeSecrets deldir "shelley" "kes.skey" toSKeyJSON kesKeys + writeSecrets deldir "shelley" "kes.vkey" toVkeyJSON kesKeys + + writeSecrets utxodir "byron" "key" serialiseToRawBytes byronUtxoKeys + writeSecrets utxodir "shelley" "skey" toSKeyJSON shelleyUtxoKeys + writeSecrets utxodir "shelley" "vkey" toVkeyJSON shelleyUtxoKeys + + writeSecrets deldir "byron" "cert.json" serialiseDelegationCert dlgCerts + + writeSecrets deldir "shelley" "opcert.json" toOpCert opCerts + writeSecrets deldir "shelley" "counter.json" toCounter opCerts + + LBS.writeFile (rootdir "byron-genesis.json") (canonicalEncodePretty byronGenesis) + writeFileGenesis (rootdir "shelley-genesis.json") shelleyGenesis + writeFileGenesis (rootdir "alonzo-genesis.json") alonzoGenesis + + liftIO $ do + case mNodeCfg of + Nothing -> pure () + Just nodeCfg -> do + nodeConfig <- Yaml.decodeFileThrow nodeCfg + let + hashShelleyGenesis :: ToJSON genesis => genesis -> Text + hashShelleyGenesis genesis = Crypto.hashToTextAsHex gh + where + content :: ByteString + content = LBS.toStrict $ encodePretty genesis + gh :: Crypto.Hash Crypto.Blake2b_256 ByteString + gh = Crypto.hashWith id content + hashByronGenesis :: Genesis.GenesisData -> Text + hashByronGenesis genesis = Crypto.hashToTextAsHex genesisHash + where + genesisHash :: Crypto.Hash Crypto.Blake2b_256 ByteString + genesisHash = Crypto.hashWith id + . LBS.toStrict + . renderCanonicalJSON + . either (error "error parsing json that was just encoded!?") identity + . parseCanonicalJSON + . canonicalEncodePretty $ genesis + -- TODO, NodeConfig needs a ToJSON instance + updateConfig :: Yaml.Value -> Yaml.Value + updateConfig (Object obj) = Object + $ (Aeson.insert "ByronGenesisHash" . String . hashByronGenesis) byronGenesis + $ (Aeson.insert "ShelleyGenesisHash" . String . hashShelleyGenesis) shelleyGenesis + $ (Aeson.insert "AlonzoGenesisHash" . String . hashShelleyGenesis) alonzoGenesis + obj + updateConfig x = x + newConfig :: Yaml.Value + newConfig = updateConfig nodeConfig + encodeFile (rootdir "node-config.json") newConfig + + where + convertToShelleyError = withExceptT ShelleyGenesisCmdByronError + convertGenesisKey :: Byron.SigningKey -> SigningKey GenesisExtendedKey + convertGenesisKey (Byron.SigningKey xsk) = GenesisExtendedSigningKey xsk + + convertDelegate :: Byron.SigningKey -> SigningKey GenesisDelegateExtendedKey + convertDelegate (Byron.SigningKey xsk) = GenesisDelegateExtendedSigningKey xsk + + convertPoor :: Byron.SigningKey -> SigningKey ByronKey + convertPoor = ByronSigningKey + + byronParams start = Byron.GenesisParameters (getSystemStart start) byronGenesisT mSecurity byronNetwork byronBalance byronFakeAvvm byronAvvmFactor Nothing + gendir = rootdir "genesis-keys" + deldir = rootdir "delegate-keys" + utxodir = rootdir "utxo-keys" + byronNetwork = CC.AProtocolMagic + (Annotated (toByronProtocolMagicId network) ()) + (toByronRequiresNetworkMagic network) + byronBalance = TestnetBalanceOptions + { tboRichmen = genNumGenesisKeys + , tboPoors = 1 + , tboTotalBalance = fromMaybe zeroLovelace $ toByronLovelace (fromMaybe 0 mAmount) + , tboRichmenShare = 0 + } + byronFakeAvvm = FakeAvvmOptions + { faoCount = 0 + , faoOneBalance = zeroLovelace + } + byronAvvmFactor = Byron.rationalToLovelacePortion 0.0 + zeroLovelace = Byron.mkKnownLovelace @0 + + -- Compare a given 'SigningKey' with a 'Certificate' 'VerificationKey' + isCertForSK :: CC.SigningKey -> Dlg.Certificate -> Bool + isCertForSK sk cert = delegateVK cert == CC.toVerification sk + + findDelegateCert :: Genesis.GenesisData -> SigningKey ByronKey -> ExceptT ByronGenesisError IO Dlg.Certificate + findDelegateCert byronGenesis bSkey@(ByronSigningKey sk) = do + case find (isCertForSK sk) (Map.elems $ dlgCertMap byronGenesis) of + Nothing -> throwE . NoGenesisDelegationForKey + . Byron.prettyPublicKey $ getVerificationKey bSkey + Just x -> pure x + + dlgCertMap :: Genesis.GenesisData -> Map Byron.KeyHash Dlg.Certificate + dlgCertMap byronGenesis = Genesis.unGenesisDelegation $ Genesis.gdHeavyDelegation byronGenesis + runGenesisCreateStaked :: GenesisDir -> Word -- ^ num genesis & delegate keys to make @@ -687,7 +951,7 @@ computeDelegation nw delegDir pool delegIx = do stakeVKF = delegDir "staking" ++ strIndexDeleg ++ ".vkey" -- | Current UTCTime plus 30 seconds -getCurrentTimePlus30 :: ExceptT ShelleyGenesisCmdError IO UTCTime +getCurrentTimePlus30 :: ExceptT a IO UTCTime getCurrentTimePlus30 = plus30sec <$> liftIO getCurrentTime where diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs index d9080a4f2d2..cf399e3dd68 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs @@ -6,6 +6,7 @@ module Cardano.CLI.Shelley.Run.Key , SomeSigningKey(..) , renderShelleyKeyCmdError , runKeyCmd + , SomeExtendedVerificationKey(..) -- * Exports for testing , decodeBech32