Merge pull request #563 from IntersectMBO/ch/register-drep-scripts

Allow for registration of DRep scripts

cardano-cli/cardano-cli.cabal

@@ -373,6 +373,7 @@ test-suite cardano-cli-golden
                         Test.Golden.Governance.Action
                         Test.Golden.Governance.Committee
                         Test.Golden.Governance.DRep
+                        Test.Golden.Governance.Hash
                         Test.Golden.Governance.StakeAddress
                         Test.Golden.Governance.Vote
                         Test.Golden.Help

cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs

@@ -48,7 +48,7 @@ data GovernanceDRepIdCmdArgs era =
 data GovernanceDRepRegistrationCertificateCmdArgs era =
   GovernanceDRepRegistrationCertificateCmdArgs
     { eon                 :: !(ConwayEraOnwards era)
-    , drepVkeyHashSource  :: !(VerificationKeyOrHashOrFile DRepKey)
+    , drepHashSource      :: !DRepHashSource
     , deposit             :: !Lovelace
     , mAnchor             :: !(Maybe (Ledger.Anchor (Ledger.EraCrypto (ShelleyLedgerEra era))))
     , outFile             :: !(File () Out)

cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Hash.hs

@@ -1,12 +1,13 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 
-
 module Cardano.CLI.EraBased.Commands.Governance.Hash
   (
     GovernanceHashCmds (..),
-    GovernanceHashCmdArgs (..),
-    GovernanceHashSource (..),
+    GovernanceHashAnchorDataCmdArgs (..),
+    GovernanceHashScriptCmdArgs (..),
+    GovernanceAnchorDataHashSource (..),
     renderGovernanceHashCmds
   ) where
 
@@ -16,21 +17,31 @@ import           Cardano.CLI.Types.Common
 
 import           Data.Text (Text)
 
-newtype GovernanceHashCmds era = GovernanceHashCmd (GovernanceHashCmdArgs era)
+data GovernanceHashCmds era
+  = GovernanceHashAnchorDataCmd !(GovernanceHashAnchorDataCmdArgs era)
+  | GovernanceHashScriptCmd !(GovernanceHashScriptCmdArgs era)
 
-data GovernanceHashCmdArgs era
-  = GovernanceHashCmdArgs {
+data GovernanceHashAnchorDataCmdArgs era
+  = GovernanceHashAnchorDataCmdArgs {
       eon     :: !(ConwayEraOnwards era)
-    , toHash  :: !GovernanceHashSource
+    , toHash  :: !GovernanceAnchorDataHashSource
     , moutFile :: !(Maybe (File () Out)) -- ^ The output file to which the hash is written
   } deriving Show
 
-data GovernanceHashSource
-  = GovernanceHashSourceBinaryFile (File ProposalText In)
-  | GovernanceHashSourceTextFile (File ProposalText In)
-  | GovernanceHashSourceText Text
+data GovernanceAnchorDataHashSource
+  = GovernanceAnchorDataHashSourceBinaryFile (File ProposalText In)
+  | GovernanceAnchorDataHashSourceTextFile (File ProposalText In)
+  | GovernanceAnchorDataHashSourceText Text
   deriving Show
 
+data GovernanceHashScriptCmdArgs era
+  = GovernanceHashScriptCmdArgs {
+      eon     :: !(ConwayEraOnwards era)
+    , toHash  ::  !ScriptFile
+    , moutFile :: !(Maybe (File () Out)) -- ^ The output file to which the hash is written
+  } deriving Show
+
 renderGovernanceHashCmds :: GovernanceHashCmds era -> Text
-renderGovernanceHashCmds =
-  \case GovernanceHashCmd {} -> "governance hash"
+renderGovernanceHashCmds = \case
+  GovernanceHashAnchorDataCmd {} -> "governance hash anchor-data"
+  GovernanceHashScriptCmd {} -> "governance hash script"

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

@@ -883,7 +883,7 @@ pConstitutionHash =
   Opt.option readSafeHash $ mconcat
     [ Opt.long "constitution-hash"
     , Opt.metavar "HASH"
-    , Opt.help "Hash of the constitution data (obtain it with \"cardano-cli conway governance hash ...\")."
+    , Opt.help "Hash of the constitution data (obtain it with \"cardano-cli conway governance hash anchor-data ...\")."
     ]
 
 pUrl :: String -> String -> Parser Ledger.Url
@@ -3029,7 +3029,7 @@ pVoteAnchorDataHash =
   Opt.option readSafeHash $ mconcat
     [ Opt.long "anchor-data-hash"
     , Opt.metavar "HASH"
-    , Opt.help "Hash of the vote anchor data (obtain it with \"cardano-cli conway governance hash ...\")."
+    , Opt.help "Hash of the vote anchor data (obtain it with \"cardano-cli conway governance hash anchor-data ...\")."
     ]
 
 pAlwaysNoConfidence :: Parser ()
@@ -3051,9 +3051,7 @@ pDRepScriptHash =
   Opt.option scriptHashReader $ mconcat
     [ Opt.long "drep-script-hash"
     , Opt.metavar "HASH"
-    , Opt.help $ mconcat
-        [ "DRep script hash (hex-encoded)."
-        ]
+    , Opt.help "DRep script hash (hex-encoded). Obtain it with \"cardano-cli conway governance hash script ...\"."
     ]
 
 pDRepVerificationKeyOrHashOrFile
@@ -3115,7 +3113,7 @@ pAnchorDataHash =
   Opt.option readSafeHash $ mconcat
     [ Opt.long "anchor-data-hash"
     , Opt.metavar "HASH"
-    , Opt.help "Proposal anchor data hash (obtain it with \"cardano-cli conway governance hash ...\")"
+    , Opt.help "Proposal anchor data hash (obtain it with \"cardano-cli conway governance hash anchor-data ...\")"
     ]
 
 pPreviousGovernanceAction :: Parser (Maybe (TxId, Word32))

cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/DRep.hs

@@ -102,7 +102,7 @@ pRegistrationCertificateCmd era = do
   mkParser w =
     fmap GovernanceDRepRegistrationCertificateCmd $
       GovernanceDRepRegistrationCertificateCmdArgs w
-        <$> pDRepVerificationKeyOrHashOrFile
+        <$> pDRepHashSource
         <*> pKeyRegistDeposit
         <*> pDRepMetadata
         <*> pOutputFile

cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Hash.hs

@@ -3,48 +3,74 @@
 
 module Cardano.CLI.EraBased.Options.Governance.Hash
   (
-    pGovernanceHashCmds
+    pGovernanceHashCmds,
   ) where
 
 import           Cardano.Api
 
-import           Cardano.CLI.EraBased.Commands.Governance.Hash
-                   (GovernanceHashCmdArgs (GovernanceHashCmdArgs))
 import qualified Cardano.CLI.EraBased.Commands.Governance.Hash as Cmd
 import           Cardano.CLI.EraBased.Options.Common
 
 import           Data.Foldable
 import           Options.Applicative
 import qualified Options.Applicative as Opt
 
-pGovernanceHashCmds :: ()
+pGovernanceHashCmds
+  :: CardanoEra era
+  -> Maybe (Parser (Cmd.GovernanceHashCmds era))
+pGovernanceHashCmds era =
+  subInfoParser "hash"
+    ( Opt.progDesc
+        $ mconcat
+          [ "Compute the hash to pass to the various --*-hash arguments of governance commands."
+          ]
+    )
+    [ pGovernanceHashAnchorDataCmd era
+    , pGovernanceHashScriptCmd era
+    ]
+
+pGovernanceHashAnchorDataCmd :: ()
   => CardanoEra era
   -> Maybe (Parser (Cmd.GovernanceHashCmds era))
-pGovernanceHashCmds era = do
+pGovernanceHashAnchorDataCmd era = do
   eon <- forEraMaybeEon era
   return
-    $ subParser "hash"
+    $ subParser "anchor-data"
     $ Opt.info
-        ( fmap Cmd.GovernanceHashCmd
-            (GovernanceHashCmdArgs eon
-               <$> pGovernanceHashSource
+        ( fmap Cmd.GovernanceHashAnchorDataCmd
+            (Cmd.GovernanceHashAnchorDataCmdArgs eon
+               <$> pGovernanceAnchorDataHashSource
                <*> optional pOutputFile))
-    $ Opt.progDesc "Compute the hash to pass to the various --*-hash arguments of governance commands."
+    $ Opt.progDesc "Compute the hash of some anchor data (to then pass it to other governance commands)."
 
-pGovernanceHashSource :: Parser Cmd.GovernanceHashSource
-pGovernanceHashSource =
+pGovernanceAnchorDataHashSource :: Parser Cmd.GovernanceAnchorDataHashSource
+pGovernanceAnchorDataHashSource =
   asum
     [
-      Cmd.GovernanceHashSourceText
+      Cmd.GovernanceAnchorDataHashSourceText
         <$> Opt.strOption
               ( mconcat
                 [ Opt.long "text"
                 , Opt.metavar "TEXT"
                 , Opt.help "Text to hash as UTF-8"
                 ]
               )
-    , Cmd.GovernanceHashSourceBinaryFile
+    , Cmd.GovernanceAnchorDataHashSourceBinaryFile
         <$> pFileInDirection "file-binary" "Binary file to hash"
-    , Cmd.GovernanceHashSourceTextFile
+    , Cmd.GovernanceAnchorDataHashSourceTextFile
         <$> pFileInDirection "file-text" "Text file to hash"
     ]
+
+pGovernanceHashScriptCmd :: ()
+  => CardanoEra era
+  -> Maybe (Parser (Cmd.GovernanceHashCmds era))
+pGovernanceHashScriptCmd era = do
+  eon <- forEraMaybeEon era
+  return
+    $ subParser "script"
+    $ Opt.info
+        ( fmap Cmd.GovernanceHashScriptCmd
+            (Cmd.GovernanceHashScriptCmdArgs eon
+               <$> pScript
+               <*> optional pOutputFile))
+    $ Opt.progDesc "Compute the hash of a script (to then pass it to other governance commands)."

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

@@ -105,24 +105,31 @@ runGovernanceDRepRegistrationCertificateCmd :: ()
 runGovernanceDRepRegistrationCertificateCmd
     Cmd.GovernanceDRepRegistrationCertificateCmdArgs
       { eon = w
-      , drepVkeyHashSource
+      , drepHashSource
       , deposit
       , mAnchor
       , outFile
-      } = do
-  DRepKeyHash drepKeyHash <- firstExceptT RegistrationReadError
-    . newExceptT
-    $ readVerificationKeyOrHashOrFile AsDRepKey drepVkeyHashSource
-  let drepCred = Ledger.KeyHashObj $ conwayEraOnwardsConstraints w drepKeyHash
-      req = DRepRegistrationRequirements w drepCred deposit
-      registrationCert = makeDrepRegistrationCertificate req mAnchor
-      description = Just @TextEnvelopeDescr "DRep Key Registration Certificate"
-
-  firstExceptT RegistrationWriteFileError
-    . newExceptT
-    . writeLazyByteStringFile outFile
-    $ conwayEraOnwardsConstraints w
-    $ textEnvelopeToJSON description registrationCert
+      } =
+  conwayEraOnwardsConstraints w $ do
+    drepCred <-
+      case drepHashSource of
+        DRepHashSourceScript (ScriptHash scriptHash) ->
+          return $ Ledger.ScriptHashObj scriptHash
+        DRepHashSourceVerificationKey drepVkeyHashSource -> do
+          DRepKeyHash drepKeyHash <-
+            firstExceptT RegistrationReadError
+              . newExceptT
+              $ readVerificationKeyOrHashOrFile AsDRepKey drepVkeyHashSource
+          return $ Ledger.KeyHashObj $ conwayEraOnwardsConstraints w drepKeyHash
+    let req = DRepRegistrationRequirements w drepCred deposit
+        registrationCert = makeDrepRegistrationCertificate req mAnchor
+        description = Just @TextEnvelopeDescr "DRep Key Registration Certificate"
+
+    firstExceptT RegistrationWriteFileError
+      . newExceptT
+      . writeLazyByteStringFile outFile
+      $ conwayEraOnwardsConstraints w
+      $ textEnvelopeToJSON description registrationCert
 
 runGovernanceDRepRetirementCertificateCmd :: ()
   => Cmd.GovernanceDRepRetirementCertificateCmdArgs era

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -15,6 +16,8 @@ module Cardano.CLI.EraBased.Run.Governance.Hash
 import           Cardano.Api
 
 import qualified Cardano.CLI.EraBased.Commands.Governance.Hash as Cmd
+import           Cardano.CLI.Read
+import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
 import           Cardano.CLI.Types.Errors.GovernanceHashError
@@ -34,28 +37,32 @@ import qualified Data.Text.IO as Text
 runGovernanceHashCmds :: ()
   => Cmd.GovernanceHashCmds era
   -> ExceptT CmdError IO ()
-runGovernanceHashCmds (Cmd.GovernanceHashCmd args)=
-    runGovernanceHashCmd args
+runGovernanceHashCmds = \case
+
+  Cmd.GovernanceHashAnchorDataCmd args ->
+    runGovernanceHashAnchorDataCmd args
+      & firstExceptT (CmdGovernanceCmdError . GovernanceCmdHashError)
+
+  Cmd.GovernanceHashScriptCmd args ->
+    runGovernanceHashScriptCmd args
       & firstExceptT (CmdGovernanceCmdError . GovernanceCmdHashError)
 
-runGovernanceHashCmd :: ()
-  => Cmd.GovernanceHashCmdArgs era
+runGovernanceHashAnchorDataCmd :: ()
+  => Cmd.GovernanceHashAnchorDataCmdArgs era
   -> ExceptT GovernanceHashError IO ()
-runGovernanceHashCmd Cmd.GovernanceHashCmdArgs { toHash, moutFile } =
-  -- TODO @smelc we probably want an option to write the computed hash to a file
-  -- This can be done in a separate PR
+runGovernanceHashAnchorDataCmd Cmd.GovernanceHashAnchorDataCmdArgs { toHash, moutFile } =
   case toHash of
-    Cmd.GovernanceHashSourceBinaryFile fp -> do
+    Cmd.GovernanceAnchorDataHashSourceBinaryFile fp -> do
       let path = unFile fp
       bytes <- handleIOExceptT (GovernanceHashReadFileError path) $ BS.readFile path
       let hash = Ledger.hashAnchorData $ Ledger.AnchorData bytes
       printHash hash
-    Cmd.GovernanceHashSourceTextFile fp -> do
+    Cmd.GovernanceAnchorDataHashSourceTextFile fp -> do
       let path = unFile fp
       text <- handleIOExceptT (GovernanceHashReadFileError path) $ Text.readFile path
       let hash = Ledger.hashAnchorData $ Ledger.AnchorData $ Text.encodeUtf8 text
       printHash hash
-    Cmd.GovernanceHashSourceText text -> do
+    Cmd.GovernanceAnchorDataHashSourceText text -> do
       let hash = Ledger.hashAnchorData $ Ledger.AnchorData $ Text.encodeUtf8 text
       printHash hash
   where
@@ -65,3 +72,16 @@ runGovernanceHashCmd Cmd.GovernanceHashCmdArgs { toHash, moutFile } =
         newExceptT $ writeTextOutput moutFile text
       where
         text = hashToTextAsHex . extractHash $ hash
+
+runGovernanceHashScriptCmd :: ()
+  => Cmd.GovernanceHashScriptCmdArgs era
+  -> ExceptT GovernanceHashError IO ()
+runGovernanceHashScriptCmd Cmd.GovernanceHashScriptCmdArgs { Cmd.toHash = ScriptFile toHash, moutFile } = do
+  ScriptInAnyLang _ script <-
+    readFileScriptInAnyLang toHash
+      & firstExceptT (GovernanceHashReadScriptError toHash)
+  firstExceptT GovernanceHashWriteFileError
+    . newExceptT
+    . writeTextOutput moutFile . serialiseToRawBytesHexText $ hashScript script
+
+

cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceHashError.hs

@@ -6,11 +6,13 @@ module Cardano.CLI.Types.Errors.GovernanceHashError
 import           Cardano.Api
 import           Cardano.Api.Pretty
 
+import           Cardano.CLI.Read (ScriptDecodeError)
 import           Cardano.Prelude (Exception (displayException), IOException)
 
 data GovernanceHashError
   = GovernanceHashReadFileError !FilePath !IOException
   | GovernanceHashWriteFileError !(FileError ())
+  | GovernanceHashReadScriptError !FilePath !(FileError ScriptDecodeError)
   deriving Show
 
 instance Error GovernanceHashError where
@@ -19,3 +21,5 @@ instance Error GovernanceHashError where
       "Cannot read " <> pretty filepath <> ": " <> pretty (displayException exc)
     GovernanceHashWriteFileError fileErr ->
       prettyError fileErr
+    GovernanceHashReadScriptError filepath err ->
+      "Cannot read script at " <> pretty filepath <> ": " <> prettyError err

cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Action.hs

@@ -27,11 +27,11 @@ hprop_golden_governance_action_create_constitution =
     redactedActionFile <- noteTempFile tempDir "create-constitution.action.redacted"
 
     proposalHash <- execCardanoCLI
-      [ "conway", "governance", "hash"
+      [ "conway", "governance", "hash", "anchor-data"
       , "--text", "whatever"]
 
     constitutionHash <- execCardanoCLI
-      [ "conway", "governance", "hash"
+      [ "conway", "governance", "hash", "anchor-data"
       , "--text", "something else"]
 
     void $ execCardanoCLI
@@ -63,15 +63,15 @@ hprop_golden_conway_governance_action_view_constitution_json =
 
     -- We go through a file for the hash, to test --out-file
     void $ execCardanoCLI
-      [ "conway", "governance", "hash"
+      [ "conway", "governance", "hash", "anchor-data"
       , "--text", "whatever "
       , "--out-file", hashFile
       ]
 
     proposalHash <- H.readFile hashFile
 
     constitutionHash <- execCardanoCLI
-      [ "conway", "governance", "hash"
+      [ "conway", "governance", "hash", "anchor-data"
       , "--text", "nonAsciiInput: 你好 and some more: こんにちは"
       ]
 

cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/Committee.hs

@@ -158,7 +158,7 @@ hprop_golden_governanceUpdateCommittee =
     outFile <- H.noteTempFile tempDir "answer-file.json"
 
     proposalHash <- execCardanoCLI
-      [ "conway", "governance", "hash"
+      [ "conway", "governance", "hash", "anchor-data"
       , "--file-text", ccProposal ]
 
     H.note_ proposalHash