Add pool operator extended key support

Author: palas

cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Command.hs

@@ -26,7 +26,7 @@ data CompatibleStakeAddressCmds era
   | CompatibleStakeAddressStakeDelegationCertificateCmd
       (ShelleyBasedEra era)
       StakeIdentifier
-      (VerificationKeyOrHashOrFile StakePoolKey)
+      StakePoolKeyHashSource
       (File () Out)
   deriving Show
 

cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Run.hs

@@ -84,40 +84,45 @@ runStakeAddressStakeDelegationCertificateCmd
   => ShelleyBasedEra era
   -> StakeIdentifier
   -- ^ Delegator stake verification key, verification key file or script file.
-  -> VerificationKeyOrHashOrFile StakePoolKey
+  -> StakePoolKeyHashSource
   -- ^ Delegatee stake pool verification key or verification key file or
   -- verification key hash.
   -> File () Out
   -> CIO e ()
 runStakeAddressStakeDelegationCertificateCmd sbe stakeVerifier poolVKeyOrHashOrFile outFp =
   shelleyBasedEraConstraints sbe $ do
-    poolStakeVKeyHash <-
-      fromExceptTCli $
-        readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile
+    poolStakeVKeyHash <- getHashFromStakePoolKeyHashSource poolVKeyOrHashOrFile
 
     stakeCred <-
       fromExceptTCli $ getStakeCredentialFromIdentifier stakeVerifier
 
-    let certificate = createStakeDelegationCertificate stakeCred poolStakeVKeyHash sbe
+    let certificate =
+          createStakeDelegationCertificate sbe stakeCred poolStakeVKeyHash
 
     fromEitherIOCli @(FileError ()) $
       writeLazyByteStringFile outFp $
         textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Delegation Certificate") certificate
 
 createStakeDelegationCertificate
-  :: StakeCredential
+  :: ShelleyBasedEra era
+  -> StakeCredential
   -> Hash StakePoolKey
-  -> ShelleyBasedEra era
   -> Certificate era
-createStakeDelegationCertificate stakeCredential (StakePoolKeyHash poolStakeVKeyHash) = do
+createStakeDelegationCertificate sbe stakeCredential stakePoolHash = do
   caseShelleyToBabbageOrConwayEraOnwards
     ( \w ->
         shelleyToBabbageEraConstraints w $
           ShelleyRelatedCertificate w $
-            L.mkDelegStakeTxCert (toShelleyStakeCredential stakeCredential) poolStakeVKeyHash
+            L.mkDelegStakeTxCert (toShelleyStakeCredential stakeCredential) (toLedgerHash stakePoolHash)
     )
     ( \w ->
         conwayEraOnwardsConstraints w $
           ConwayCertificate w $
-            L.mkDelegTxCert (toShelleyStakeCredential stakeCredential) (L.DelegStake poolStakeVKeyHash)
+            L.mkDelegTxCert
+              (toShelleyStakeCredential stakeCredential)
+              (L.DelegStake (toLedgerHash stakePoolHash))
     )
+    sbe
+ where
+  toLedgerHash :: Hash StakePoolKey -> L.KeyHash L.StakePool L.StandardCrypto
+  toLedgerHash (StakePoolKeyHash poolStakeVKeyHash) = poolStakeVKeyHash

cardano-cli/src/Cardano/CLI/Compatible/StakePool/Command.hs

@@ -19,16 +19,16 @@ import Prelude
 
 import Data.Text (Text)
 
-data CompatibleStakePoolCmds era
+newtype CompatibleStakePoolCmds era
   = CompatibleStakePoolRegistrationCertificateCmd
-      !(CompatibleStakePoolRegistrationCertificateCmdArgs era)
+      (CompatibleStakePoolRegistrationCertificateCmdArgs era)
   deriving Show
 
 data CompatibleStakePoolRegistrationCertificateCmdArgs era
   = CompatibleStakePoolRegistrationCertificateCmdArgs
   { sbe :: !(ShelleyBasedEra era)
   -- ^ Era in which to register the stake pool.
-  , poolVerificationKeyOrFile :: !(VerificationKeyOrFile StakePoolKey)
+  , poolVerificationKeyOrFile :: !StakePoolVerificationKeySource
   -- ^ Stake pool verification key.
   , vrfVerificationKeyOrFile :: !(VerificationKeyOrFile VrfKey)
   -- ^ VRF Verification key.

cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs

@@ -14,6 +14,9 @@ import Cardano.Api.Shelley
 import Cardano.CLI.Compatible.Exception
 import Cardano.CLI.Compatible.StakePool.Command
 import Cardano.CLI.EraBased.StakePool.Internal.Metadata
+import Cardano.CLI.Read
+  ( getVerificationKeyFromStakePoolVerificationKeySource
+  )
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Error.StakePoolCmdError
 import Cardano.CLI.Type.Key (readVerificationKeyOrFile)
@@ -48,11 +51,8 @@ runStakePoolRegistrationCertificateCmd
     } =
     shelleyBasedEraConstraints sbe $ do
       -- Pool verification key
-      stakePoolVerKey <-
-        fromExceptTCli $
-          firstExceptT StakePoolCmdReadKeyFileError $
-            readVerificationKeyOrFile AsStakePoolKey poolVerificationKeyOrFile
-      let stakePoolId' = verificationKeyHash stakePoolVerKey
+      stakePoolVerKey <- getVerificationKeyFromStakePoolVerificationKeySource poolVerificationKeyOrFile
+      let stakePoolId' = anyStakePoolVerificationKeyHash stakePoolVerKey
 
       -- VRF verification key
       vrfVerKey <-

cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs

@@ -434,23 +434,40 @@ parseLovelace = do
     else return $ L.Coin i
 
 -- | The first argument is the optional prefix.
-pStakePoolVerificationKeyOrFile :: Maybe String -> Parser (VerificationKeyOrFile StakePoolKey)
+pStakePoolVerificationKeyOrFile
+  :: Maybe String
+  -> Parser StakePoolVerificationKeySource
 pStakePoolVerificationKeyOrFile prefix =
   asum
-    [ VerificationKeyValue <$> pStakePoolVerificationKey prefix
-    , VerificationKeyFilePath <$> pStakePoolVerificationKeyFile prefix
+    [ StakePoolVerificationKeyFromLiteral . AnyStakePoolNormalVerificationKey
+        <$> pStakePoolVerificationNormalKey prefix
+    , StakePoolVerificationKeyFromLiteral . AnyStakePoolExtendedVerificationKey
+        <$> pStakePoolVerificationExtendedKey prefix
+    , StakePoolVerificationKeyFromFile <$> pStakePoolVerificationKeyFile prefix
     ]
 
 -- | The first argument is the optional prefix.
-pStakePoolVerificationKey :: Maybe String -> Parser (VerificationKey StakePoolKey)
-pStakePoolVerificationKey prefix =
+pStakePoolVerificationNormalKey
+  :: Maybe String -> Parser (VerificationKey StakePoolKey)
+pStakePoolVerificationNormalKey prefix =
   Opt.option (readVerificationKey AsStakePoolKey) $
     mconcat
       [ Opt.long $ prefixFlag prefix "stake-pool-verification-key"
       , Opt.metavar "STRING"
       , Opt.help "Stake pool verification key (Bech32 or hex-encoded)."
       ]
 
+-- | The first argument is the optional prefix.
+pStakePoolVerificationExtendedKey
+  :: Maybe String -> Parser (VerificationKey StakePoolExtendedKey)
+pStakePoolVerificationExtendedKey prefix =
+  Opt.option (readVerificationKey AsStakePoolExtendedKey) $
+    mconcat
+      [ Opt.long $ prefixFlag prefix "stake-pool-verification-extended-key"
+      , Opt.metavar "STRING"
+      , Opt.help "Stake pool verification extended key (Bech32 or hex-encoded)."
+      ]
+
 -- | The first argument is the optional prefix.
 pStakePoolVerificationKeyFile :: Maybe String -> Parser (VerificationKeyFile In)
 pStakePoolVerificationKeyFile prefix =
@@ -570,7 +587,10 @@ rVerificationKey a mErrPrefix =
 pColdVerificationKeyOrFile :: Maybe String -> Parser ColdVerificationKeyOrFile
 pColdVerificationKeyOrFile prefix =
   asum
-    [ ColdStakePoolVerificationKey <$> pStakePoolVerificationKey prefix
+    [ ColdStakePoolVerificationKey . AnyStakePoolNormalVerificationKey
+        <$> pStakePoolVerificationNormalKey prefix
+    , ColdStakePoolVerificationKey . AnyStakePoolExtendedVerificationKey
+        <$> pStakePoolVerificationExtendedKey prefix
     , ColdGenesisDelegateVerificationKey <$> pGenesisDelegateVerificationKey
     , ColdVerificationKeyFile <$> pColdVerificationKeyFile
     ]
@@ -950,11 +970,11 @@ pStakeVerificationKeyHash prefix =
 
 -- | The first argument is the optional prefix.
 pStakePoolVerificationKeyOrHashOrFile
-  :: Maybe String -> Parser (VerificationKeyOrHashOrFile StakePoolKey)
+  :: Maybe String -> Parser StakePoolKeyHashSource
 pStakePoolVerificationKeyOrHashOrFile prefix =
   asum
-    [ VerificationKeyOrFile <$> pStakePoolVerificationKeyOrFile prefix
-    , VerificationKeyHash <$> pStakePoolVerificationKeyHash prefix
+    [ StakePoolKeyHashSource <$> pStakePoolVerificationKeyOrFile prefix
+    , StakePoolKeyHashLiteral <$> pStakePoolVerificationKeyHash prefix
     ]
 
 --------------------------------------------------------------------------------
@@ -3416,7 +3436,7 @@ pVoterType =
     ]
 
 -- TODO: Conway era include "normal" stake keys
-pVotingCredential :: Parser (VerificationKeyOrFile StakePoolKey)
+pVotingCredential :: Parser StakePoolVerificationKeySource
 pVotingCredential = pStakePoolVerificationKeyOrFile Nothing
 
 pVoteDelegationTarget :: Parser VoteDelegationTarget

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

@@ -339,7 +339,8 @@ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys = do
     createOpCert (kesKey, delegateKey) = either (error . show) id eResult
      where
       eResult = issueOperationalCertificate kesKey (Right delegateKey) (KESPeriod 0) counter
-      counter = OperationalCertificateIssueCounter 0 (convertFun . getVerificationKey $ delegateKey)
+      counter =
+        OperationalCertificateIssueCounter 0 (convertFun . getVerificationKey $ delegateKey)
       convertFun
         :: VerificationKey GenesisDelegateExtendedKey
         -> VerificationKey StakePoolKey

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

@@ -18,6 +18,7 @@ import Cardano.Api.Shelley
 import Cardano.CLI.EraBased.Governance.Vote.Command qualified as Cmd
 import Cardano.CLI.EraBased.Script.Vote.Read
 import Cardano.CLI.EraIndependent.Hash.Internal.Common (carryHashChecks)
+import Cardano.CLI.Read (getHashFromStakePoolKeyHashSource)
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Error.CmdError
 import Cardano.CLI.Type.Error.GovernanceVoteCmdError
@@ -81,7 +82,8 @@ runGovernanceVoteCreateCmd
           drepCred <- readVerificationKeyOrHashOrFileOrScriptHash AsDRepKey unDRepKeyHash stake
           pure $ L.DRepVoter drepCred
         AnyStakePoolVerificationKeyOrHashOrFile stake -> do
-          StakePoolKeyHash h <- readVerificationKeyOrHashOrTextEnvFile AsStakePoolKey stake
+          StakePoolKeyHash h <-
+            liftIO $ getHashFromStakePoolKeyHashSource stake
           pure $ L.StakePoolVoter h
         AnyCommitteeHotVerificationKeyOrHashOrFileOrScriptHash stake -> do
           hotCred <- readVerificationKeyOrHashOrFileOrScriptHash AsCommitteeHotKey unCommitteeHotKeyHash stake

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

@@ -86,7 +86,7 @@ data QueryCommons = QueryCommons
 data QueryLeadershipScheduleCmdArgs = QueryLeadershipScheduleCmdArgs
   { commons :: !QueryCommons
   , genesisFp :: !GenesisFile
-  , poolColdVerKeyFile :: !(VerificationKeyOrHashOrFile StakePoolKey)
+  , poolColdVerKeyFile :: !StakePoolKeyHashSource
   , vrkSkeyFp :: !(SigningKeyFile In)
   , whichSchedule :: !EpochLeadershipSchedule
   , format :: Maybe OutputFormatJsonOrText

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

@@ -51,6 +51,9 @@ import Cardano.Binary qualified as CBOR
 import Cardano.CLI.EraBased.Genesis.Internal.Common
 import Cardano.CLI.EraBased.Query.Command qualified as Cmd
 import Cardano.CLI.Helper
+import Cardano.CLI.Read
+  ( getHashFromStakePoolKeyHashSource
+  )
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Error.NodeEraMismatchError
 import Cardano.CLI.Type.Error.QueryCmdError
@@ -551,7 +554,8 @@ runQueryKesPeriodInfoCmd
       -- We need the stake pool id to determine what the counter of our SPO
       -- should be.
       let opCertCounterMap = Consensus.getOpCertCounters (Proxy @(ConsensusProtocol era)) chainDepState
-          StakePoolKeyHash blockIssuerHash = verificationKeyHash stakePoolVKey
+          StakePoolKeyHash blockIssuerHash =
+            verificationKeyHash stakePoolVKey
 
       case Map.lookup (coerce blockIssuerHash) opCertCounterMap of
         -- Operational certificate exists in the protocol state
@@ -1416,9 +1420,7 @@ runQueryLeadershipScheduleCmd
     , Cmd.format
     , Cmd.mOutFile
     } = do
-    poolid <-
-      modifyError QueryCmdTextReadError $
-        readVerificationKeyOrHashOrFile AsStakePoolKey poolColdVerKeyFile
+    poolid <- getHashFromStakePoolKeyHashSource poolColdVerKeyFile
 
     vrkSkey <-
       modifyError QueryCmdTextEnvelopeReadError . hoistIOEither $
@@ -1449,7 +1451,8 @@ runQueryLeadershipScheduleCmd
               CurrentEpoch -> do
                 beo <- requireEon BabbageEra era
 
-                serCurrentEpochState <- easyRunQuery (queryPoolDistribution beo (Just (Set.singleton poolid)))
+                serCurrentEpochState <-
+                  easyRunQuery (queryPoolDistribution beo (Just (Set.singleton poolid)))
 
                 pure $ do
                   schedule <-

cardano-cli/src/Cardano/CLI/EraBased/StakeAddress/Command.hs

@@ -38,12 +38,12 @@ data StakeAddressCmds era
   | StakeAddressStakeDelegationCertificateCmd
       (ShelleyBasedEra era)
       StakeIdentifier
-      (VerificationKeyOrHashOrFile StakePoolKey)
+      StakePoolKeyHashSource
       (File () Out)
   | StakeAddressStakeAndVoteDelegationCertificateCmd
       (ConwayEraOnwards era)
       StakeIdentifier
-      (VerificationKeyOrHashOrFile StakePoolKey)
+      StakePoolKeyHashSource
       VoteDelegationTarget
       (File () Out)
   | StakeAddressVoteDelegationCertificateCmd
@@ -59,7 +59,7 @@ data StakeAddressCmds era
   | StakeAddressRegistrationAndDelegationCertificateCmd
       (ConwayEraOnwards era)
       StakeIdentifier
-      (VerificationKeyOrHashOrFile StakePoolKey)
+      StakePoolKeyHashSource
       Coin
       (File () Out)
   | StakeAddressRegistrationAndVoteDelegationCertificateCmd
@@ -71,7 +71,7 @@ data StakeAddressCmds era
   | StakeAddressRegistrationStakeAndVoteDelegationCertificateCmd
       (ConwayEraOnwards era)
       StakeIdentifier
-      (VerificationKeyOrHashOrFile StakePoolKey)
+      StakePoolKeyHashSource
       VoteDelegationTarget
       Coin
       (File () Out)