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

module Cardano.CLI.EraBased.Script.Certificate.Read
  ( readCertificateScriptWitness
  , readCertificateScriptWitnesses
  )
where

import Cardano.Api (File (..))
import Cardano.Api.Experimental
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Experimental.AnyScriptWitness
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.Orphan ()
import Cardano.CLI.Read
import Cardano.CLI.Type.Common (AnySLanguage (..), CertificateFile)

readCertificateScriptWitness
  :: forall era e
   . IsEra era
  => ScriptRequirements Exp.CertItem
  -> CIO e (AnyWitness (LedgerEra era))
readCertificateScriptWitness :: forall era e.
IsEra era =>
ScriptRequirements 'CertItem -> CIO e (AnyWitness (LedgerEra era))
readCertificateScriptWitness (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
  SimpleScriptOrReferenceInput (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
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
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
<$> FilePath -> Era era -> CIO e (SimpleScript (LedgerEra era))
forall era e.
FilePath -> Era era -> CIO e (SimpleScript (LedgerEra era))
readFileSimpleScript FilePath
sFp Era era
forall era. IsEra era => Era era
useEra
readCertificateScriptWitness
  ( OnDiskPlutusScript
      (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In
scriptFp NoScriptDatum
OptionalDatum 'CertItem
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 script <-
      forall e era.
IsEra era =>
FilePath -> CIO e (AnyPlutusScript (LedgerEra era))
readFilePlutusScript @_ @era FilePath
plutusScriptFp

    let
      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
      script' = PlutusScriptInEra lang (LedgerEra era)
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
forall (lang :: Language) era.
PlutusScriptInEra lang era -> PlutusScriptOrReferenceInput lang era
PScript PlutusScriptInEra lang (LedgerEra era)
script

    redeemer <-
      fromExceptTCli $
        readScriptDataOrFile redeemerFile

    let sw =
          SLanguage lang
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
-> PlutusScriptDatum lang 'CertifyingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
forall (lang :: Language) era (purpose :: PlutusScriptPurpose).
SLanguage lang
-> PlutusScriptOrReferenceInput lang era
-> PlutusScriptDatum lang purpose
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang purpose era
PlutusScriptWitness
            SLanguage lang
lang
            PlutusScriptOrReferenceInput lang (LedgerEra era)
script'
            PlutusScriptDatum lang 'CertifyingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
            HashableScriptData
redeemer
            ExecutionUnits
execUnits
    return $
      AnyPlutusScriptWitness $
        AnyPlutusCertifyingScriptWitness sw
readCertificateScriptWitness
  ( PlutusReferenceScript
      ( PlutusRefScriptCliArgs
          TxIn
refInput
          (AnySLanguage SLanguage lang
lang)
          NoScriptDatum
OptionalDatum 'CertItem
Exp.NoScriptDatumAllowed
          NoPolicyId
MintPolicyId 'CertItem
NoPolicyId
          ScriptDataOrFile
redeemerFile
          ExecutionUnits
execUnits
        )
    ) = 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
    return $
      AnyPlutusScriptWitness $
        AnyPlutusCertifyingScriptWitness $
          PlutusScriptWitness
            lang
            (PReferenceScript refInput)
            NoScriptDatum
            redeemer
            execUnits
readCertificateScriptWitness (SimpleReferenceScript (SimpleRefScriptArgs TxIn
refTxin NoPolicyId
MintPolicyId 'CertItem
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)))
-> (SimpleScriptOrReferenceInput (LedgerEra era)
    -> AnyWitness (LedgerEra era))
-> SimpleScriptOrReferenceInput (LedgerEra era)
-> RIO e (AnyWitness (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScriptOrReferenceInput (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
AnySimpleScriptWitness (SimpleScriptOrReferenceInput (LedgerEra era)
 -> RIO e (AnyWitness (LedgerEra era)))
-> SimpleScriptOrReferenceInput (LedgerEra era)
-> RIO e (AnyWitness (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ TxIn -> SimpleScriptOrReferenceInput (LedgerEra era)
forall era. TxIn -> SimpleScriptOrReferenceInput era
SReferenceScript TxIn
refTxin

readCertificateScriptWitnesses
  :: IsEra era
  => [(CertificateFile, Maybe (ScriptRequirements Exp.CertItem))]
  -> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
readCertificateScriptWitnesses :: forall era e.
IsEra era =>
[(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
readCertificateScriptWitnesses =
  ((CertificateFile, Maybe (ScriptRequirements 'CertItem))
 -> RIO e (CertificateFile, AnyWitness (LedgerEra era)))
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> RIO e [(CertificateFile, 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
    ( \(CertificateFile
vFile, Maybe (ScriptRequirements 'CertItem)
mCert) -> do
        case Maybe (ScriptRequirements 'CertItem)
mCert of
          Maybe (ScriptRequirements 'CertItem)
Nothing -> (CertificateFile, AnyWitness (LedgerEra era))
-> RIO e (CertificateFile, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (CertificateFile
vFile, AnyWitness (LedgerEra era)
forall era. AnyWitness era
AnyKeyWitnessPlaceholder)
          Just ScriptRequirements 'CertItem
cert -> do
            sWit <- ScriptRequirements 'CertItem -> CIO e (AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
ScriptRequirements 'CertItem -> CIO e (AnyWitness (LedgerEra era))
readCertificateScriptWitness ScriptRequirements 'CertItem
cert
            return (vFile, sWit)
    )