Merge pull request #3404 from input-output-hk/cblp/stake-address_regi…

…stration-certificate_--stake-address

cardano-cli: Add option `--stake-address` to several subcommands

cardano-api/src/Cardano/Api.hs

@@ -98,6 +98,7 @@ module Cardano.Api (
     StakeAddress,
     StakeCredential,
     makeStakeAddress,
+    stakeAddressCredential,
     StakeKey,
     StakeExtendedKey,
 

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

@@ -47,6 +47,7 @@ module Cardano.Api.Address (
     StakeAddress(..),
     StakeCredential(..),
     makeStakeAddress,
+    stakeAddressCredential,
     StakeKey,
     StakeExtendedKey,
 
@@ -718,3 +719,7 @@ fromShelleyStakeReference (Shelley.StakeRefPtr ptr) =
 fromShelleyStakeReference Shelley.StakeRefNull =
   NoStakeAddress
 
+-- | Get a stake credential from a stake address.
+-- This drops the network information.
+stakeAddressCredential :: StakeAddress -> StakeCredential
+stakeAddressCredential (StakeAddress _ scred) = fromShelleyStakeCredential scred

cardano-cli/ChangeLog.md

@@ -14,6 +14,13 @@
 
 - Add `slotInEpoch` and `slotsToEpochEnd` to output of `query tip` command ([PR 4912](https://github.com/input-output-hk/cardano-node/pull/4912))
 
+- Add `--stake-address` option to the following CLI commands ([PR 3404](https://github.com/input-output-hk/cardano-node/pull/3404)):
+  - address build
+  - stake-address build
+  - stake-address registration-certificate
+  - stake-address delegation-certificate
+  - stake-address deregistration-certificate
+
 ### Bugs
 
 - Allow reading signing keys from a pipe ([PR 4342](https://github.com/input-output-hk/cardano-node/pull/4342))

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

@@ -102,6 +102,7 @@ data PaymentVerifier
 data StakeVerifier
   = StakeVerifierKey (VerificationKeyOrFile StakeKey)
   | StakeVerifierScriptFile ScriptFile
+  | StakeVerifierAddress StakeAddress
   deriving (Eq, Show)
 
 -- | Either an unvalidated text representation of a verification key or a path

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

@@ -178,6 +178,7 @@ pStakeVerifier =
     <|> StakeVerifierScriptFile <$>
           pScriptFor "stake-script-file" Nothing
                      "Filepath of the staking script."
+    <|> StakeVerifierAddress <$> pStakeAddress
 
 pPaymentVerificationKeyTextOrFile :: Parser VerificationKeyTextOrFile
 pPaymentVerificationKeyTextOrFile =

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

@@ -173,6 +173,9 @@ makeStakeAddressRef stakeVerifier = case stakeVerifier of
         let stakeCred = StakeCredentialByScript (hashScript script)
         return (StakeAddressByValue stakeCred)
 
+      StakeVerifierAddress stakeAddr ->
+        pure $ StakeAddressByValue $ stakeAddressCredential stakeAddr
+
 buildShelleyAddress
   :: VerificationKey PaymentKey
   -> Maybe StakeVerifier

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

@@ -87,7 +87,7 @@ runGovernanceMIRCertificatePayStakeAddrs mirPot sAddrs rwdAmts (OutputFile oFp)
       left $ ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach
                oFp (length sAddrs) (length rwdAmts)
 
-    let sCreds  = map stakeAddrToStakeCredential sAddrs
+    let sCreds  = map stakeAddressCredential sAddrs
         mirCert = makeMIRCertificate mirPot (StakeAddressesMIR $ zip sCreds rwdAmts)
 
     firstExceptT ShelleyGovernanceCmdTextEnvWriteError
@@ -97,11 +97,6 @@ runGovernanceMIRCertificatePayStakeAddrs mirPot sAddrs rwdAmts (OutputFile oFp)
     mirCertDesc :: TextEnvelopeDescr
     mirCertDesc = "Move Instantaneous Rewards Certificate"
 
-    --TODO: expose a pattern for StakeAddress that give us the StakeCredential
-    stakeAddrToStakeCredential :: StakeAddress -> StakeCredential
-    stakeAddrToStakeCredential (StakeAddress _ scred) =
-      fromShelleyStakeCredential scred
-
 runGovernanceMIRCertificateTransfer
   :: Lovelace
   -> OutputFile

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

@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Cardano.CLI.Shelley.Run.StakeAddress
   ( ShelleyStakeAddressCmdError(ShelleyStakeAddressCmdReadKeyFileError)
   , renderShelleyStakeAddressCmdError
@@ -89,50 +91,23 @@ runStakeAddressBuild
   -> NetworkId
   -> Maybe OutputFile
   -> ExceptT ShelleyStakeAddressCmdError IO ()
-runStakeAddressBuild stakeVerifier network mOutputFp =
-  case stakeVerifier of
-    StakeVerifierScriptFile (ScriptFile sFile) -> do
-      ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
-                                    $ readFileScriptInAnyLang sFile
-      let stakeCred = StakeCredentialByScript $ hashScript script
-          stakeAddr = makeStakeAddress network stakeCred
-          stakeAddrText = serialiseAddress stakeAddr
-
-      case mOutputFp of
-        Just (OutputFile fpath) -> liftIO $ Text.writeFile fpath stakeAddrText
-        Nothing -> liftIO $ Text.putStrLn stakeAddrText
-
-    StakeVerifierKey stakeVerKeyOrFile -> do
-      stakeVerKey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
-                       . newExceptT
-                       $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
-
-      let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVerKey)
-          stakeAddr = makeStakeAddress network stakeCred
-          stakeAddrText = serialiseAddress stakeAddr
-
-      case mOutputFp of
-        Just (OutputFile fpath) -> liftIO $ Text.writeFile fpath stakeAddrText
-        Nothing -> liftIO $ Text.putStrLn stakeAddrText
+runStakeAddressBuild stakeVerifier network mOutputFp = do
+  stakeAddr <- getStakeAddressFromVerifier network stakeVerifier
+  let stakeAddrText = serialiseAddress stakeAddr
+  liftIO $
+    case mOutputFp of
+      Just (OutputFile fpath) -> Text.writeFile fpath stakeAddrText
+      Nothing -> Text.putStrLn stakeAddrText
 
 
 runStakeCredentialRegistrationCert
   :: StakeVerifier
   -> OutputFile
   -> ExceptT ShelleyStakeAddressCmdError IO ()
-runStakeCredentialRegistrationCert stakeVerifier (OutputFile oFp) =
-  case stakeVerifier of
-    StakeVerifierScriptFile (ScriptFile sFile) -> do
-      ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
-                                    $ readFileScriptInAnyLang sFile
-      let stakeCred = StakeCredentialByScript $ hashScript script
-      writeRegistrationCert stakeCred
-    StakeVerifierKey stakeVerKeyOrFile -> do
-      stakeVerKey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
-        . newExceptT
-        $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
-      let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVerKey)
-      writeRegistrationCert stakeCred
+runStakeCredentialRegistrationCert stakeVerifier (OutputFile oFp) = do
+  stakeCred <- getStakeCredentialFromVerifier stakeVerifier
+  writeRegistrationCert stakeCred
+
  where
   writeRegistrationCert
     :: StakeCredential
@@ -160,19 +135,9 @@ runStakeCredentialDelegationCert stakeVerifier poolVKeyOrHashOrFile (OutputFile
     firstExceptT
       ShelleyStakeAddressCmdReadKeyFileError
       (newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
+  stakeCred <- getStakeCredentialFromVerifier stakeVerifier
+  writeDelegationCert stakeCred poolStakeVKeyHash
 
-  case stakeVerifier of
-    StakeVerifierScriptFile (ScriptFile sFile) -> do
-      ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
-                                    $ readFileScriptInAnyLang sFile
-      let stakeCred = StakeCredentialByScript $ hashScript script
-      writeDelegationCert stakeCred poolStakeVKeyHash
-    StakeVerifierKey stakeVerKeyOrFile -> do
-      stakeVkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
-        . newExceptT
-        $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
-      let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVkey)
-      writeDelegationCert stakeCred poolStakeVKeyHash
   where
     writeDelegationCert
       :: StakeCredential
@@ -192,19 +157,10 @@ runStakeCredentialDeRegistrationCert
   :: StakeVerifier
   -> OutputFile
   -> ExceptT ShelleyStakeAddressCmdError IO ()
-runStakeCredentialDeRegistrationCert stakeVerifier (OutputFile oFp) =
-  case stakeVerifier of
-    StakeVerifierScriptFile (ScriptFile sFile) -> do
-      ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
-                                    $ readFileScriptInAnyLang sFile
-      let stakeCred = StakeCredentialByScript $ hashScript script
-      writeDeregistrationCert stakeCred
-    StakeVerifierKey stakeVerKeyOrFile -> do
-      stakeVkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
-        . newExceptT
-        $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
-      let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVkey)
-      writeDeregistrationCert stakeCred
+runStakeCredentialDeRegistrationCert stakeVerifier (OutputFile oFp) = do
+  stakeCred <- getStakeCredentialFromVerifier stakeVerifier
+  writeDeregistrationCert stakeCred
+
   where
     writeDeregistrationCert
       :: StakeCredential
@@ -217,3 +173,31 @@ runStakeCredentialDeRegistrationCert stakeVerifier (OutputFile oFp) =
 
     deregCertDesc :: TextEnvelopeDescr
     deregCertDesc = "Stake Address Deregistration Certificate"
+
+
+getStakeCredentialFromVerifier
+  :: StakeVerifier -> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
+getStakeCredentialFromVerifier = \case
+  StakeVerifierScriptFile (ScriptFile sFile) -> do
+    ScriptInAnyLang _ script <-
+      firstExceptT ShelleyStakeAddressCmdReadScriptFileError $
+        readFileScriptInAnyLang sFile
+    pure $ StakeCredentialByScript $ hashScript script
+
+  StakeVerifierKey stakeVerKeyOrFile -> do
+    stakeVerKey <-
+      firstExceptT ShelleyStakeAddressCmdReadKeyFileError
+        . newExceptT
+        $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
+    pure $ StakeCredentialByKey $ verificationKeyHash stakeVerKey
+
+  StakeVerifierAddress stakeAddr -> pure $ stakeAddressCredential stakeAddr
+
+getStakeAddressFromVerifier
+  :: NetworkId
+  -> StakeVerifier
+  -> ExceptT ShelleyStakeAddressCmdError IO StakeAddress
+getStakeAddressFromVerifier networkId = \case
+  StakeVerifierAddress stakeAddr -> pure stakeAddr
+  stakeVerifier ->
+    makeStakeAddress networkId <$> getStakeCredentialFromVerifier stakeVerifier