WIP

cardano-cli/cardano-cli.cabal

@@ -121,9 +121,11 @@ library
     Cardano.CLI.EraBased.Script.Certificate.Types
     Cardano.CLI.EraBased.Script.Mint.Read
     Cardano.CLI.EraBased.Script.Mint.Types
+    Cardano.CLI.EraBased.Script.Read.Common
     Cardano.CLI.EraBased.Script.Spend.Read
     Cardano.CLI.EraBased.Script.Spend.Types
     Cardano.CLI.EraBased.Script.Types
+    Cardano.CLI.EraBased.Script.Vote.Read
     Cardano.CLI.EraBased.Script.Vote.Types
     Cardano.CLI.EraBased.Transaction.HashCheck
     Cardano.CLI.Helpers

cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs

@@ -25,6 +25,8 @@ import           Cardano.CLI.EraBased.Run.Transaction
 import           Cardano.CLI.EraBased.Script.Certificate.Read
 import           Cardano.CLI.EraBased.Script.Certificate.Types
 import           Cardano.CLI.EraBased.Script.Types
+import           Cardano.CLI.EraBased.Script.Vote.Types (CliVoteScriptRequirements,
+                   VoteScriptWitness (..))
 import           Cardano.CLI.Parser
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
@@ -182,7 +184,7 @@ data CompatibleTransactionCmds era
       [TxOutAnyEra]
       !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)))
       !(Maybe (Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]))
-      ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
+      ![(VoteFile In, Maybe CliVoteScriptRequirements)]
       [WitnessSigningData]
       -- ^ Signing keys
       (Maybe NetworkId)
@@ -272,7 +274,7 @@ runCompatibleTransactionCmd
                 readVotingProceduresFiles w mVotes
             votingProcedures <-
               firstExceptT CompatibleVoteMergeError . hoistEither $
-                mkTxVotingProcedures votesAndWits
+                mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votesAndWits]
             return (prop, VotingProcedures w votingProcedures)
         )
         sbe

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

@@ -16,7 +16,7 @@ import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley
 
 import qualified Cardano.CLI.EraBased.Commands.Governance.Vote as Cmd
-import           Cardano.CLI.Read (readSingleVote)
+import           Cardano.CLI.EraBased.Script.Vote.Read
 import           Cardano.CLI.Run.Hash (carryHashChecks)
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
@@ -108,8 +108,9 @@ runGovernanceVoteViewCmd
 
     shelleyBasedEraConstraints sbe $ do
       voteProcedures <-
-        fmap fst . firstExceptT GovernanceVoteCmdReadVoteFileError . newExceptT $
-          readSingleVote eon (voteFile, Nothing)
+        fmap fst $
+          firstExceptT GovernanceVoteCmdReadVoteFileError $
+            readVoteScriptWitness eon (voteFile, Nothing)
       firstExceptT GovernanceVoteCmdWriteError
         . newExceptT
         . ( case outFormat of

cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs

@@ -13,9 +13,9 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Script.Certificate.Types
+import           Cardano.CLI.EraBased.Script.Read.Common
 import           Cardano.CLI.EraBased.Script.Types
-import           Cardano.CLI.Read
-import           Cardano.CLI.Types.Common
+import           Cardano.CLI.Types.Common (CertificateFile)
 
 import           Control.Monad
 

cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs

@@ -11,8 +11,8 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Script.Mint.Types
+import           Cardano.CLI.EraBased.Script.Read.Common
 import           Cardano.CLI.EraBased.Script.Types
-import           Cardano.CLI.Read
 
 readMintScriptWitness
   :: MonadIOTransError (FileError CliScriptWitnessError) t m

cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs

@@ -14,6 +14,7 @@ where
 import           Cardano.Api
 import           Cardano.Api.Shelley
 
+import           Cardano.CLI.EraBased.Script.Read.Common
 import           Cardano.CLI.EraBased.Script.Spend.Types
 import           Cardano.CLI.EraBased.Script.Types
 import           Cardano.CLI.Read

cardano-cli/src/Cardano/CLI/EraBased/Script/Types.hs

@@ -1,8 +1,11 @@
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Cardano.CLI.EraBased.Script.Types
-  ( -- * Errors
-    CliScriptWitnessError (..)
+  ( AnyPlutusScript (..)
+
+    -- * Errors
+  , CliScriptWitnessError (..)
   )
 where
 
@@ -12,17 +15,25 @@ import           Cardano.CLI.Types.Errors.PlutusScriptDecodeError
 import           Cardano.CLI.Types.Errors.ScriptDataError
 import           Cardano.CLI.Types.Errors.ScriptDecodeError
 
+-- TODO: Move to cardano-api
+data AnyPlutusScript where
+  AnyPlutusScript
+    :: IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript
+
 data CliScriptWitnessError
   = SimpleScriptWitnessDecodeError ScriptDecodeError
+  | TextEnvelopeError TextEnvelopeError
   | PlutusScriptWitnessDecodeError PlutusScriptDecodeError
   | PlutusScriptWitnessLanguageNotSupportedInEra
       AnyPlutusScriptVersion
       AnyShelleyBasedEra
   | PlutusScriptWitnessRedeemerError ScriptDataError
+  deriving Show
 
 instance Error CliScriptWitnessError where
   prettyError = \case
     SimpleScriptWitnessDecodeError err -> prettyError err
+    TextEnvelopeError err -> prettyError err
     PlutusScriptWitnessDecodeError err -> prettyError err
     PlutusScriptWitnessLanguageNotSupportedInEra version era ->
       "Plutus script version " <> pshow version <> " is not supported in era " <> pshow era

cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+
+module Cardano.CLI.EraBased.Script.Vote.Read
+  ( readVoteScriptWitness
+  )
+where
+
+import           Cardano.Api
+import           Cardano.Api.Shelley
+
+import           Cardano.CLI.EraBased.Script.Read.Common
+import           Cardano.CLI.EraBased.Script.Types
+import           Cardano.CLI.EraBased.Script.Vote.Types
+import           Cardano.CLI.Types.Governance
+
+readVoteScriptWitness
+  :: MonadIOTransError (FileError CliScriptWitnessError) t m
+  => ConwayEraOnwards era
+  -> (VoteFile In, Maybe CliVoteScriptRequirements)
+  -> t m (VotingProcedures era, Maybe (VoteScriptWitness era))
+readVoteScriptWitness w (voteFp, Nothing) = do
+  votProceds <-
+    conwayEraOnwardsConstraints w $
+      modifyError (fmap TextEnvelopeError) $
+        hoistIOEither $
+          readFileTextEnvelope AsVotingProcedures voteFp
+  return (votProceds, Nothing)
+readVoteScriptWitness w (voteFp, Just certScriptReq) = do
+  let sbe = convert w
+  votProceds <-
+    conwayEraOnwardsConstraints w $
+      modifyError (fmap TextEnvelopeError) $
+        hoistIOEither $
+          readFileTextEnvelope AsVotingProcedures voteFp
+  case certScriptReq of
+    OnDiskSimpleScript scriptFp -> do
+      let sFp = unFile scriptFp
+      s <-
+        modifyError (fmap SimpleScriptWitnessDecodeError) $
+          readFileSimpleScript sFp
+      case s of
+        SimpleScript ss -> do
+          return 
+            ( votProceds
+            , Just $
+                VoteScriptWitness
+                  ( SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $
+                      SScript ss
+                  )
+            )
+    OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits) -> do
+      let plutusScriptFp = unFile scriptFp
+      plutusScript <-
+        modifyError (fmap PlutusScriptWitnessDecodeError) $
+          readFilePlutusScript plutusScriptFp
+      redeemer <-
+        modifyError (FileError plutusScriptFp . PlutusScriptWitnessRedeemerError) $
+          readScriptDataOrFile redeemerFile
+      case plutusScript of
+        AnyPlutusScript lang script -> do
+          let pScript = PScript script
+          sLangSupported <-
+            modifyError (FileError plutusScriptFp)
+              $ hoistMaybe
+                ( PlutusScriptWitnessLanguageNotSupportedInEra
+                    (AnyPlutusScriptVersion lang)
+                    (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
+                )
+              $ scriptLanguageSupportedInEra sbe
+              $ PlutusScriptLanguage lang
+          return
+            ( votProceds
+            , Just $
+                VoteScriptWitness $
+                  PlutusScriptWitness
+                    sLangSupported
+                    lang
+                    pScript
+                    NoScriptDatumForStake
+                    redeemer
+                    execUnits
+            )
+    OnDiskPlutusRefScript (PlutusRefScriptCliArgs refTxIn anyPlutusScriptVersion redeemerFile execUnits) -> do
+      case anyPlutusScriptVersion of
+        AnyPlutusScriptVersion lang -> do
+          let pScript = PReferenceScript refTxIn
+          redeemer <-
+            -- TODO: Implement a new error type to capture this. FileError is not representative of cases
+            -- where we do not have access to the script.
+            modifyError
+              ( FileError "Reference script filepath not available"
+                  . PlutusScriptWitnessRedeemerError
+              )
+              $ readScriptDataOrFile redeemerFile
+          sLangSupported <-
+            -- TODO: Implement a new error type to capture this. FileError is not representative of cases
+            -- where we do not have access to the script.
+            modifyError (FileError "Reference script filepath not available")
+              $ hoistMaybe
+                ( PlutusScriptWitnessLanguageNotSupportedInEra
+                    (AnyPlutusScriptVersion lang)
+                    (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
+                )
+              $ scriptLanguageSupportedInEra sbe
+              $ PlutusScriptLanguage lang
+
+          return
+            ( votProceds
+            , Just $
+                VoteScriptWitness $
+                  PlutusScriptWitness
+                    sLangSupported
+                    lang
+                    pScript
+                    NoScriptDatumForStake
+                    redeemer
+                    execUnits
+            )