{-# 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.Plutus

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 AnySpendScript)]
  -> CIO e [(TxIn, Exp.AnyWitness (LedgerEra era))]
readSpendScriptWitnesses :: forall era e.
IsEra era =>
[(TxIn, Maybe AnySpendScript)]
-> CIO e [(TxIn, AnyWitness (LedgerEra era))]
readSpendScriptWitnesses =
  ((TxIn, Maybe AnySpendScript)
 -> RIO e (TxIn, AnyWitness (LedgerEra era)))
-> [(TxIn, Maybe AnySpendScript)]
-> 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 AnySpendScript
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 AnySpendScript -> CIO e (AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
Maybe AnySpendScript -> CIO e (AnyWitness (LedgerEra era))
readSpendScriptWitness Maybe AnySpendScript
mWit)

readSpendScriptWitness
  :: forall era e
   . IsEra era => Maybe AnySpendScript -> CIO e (Exp.AnyWitness (LedgerEra era))
readSpendScriptWitness :: forall era e.
IsEra era =>
Maybe AnySpendScript -> CIO e (AnyWitness (LedgerEra era))
readSpendScriptWitness Maybe AnySpendScript
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 AnySpendScript
spendScriptReq) =
  case AnySpendScript
spendScriptReq of
    AnySpendScriptSimple SimpleScriptRequirements
simpleReq ->
      case SimpleScriptRequirements
simpleReq 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)
        ReferenceSimpleScript TxIn
refTxIn ->
          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
    AnySpendScriptPlutus PlutusSpendingScriptRequirements
plutusReq ->
      case PlutusSpendingScriptRequirements
plutusReq of
        OnDiskPlutusSpendingScript File ScriptInAnyLang 'In
plutusScriptFp ScriptDatumOrFileSpending
mScriptDatum ScriptDataOrFile
redeemerFile ExecutionUnits
execUnits -> do
          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 anyScript of
            Exp.Plutus.AnyPlutusScript PlutusScriptInEra lang (LedgerEra era)
script -> do
              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 = PlutusScriptInEra lang (LedgerEra era) -> SLanguage lang
forall (lang :: Language) era.
PlutusLanguage lang =>
PlutusScriptInEra lang era -> SLanguage lang
Exp.Plutus.plutusScriptInEraSLanguage PlutusScriptInEra lang (LedgerEra era)
script
              mDatum <- handlePotentialScriptDatum mScriptDatum lang
              let pScript = PlutusScriptInEra lang (LedgerEra era)
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
forall (lang :: Language) era.
PlutusScriptInEra lang era -> PlutusScriptOrReferenceInput lang era
Exp.Plutus.PScript PlutusScriptInEra lang (LedgerEra era)
script
                  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.Plutus.PlutusScriptWitness SLanguage lang
lang PlutusScriptOrReferenceInput lang (LedgerEra era)
pScript PlutusScriptDatum lang 'SpendingScript
mDatum HashableScriptData
redeemer ExecutionUnits
execUnits
              return $
                Exp.AnyPlutusScriptWitness $
                  Exp.AnyPlutusSpendingScriptWitness $
                    Exp.createPlutusSpendingScriptWitness lang plutusScriptWitness
        ReferencePlutusSpendingScript TxIn
refTxIn (AnySLanguage SLanguage lang
lang) ScriptDatumOrFileSpending
mScriptDatum 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.Plutus.PReferenceScript TxIn
refTxIn
          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
          mDatum <- handlePotentialScriptDatum mScriptDatum lang
          let 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.Plutus.PlutusScriptWitness SLanguage lang
lang PlutusScriptOrReferenceInput lang (LedgerEra era)
pRefScript PlutusScriptDatum lang 'SpendingScript
mDatum HashableScriptData
redeemer ExecutionUnits
execUnits
          return $
            Exp.AnyPlutusScriptWitness $
              Exp.AnyPlutusSpendingScriptWitness $
                Exp.createPlutusSpendingScriptWitness lang plutusScriptWitness

handlePotentialScriptDatum
  :: ScriptDatumOrFileSpending
  -> L.SLanguage lang
  -> CIO e (Exp.Plutus.PlutusScriptDatum lang Exp.Plutus.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.Plutus.InlineDatum
handlePotentialScriptDatum (PotentialDatum (Just ScriptDataOrFile
sDatFp)) SLanguage lang
lang = do
  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
  return $
    Exp.Plutus.SpendingScriptDatum
      ( case 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.Plutus.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.Plutus.NoScriptDatum