WIP CAD-1878 cli: cardano-cli shelley genesis create-staked

cardano-api/src/Cardano/Api/Typed.hs

@@ -305,7 +305,8 @@ module Cardano.Api.Typed (
     toByronProtocolMagicId,
     toByronRequiresNetworkMagic,
     toShelleyNetwork,
-    toNetworkMagic,
+    toShelleyStakeAddr,
+    toNetworkMagic
   ) where
 
 import           Prelude

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

@@ -300,6 +300,7 @@ renderTextViewCmd (TextViewInfo _ _) = "text-view decode-cbor"
 
 data GenesisCmd
   = GenesisCreate GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) NetworkId
+  | GenesisCreateStaked GenesisDir Word Word Word Word (Maybe SystemStart) (Maybe Lovelace) Lovelace NetworkId
   | GenesisKeyGenGenesis VerificationKeyFile SigningKeyFile
   | GenesisKeyGenDelegate VerificationKeyFile SigningKeyFile OpCertCounterFile
   | GenesisKeyGenUTxO VerificationKeyFile SigningKeyFile
@@ -314,6 +315,7 @@ renderGenesisCmd :: GenesisCmd -> Text
 renderGenesisCmd cmd =
   case cmd of
     GenesisCreate {} -> "genesis create"
+    GenesisCreateStaked {} -> "genesis create-staked"
     GenesisKeyGenGenesis {} -> "genesis key-gen-genesis"
     GenesisKeyGenDelegate {} -> "genesis key-gen-delegate"
     GenesisKeyGenUTxO {} -> "genesis key-gen-utxo"

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -757,6 +757,11 @@ pGenesisCmd =
              Opt.progDesc ("Create a Shelley genesis file from a genesis "
                         ++ "template and genesis/delegation/spending keys."))
 
+      , Opt.command "create-staked"
+          (Opt.info pGenesisCreateStaked $
+             Opt.progDesc ("Create a staked Shelley genesis file from a genesis "
+                        ++ "template and genesis/delegation/spending keys."))
+
       , Opt.command "hash"
           (Opt.info pGenesisHash $
              Opt.progDesc "Compute the hash of a genesis file")
@@ -798,9 +803,22 @@ pGenesisCmd =
                     <*> pGenesisNumGenesisKeys
                     <*> pGenesisNumUTxOKeys
                     <*> pMaybeSystemStart
-                    <*> pInitialSupply
+                    <*> pInitialSupplyNonDelegated
                     <*> pNetworkId
 
+    pGenesisCreateStaked :: Parser GenesisCmd
+    pGenesisCreateStaked =
+      GenesisCreateStaked
+        <$> pGenesisDir
+        <*> pGenesisNumGenesisKeys
+        <*> pGenesisNumUTxOKeys
+        <*> pGenesisNumPools
+        <*> pGenesisNumStDelegs
+        <*> pMaybeSystemStart
+        <*> pInitialSupplyNonDelegated
+        <*> pInitialSupplyDelegated
+        <*> pNetworkId
+
     pGenesisHash :: Parser GenesisCmd
     pGenesisHash =
       GenesisHashFile <$> pGenesisFile
@@ -842,18 +860,46 @@ pGenesisCmd =
           <> Opt.value 0
           )
 
+    pGenesisNumPools :: Parser Word
+    pGenesisNumPools =
+        Opt.option Opt.auto
+          (  Opt.long "gen-pools"
+          <> Opt.metavar "INT"
+          <> Opt.help "The number of stake pool credential sets to make [default is 0]."
+          <> Opt.value 0
+          )
+
+    pGenesisNumStDelegs :: Parser Word
+    pGenesisNumStDelegs =
+        Opt.option Opt.auto
+          (  Opt.long "gen-stake-delegs"
+          <> Opt.metavar "INT"
+          <> Opt.help "The number of stake delegator credential sets to make [default is 0]."
+          <> Opt.value 0
+          )
+
     convertTime :: String -> UTCTime
     convertTime =
       parseTimeOrError False defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%SZ")
 
-    pInitialSupply :: Parser (Maybe Lovelace)
-    pInitialSupply =
+    pInitialSupplyNonDelegated :: Parser (Maybe Lovelace)
+    pInitialSupplyNonDelegated =
       Opt.optional $
       Lovelace <$>
         Opt.option Opt.auto
           (  Opt.long "supply"
           <> Opt.metavar "LOVELACE"
-          <> Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial stake holders."
+          <> Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial, non-delegating stake holders."
+          )
+
+    pInitialSupplyDelegated :: Parser Lovelace
+    pInitialSupplyDelegated =
+      fmap (Lovelace . fromMaybe 0) $ Opt.optional $
+        Opt.option Opt.auto
+          (  Opt.long "supply-delegated"
+          <> Opt.metavar "LOVELACE"
+          <> Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial, delegating stake holders."
+          <> Opt.value (fromIntegral (0 :: Integer))
           )
 
 

cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs

@@ -1,9 +1,13 @@
 {-# LANGUAGE RankNTypes #-}
 
 module Cardano.CLI.Shelley.Run.Address
-  ( ShelleyAddressCmdError
+  ( ShelleyAddressCmdError(ShelleyAddressCmdReadFileError)
+  , SomeAddressVerificationKey(..)
+  , buildShelleyAddress
   , renderShelleyAddressCmdError
   , runAddressCmd
+  , runAddressKeyGen
+  , readAddressVerificationKeyFile
   ) where
 
 import           Cardano.Prelude hiding (putStrLn)
@@ -107,38 +111,42 @@ runAddressBuild payVkeyFp mstkVkeyFp nw mOutFp = do
                 return (makeByronAddress nw vk)
 
               APaymentVerificationKey vk ->
-                buildShelleyAddress vk
+                buildShelleyAddress vk mstkVkeyFp nw
 
               APaymentExtendedVerificationKey vk ->
-                buildShelleyAddress (castVerificationKey vk)
+                buildShelleyAddress (castVerificationKey vk) mstkVkeyFp nw
 
               AGenesisUTxOVerificationKey vk ->
-                buildShelleyAddress (castVerificationKey vk)
+                buildShelleyAddress (castVerificationKey vk) mstkVkeyFp nw
 
     let addrText = serialiseAddress addr
 
     case mOutFp of
       Just (OutputFile fpath) -> liftIO $ Text.writeFile fpath addrText
       Nothing                 -> liftIO $ Text.putStrLn        addrText
 
-  where
-    buildShelleyAddress vkey = do
-      mstakeVKey <-
-        case mstkVkeyFp of
-          Nothing -> pure Nothing
-          Just (VerificationKeyFile stkVkeyFp) ->
-            firstExceptT ShelleyAddressCmdReadFileError $
-              fmap Just $ newExceptT $
-                readFileTextEnvelope (AsVerificationKey AsStakeKey) stkVkeyFp
-
-      let paymentCred  = PaymentCredentialByKey (verificationKeyHash vkey)
-          stakeAddrRef = maybe NoStakeAddress
-                               (StakeAddressByValue . StakeCredentialByKey
-                                                    . verificationKeyHash)
-                               mstakeVKey
-          address      = makeShelleyAddress nw paymentCred stakeAddrRef
-
-      return address
+buildShelleyAddress ::
+     VerificationKey PaymentKey
+  -> Maybe VerificationKeyFile
+  -> NetworkId
+  -> ExceptT ShelleyAddressCmdError IO (Address Shelley)
+buildShelleyAddress vkey mstkVkeyFp nw = do
+  mstakeVKey <-
+    case mstkVkeyFp of
+      Nothing -> pure Nothing
+      Just (VerificationKeyFile stkVkeyFp) ->
+        firstExceptT ShelleyAddressCmdReadFileError $
+          fmap Just $ newExceptT $
+            readFileTextEnvelope (AsVerificationKey AsStakeKey) stkVkeyFp
+
+  let paymentCred  = PaymentCredentialByKey (verificationKeyHash vkey)
+      stakeAddrRef = maybe NoStakeAddress
+                           (StakeAddressByValue . StakeCredentialByKey
+                                                . verificationKeyHash)
+                           mstakeVKey
+      address      = makeShelleyAddress nw paymentCred stakeAddrRef
+
+  return address
 
 
 --
@@ -152,6 +160,7 @@ data SomeAddressVerificationKey
   | APaymentVerificationKey         (VerificationKey PaymentKey)
   | APaymentExtendedVerificationKey (VerificationKey PaymentExtendedKey)
   | AGenesisUTxOVerificationKey     (VerificationKey GenesisUTxOKey)
+  deriving (Show)
 
 foldSomeAddressVerificationKey :: (forall keyrole. Key keyrole =>
                                    VerificationKey keyrole -> a)