{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

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.Api.Experimental qualified as Exp
import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp
import Cardano.Api.Experimental.Plutus qualified as Exp

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Script.Read.Common
import Cardano.CLI.EraBased.Script.Type
import Cardano.CLI.Read
import Cardano.CLI.Type.Common (AnySLanguage (..))
import Cardano.Ledger.Plutus.Language qualified as L

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, Exp.AnyWitness (LedgerEra era))]
readSpendScriptWitnesses :: forall era e.
IsEra era =>
[(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> CIO e [(TxIn, AnyWitness (LedgerEra era))]
readSpendScriptWitnesses =
  ((TxIn, Maybe (ScriptRequirements 'TxInItem))
 -> RIO e (TxIn, AnyWitness (LedgerEra era)))
-> [(TxIn, Maybe (ScriptRequirements 'TxInItem))]
-> RIO e [(TxIn, AnyWitness (LedgerEra 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)
mWit) -> (TxIn
txin,) (AnyWitness (LedgerEra era) -> (TxIn, AnyWitness (LedgerEra era)))
-> RIO e (AnyWitness (LedgerEra era))
-> RIO e (TxIn, AnyWitness (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ScriptRequirements 'TxInItem)
-> CIO e (AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
Maybe (ScriptRequirements 'TxInItem)
-> CIO e (AnyWitness (LedgerEra era))
readSpendScriptWitness Maybe (ScriptRequirements 'TxInItem)
mWit)

readSpendScriptWitness
  :: forall era e
   . IsEra era => Maybe (ScriptRequirements TxInItem) -> CIO e (Exp.AnyWitness (LedgerEra era))
readSpendScriptWitness :: forall era e.
IsEra era =>
Maybe (ScriptRequirements 'TxInItem)
-> CIO e (AnyWitness (LedgerEra era))
readSpendScriptWitness Maybe (ScriptRequirements 'TxInItem)
Nothing = AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return AnyWitness (LedgerEra era)
forall era. AnyWitness era
Exp.AnyKeyWitnessPlaceholder
readSpendScriptWitness (Just ScriptRequirements 'TxInItem
spendScriptReq) =
  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
      SimpleScriptOrReferenceInput (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
Exp.AnySimpleScriptWitness (SimpleScriptOrReferenceInput (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> (SimpleScript (LedgerEra era)
    -> SimpleScriptOrReferenceInput (LedgerEra era))
-> SimpleScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript (LedgerEra era)
-> SimpleScriptOrReferenceInput (LedgerEra era)
forall era. SimpleScript era -> SimpleScriptOrReferenceInput era
Exp.SScript (SimpleScript (LedgerEra era) -> AnyWitness (LedgerEra era))
-> RIO e (SimpleScript (LedgerEra era))
-> RIO e (AnyWitness (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Era era -> CIO e (SimpleScript (LedgerEra era))
forall era e.
String -> Era era -> CIO e (SimpleScript (LedgerEra era))
readFileSimpleScript String
sFp (forall era. IsEra era => Era era
useEra @era)
    OnDiskPlutusScript
      (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In
plutusScriptFp OptionalDatum 'TxInItem
mScriptDatum ScriptDataOrFile
redeemerFile ExecutionUnits
execUnits) -> do
        AnyPlutusScript (LedgerEra era)
anyScript <-
          forall e era.
IsEra era =>
String -> CIO e (AnyPlutusScript (LedgerEra era))
readFilePlutusScript @_ @era (File ScriptInAnyLang 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File ScriptInAnyLang 'In
plutusScriptFp)
        case AnyPlutusScript (LedgerEra era)
anyScript of
          Exp.AnyPlutusScript PlutusScriptInEra lang (LedgerEra era)
script -> do
            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
            let lang :: SLanguage lang
lang = PlutusScriptInEra lang (LedgerEra era) -> SLanguage lang
forall (lang :: Language) era.
PlutusLanguage lang =>
PlutusScriptInEra lang era -> SLanguage lang
Exp.plutusScriptInEraSLanguage PlutusScriptInEra lang (LedgerEra era)
script
            PlutusScriptDatum lang 'SpendingScript
mDatum <- ScriptDatumOrFileSpending
-> SLanguage lang -> CIO e (PlutusScriptDatum lang 'SpendingScript)
forall (lang :: Language) e.
ScriptDatumOrFileSpending
-> SLanguage lang -> CIO e (PlutusScriptDatum lang 'SpendingScript)
handlePotentialScriptDatum ScriptDatumOrFileSpending
OptionalDatum 'TxInItem
mScriptDatum SLanguage lang
lang

            let pScript :: PlutusScriptOrReferenceInput lang (LedgerEra era)
pScript = PlutusScriptInEra lang (LedgerEra era)
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
forall (lang :: Language) era.
PlutusScriptInEra lang era -> PlutusScriptOrReferenceInput lang era
Exp.PScript PlutusScriptInEra lang (LedgerEra era)
script
                plutusScriptWitness :: PlutusScriptWitness lang 'SpendingScript (LedgerEra era)
plutusScriptWitness = SLanguage lang
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
-> PlutusScriptDatum lang 'SpendingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang 'SpendingScript (LedgerEra era)
forall (lang :: Language) era (purpose :: PlutusScriptPurpose).
SLanguage lang
-> PlutusScriptOrReferenceInput lang era
-> PlutusScriptDatum lang purpose
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang purpose era
Exp.PlutusScriptWitness SLanguage lang
lang PlutusScriptOrReferenceInput lang (LedgerEra era)
pScript PlutusScriptDatum lang 'SpendingScript
mDatum HashableScriptData
redeemer ExecutionUnits
execUnits
            AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era)))
-> AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
              AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
                PlutusSpendingScriptWitness (LedgerEra era)
-> AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
forall era (lang :: Language).
PlutusSpendingScriptWitness era
-> AnyPlutusScriptWitness lang 'SpendingScript era
Exp.AnyPlutusSpendingScriptWitness (PlutusSpendingScriptWitness (LedgerEra era)
 -> AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era))
-> PlutusSpendingScriptWitness (LedgerEra era)
-> AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
                  SLanguage lang
-> PlutusScriptWitness lang 'SpendingScript (LedgerEra era)
-> PlutusSpendingScriptWitness (LedgerEra era)
forall (lang :: Language) era.
SLanguage lang
-> PlutusScriptWitness lang 'SpendingScript era
-> PlutusSpendingScriptWitness era
Exp.createPlutusSpendingScriptWitness SLanguage lang
lang PlutusScriptWitness lang 'SpendingScript (LedgerEra era)
plutusScriptWitness
    SimpleReferenceScript (SimpleRefScriptArgs TxIn
refTxIn NoPolicyId
MintPolicyId 'TxInItem
NoPolicyId) ->
      AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era)))
-> AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        SimpleScriptOrReferenceInput (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
Exp.AnySimpleScriptWitness (SimpleScriptOrReferenceInput (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> SimpleScriptOrReferenceInput (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
          TxIn -> SimpleScriptOrReferenceInput (LedgerEra era)
forall era. TxIn -> SimpleScriptOrReferenceInput era
Exp.SReferenceScript TxIn
refTxIn
    PlutusReferenceScript
      (PlutusRefScriptCliArgs TxIn
refTxIn (AnySLanguage SLanguage lang
lang) OptionalDatum 'TxInItem
mScriptDatum NoPolicyId
MintPolicyId 'TxInItem
NoPolicyId ScriptDataOrFile
redeemerFile ExecutionUnits
execUnits) -> do
        let pRefScript :: PlutusScriptOrReferenceInput lang (LedgerEra era)
pRefScript = TxIn -> PlutusScriptOrReferenceInput lang (LedgerEra era)
forall (lang :: Language) era.
TxIn -> PlutusScriptOrReferenceInput lang era
Exp.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

        PlutusScriptDatum lang 'SpendingScript
mDatum <- ScriptDatumOrFileSpending
-> SLanguage lang -> CIO e (PlutusScriptDatum lang 'SpendingScript)
forall (lang :: Language) e.
ScriptDatumOrFileSpending
-> SLanguage lang -> CIO e (PlutusScriptDatum lang 'SpendingScript)
handlePotentialScriptDatum ScriptDatumOrFileSpending
OptionalDatum 'TxInItem
mScriptDatum SLanguage lang
lang
        let plutusScriptWitness :: PlutusScriptWitness lang 'SpendingScript (LedgerEra era)
plutusScriptWitness = SLanguage lang
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
-> PlutusScriptDatum lang 'SpendingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang 'SpendingScript (LedgerEra era)
forall (lang :: Language) era (purpose :: PlutusScriptPurpose).
SLanguage lang
-> PlutusScriptOrReferenceInput lang era
-> PlutusScriptDatum lang purpose
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang purpose era
Exp.PlutusScriptWitness SLanguage lang
lang PlutusScriptOrReferenceInput lang (LedgerEra era)
pRefScript PlutusScriptDatum lang 'SpendingScript
mDatum HashableScriptData
redeemer ExecutionUnits
execUnits
        AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era)))
-> AnyWitness (LedgerEra era) -> RIO e (AnyWitness (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
          AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
            PlutusSpendingScriptWitness (LedgerEra era)
-> AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
forall era (lang :: Language).
PlutusSpendingScriptWitness era
-> AnyPlutusScriptWitness lang 'SpendingScript era
Exp.AnyPlutusSpendingScriptWitness (PlutusSpendingScriptWitness (LedgerEra era)
 -> AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era))
-> PlutusSpendingScriptWitness (LedgerEra era)
-> AnyPlutusScriptWitness Any 'SpendingScript (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
              SLanguage lang
-> PlutusScriptWitness lang 'SpendingScript (LedgerEra era)
-> PlutusSpendingScriptWitness (LedgerEra era)
forall (lang :: Language) era.
SLanguage lang
-> PlutusScriptWitness lang 'SpendingScript era
-> PlutusSpendingScriptWitness era
Exp.createPlutusSpendingScriptWitness SLanguage lang
lang PlutusScriptWitness lang 'SpendingScript (LedgerEra era)
plutusScriptWitness

handlePotentialScriptDatum
  :: ScriptDatumOrFileSpending
  -> L.SLanguage lang
  -> CIO e (Exp.PlutusScriptDatum lang Exp.SpendingScript)
handlePotentialScriptDatum :: forall (lang :: Language) e.
ScriptDatumOrFileSpending
-> SLanguage lang -> CIO e (PlutusScriptDatum lang 'SpendingScript)
handlePotentialScriptDatum ScriptDatumOrFileSpending
InlineDatum SLanguage lang
_ = PlutusScriptDatum lang 'SpendingScript
-> RIO e (PlutusScriptDatum lang 'SpendingScript)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return PlutusScriptDatum lang 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.InlineDatum
handlePotentialScriptDatum (PotentialDatum (Just ScriptDataOrFile
sDatFp)) SLanguage lang
lang = do
  HashableScriptData
d <- 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
sDatFp
  PlutusScriptDatum lang 'SpendingScript
-> RIO e (PlutusScriptDatum lang 'SpendingScript)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlutusScriptDatum lang 'SpendingScript
 -> RIO e (PlutusScriptDatum lang 'SpendingScript))
-> PlutusScriptDatum lang 'SpendingScript
-> RIO e (PlutusScriptDatum lang 'SpendingScript)
forall a b. (a -> b) -> a -> b
$
    PlutusScriptDatumF lang 'SpendingScript
-> PlutusScriptDatum lang 'SpendingScript
forall (lang :: Language).
PlutusScriptDatumF lang 'SpendingScript
-> PlutusScriptDatum lang 'SpendingScript
Exp.SpendingScriptDatum
      ( case SLanguage lang
lang of
          SLanguage lang
L.SPlutusV1 -> HashableScriptData
PlutusScriptDatumF lang 'SpendingScript
d
          SLanguage lang
L.SPlutusV2 -> HashableScriptData
PlutusScriptDatumF lang 'SpendingScript
d
          SLanguage lang
L.SPlutusV3 -> HashableScriptData -> Maybe HashableScriptData
forall a. a -> Maybe a
Just HashableScriptData
d
          SLanguage lang
L.SPlutusV4 -> HashableScriptData -> Maybe HashableScriptData
forall a. a -> Maybe a
Just HashableScriptData
d
      )
handlePotentialScriptDatum (PotentialDatum Maybe ScriptDataOrFile
Nothing) SLanguage lang
lang =
  case SLanguage lang
lang of
    SLanguage lang
L.SPlutusV1 ->
      forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError @String
        String
"handlePotentialScriptDatum: You must provide a script datum for Plutus V1 scripts."
    SLanguage lang
L.SPlutusV2 ->
      forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError @String
        String
"handlePotentialScriptDatum: You must provide a script datum for Plutus V2 scripts."
    SLanguage lang
L.SPlutusV3 -> PlutusScriptDatum lang 'SpendingScript
-> RIO e (PlutusScriptDatum lang 'SpendingScript)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return PlutusScriptDatum lang 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
    SLanguage lang
L.SPlutusV4 -> PlutusScriptDatum lang 'SpendingScript
-> RIO e (PlutusScriptDatum lang 'SpendingScript)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return PlutusScriptDatum lang 'SpendingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum