cardano-cli: Add option --stake-address to subcommand stake-address registration-certificate

Fix #2723

Author: cblp

cardano-api/src/Cardano/Api.hs

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

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

@@ -44,6 +44,7 @@ module Cardano.Api.Address (
     StakeAddress(..),
     StakeCredential(..),
     makeStakeAddress,
+    getStakeAddressCredential,
     StakeKey,
     StakeExtendedKey,
 
@@ -621,3 +622,6 @@ fromShelleyStakeReference (Shelley.StakeRefPtr ptr) =
 fromShelleyStakeReference Shelley.StakeRefNull =
   NoStakeAddress
 
+getStakeAddressCredential :: StakeAddress -> StakeCredential
+getStakeAddressCredential (StakeAddress _ scred) =
+  fromShelleyStakeCredential scred

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

@@ -392,6 +392,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

@@ -174,10 +174,13 @@ pPaymentVerifier =
 
 pStakeVerifier :: Parser StakeVerifier
 pStakeVerifier =
-        StakeVerifierKey <$> pStakeVerificationKeyOrFile
-    <|> StakeVerifierScriptFile <$>
-          pScriptFor "stake-script-file" Nothing
-                     "Filepath of the staking script."
+  StakeVerifierKey <$> pStakeVerificationKeyOrFile
+  <|> StakeVerifierScriptFile
+      <$> pScriptFor
+            "stake-script-file"
+            Nothing
+            "Filepath of the staking script."
+  <|> StakeVerifierAddress <$> pStakeAddress
 
 pPaymentVerificationKeyTextOrFile :: Parser VerificationKeyTextOrFile
 pPaymentVerificationKeyTextOrFile =
@@ -341,9 +344,8 @@ pStakeAddressCmd =
                                            <*> pMaybeOutputFile
 
     pStakeAddressRegistrationCert :: Parser StakeAddressCmd
-    pStakeAddressRegistrationCert = StakeRegistrationCert
-                                      <$> pStakeVerifier
-                                      <*> pOutputFile
+    pStakeAddressRegistrationCert =
+      StakeRegistrationCert <$> pStakeVerifier <*> pOutputFile
 
     pStakeAddressDeregistrationCert :: Parser StakeAddressCmd
     pStakeAddressDeregistrationCert = StakeCredentialDeRegistrationCert

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

@@ -165,6 +165,9 @@ makeStakeAddressRef mbStakeVerifier = do
         let stakeCred = StakeCredentialByScript (hashScript script)
         return (StakeAddressByValue stakeCred)
 
+      StakeVerifierAddress stakeAddr ->
+        pure $ StakeAddressByValue $ getStakeAddressCredential stakeAddr
+
 buildShelleyAddress
   :: VerificationKey PaymentKey
   -> Maybe StakeVerifier
@@ -232,4 +235,3 @@ runAddressBuildScript
 runAddressBuildScript scriptFile networkId mOutputFile = do
   liftIO $ deprecationWarning "'address build'"
   runAddressBuild (PaymentVerifierScriptFile scriptFile) Nothing networkId mOutputFile
-

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

@@ -74,7 +74,7 @@ runGovernanceMIRCertificatePayStakeAddrs mirPot sAddrs rwdAmts (OutputFile oFp)
       left $ ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach
                oFp (length sAddrs) (length rwdAmts)
 
-    let sCreds  = map stakeAddrToStakeCredential sAddrs
+    let sCreds  = map getStakeAddressCredential sAddrs
         mirCert = makeMIRCertificate mirPot (StakeAddressesMIR $ zip sCreds rwdAmts)
 
     firstExceptT ShelleyGovernanceCmdTextEnvWriteError
@@ -84,11 +84,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

@@ -88,51 +88,51 @@ 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 <-
+    case stakeVerifier of
+      StakeVerifierScriptFile (ScriptFile sFile) -> do
+        ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
+                                      $ readFileScriptInAnyLang sFile
+        let stakeCred = StakeCredentialByScript $ hashScript script
+        pure $ makeStakeAddress network stakeCred
+
+      StakeVerifierKey stakeVerKeyOrFile -> do
+        stakeVerKey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
+                        . newExceptT
+                        $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
+
+        let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVerKey)
+        pure $ makeStakeAddress network stakeCred
+
+      StakeVerifierAddress stakeAddr -> pure stakeAddr
+
+  let stakeAddrText = serialiseAddress stakeAddr
+  case mOutputFp of
+    Just (OutputFile fpath) -> liftIO $ Text.writeFile fpath stakeAddrText
+    Nothing -> liftIO $ 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
+  :: StakeVerifier -> OutputFile -> ExceptT ShelleyStakeAddressCmdError IO ()
+runStakeCredentialRegistrationCert stakeVerifier (OutputFile oFp) = do
+  stakeCred <-
+    case stakeVerifier of
+      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 $ getStakeAddressCredential stakeAddr
+  writeRegistrationCert stakeCred
  where
+
   writeRegistrationCert
     :: StakeCredential
     -> ExceptT ShelleyStakeAddressCmdError IO ()
@@ -160,18 +160,23 @@ runStakeCredentialDelegationCert stakeVerifier poolVKeyOrHashOrFile (OutputFile
       ShelleyStakeAddressCmdReadKeyFileError
       (newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
 
-  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
+  stakeCred <-
+    case stakeVerifier of
+      StakeVerifierScriptFile (ScriptFile sFile) -> do
+        ScriptInAnyLang _ script <-
+          firstExceptT ShelleyStakeAddressCmdReadScriptFileError $
+            readFileScriptInAnyLang sFile
+        pure $ StakeCredentialByScript $ hashScript script
+      StakeVerifierKey stakeVerKeyOrFile -> do
+        stakeVkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
+          . newExceptT
+          $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
+        pure $ StakeCredentialByKey $ verificationKeyHash stakeVkey
+      StakeVerifierAddress stakeAddr ->
+        pure $ getStakeAddressCredential stakeAddr
+
+  writeDelegationCert stakeCred poolStakeVKeyHash
+
   where
     writeDelegationCert
       :: StakeCredential
@@ -191,19 +196,23 @@ 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 <-
+    case stakeVerifier of
+      StakeVerifierScriptFile (ScriptFile sFile) -> do
+        ScriptInAnyLang _ script <-
+          firstExceptT ShelleyStakeAddressCmdReadScriptFileError $
+            readFileScriptInAnyLang sFile
+        pure $ StakeCredentialByScript $ hashScript script
+      StakeVerifierKey stakeVerKeyOrFile -> do
+        stakeVkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
+          . newExceptT
+          $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
+        pure $ StakeCredentialByKey $ verificationKeyHash stakeVkey
+      StakeVerifierAddress stakeAddr ->
+        pure $ getStakeAddressCredential stakeAddr
+  writeDeregistrationCert stakeCred
+
   where
     writeDeregistrationCert
       :: StakeCredential