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

module Cardano.CLI.EraBased.Script.Mint.Read
  ( readMintScriptWitness
  )
where

import Cardano.Api
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Experimental.AnyScriptWitness
import Cardano.Api.Experimental.Plutus qualified as Exp
import Cardano.Api.Experimental.Plutus qualified as L
import Cardano.Api.Ledger qualified as L

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.Core qualified as L

readMintScriptWitness
  :: forall era e
   . Exp.IsEra era
  => ScriptRequirements Exp.MintItem -> CIO e (PolicyId, Exp.AnyWitness (Exp.LedgerEra era))
readMintScriptWitness :: forall era e.
IsEra era =>
ScriptRequirements 'MintItem
-> CIO e (PolicyId, AnyWitness (LedgerEra era))
readMintScriptWitness (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
  SimpleScript (LedgerEra era)
s <- FilePath -> Era era -> CIO e (SimpleScript (LedgerEra era))
forall era e.
FilePath -> Era era -> CIO e (SimpleScript (LedgerEra era))
readFileSimpleScript FilePath
sFp (forall era. IsEra era => Era era
Exp.useEra @era)
  let ScriptHash
sHash :: L.ScriptHash =
        SimpleScript (LedgerEra era) -> ScriptHash
forall era. IsEra era => SimpleScript (LedgerEra era) -> ScriptHash
Exp.hashSimpleScript (SimpleScript (LedgerEra era)
s :: Exp.SimpleScript (Exp.LedgerEra era))
  (PolicyId, AnyWitness (LedgerEra era))
-> RIO e (PolicyId, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (PolicyID -> PolicyId
fromMaryPolicyID (PolicyID -> PolicyId) -> PolicyID -> PolicyId
forall a b. (a -> b) -> a -> b
$ ScriptHash -> PolicyID
L.PolicyID ScriptHash
sHash, 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
$ SimpleScript (LedgerEra era)
-> SimpleScriptOrReferenceInput (LedgerEra era)
forall era. SimpleScript era -> SimpleScriptOrReferenceInput era
Exp.SScript SimpleScript (LedgerEra era)
s)
readMintScriptWitness
  ( OnDiskPlutusScript
      (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In
scriptFp NoScriptDatum
OptionalDatum 'MintItem
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
    Exp.AnyPlutusScript PlutusScriptInEra lang (LedgerEra era)
script <-
      forall e era.
IsEra era =>
FilePath -> CIO e (AnyPlutusScript (LedgerEra era))
readFilePlutusScript @_ @era FilePath
plutusScriptFp
    let polId :: PolicyId
polId = PolicyID -> PolicyId
fromMaryPolicyID (PolicyID -> PolicyId)
-> (ScriptHash -> PolicyID) -> ScriptHash -> PolicyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> PolicyID
L.PolicyID (ScriptHash -> PolicyId) -> ScriptHash -> PolicyId
forall a b. (a -> b) -> a -> b
$ PlutusScriptInEra lang (LedgerEra era) -> ScriptHash
forall era (lang :: Language).
IsEra era =>
PlutusScriptInEra lang (LedgerEra era) -> ScriptHash
L.hashPlutusScriptInEra PlutusScriptInEra lang (LedgerEra era)
script
    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 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
        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
    let sw :: PlutusScriptWitness lang 'MintingScript (LedgerEra era)
sw =
          SLanguage lang
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
-> PlutusScriptDatum lang 'MintingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang 'MintingScript (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 'MintingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
            HashableScriptData
redeemer
            ExecutionUnits
execUnits
    (PolicyId, AnyWitness (LedgerEra era))
-> RIO e (PolicyId, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
      ( PolicyId
polId
      , AnyPlutusScriptWitness lang 'MintingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness lang 'MintingScript (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness lang 'MintingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
          PlutusScriptWitness lang 'MintingScript (LedgerEra era)
-> AnyPlutusScriptWitness lang 'MintingScript (LedgerEra era)
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'MintingScript era
-> AnyPlutusScriptWitness lang 'MintingScript era
AnyPlutusMintingScriptWitness PlutusScriptWitness lang 'MintingScript (LedgerEra era)
sw
      )
readMintScriptWitness
  ( PlutusReferenceScript
      ( PlutusRefScriptCliArgs
          TxIn
refTxIn
          (AnySLanguage SLanguage lang
lang)
          NoScriptDatum
OptionalDatum 'MintItem
Exp.NoScriptDatumAllowed
          MintPolicyId 'MintItem
polId
          ScriptDataOrFile
redeemerFile
          ExecutionUnits
execUnits
        )
    ) = 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 sw :: PlutusScriptWitness lang 'MintingScript (LedgerEra era)
sw =
          SLanguage lang
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
-> PlutusScriptDatum lang 'MintingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang 'MintingScript (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
            (TxIn -> PlutusScriptOrReferenceInput lang (LedgerEra era)
forall (lang :: Language) era.
TxIn -> PlutusScriptOrReferenceInput lang era
Exp.PReferenceScript TxIn
refTxIn)
            PlutusScriptDatum lang 'MintingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
            HashableScriptData
redeemer
            ExecutionUnits
execUnits
    (PolicyId, AnyWitness (LedgerEra era))
-> RIO e (PolicyId, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
      ( PolicyId
MintPolicyId 'MintItem
polId
      , AnyPlutusScriptWitness lang 'MintingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness lang 'MintingScript (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness lang 'MintingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
          PlutusScriptWitness lang 'MintingScript (LedgerEra era)
-> AnyPlutusScriptWitness lang 'MintingScript (LedgerEra era)
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'MintingScript era
-> AnyPlutusScriptWitness lang 'MintingScript era
AnyPlutusMintingScriptWitness
            PlutusScriptWitness lang 'MintingScript (LedgerEra era)
sw
      )
readMintScriptWitness (SimpleReferenceScript (SimpleRefScriptArgs TxIn
refTxIn MintPolicyId 'MintItem
polId)) =
  (PolicyId, AnyWitness (LedgerEra era))
-> RIO e (PolicyId, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (PolicyId
MintPolicyId 'MintItem
polId, 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)