Merge pull request #641 from IntersectMBO/mgalazyn/feature/script-sup…

…port-in-create-hot-key-auth-cert

Extend committee `create-hot-key-authorization-certificate` to support scripts

cabal.project

@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2024-03-05T09:38:08Z
-  , cardano-haskell-packages 2024-03-14T09:14:40Z
+  , cardano-haskell-packages 2024-03-15T13:35:00Z
 
 packages:
   cardano-cli

cardano-cli/cardano-cli.cabal

@@ -196,7 +196,7 @@ library
                       , binary
                       , bytestring
                       , canonical-json
-                      , cardano-api ^>= 8.40.0.0
+                      , cardano-api ^>= 8.41.0.0
                       , cardano-binary
                       , cardano-crypto
                       , cardano-crypto-class ^>= 2.1.2

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

@@ -52,8 +52,8 @@ data GovernanceCommitteeKeyHashCmdArgs era =
 data GovernanceCommitteeCreateHotKeyAuthorizationCertificateCmdArgs era =
   GovernanceCommitteeCreateHotKeyAuthorizationCertificateCmdArgs
     { eon               :: !(ConwayEraOnwards era)
-    , vkeyColdKeySource :: !(VerificationKeyOrHashOrFile CommitteeColdKey)
-    , vkeyHotKeySource  :: !(VerificationKeyOrHashOrFile CommitteeHotKey)
+    , vkeyColdKeySource :: !(VerificationKeyOrHashOrFileOrScript CommitteeColdKey)
+    , vkeyHotKeySource  :: !(VerificationKeyOrHashOrFileOrScript CommitteeHotKey)
     , outFile           :: !(File () Out)
     } deriving Show
 
@@ -66,14 +66,14 @@ data GovernanceCommitteeCreateColdKeyResignationCertificateCmdArgs era =
     } deriving Show
 
 renderGovernanceCommitteeCmds :: GovernanceCommitteeCmds era -> Text
-renderGovernanceCommitteeCmds = \case
+renderGovernanceCommitteeCmds = ("governance committee " <>) . \case
   GovernanceCommitteeKeyGenColdCmd {} ->
-    "governance committee key-gen-cold"
+    "key-gen-cold"
   GovernanceCommitteeKeyGenHotCmd {} ->
-    "governance committee key-gen-hot"
+    "key-gen-hot"
   GovernanceCommitteeKeyHashCmd {} ->
-    "governance committee key-hash"
+    "key-hash"
   GovernanceCommitteeCreateHotKeyAuthorizationCertificateCmd {} ->
-    "governance committee create-hot-key-authorization-certificate"
+    "create-hot-key-authorization-certificate"
   GovernanceCommitteeCreateColdKeyResignationCertificateCmd {} ->
-    "governance committee create-cold-key-resignation-certificate"
+    "create-cold-key-resignation-certificate"

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

@@ -241,7 +241,7 @@ pStakeVerificationKeyOrFile prefix =
 
 pScriptFor :: String -> Maybe String -> String -> Parser ScriptFile
 pScriptFor name Nothing help' =
-  fmap ScriptFile $ Opt.strOption $ mconcat
+  fmap File $ Opt.strOption $ mconcat
     [ Opt.long name
     , Opt.metavar "FILE"
     , Opt.help help'
@@ -250,7 +250,7 @@ pScriptFor name Nothing help' =
 
 pScriptFor name (Just deprecated) help' =
       pScriptFor name Nothing help'
-  <|> ScriptFile <$> Opt.strOption
+  <|> File <$> Opt.strOption
         (  Opt.long deprecated
         <> Opt.internal
         )

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

@@ -11,7 +11,9 @@ import qualified Cardano.Api.Ledger as L
 import           Cardano.CLI.EraBased.Commands.Governance.Committee
 import           Cardano.CLI.EraBased.Options.Common hiding (pAnchorUrl)
 import           Cardano.CLI.Read
+import           Cardano.CLI.Types.Key
 
+import           Data.Foldable (asum)
 import           Options.Applicative (Parser)
 import qualified Options.Applicative as Opt
 
@@ -103,14 +105,23 @@ pGovernanceCommitteeCreateHotKeyAuthorizationCertificateCmd era = do
     $ Opt.info
         ( fmap GovernanceCommitteeCreateHotKeyAuthorizationCertificateCmd $
             GovernanceCommitteeCreateHotKeyAuthorizationCertificateCmdArgs w
-              <$> pCommitteeColdVerificationKeyOrHashOrFile
-              <*> pCommitteeHotKeyOrHashOrFile
+              <$> pColdVerificationKeyOrHashOrFileOrScript
+              <*> pHotVerificationKeyOrHashOrFileOrScript
               <*> pOutputFile
         )
     $ Opt.progDesc
     $ mconcat
         [ "Create hot key authorization certificate for a Constitutional Committee Member"
         ]
+  where
+    pColdVerificationKeyOrHashOrFileOrScript = asum
+      [ VkhfsKeyHashFile <$> pCommitteeColdVerificationKeyOrHashOrFile
+      , VkhfsScript <$> pScriptFor "cold-script-file" Nothing "Cold Native or Plutus script file"
+      ]
+    pHotVerificationKeyOrHashOrFileOrScript = asum
+      [ VkhfsKeyHashFile <$> pCommitteeHotKeyOrHashOrFile
+      , VkhfsScript <$> pScriptFor "hot-script-file" Nothing "Hot Native or Plutus script file"
+      ]
 
 pGovernanceCommitteeCreateColdKeyResignationCertificateCmd :: ()
   => CardanoEra era

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

@@ -171,7 +171,7 @@ runAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp = do
           left $ AddressCmdExpectedPaymentVerificationKey nonPaymentKey
       return $ serialiseAddress (addr :: AddressAny)
 
-    PaymentVerifierScriptFile (ScriptFile fp) -> do
+    PaymentVerifierScriptFile (File fp) -> do
       ScriptInAnyLang _lang script <-
         firstExceptT AddressCmdReadScriptFileError $
           readFileScriptInAnyLang fp
@@ -199,7 +199,7 @@ makeStakeAddressRef stakeIdentifier =
 
           return . StakeAddressByValue $ StakeCredentialByKey stakeVKeyHash
 
-        StakeVerifierScriptFile (ScriptFile fp) -> do
+        StakeVerifierScriptFile (File fp) -> do
           ScriptInAnyLang _lang script <-
             firstExceptT AddressCmdReadScriptFileError $
               readFileScriptInAnyLang fp

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

@@ -13,6 +13,7 @@ import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Commands.Governance.Committee
 import qualified Cardano.CLI.EraBased.Commands.Governance.Committee as Cmd
+import           Cardano.CLI.Read (readVerificationKeyOrHashOrFileOrScript)
 import           Cardano.CLI.Types.Errors.GovernanceCommitteeError
 import           Cardano.CLI.Types.Key
 import           Cardano.CLI.Types.Key.VerificationKey
@@ -137,20 +138,20 @@ runGovernanceCommitteeCreateHotKeyAuthorizationCertificate :: ()
 runGovernanceCommitteeCreateHotKeyAuthorizationCertificate
     Cmd.GovernanceCommitteeCreateHotKeyAuthorizationCertificateCmdArgs
       { Cmd.eon = eon
-      , Cmd.vkeyColdKeySource = coldVkOrHashOrFp
-      , Cmd.vkeyHotKeySource = hotVkOrHashOrFp
+      , Cmd.vkeyColdKeySource
+      , Cmd.vkeyHotKeySource
       , Cmd.outFile = oFp
       } =
   conwayEraOnwardsConstraints eon $ do
-    CommitteeColdKeyHash coldVKHash <-
-      lift (readVerificationKeyOrHashOrTextEnvFile AsCommitteeColdKey coldVkOrHashOrFp)
-        & onLeft (left . GovernanceCommitteeCmdKeyReadError)
-
-    CommitteeHotKeyHash hotVkHash <-
-      lift (readVerificationKeyOrHashOrTextEnvFile AsCommitteeHotKey hotVkOrHashOrFp)
-        & onLeft (left . GovernanceCommitteeCmdKeyReadError)
-
-    makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequirements eon coldVKHash hotVkHash)
+    let mapError' = modifyError $ either GovernanceCommitteeCmdScriptReadError  GovernanceCommitteeCmdKeyReadError
+    hotCred <-
+      mapError' $
+        readVerificationKeyOrHashOrFileOrScript AsCommitteeHotKey (\(CommitteeHotKeyHash kh) -> kh) vkeyHotKeySource
+    coldCred <-
+      mapError' $
+        readVerificationKeyOrHashOrFileOrScript AsCommitteeColdKey (\(CommitteeColdKeyHash kh) -> kh) vkeyColdKeySource
+
+    makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequirements eon coldCred hotCred)
       & textEnvelopeToJSON (Just genKeyDelegCertDesc)
       & writeLazyByteStringFile oFp
       & firstExceptT GovernanceCommitteeCmdTextEnvWriteError . newExceptT

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

@@ -16,7 +16,6 @@ module Cardano.CLI.EraBased.Run.Governance.DRep
 
 import           Cardano.Api
 import           Cardano.Api.Ledger (Credential (KeyHashObj))
-import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley
 
 import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as Cmd
@@ -111,16 +110,7 @@ runGovernanceDRepRegistrationCertificateCmd
       , outFile
       } =
   conwayEraOnwardsConstraints w $ do
-    drepCred <-
-      case drepHashSource of
-        DRepHashSourceScript (ScriptHash scriptHash) ->
-          return $ L.ScriptHashObj scriptHash
-        DRepHashSourceVerificationKey drepVkeyHashSource -> do
-          DRepKeyHash drepKeyHash <-
-            firstExceptT RegistrationReadError
-              . newExceptT
-              $ readVerificationKeyOrHashOrFile AsDRepKey drepVkeyHashSource
-          return $ L.KeyHashObj $ conwayEraOnwardsConstraints w drepKeyHash
+    drepCred <- modifyError RegistrationReadError $ readDRepCredential drepHashSource
     let req = DRepRegistrationRequirements w drepCred deposit
         registrationCert = makeDrepRegistrationCertificate req mAnchor
         description = Just @TextEnvelopeDescr "DRep Key Registration Certificate"

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

@@ -7,8 +7,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-{- HLINT ignore "Use let" -}
-
 module Cardano.CLI.EraBased.Run.Governance.Hash
   ( runGovernanceHashCmds
   ) where
@@ -18,7 +16,6 @@ import qualified Cardano.Api.Ledger as L
 
 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
@@ -71,12 +68,11 @@ runGovernanceHashAnchorDataCmd Cmd.GovernanceHashAnchorDataCmdArgs { toHash, mou
 runGovernanceHashScriptCmd :: ()
   => Cmd.GovernanceHashScriptCmdArgs era
   -> ExceptT GovernanceHashError IO ()
-runGovernanceHashScriptCmd Cmd.GovernanceHashScriptCmdArgs { Cmd.toHash = ScriptFile toHash, moutFile } = do
+runGovernanceHashScriptCmd Cmd.GovernanceHashScriptCmdArgs { Cmd.toHash = File toHash, moutFile } = do
   ScriptInAnyLang _ script <-
     readFileScriptInAnyLang toHash
       & firstExceptT (GovernanceHashReadScriptError toHash)
   firstExceptT GovernanceHashWriteFileError
     . newExceptT
     . writeTextOutput moutFile . serialiseToRawBytesHexText $ hashScript script
 
-

cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs

@@ -151,7 +151,7 @@ runTransactionBuildCmd
     readTxMetadata eon metadataSchema metadataFiles
   valuesWithScriptWits <- readValueScriptWitnesses eon $ fromMaybe mempty mValue
   scripts <- firstExceptT TxCmdScriptFileError $
-    mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles
+    mapM (readFileScriptInAnyLang . unFile) scriptFiles
   txAuxScripts <- hoistEither $ first TxCmdAuxScriptsValidationError $ validateTxAuxScripts eon scripts
 
   mProp <- case mfUpdateProposalFile of
@@ -288,7 +288,7 @@ runTransactionBuildRawCmd
                   . newExceptT $ readTxMetadata eon metadataSchema metadataFiles
   valuesWithScriptWits <- readValueScriptWitnesses eon $ fromMaybe mempty mValue
   scripts <- firstExceptT TxCmdScriptFileError $
-                     mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles
+                     mapM (readFileScriptInAnyLang . unFile) scriptFiles
   txAuxScripts <- hoistEither $ first TxCmdAuxScriptsValidationError $ validateTxAuxScripts eon scripts
 
   -- TODO: Conway era - update readProtocolParameters to rely on L.PParams JSON instances
@@ -1077,7 +1077,7 @@ runTransactionPolicyIdCmd :: ()
   -> ExceptT TxCmdError IO ()
 runTransactionPolicyIdCmd
     Cmd.TransactionPolicyIdCmdArgs
-      { scriptFile = ScriptFile sFile
+      { scriptFile = File sFile
       } = do
   ScriptInAnyLang _ script <- firstExceptT TxCmdScriptFileError $
                                 readFileScriptInAnyLang sFile

cardano-cli/src/Cardano/CLI/Read.hs

@@ -96,6 +96,8 @@ module Cardano.CLI.Read
 
   -- * Vote related
   , readVoteDelegationTarget
+
+  , readVerificationKeyOrHashOrFileOrScript
   ) where
 
 import           Cardano.Api as Api
@@ -259,7 +261,7 @@ readScriptWitness
   :: ShelleyBasedEra era
   -> ScriptWitnessFiles witctx
   -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-readScriptWitness era (SimpleScriptWitnessFile (ScriptFile scriptFile)) = do
+readScriptWitness era (SimpleScriptWitnessFile (File scriptFile)) = do
     script@(ScriptInAnyLang lang _) <- firstExceptT ScriptWitnessErrorFile $
                                          readFileScriptInAnyLang scriptFile
     ScriptInEra langInEra script'   <- validateScriptSupportedInEra era script
@@ -276,7 +278,7 @@ readScriptWitness era (SimpleScriptWitnessFile (ScriptFile scriptFile)) = do
                  (AnyScriptLanguage lang)
 
 readScriptWitness era (PlutusScriptWitnessFiles
-                          (ScriptFile scriptFile)
+                          (File scriptFile)
                           datumOrFile
                           redeemerOrFile
                           execUnits) = do
@@ -420,17 +422,35 @@ readScriptDataOrFile (ScriptDataCborFile fp) = do
           $ hoistEither $ validateScriptData $ getScriptData hSd
   return hSd
 
+readVerificationKeyOrHashOrFileOrScript
+  :: MonadIOTransError (Either (FileError ScriptDecodeError) (FileError InputDecodeError)) t m
+  => Key keyrole
+  => AsType keyrole
+  -> (Hash keyrole -> L.KeyHash kr L.StandardCrypto)
+  -> VerificationKeyOrHashOrFileOrScript keyrole
+  -> t m (L.Credential kr L.StandardCrypto)
+readVerificationKeyOrHashOrFileOrScript asType extractHash = \case
+  VkhfsScript (File fp) -> do
+    ScriptInAnyLang _lang script <-
+      modifyError Left $
+        readFileScriptInAnyLang fp
+    pure . L.ScriptHashObj . toShelleyScriptHash $ hashScript script
+  VkhfsKeyHashFile vkOrHashOrFp ->
+    fmap (L.KeyHashObj . extractHash) . modifyError Right . hoistIOEither $
+      readVerificationKeyOrHashOrTextEnvFile asType vkOrHashOrFp
+
 -- | Read a script file. The file can either be in the text envelope format
 -- wrapping the binary representation of any of the supported script languages,
 -- or alternatively it can be a JSON format file for one of the simple script
 -- language versions.
 --
-readFileScriptInAnyLang :: FilePath
-                        -> ExceptT (FileError ScriptDecodeError) IO
-                                   ScriptInAnyLang
+readFileScriptInAnyLang
+  :: MonadIOTransError (FileError ScriptDecodeError) t m
+  => FilePath
+  -> t m ScriptInAnyLang
 readFileScriptInAnyLang file = do
-  scriptBytes <- handleIOExceptT (FileIOError file) $ BS.readFile file
-  firstExceptT (FileError file) $ hoistEither $
+  scriptBytes <- handleIOExceptionsLiftWith (FileIOError file) . liftIO $ BS.readFile file
+  modifyError (FileError file) $ hoistEither $
     deserialiseScriptInAnyLang scriptBytes
 
 
@@ -1033,7 +1053,7 @@ getStakeCredentialFromVerifier :: ()
   => StakeVerifier
   -> ExceptT StakeCredentialError IO StakeCredential
 getStakeCredentialFromVerifier = \case
-  StakeVerifierScriptFile (ScriptFile sFile) -> do
+  StakeVerifierScriptFile (File sFile) -> do
     ScriptInAnyLang _ script <-
       readFileScriptInAnyLang sFile
         & firstExceptT StakeCredentialScriptDecodeError
@@ -1128,16 +1148,9 @@ readVoteDelegationTarget :: ()
   -> ExceptT DelegationError IO (L.DRep L.StandardCrypto)
 readVoteDelegationTarget voteDelegationTarget =
   case voteDelegationTarget of
-    VoteDelegationTargetOfDRep drepHashSource -> do
-      drepHash <- case drepHashSource of
-        DRepHashSourceScript (ScriptHash scriptHash) ->
-          pure $ L.ScriptHashObj scriptHash
-        DRepHashSourceVerificationKey drepVKeyOrHashOrFile -> do
-          DRepKeyHash drepKeyHash <-
-            lift (readVerificationKeyOrHashOrTextEnvFile AsDRepKey drepVKeyOrHashOrFile)
-              & onLeft (left . DelegationDRepReadError)
-          pure $ L.KeyHashObj drepKeyHash
-      pure $ L.DRepCredential drepHash
+    VoteDelegationTargetOfDRep drepHashSource ->
+      modifyError  DelegationDRepReadError $
+        L.DRepCredential <$> readDRepCredential drepHashSource
     VoteDelegationTargetOfAbstain ->
       pure L.DRepAlwaysAbstain
     VoteDelegationTargetOfNoConfidence ->

cardano-cli/src/Cardano/CLI/Types/Common.hs

@@ -49,7 +49,7 @@ module Cardano.CLI.Types.Common
   , RequiredSigner (..)
   , ScriptDataOrFile (..)
   , ScriptDatumOrFile (..)
-  , ScriptFile (..)
+  , ScriptFile
   , ScriptRedeemerOrFile
   , ScriptWitnessFiles (..)
   , SigningKeyFile
@@ -82,7 +82,7 @@ module Cardano.CLI.Types.Common
   , DRepMetadataFile
   ) where
 
-import           Cardano.Api
+import           Cardano.Api hiding (Script)
 import qualified Cardano.Api.Ledger as L
 
 import qualified Cardano.Chain.Slotting as Byron
@@ -322,8 +322,7 @@ newtype UpdateProposalFile = UpdateProposalFile { unUpdateProposalFile :: FilePa
 
 type VerificationKeyFile = File (VerificationKey ())
 
-newtype ScriptFile = ScriptFile { unScriptFile :: FilePath }
-                     deriving (Eq, Show)
+type ScriptFile = File ScriptInAnyLang In
 
 data ScriptDataOrFile = ScriptDataCborFile  FilePath   -- ^ By reference to a CBOR file
                       | ScriptDataJsonFile  FilePath   -- ^ By reference to a JSON file

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

@@ -6,9 +6,12 @@ module Cardano.CLI.Types.Errors.GovernanceCommitteeError
 
 import           Cardano.Api
 
+import           Cardano.CLI.Types.Errors.ScriptDecodeError
+
 data GovernanceCommitteeError
   = GovernanceCommitteeCmdKeyDecodeError InputDecodeError
   | GovernanceCommitteeCmdKeyReadError (FileError InputDecodeError)
+  | GovernanceCommitteeCmdScriptReadError (FileError ScriptDecodeError)
   | GovernanceCommitteeCmdTextEnvReadFileError (FileError TextEnvelopeError)
   | GovernanceCommitteeCmdTextEnvWriteError (FileError ())
   | GovernanceCommitteeCmdWriteFileError (FileError ())
@@ -26,3 +29,5 @@ instance Error GovernanceCommitteeError where
       "Cannot read text envelope file: " <> prettyError e
     GovernanceCommitteeCmdTextEnvWriteError e ->
       "Cannot write text envelope file: " <> prettyError e
+    GovernanceCommitteeCmdScriptReadError e ->
+      "Cannot read script file: " <> prettyError e