{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Cardano.CLI.EraBased.Script.Proposal.Read ( readProposal , readProposalScriptWitness , readTxGovernanceActions , ProposalError (..) ) where import Cardano.Api import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Proposal.Type import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.Read import Cardano.CLI.Type.Common readProposalScriptWitness :: forall e era . Exp.IsEra era => (ProposalFile In, Maybe (ScriptRequirements Exp.ProposalItem)) -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) readProposalScriptWitness :: forall e era. IsEra era => (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem)) -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) readProposalScriptWitness (ProposalFile 'In propFp, Maybe (ScriptRequirements 'ProposalItem) Nothing) = do Proposal era proposal <- Era era -> (EraCommonConstraints era => RIO e (Proposal era)) -> RIO e (Proposal era) forall era a. Era era -> (EraCommonConstraints era => a) -> a obtainCommonConstraints (forall era. IsEra era => Era era Exp.useEra @era) ((EraCommonConstraints era => RIO e (Proposal era)) -> RIO e (Proposal era)) -> (EraCommonConstraints era => RIO e (Proposal era)) -> RIO e (Proposal era) forall a b. (a -> b) -> a -> b $ forall e (m :: * -> *) a. (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => IO (Either e a) -> m a fromEitherIOCli @(FileError TextEnvelopeError) (IO (Either (FileError TextEnvelopeError) (Proposal era)) -> RIO e (Proposal era)) -> IO (Either (FileError TextEnvelopeError) (Proposal era)) -> RIO e (Proposal era) forall a b. (a -> b) -> a -> b $ ProposalFile 'In -> IO (Either (FileError TextEnvelopeError) (Proposal era)) forall a content. HasTextEnvelope a => File content 'In -> IO (Either (FileError TextEnvelopeError) a) readFileTextEnvelope ProposalFile 'In propFp (Proposal era, Maybe (ProposalScriptWitness era)) -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return (Proposal era proposal, Maybe (ProposalScriptWitness era) forall a. Maybe a Nothing) readProposalScriptWitness (ProposalFile 'In propFp, Just ScriptRequirements 'ProposalItem certScriptReq) = do let sbe :: ShelleyBasedEra era sbe = Era era -> ShelleyBasedEra era forall era. Era era -> ShelleyBasedEra era forall a (f :: a -> *) (g :: a -> *) (era :: a). Convert f g => f era -> g era convert Era era forall era. IsEra era => Era era Exp.useEra Proposal era proposal <- Era era -> (EraCommonConstraints era => RIO e (Proposal era)) -> RIO e (Proposal era) forall era a. Era era -> (EraCommonConstraints era => a) -> a obtainCommonConstraints (forall era. IsEra era => Era era Exp.useEra @era) ((EraCommonConstraints era => RIO e (Proposal era)) -> RIO e (Proposal era)) -> (EraCommonConstraints era => RIO e (Proposal era)) -> RIO e (Proposal era) forall a b. (a -> b) -> a -> b $ forall e (m :: * -> *) a. (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => IO (Either e a) -> m a fromEitherIOCli @(FileError TextEnvelopeError) (IO (Either (FileError TextEnvelopeError) (Proposal era)) -> RIO e (Proposal era)) -> IO (Either (FileError TextEnvelopeError) (Proposal era)) -> RIO e (Proposal era) forall a b. (a -> b) -> a -> b $ ProposalFile 'In -> IO (Either (FileError TextEnvelopeError) (Proposal era)) forall a content. HasTextEnvelope a => File content 'In -> IO (Either (FileError TextEnvelopeError) a) readFileTextEnvelope ProposalFile 'In propFp case ScriptRequirements 'ProposalItem certScriptReq of OnDiskSimpleScript File ScriptInAnyLang 'In scriptFp -> do let sFp :: FilePath sFp = File ScriptInAnyLang 'In -> FilePath forall content (direction :: FileDirection). File content direction -> FilePath unFile File ScriptInAnyLang 'In scriptFp Script SimpleScript' s <- FilePath -> CIO e (Script SimpleScript') forall e. FilePath -> CIO e (Script SimpleScript') readFileSimpleScript FilePath sFp case Script SimpleScript' s of SimpleScript SimpleScript ss -> do (Proposal era, Maybe (ProposalScriptWitness era)) -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return ( Proposal era proposal , ProposalScriptWitness era -> Maybe (ProposalScriptWitness era) forall a. a -> Maybe a Just (ProposalScriptWitness era -> Maybe (ProposalScriptWitness era)) -> ProposalScriptWitness era -> Maybe (ProposalScriptWitness era) forall a b. (a -> b) -> a -> b $ ScriptWitness WitCtxStake era -> ProposalScriptWitness era forall era. ScriptWitness WitCtxStake era -> ProposalScriptWitness era ProposalScriptWitness ( ScriptLanguageInEra SimpleScript' era -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness WitCtxStake era forall era witctx. ScriptLanguageInEra SimpleScript' era -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness witctx era SimpleScriptWitness (ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era forall era. ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era sbeToSimpleScriptLanguageInEra ShelleyBasedEra era sbe) (SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness WitCtxStake era) -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness WitCtxStake era forall a b. (a -> b) -> a -> b $ SimpleScript -> SimpleScriptOrReferenceInput SimpleScript' forall lang. SimpleScript -> SimpleScriptOrReferenceInput lang SScript SimpleScript ss ) ) OnDiskPlutusScript (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In scriptFp NoScriptDatum OptionalDatum 'ProposalItem Exp.NoScriptDatumAllowed ScriptDataOrFile redeemerFile ExecutionUnits execUnits) -> do let plutusScriptFp :: FilePath plutusScriptFp = File ScriptInAnyLang 'In -> FilePath forall content (direction :: FileDirection). File content direction -> FilePath unFile File ScriptInAnyLang 'In scriptFp AnyPlutusScript plutusScript <- FilePath -> CIO e AnyPlutusScript forall e. FilePath -> CIO e AnyPlutusScript readFilePlutusScript FilePath plutusScriptFp HashableScriptData redeemer <- ExceptT ScriptDataError IO HashableScriptData -> RIO e HashableScriptData forall e (m :: * -> *) a. (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => ExceptT e IO a -> m a fromExceptTCli (ExceptT ScriptDataError IO HashableScriptData -> RIO e HashableScriptData) -> ExceptT ScriptDataError IO HashableScriptData -> RIO e HashableScriptData forall a b. (a -> b) -> a -> b $ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData forall (m :: * -> *). MonadIO m => ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData readScriptDataOrFile ScriptDataOrFile redeemerFile case AnyPlutusScript plutusScript of AnyPlutusScript PlutusScriptVersion lang lang PlutusScript lang script -> do let pScript :: PlutusScriptOrReferenceInput lang pScript = PlutusScript lang -> PlutusScriptOrReferenceInput lang forall lang. PlutusScript lang -> PlutusScriptOrReferenceInput lang PScript PlutusScript lang script ScriptLanguageInEra lang era sLangSupported <- CliScriptWitnessError -> Maybe (ScriptLanguageInEra lang era) -> CIO e (ScriptLanguageInEra lang era) forall err a e. (Show err, Typeable err, Error err) => err -> Maybe a -> CIO e a fromMaybeCli ( AnyPlutusScriptVersion -> AnyShelleyBasedEra -> CliScriptWitnessError PlutusScriptWitnessLanguageNotSupportedInEra (PlutusScriptVersion lang -> AnyPlutusScriptVersion forall lang. IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> AnyPlutusScriptVersion AnyPlutusScriptVersion PlutusScriptVersion lang lang) (ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => AnyShelleyBasedEra) -> AnyShelleyBasedEra forall era a. ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a shelleyBasedEraConstraints ShelleyBasedEra era sbe ((ShelleyBasedEraConstraints era => AnyShelleyBasedEra) -> AnyShelleyBasedEra) -> (ShelleyBasedEraConstraints era => AnyShelleyBasedEra) -> AnyShelleyBasedEra forall a b. (a -> b) -> a -> b $ ShelleyBasedEra era -> AnyShelleyBasedEra forall era. Typeable era => ShelleyBasedEra era -> AnyShelleyBasedEra AnyShelleyBasedEra ShelleyBasedEra era sbe) ) (Maybe (ScriptLanguageInEra lang era) -> CIO e (ScriptLanguageInEra lang era)) -> Maybe (ScriptLanguageInEra lang era) -> CIO e (ScriptLanguageInEra lang era) forall a b. (a -> b) -> a -> b $ ShelleyBasedEra era -> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era) forall era lang. ShelleyBasedEra era -> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era) scriptLanguageSupportedInEra ShelleyBasedEra era sbe (ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)) -> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era) forall a b. (a -> b) -> a -> b $ PlutusScriptVersion lang -> ScriptLanguage lang forall lang. IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> ScriptLanguage lang PlutusScriptLanguage PlutusScriptVersion lang lang (Proposal era, Maybe (ProposalScriptWitness era)) -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return ( Proposal era proposal , ProposalScriptWitness era -> Maybe (ProposalScriptWitness era) forall a. a -> Maybe a Just (ProposalScriptWitness era -> Maybe (ProposalScriptWitness era)) -> ProposalScriptWitness era -> Maybe (ProposalScriptWitness era) forall a b. (a -> b) -> a -> b $ ScriptWitness WitCtxStake era -> ProposalScriptWitness era forall era. ScriptWitness WitCtxStake era -> ProposalScriptWitness era ProposalScriptWitness (ScriptWitness WitCtxStake era -> ProposalScriptWitness era) -> ScriptWitness WitCtxStake era -> ProposalScriptWitness era forall a b. (a -> b) -> a -> b $ ScriptLanguageInEra lang era -> PlutusScriptVersion lang -> PlutusScriptOrReferenceInput lang -> ScriptDatum WitCtxStake -> HashableScriptData -> ExecutionUnits -> ScriptWitness WitCtxStake era forall lang era witctx. IsPlutusScriptLanguage lang => ScriptLanguageInEra lang era -> PlutusScriptVersion lang -> PlutusScriptOrReferenceInput lang -> ScriptDatum witctx -> HashableScriptData -> ExecutionUnits -> ScriptWitness witctx era PlutusScriptWitness ScriptLanguageInEra lang era sLangSupported PlutusScriptVersion lang lang PlutusScriptOrReferenceInput lang pScript ScriptDatum WitCtxStake NoScriptDatumForStake HashableScriptData redeemer ExecutionUnits execUnits ) SimpleReferenceScript (SimpleRefScriptArgs TxIn refTxIn NoPolicyId MintPolicyId 'ProposalItem NoPolicyId) -> (Proposal era, Maybe (ProposalScriptWitness era)) -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return ( Proposal era proposal , ProposalScriptWitness era -> Maybe (ProposalScriptWitness era) forall a. a -> Maybe a Just (ProposalScriptWitness era -> Maybe (ProposalScriptWitness era)) -> (ScriptWitness WitCtxStake era -> ProposalScriptWitness era) -> ScriptWitness WitCtxStake era -> Maybe (ProposalScriptWitness era) forall b c a. (b -> c) -> (a -> b) -> a -> c . ScriptWitness WitCtxStake era -> ProposalScriptWitness era forall era. ScriptWitness WitCtxStake era -> ProposalScriptWitness era ProposalScriptWitness (ScriptWitness WitCtxStake era -> Maybe (ProposalScriptWitness era)) -> ScriptWitness WitCtxStake era -> Maybe (ProposalScriptWitness era) forall a b. (a -> b) -> a -> b $ ScriptLanguageInEra SimpleScript' era -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness WitCtxStake era forall era witctx. ScriptLanguageInEra SimpleScript' era -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness witctx era SimpleScriptWitness (ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era forall era. ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era sbeToSimpleScriptLanguageInEra (ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era) -> ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era forall a b. (a -> b) -> a -> b $ Era era -> ShelleyBasedEra era forall era. Era era -> ShelleyBasedEra era forall a (f :: a -> *) (g :: a -> *) (era :: a). Convert f g => f era -> g era convert Era era forall era. IsEra era => Era era Exp.useEra) (TxIn -> SimpleScriptOrReferenceInput SimpleScript' forall lang. TxIn -> SimpleScriptOrReferenceInput lang SReferenceScript TxIn refTxIn) ) PlutusReferenceScript ( PlutusRefScriptCliArgs TxIn refTxIn AnyPlutusScriptVersion anyPlutusScriptVersion NoScriptDatum OptionalDatum 'ProposalItem Exp.NoScriptDatumAllowed NoPolicyId MintPolicyId 'ProposalItem NoPolicyId ScriptDataOrFile redeemerFile ExecutionUnits execUnits ) -> do case AnyPlutusScriptVersion anyPlutusScriptVersion of AnyPlutusScriptVersion PlutusScriptVersion lang lang -> do let pScript :: PlutusScriptOrReferenceInput lang pScript = TxIn -> PlutusScriptOrReferenceInput lang forall lang. TxIn -> PlutusScriptOrReferenceInput lang PReferenceScript TxIn refTxIn HashableScriptData redeemer <- ExceptT ScriptDataError IO HashableScriptData -> RIO e HashableScriptData forall e (m :: * -> *) a. (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => ExceptT e IO a -> m a fromExceptTCli (ExceptT ScriptDataError IO HashableScriptData -> RIO e HashableScriptData) -> ExceptT ScriptDataError IO HashableScriptData -> RIO e HashableScriptData forall a b. (a -> b) -> a -> b $ ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData forall (m :: * -> *). MonadIO m => ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData readScriptDataOrFile ScriptDataOrFile redeemerFile ScriptLanguageInEra lang era sLangSupported <- CliScriptWitnessError -> Maybe (ScriptLanguageInEra lang era) -> CIO e (ScriptLanguageInEra lang era) forall err a e. (Show err, Typeable err, Error err) => err -> Maybe a -> CIO e a fromMaybeCli ( AnyPlutusScriptVersion -> AnyShelleyBasedEra -> CliScriptWitnessError PlutusScriptWitnessLanguageNotSupportedInEra (PlutusScriptVersion lang -> AnyPlutusScriptVersion forall lang. IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> AnyPlutusScriptVersion AnyPlutusScriptVersion PlutusScriptVersion lang lang) (ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => AnyShelleyBasedEra) -> AnyShelleyBasedEra forall era a. ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a shelleyBasedEraConstraints ShelleyBasedEra era sbe ((ShelleyBasedEraConstraints era => AnyShelleyBasedEra) -> AnyShelleyBasedEra) -> (ShelleyBasedEraConstraints era => AnyShelleyBasedEra) -> AnyShelleyBasedEra forall a b. (a -> b) -> a -> b $ ShelleyBasedEra era -> AnyShelleyBasedEra forall era. Typeable era => ShelleyBasedEra era -> AnyShelleyBasedEra AnyShelleyBasedEra ShelleyBasedEra era sbe) ) (Maybe (ScriptLanguageInEra lang era) -> CIO e (ScriptLanguageInEra lang era)) -> Maybe (ScriptLanguageInEra lang era) -> CIO e (ScriptLanguageInEra lang era) forall a b. (a -> b) -> a -> b $ ShelleyBasedEra era -> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era) forall era lang. ShelleyBasedEra era -> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era) scriptLanguageSupportedInEra ShelleyBasedEra era sbe (ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)) -> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era) forall a b. (a -> b) -> a -> b $ PlutusScriptVersion lang -> ScriptLanguage lang forall lang. IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> ScriptLanguage lang PlutusScriptLanguage PlutusScriptVersion lang lang (Proposal era, Maybe (ProposalScriptWitness era)) -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return ( Proposal era proposal , ProposalScriptWitness era -> Maybe (ProposalScriptWitness era) forall a. a -> Maybe a Just (ProposalScriptWitness era -> Maybe (ProposalScriptWitness era)) -> ProposalScriptWitness era -> Maybe (ProposalScriptWitness era) forall a b. (a -> b) -> a -> b $ ScriptWitness WitCtxStake era -> ProposalScriptWitness era forall era. ScriptWitness WitCtxStake era -> ProposalScriptWitness era ProposalScriptWitness (ScriptWitness WitCtxStake era -> ProposalScriptWitness era) -> ScriptWitness WitCtxStake era -> ProposalScriptWitness era forall a b. (a -> b) -> a -> b $ ScriptLanguageInEra lang era -> PlutusScriptVersion lang -> PlutusScriptOrReferenceInput lang -> ScriptDatum WitCtxStake -> HashableScriptData -> ExecutionUnits -> ScriptWitness WitCtxStake era forall lang era witctx. IsPlutusScriptLanguage lang => ScriptLanguageInEra lang era -> PlutusScriptVersion lang -> PlutusScriptOrReferenceInput lang -> ScriptDatum witctx -> HashableScriptData -> ExecutionUnits -> ScriptWitness witctx era PlutusScriptWitness ScriptLanguageInEra lang era sLangSupported PlutusScriptVersion lang lang PlutusScriptOrReferenceInput lang pScript ScriptDatum WitCtxStake NoScriptDatumForStake HashableScriptData redeemer ExecutionUnits execUnits ) newtype ProposalError = ProposalErrorFile (FileError CliScriptWitnessError) deriving Int -> ProposalError -> ShowS [ProposalError] -> ShowS ProposalError -> FilePath (Int -> ProposalError -> ShowS) -> (ProposalError -> FilePath) -> ([ProposalError] -> ShowS) -> Show ProposalError forall a. (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> ProposalError -> ShowS showsPrec :: Int -> ProposalError -> ShowS $cshow :: ProposalError -> FilePath show :: ProposalError -> FilePath $cshowList :: [ProposalError] -> ShowS showList :: [ProposalError] -> ShowS Show instance Error ProposalError where prettyError :: forall ann. ProposalError -> Doc ann prettyError = ProposalError -> Doc ann forall a ann. Show a => a -> Doc ann pshow readProposal :: Exp.IsEra era => (ProposalFile In, Maybe (ScriptRequirements Exp.ProposalItem)) -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) readProposal :: forall era e. IsEra era => (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem)) -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) readProposal (ProposalFile 'In fp, Maybe (ScriptRequirements 'ProposalItem) mScriptWit) = do (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem)) -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) forall e era. IsEra era => (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem)) -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) readProposalScriptWitness (ProposalFile 'In fp, Maybe (ScriptRequirements 'ProposalItem) mScriptWit) readTxGovernanceActions :: Exp.IsEra era => [(ProposalFile In, Maybe (ScriptRequirements Exp.ProposalItem))] -> CIO e [(Proposal era, Maybe (ProposalScriptWitness era))] readTxGovernanceActions :: forall era e. IsEra era => [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))] -> CIO e [(Proposal era, Maybe (ProposalScriptWitness era))] readTxGovernanceActions = ((ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem)) -> RIO e (Proposal era, Maybe (ProposalScriptWitness era))) -> [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))] -> RIO e [(Proposal era, Maybe (ProposalScriptWitness era))] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b] mapM (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem)) -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)) (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem)) -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) forall era e. IsEra era => (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem)) -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) readProposal