{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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.AnyScriptWitness
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.Orphan ()
import Cardano.CLI.Read
import Cardano.CLI.Type.Common (AnySLanguage (..), CertificateFile)

readCertificateScriptWitness
  :: forall era e
   . IsEra era
  => AnyNonAssetScript
  -> CIO e (AnyWitness (LedgerEra era))
readCertificateScriptWitness :: forall era e.
IsEra era =>
AnyNonAssetScript -> CIO e (AnyWitness (LedgerEra era))
readCertificateScriptWitness (AnyNonAssetScriptSimple SimpleScriptRequirements
simpleReq) =
  case SimpleScriptRequirements
simpleReq of
    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
    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)))
-> (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
readCertificateScriptWitness (AnyNonAssetScriptPlutus PlutusNonAssetScriptRequirements
plutusReq) =
  case PlutusNonAssetScriptRequirements
plutusReq of
    OnDiskPlutusNonAssetScript File ScriptInAnyLang 'In
scriptFp 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.Plutus.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.Plutus.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 purpose
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang purpose (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 purpose
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
NoScriptDatum
              HashableScriptData
redeemer
              ExecutionUnits
execUnits
      return $
        AnyPlutusScriptWitness $
          AnyPlutusCertifyingScriptWitness sw
    ReferencePlutusNonAssetScript TxIn
refInput (AnySLanguage SLanguage lang
lang) 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

readCertificateScriptWitnesses
  :: IsEra era
  => [(CertificateFile, Maybe AnyNonAssetScript)]
  -> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
readCertificateScriptWitnesses :: forall era e.
IsEra era =>
[(CertificateFile, Maybe AnyNonAssetScript)]
-> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
readCertificateScriptWitnesses =
  ((CertificateFile, Maybe AnyNonAssetScript)
 -> RIO e (CertificateFile, AnyWitness (LedgerEra era)))
-> [(CertificateFile, Maybe AnyNonAssetScript)]
-> 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 AnyNonAssetScript
mCert) -> do
        case Maybe AnyNonAssetScript
mCert of
          Maybe AnyNonAssetScript
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 AnyNonAssetScript
cert -> do
            sWit <- AnyNonAssetScript -> CIO e (AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
AnyNonAssetScript -> CIO e (AnyWitness (LedgerEra era))
readCertificateScriptWitness AnyNonAssetScript
cert
            return (vFile, sWit)
    )