{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} module Cardano.CLI.EraBased.Script.Spend.Read ( CliSpendScriptWitnessError , readSpendScriptWitness , readSpendScriptWitnesses ) where import Cardano.Api import Cardano.Api.Experimental hiding ( InlineDatum , PReferenceScript , PScript , PlutusScriptWitness , SReferenceScript , SScript , SimpleScript ) import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.EraBased.Script.Spend.Type ( SpendScriptWitness (..) ) import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.Read import Control.Monad newtype CliSpendScriptWitnessError = CliScriptWitnessError CliScriptWitnessError deriving Int -> CliSpendScriptWitnessError -> ShowS [CliSpendScriptWitnessError] -> ShowS CliSpendScriptWitnessError -> String (Int -> CliSpendScriptWitnessError -> ShowS) -> (CliSpendScriptWitnessError -> String) -> ([CliSpendScriptWitnessError] -> ShowS) -> Show CliSpendScriptWitnessError forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> CliSpendScriptWitnessError -> ShowS showsPrec :: Int -> CliSpendScriptWitnessError -> ShowS $cshow :: CliSpendScriptWitnessError -> String show :: CliSpendScriptWitnessError -> String $cshowList :: [CliSpendScriptWitnessError] -> ShowS showList :: [CliSpendScriptWitnessError] -> ShowS Show instance Error CliSpendScriptWitnessError where prettyError :: forall ann. CliSpendScriptWitnessError -> Doc ann prettyError = \case CliScriptWitnessError CliScriptWitnessError e -> CliScriptWitnessError -> Doc ann forall e ann. Error e => e -> Doc ann forall ann. CliScriptWitnessError -> Doc ann prettyError CliScriptWitnessError e readSpendScriptWitnesses :: IsEra era => [(TxIn, Maybe (ScriptRequirements TxInItem))] -> CIO e [(TxIn, Maybe (SpendScriptWitness era))] readSpendScriptWitnesses :: forall era e. IsEra era => [(TxIn, Maybe (ScriptRequirements 'TxInItem))] -> CIO e [(TxIn, Maybe (SpendScriptWitness era))] readSpendScriptWitnesses = ((TxIn, Maybe (ScriptRequirements 'TxInItem)) -> RIO e (TxIn, Maybe (SpendScriptWitness era))) -> [(TxIn, Maybe (ScriptRequirements 'TxInItem))] -> RIO e [(TxIn, Maybe (SpendScriptWitness 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 ( \(TxIn txin, Maybe (ScriptRequirements 'TxInItem) mSWit) -> do (TxIn txin,) (Maybe (SpendScriptWitness era) -> (TxIn, Maybe (SpendScriptWitness era))) -> RIO e (Maybe (SpendScriptWitness era)) -> RIO e (TxIn, Maybe (SpendScriptWitness era)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (ScriptRequirements 'TxInItem) -> (ScriptRequirements 'TxInItem -> RIO e (SpendScriptWitness era)) -> RIO e (Maybe (SpendScriptWitness era)) forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM Maybe (ScriptRequirements 'TxInItem) mSWit ScriptRequirements 'TxInItem -> RIO e (SpendScriptWitness era) ScriptRequirements 'TxInItem -> CIO e (SpendScriptWitness era) forall era e. IsEra era => ScriptRequirements 'TxInItem -> CIO e (SpendScriptWitness era) readSpendScriptWitness ) readSpendScriptWitness :: IsEra era => ScriptRequirements TxInItem -> CIO e (SpendScriptWitness era) readSpendScriptWitness :: forall era e. IsEra era => ScriptRequirements 'TxInItem -> CIO e (SpendScriptWitness era) readSpendScriptWitness ScriptRequirements 'TxInItem spendScriptReq = 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 useEra in case ScriptRequirements 'TxInItem spendScriptReq of OnDiskSimpleScript File ScriptInAnyLang 'In simpleFp -> do let sFp :: String sFp = File ScriptInAnyLang 'In -> String forall content (direction :: FileDirection). File content direction -> String unFile File ScriptInAnyLang 'In simpleFp Script SimpleScript' s <- String -> CIO e (Script SimpleScript') forall e. String -> CIO e (Script SimpleScript') readFileSimpleScript String sFp case Script SimpleScript' s of SimpleScript SimpleScript ss -> do SpendScriptWitness era -> RIO e (SpendScriptWitness era) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return (SpendScriptWitness era -> RIO e (SpendScriptWitness era)) -> SpendScriptWitness era -> RIO e (SpendScriptWitness era) forall a b. (a -> b) -> a -> b $ ScriptWitness WitCtxTxIn era -> SpendScriptWitness era forall era. ScriptWitness WitCtxTxIn era -> SpendScriptWitness era SpendScriptWitness (ScriptWitness WitCtxTxIn era -> SpendScriptWitness era) -> ScriptWitness WitCtxTxIn era -> SpendScriptWitness era forall a b. (a -> b) -> a -> b $ ScriptLanguageInEra SimpleScript' era -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness WitCtxTxIn 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 WitCtxTxIn era) -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness WitCtxTxIn era forall a b. (a -> b) -> a -> b $ SimpleScript -> SimpleScriptOrReferenceInput SimpleScript' forall lang. SimpleScript -> SimpleScriptOrReferenceInput lang SScript SimpleScript ss OnDiskPlutusScript (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In plutusScriptFp OptionalDatum 'TxInItem mScriptDatum ScriptDataOrFile redeemerFile ExecutionUnits execUnits) -> do AnyPlutusScript plutusScript <- String -> CIO e AnyPlutusScript forall e. String -> CIO e AnyPlutusScript readFilePlutusScript (String -> CIO e AnyPlutusScript) -> String -> CIO e AnyPlutusScript forall a b. (a -> b) -> a -> b $ File ScriptInAnyLang 'In -> String forall content (direction :: FileDirection). File content direction -> String unFile File ScriptInAnyLang 'In 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 <- CliSpendScriptWitnessError -> 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 ( CliScriptWitnessError -> CliSpendScriptWitnessError CliScriptWitnessError (CliScriptWitnessError -> CliSpendScriptWitnessError) -> CliScriptWitnessError -> CliSpendScriptWitnessError forall a b. (a -> b) -> a -> b $ 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 ScriptDatum WitCtxTxIn mDatum <- ScriptDatumOrFileSpending -> CIO e (ScriptDatum WitCtxTxIn) forall e. ScriptDatumOrFileSpending -> CIO e (ScriptDatum WitCtxTxIn) handlePotentialScriptDatum ScriptDatumOrFileSpending OptionalDatum 'TxInItem mScriptDatum SpendScriptWitness era -> RIO e (SpendScriptWitness era) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return (SpendScriptWitness era -> RIO e (SpendScriptWitness era)) -> SpendScriptWitness era -> RIO e (SpendScriptWitness era) forall a b. (a -> b) -> a -> b $ ScriptWitness WitCtxTxIn era -> SpendScriptWitness era forall era. ScriptWitness WitCtxTxIn era -> SpendScriptWitness era SpendScriptWitness (ScriptWitness WitCtxTxIn era -> SpendScriptWitness era) -> ScriptWitness WitCtxTxIn era -> SpendScriptWitness era forall a b. (a -> b) -> a -> b $ ScriptLanguageInEra lang era -> PlutusScriptVersion lang -> PlutusScriptOrReferenceInput lang -> ScriptDatum WitCtxTxIn -> HashableScriptData -> ExecutionUnits -> ScriptWitness WitCtxTxIn 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 WitCtxTxIn mDatum HashableScriptData redeemer ExecutionUnits execUnits SimpleReferenceScript (SimpleRefScriptArgs TxIn refTxIn NoPolicyId MintPolicyId 'TxInItem NoPolicyId) -> SpendScriptWitness era -> RIO e (SpendScriptWitness era) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return (SpendScriptWitness era -> RIO e (SpendScriptWitness era)) -> SpendScriptWitness era -> RIO e (SpendScriptWitness era) forall a b. (a -> b) -> a -> b $ ScriptWitness WitCtxTxIn era -> SpendScriptWitness era forall era. ScriptWitness WitCtxTxIn era -> SpendScriptWitness era SpendScriptWitness (ScriptWitness WitCtxTxIn era -> SpendScriptWitness era) -> ScriptWitness WitCtxTxIn era -> SpendScriptWitness era forall a b. (a -> b) -> a -> b $ ScriptLanguageInEra SimpleScript' era -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness WitCtxTxIn 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) (TxIn -> SimpleScriptOrReferenceInput SimpleScript' forall lang. TxIn -> SimpleScriptOrReferenceInput lang SReferenceScript TxIn refTxIn) PlutusReferenceScript (PlutusRefScriptCliArgs TxIn refTxIn AnyPlutusScriptVersion anyPlutusScriptVersion OptionalDatum 'TxInItem mScriptDatum NoPolicyId MintPolicyId 'TxInItem NoPolicyId ScriptDataOrFile redeemerFile ExecutionUnits execUnits) -> 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 <- CliSpendScriptWitnessError -> 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 ( CliScriptWitnessError -> CliSpendScriptWitnessError CliScriptWitnessError (CliScriptWitnessError -> CliSpendScriptWitnessError) -> CliScriptWitnessError -> CliSpendScriptWitnessError forall a b. (a -> b) -> a -> b $ 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 ScriptDatum WitCtxTxIn mDatum <- ScriptDatumOrFileSpending -> CIO e (ScriptDatum WitCtxTxIn) forall e. ScriptDatumOrFileSpending -> CIO e (ScriptDatum WitCtxTxIn) handlePotentialScriptDatum ScriptDatumOrFileSpending OptionalDatum 'TxInItem mScriptDatum SpendScriptWitness era -> RIO e (SpendScriptWitness era) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return (SpendScriptWitness era -> RIO e (SpendScriptWitness era)) -> SpendScriptWitness era -> RIO e (SpendScriptWitness era) forall a b. (a -> b) -> a -> b $ ScriptWitness WitCtxTxIn era -> SpendScriptWitness era forall era. ScriptWitness WitCtxTxIn era -> SpendScriptWitness era SpendScriptWitness (ScriptWitness WitCtxTxIn era -> SpendScriptWitness era) -> ScriptWitness WitCtxTxIn era -> SpendScriptWitness era forall a b. (a -> b) -> a -> b $ ScriptLanguageInEra lang era -> PlutusScriptVersion lang -> PlutusScriptOrReferenceInput lang -> ScriptDatum WitCtxTxIn -> HashableScriptData -> ExecutionUnits -> ScriptWitness WitCtxTxIn 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 WitCtxTxIn mDatum HashableScriptData redeemer ExecutionUnits execUnits handlePotentialScriptDatum :: ScriptDatumOrFileSpending -> CIO e (ScriptDatum WitCtxTxIn) handlePotentialScriptDatum :: forall e. ScriptDatumOrFileSpending -> CIO e (ScriptDatum WitCtxTxIn) handlePotentialScriptDatum ScriptDatumOrFileSpending InlineDatum = ScriptDatum WitCtxTxIn -> RIO e (ScriptDatum WitCtxTxIn) forall a. a -> RIO e a forall (m :: * -> *) a. Monad m => a -> m a return ScriptDatum WitCtxTxIn InlineScriptDatum handlePotentialScriptDatum (PotentialDatum Maybe ScriptDataOrFile mDatum) = Maybe HashableScriptData -> ScriptDatum WitCtxTxIn ScriptDatumForTxIn (Maybe HashableScriptData -> ScriptDatum WitCtxTxIn) -> RIO e (Maybe HashableScriptData) -> RIO e (ScriptDatum WitCtxTxIn) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe ScriptDataOrFile -> (ScriptDataOrFile -> RIO e HashableScriptData) -> RIO e (Maybe HashableScriptData) forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM Maybe ScriptDataOrFile mDatum (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) -> (ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData) -> ScriptDataOrFile -> RIO e HashableScriptData forall b c a. (b -> c) -> (a -> b) -> a -> c . ScriptDataOrFile -> ExceptT ScriptDataError IO HashableScriptData forall (m :: * -> *). MonadIO m => ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData readScriptDataOrFile)