cardano-cli: Add option --stake-address to some subcommands:

- address build - stake-address build - stake-address registration-certificate - stake-address deregistration-certificate - stake-address delegation-certificate Fix #2723
IntersectMBO · Mar 17, 2022 · ffe0d7d · ffe0d7d
1 parent aa49e91
commit ffe0d7d
Show file tree

Hide file tree

Showing 4 changed files with 65 additions and 63 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Key.hs b/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

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/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 =

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Address.hs b/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 $ stakeAddressCredential stakeAddr
+
 buildShelleyAddress
   :: VerificationKey PaymentKey
   -> Maybe StakeVerifier

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/StakeAddress.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Cardano.CLI.Shelley.Run.StakeAddress
   ( ShelleyStakeAddressCmdError(ShelleyStakeAddressCmdReadKeyFileError)
   , renderShelleyStakeAddressCmdError
@@ -88,51 +90,24 @@ 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 <- loadStakeAddressFromVerifier 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 <- loadStakeCredentialFromVerifier stakeVerifier
+  writeRegistrationCert stakeCred
  where
+
   writeRegistrationCert
     :: StakeCredential
     -> ExceptT ShelleyStakeAddressCmdError IO ()
@@ -159,19 +134,9 @@ runStakeCredentialDelegationCert stakeVerifier poolVKeyOrHashOrFile (OutputFile
     firstExceptT
       ShelleyStakeAddressCmdReadKeyFileError
       (newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
+  stakeCred <- loadStakeCredentialFromVerifier 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
@@ -191,19 +156,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 <- loadStakeCredentialFromVerifier stakeVerifier
+  writeDeregistrationCert stakeCred
+
   where
     writeDeregistrationCert
       :: StakeCredential
@@ -216,3 +172,44 @@ runStakeCredentialDeRegistrationCert stakeVerifier (OutputFile oFp) =
 
     deregCertDesc :: TextEnvelopeDescr
     deregCertDesc = "Stake Address Deregistration Certificate"
+
+
+loadStakeCredentialFromVerifier
+  :: StakeVerifier -> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
+loadStakeCredentialFromVerifier stakeVerifier =
+  either stakeAddressCredential identity <$> loadStakeVerifier stakeVerifier
+
+loadStakeAddressFromVerifier
+  :: NetworkId
+  -> StakeVerifier
+  -> ExceptT ShelleyStakeAddressCmdError IO StakeAddress
+loadStakeAddressFromVerifier network stakeVerifier =
+  either identity (makeStakeAddress network) <$> loadStakeVerifier stakeVerifier
+
+-- | Load 'StakeAddress' or 'StakeCredential' from 'StakeVerifier',
+-- which one is closer.
+--
+-- For internal use in 'loadStakeCredentialFromVerifier' and
+-- 'loadStakeAddressFromVerifier' only
+loadStakeVerifier
+  :: StakeVerifier
+  -> ExceptT
+        ShelleyStakeAddressCmdError
+        IO
+        (Either StakeAddress StakeCredential)
+loadStakeVerifier = \case
+
+  StakeVerifierScriptFile (ScriptFile sFile) -> do
+    ScriptInAnyLang _ script <-
+      firstExceptT ShelleyStakeAddressCmdReadScriptFileError $
+        readFileScriptInAnyLang sFile
+    pure $ Right $ StakeCredentialByScript $ hashScript script
+
+  StakeVerifierKey stakeVerKeyOrFile -> do
+    stakeVerKey <-
+      firstExceptT ShelleyStakeAddressCmdReadKeyFileError
+        . newExceptT
+        $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
+    pure $ Right $ StakeCredentialByKey $ verificationKeyHash stakeVerKey
+
+  StakeVerifierAddress stakeAddr -> pure $ Left stakeAddr