Implement stake address (via script credential) registration, deregistration and delegation

cardano-cli/cardano-cli.cabal

@@ -209,6 +209,7 @@ test-suite cardano-cli-golden
                       , Diff
                       , directory
                       , exceptions
+                      , filepath
                       , hedgehog
                       , hedgehog-extras
                       , text

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

@@ -118,12 +118,12 @@ data StakeAddressCmd
   = StakeAddressKeyGen VerificationKeyFile SigningKeyFile
   | StakeAddressKeyHash (VerificationKeyOrFile StakeKey) (Maybe OutputFile)
   | StakeAddressBuild (VerificationKeyOrFile StakeKey) NetworkId (Maybe OutputFile)
-  | StakeKeyRegistrationCert (VerificationKeyOrFile StakeKey) OutputFile
-  | StakeKeyDelegationCert
-      (VerificationKeyOrFile StakeKey)
+  | StakeRegistrationCert StakeVerifier OutputFile
+  | StakeCredentialDelegationCert
+      StakeVerifier
       (VerificationKeyOrHashOrFile StakePoolKey)
       OutputFile
-  | StakeKeyDeRegistrationCert (VerificationKeyOrFile StakeKey) OutputFile
+  | StakeCredentialDeRegistrationCert StakeVerifier OutputFile
   deriving Show
 
 renderStakeAddressCmd :: StakeAddressCmd -> Text
@@ -132,9 +132,9 @@ renderStakeAddressCmd cmd =
     StakeAddressKeyGen {} -> "stake-address key-gen"
     StakeAddressKeyHash {} -> "stake-address key-hash"
     StakeAddressBuild {} -> "stake-address build"
-    StakeKeyRegistrationCert {} -> "stake-address registration-certificate"
-    StakeKeyDelegationCert {} -> "stake-address delegation-certificate"
-    StakeKeyDeRegistrationCert {} -> "stake-address deregistration-certificate"
+    StakeRegistrationCert {} -> "stake-address registration-certificate"
+    StakeCredentialDelegationCert {} -> "stake-address delegation-certificate"
+    StakeCredentialDeRegistrationCert {} -> "stake-address deregistration-certificate"
 
 data KeyCmd
   = KeyGetVerificationKey SigningKeyFile VerificationKeyFile

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

@@ -48,8 +48,8 @@ import qualified Data.Attoparsec.ByteString.Char8 as Atto
 import qualified Options.Applicative as Opt
 import qualified Text.Parsec as Parsec
 import qualified Text.Parsec.Error as Parsec
-import qualified Text.Parsec.String as Parsec
 import qualified Text.Parsec.Language as Parsec
+import qualified Text.Parsec.String as Parsec
 import qualified Text.Parsec.Token as Parsec
 
 import qualified Shelley.Spec.Ledger.TxBody as Shelley
@@ -327,18 +327,18 @@ pStakeAddressCmd =
                                            <*> pMaybeOutputFile
 
     pStakeAddressRegistrationCert :: Parser StakeAddressCmd
-    pStakeAddressRegistrationCert = StakeKeyRegistrationCert
-                                      <$> pStakeVerificationKeyOrFile
+    pStakeAddressRegistrationCert = StakeRegistrationCert
+                                      <$> pStakeVerifier
                                       <*> pOutputFile
 
     pStakeAddressDeregistrationCert :: Parser StakeAddressCmd
-    pStakeAddressDeregistrationCert = StakeKeyDeRegistrationCert
-                                        <$> pStakeVerificationKeyOrFile
+    pStakeAddressDeregistrationCert = StakeCredentialDeRegistrationCert
+                                        <$> pStakeVerifier
                                         <*> pOutputFile
 
     pStakeAddressDelegationCert :: Parser StakeAddressCmd
-    pStakeAddressDelegationCert = StakeKeyDelegationCert
-                                    <$> pStakeVerificationKeyOrFile
+    pStakeAddressDelegationCert = StakeCredentialDelegationCert
+                                    <$> pStakeVerifier
                                     <*> pStakePoolVerificationKeyOrHashOrFile
                                     <*> pOutputFile
 

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

@@ -16,14 +16,16 @@ import           Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT)
 import           Cardano.Api
 import           Cardano.Api.Shelley
 
-import           Cardano.CLI.Shelley.Key (InputDecodeError, VerificationKeyOrFile,
-                     VerificationKeyOrHashOrFile, readVerificationKeyOrFile,
-                     readVerificationKeyOrHashOrFile)
+import           Cardano.CLI.Shelley.Key (InputDecodeError, StakeVerifier (..),
+                   VerificationKeyOrFile, VerificationKeyOrHashOrFile, readVerificationKeyOrFile,
+                   readVerificationKeyOrHashOrFile)
 import           Cardano.CLI.Shelley.Parsers
+import           Cardano.CLI.Shelley.Script (ScriptDecodeError, readFileScriptInAnyLang)
 import           Cardano.CLI.Types
 
 data ShelleyStakeAddressCmdError
   = ShelleyStakeAddressCmdReadKeyFileError !(FileError InputDecodeError)
+  | ShelleyStakeAddressCmdReadScriptFileError !(FileError ScriptDecodeError)
   | ShelleyStakeAddressCmdWriteFileError !(FileError ())
   deriving Show
 
@@ -32,18 +34,18 @@ renderShelleyStakeAddressCmdError err =
   case err of
     ShelleyStakeAddressCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr)
     ShelleyStakeAddressCmdWriteFileError fileErr -> Text.pack (displayError fileErr)
-
+    ShelleyStakeAddressCmdReadScriptFileError fileErr -> Text.pack (displayError fileErr)
 
 runStakeAddressCmd :: StakeAddressCmd -> ExceptT ShelleyStakeAddressCmdError IO ()
 runStakeAddressCmd (StakeAddressKeyGen vk sk) = runStakeAddressKeyGen vk sk
 runStakeAddressCmd (StakeAddressKeyHash vk mOutputFp) = runStakeAddressKeyHash vk mOutputFp
 runStakeAddressCmd (StakeAddressBuild vk nw mOutputFp) = runStakeAddressBuild vk nw mOutputFp
-runStakeAddressCmd (StakeKeyRegistrationCert stkKeyVerKeyOrFp outputFp) =
-  runStakeKeyRegistrationCert stkKeyVerKeyOrFp outputFp
-runStakeAddressCmd (StakeKeyDelegationCert stkKeyVerKeyOrFp stkPoolVerKeyHashOrFp outputFp) =
-  runStakeKeyDelegationCert stkKeyVerKeyOrFp stkPoolVerKeyHashOrFp outputFp
-runStakeAddressCmd (StakeKeyDeRegistrationCert stkKeyVerKeyOrFp outputFp) =
-  runStakeKeyDeRegistrationCert stkKeyVerKeyOrFp outputFp
+runStakeAddressCmd (StakeRegistrationCert stakeVerifier outputFp) =
+  runStakeCredentialRegistrationCert stakeVerifier outputFp
+runStakeAddressCmd (StakeCredentialDelegationCert stakeVerifier stkPoolVerKeyHashOrFp outputFp) =
+  runStakeCredentialDelegationCert stakeVerifier stkPoolVerKeyHashOrFp outputFp
+runStakeAddressCmd (StakeCredentialDeRegistrationCert stakeVerifier outputFp) =
+  runStakeCredentialDeRegistrationCert stakeVerifier outputFp
 
 
 --
@@ -96,67 +98,104 @@ runStakeAddressBuild stakeVerKeyOrFile network mOutputFp = do
       Nothing -> liftIO $ Text.putStrLn stakeAddrText
 
 
-runStakeKeyRegistrationCert
-  :: VerificationKeyOrFile StakeKey
+runStakeCredentialRegistrationCert
+  :: StakeVerifier
   -> OutputFile
   -> ExceptT ShelleyStakeAddressCmdError IO ()
-runStakeKeyRegistrationCert stakeVerKeyOrFile (OutputFile oFp) = do
-    stakeVerKey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
-      . newExceptT
-      $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
-    let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVerKey)
-        regCert = makeStakeAddressRegistrationCertificate stakeCred
+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
+ where
+  writeRegistrationCert
+    :: StakeCredential
+    -> ExceptT ShelleyStakeAddressCmdError IO ()
+  writeRegistrationCert sCred = do
+    let deRegCert = makeStakeAddressRegistrationCertificate sCred
     firstExceptT ShelleyStakeAddressCmdWriteFileError
       . newExceptT
-      $ writeFileTextEnvelope oFp (Just regCertDesc) regCert
-  where
-    regCertDesc :: TextEnvelopeDescr
-    regCertDesc = "Stake Address Registration Certificate"
+      $ writeFileTextEnvelope oFp (Just regCertDesc) deRegCert
 
+  regCertDesc :: TextEnvelopeDescr
+  regCertDesc = "Stake Address Registration Certificate"
 
-runStakeKeyDelegationCert
-  :: VerificationKeyOrFile StakeKey
-  -- ^ Delegator stake verification key or verification key file.
+
+runStakeCredentialDelegationCert
+  :: StakeVerifier
+  -- ^ Delegator stake verification key, verification key file or script file.
   -> VerificationKeyOrHashOrFile StakePoolKey
   -- ^ Delegatee stake pool verification key or verification key file or
   -- verification key hash.
   -> OutputFile
   -> ExceptT ShelleyStakeAddressCmdError IO ()
-runStakeKeyDelegationCert stakeVerKeyOrFile poolVKeyOrHashOrFile (OutputFile outFp) = do
-    stakeVkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
-      . newExceptT
-      $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
-
-    poolStakeVKeyHash <-
-      firstExceptT
-        ShelleyStakeAddressCmdReadKeyFileError
-        (newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
-
-    let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVkey)
-        delegCert = makeStakeAddressDelegationCertificate
-                      stakeCred
-                      poolStakeVKeyHash
-    firstExceptT ShelleyStakeAddressCmdWriteFileError
-      . newExceptT
-      $ writeFileTextEnvelope outFp (Just delegCertDesc) delegCert
+runStakeCredentialDelegationCert stakeVerifier poolVKeyOrHashOrFile (OutputFile outFp) = do
+  poolStakeVKeyHash <-
+    firstExceptT
+      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
   where
+    writeDelegationCert
+      :: StakeCredential
+      -> Hash StakePoolKey
+      -> ExceptT ShelleyStakeAddressCmdError IO ()
+    writeDelegationCert sCred poolStakeVKeyHash = do
+      let delegCert = makeStakeAddressDelegationCertificate sCred poolStakeVKeyHash
+      firstExceptT ShelleyStakeAddressCmdWriteFileError
+        . newExceptT
+        $ writeFileTextEnvelope outFp (Just delegCertDesc) delegCert
+
     delegCertDesc :: TextEnvelopeDescr
     delegCertDesc = "Stake Address Delegation Certificate"
 
 
-runStakeKeyDeRegistrationCert
-  :: VerificationKeyOrFile StakeKey
+runStakeCredentialDeRegistrationCert
+  :: StakeVerifier
   -> OutputFile
   -> ExceptT ShelleyStakeAddressCmdError IO ()
-runStakeKeyDeRegistrationCert stakeVerKeyOrFile (OutputFile oFp) = do
-    stakeVkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
-      . newExceptT
-      $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
-    let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVkey)
-        deRegCert = makeStakeAddressDeregistrationCertificate stakeCred
-    firstExceptT ShelleyStakeAddressCmdWriteFileError
-      . newExceptT
-      $ writeFileTextEnvelope oFp (Just deregCertDesc) deRegCert
+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
   where
+    writeDeregistrationCert
+      :: StakeCredential
+      -> ExceptT ShelleyStakeAddressCmdError IO ()
+    writeDeregistrationCert sCred = do
+      let deRegCert = makeStakeAddressDeregistrationCertificate sCred
+      firstExceptT ShelleyStakeAddressCmdWriteFileError
+        . newExceptT
+        $ writeFileTextEnvelope oFp (Just deregCertDesc) deRegCert
+
     deregCertDesc :: TextEnvelopeDescr
     deregCertDesc = "Stake Address Deregistration Certificate"

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

@@ -4,14 +4,13 @@ module Cardano.CLI.Shelley.Script
   , readFileScriptInAnyLang
   ) where
 
-import           Prelude
 import           Cardano.Prelude (ExceptT)
+import           Prelude
 
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS
 
-import           Control.Monad.Trans.Except.Extra
-                   (firstExceptT, handleIOExceptT, hoistEither)
+import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither)
 
 import           Cardano.Api
 
@@ -42,9 +41,9 @@ readFileScriptInAnyLang :: FilePath
                         -> ExceptT (FileError ScriptDecodeError) IO
                                    ScriptInAnyLang
 readFileScriptInAnyLang file = do
-    scriptBytes <- handleIOExceptT (FileIOError file) $ BS.readFile file
-    firstExceptT (FileError file) $ hoistEither $
-      deserialiseScriptInAnyLang scriptBytes
+  scriptBytes <- handleIOExceptT (FileIOError file) $ BS.readFile file
+  firstExceptT (FileError file) $ hoistEither $
+    deserialiseScriptInAnyLang scriptBytes
 
 
 deserialiseScriptInAnyLang :: ByteString

cardano-cli/test/Test/Golden/Shelley/StakeAddress/DeregistrationCertificate.hs

@@ -6,17 +6,23 @@ module Test.Golden.Shelley.StakeAddress.DeregistrationCertificate
 
 import           Cardano.Prelude
 import           Hedgehog (Property)
+import           System.FilePath ((</>))
 import           Test.OptParse
 
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
+import qualified Hedgehog.Extras.Test.Process as H
 
 {- HLINT ignore "Use camelCase" -}
 
 golden_shelleyStakeAddressDeregistrationCertificate :: Property
 golden_shelleyStakeAddressDeregistrationCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
+  base <- H.getProjectBase
+
   verificationKeyFile <- noteInputFile "test/data/golden/shelley/keys/stake_keys/verification_key"
   deregistrationCertFile <- noteTempFile tempDir "deregistrationCertFile"
+  scriptDeregistrationCertFile <- noteTempFile tempDir "scripDeregistrationCertFile"
+  exampleScript <- noteInputFile $ base </> "scripts/plutus/scripts/typed-guessing-game-redeemer-42-datum-42.plutus"
 
   void $ execCardanoCLI
     [ "stake-address","deregistration-certificate"
@@ -26,4 +32,12 @@ golden_shelleyStakeAddressDeregistrationCertificate = propertyOnce . H.moduleWor
 
   H.assertFileOccurences 1 "Stake Address Deregistration Certificate" deregistrationCertFile
 
+  void $ execCardanoCLI
+    [ "stake-address","deregistration-certificate"
+    , "--stake-script-file", exampleScript
+    , "--out-file", scriptDeregistrationCertFile
+    ]
+
+  H.assertFileOccurences 1 "Stake Address Deregistration Certificate" scriptDeregistrationCertFile
+
   H.assertEndsWithSingleNewline deregistrationCertFile

cardano-cli/test/Test/Golden/Shelley/StakeAddress/RegistrationCertificate.hs

@@ -6,17 +6,23 @@ module Test.Golden.Shelley.StakeAddress.RegistrationCertificate
 
 import           Cardano.Prelude
 import           Hedgehog (Property)
+import           System.FilePath ((</>))
 import           Test.OptParse
 
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
+import qualified Hedgehog.Extras.Test.Process as H
 
 {- HLINT ignore "Use camelCase" -}
 
 golden_shelleyStakeAddressRegistrationCertificate :: Property
 golden_shelleyStakeAddressRegistrationCertificate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
+  base <- H.getProjectBase
+
   keyGenStakingVerificationKeyFile <- noteInputFile "test/data/golden/shelley/keys/stake_keys/verification_key"
   registrationCertFile <- noteTempFile tempDir "registration.cert"
+  scriptRegistrationCertFile <- noteTempFile tempDir "script-registration.cert"
+  exampleScript <- noteInputFile $ base </> "scripts/plutus/scripts/typed-guessing-game-redeemer-42-datum-42.plutus"
 
   void $ execCardanoCLI
     [ "stake-address","registration-certificate"
@@ -26,4 +32,12 @@ golden_shelleyStakeAddressRegistrationCertificate = propertyOnce . H.moduleWorks
 
   H.assertFileOccurences 1 "Stake Address Registration Certificate" registrationCertFile
 
+  void $ execCardanoCLI
+    [ "stake-address","registration-certificate"
+    , "--stake-script-file", exampleScript
+    , "--out-file", scriptRegistrationCertFile
+    ]
+
+  H.assertFileOccurences 1 "Stake Address Registration Certificate" scriptRegistrationCertFile
+
   H.assertEndsWithSingleNewline registrationCertFile

nix/haskell.nix

@@ -115,7 +115,10 @@ let
         packages.ekg.components.library.enableSeparateDataOutput = true;
 
         # cardano-cli-test depends on cardano-cli
-        packages.cardano-cli.preCheck = "export CARDANO_CLI=${config.hsPkgs.cardano-cli.components.exes.cardano-cli}/bin/cardano-cli${pkgs.stdenv.hostPlatform.extensions.executable}";
+        packages.cardano-cli.preCheck = "
+          export CARDANO_CLI=${config.hsPkgs.cardano-cli.components.exes.cardano-cli}/bin/cardano-cli${pkgs.stdenv.hostPlatform.extensions.executable}
+          export CARDANO_NODE_SRC=${src}
+        ";
 
         packages.cardano-node-chairman.components.tests.chairman-tests.build-tools =
           lib.mkForce [