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

module Cardano.CLI.Compatible.Transaction.ScriptWitness
  ( readCertificateScriptWitness
  , readCertificateScriptWitnesses
  )
where

import Cardano.Api
  ( DecoderError
  , SerialiseAsCBOR (serialiseToCBOR)
  , ShelleyBasedEra
  , ShelleyLedgerEra
  , shelleyBasedEraConstraints
  , unFile
  )
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.Compatible.Read (readFilePlutusScript, readFileSimpleScript)
import Cardano.CLI.EraBased.Script.Read.Common (readScriptDataOrFile)
import Cardano.CLI.EraBased.Script.Type
  ( NoPolicyId (..)
  , OnDiskPlutusScriptCliArgs (..)
  , PlutusRefScriptCliArgs (..)
  , ScriptRequirements (..)
  , SimpleRefScriptCliArgs (..)
  )
import Cardano.CLI.Type.Common (AnySLanguage (..), CertificateFile)

import Control.Monad

readCertificateScriptWitnesses
  :: forall era e
   . ShelleyBasedEra era
  -> [(CertificateFile, Maybe (ScriptRequirements Exp.CertItem))]
  -> CIO e [(CertificateFile, Maybe (Exp.AnyWitness (ShelleyLedgerEra era)))]
readCertificateScriptWitnesses :: forall era e.
ShelleyBasedEra era
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO
     e [(CertificateFile, Maybe (AnyWitness (ShelleyLedgerEra era)))]
readCertificateScriptWitnesses ShelleyBasedEra era
sbe =
  ((CertificateFile, Maybe (ScriptRequirements 'CertItem))
 -> RIO
      e (CertificateFile, Maybe (AnyWitness (ShelleyLedgerEra era))))
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> RIO
     e [(CertificateFile, Maybe (AnyWitness (ShelleyLedgerEra 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
certFile, Maybe (ScriptRequirements 'CertItem)
mSWit) -> do
        (CertificateFile
certFile,) (Maybe (AnyWitness (ShelleyLedgerEra era))
 -> (CertificateFile, Maybe (AnyWitness (ShelleyLedgerEra era))))
-> RIO e (Maybe (AnyWitness (ShelleyLedgerEra era)))
-> RIO
     e (CertificateFile, Maybe (AnyWitness (ShelleyLedgerEra era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ScriptRequirements 'CertItem)
-> (ScriptRequirements 'CertItem
    -> RIO e (AnyWitness (ShelleyLedgerEra era)))
-> RIO e (Maybe (AnyWitness (ShelleyLedgerEra era)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (ScriptRequirements 'CertItem)
mSWit (ShelleyBasedEra era
-> ScriptRequirements 'CertItem
-> CIO e (AnyWitness (ShelleyLedgerEra era))
forall era e.
ShelleyBasedEra era
-> ScriptRequirements 'CertItem
-> CIO e (AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitness ShelleyBasedEra era
sbe)
    )

readCertificateScriptWitness
  :: forall era e
   . ShelleyBasedEra era
  -> ScriptRequirements Exp.CertItem
  -> CIO e (Exp.AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitness :: forall era e.
ShelleyBasedEra era
-> ScriptRequirements 'CertItem
-> CIO e (AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitness ShelleyBasedEra era
sbe ScriptRequirements 'CertItem
certScriptReq =
  case ScriptRequirements 'CertItem
certScriptReq 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
      ss <- FilePath -> CIO e (Script SimpleScript')
forall e. FilePath -> CIO e (Script SimpleScript')
readFileSimpleScript FilePath
sFp
      let serialisedSS = Script SimpleScript' -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Script SimpleScript'
ss
      simpleScript <-
        fromEitherCli
          ( shelleyBasedEraConstraints sbe (Exp.deserialiseSimpleScript serialisedSS)
              :: Either DecoderError (Exp.SimpleScript (ShelleyLedgerEra era))
          )
      return $ Exp.AnySimpleScriptWitness $ Exp.SScript simpleScript
    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 anyPlutusScript <- ShelleyBasedEra era
-> FilePath -> CIO e (AnyPlutusScript (ShelleyLedgerEra era))
forall era e.
ShelleyBasedEra era
-> FilePath -> CIO e (AnyPlutusScript (ShelleyLedgerEra era))
readFilePlutusScript ShelleyBasedEra era
sbe FilePath
plutusScriptFp
        let lang = PlutusScriptInEra lang (ShelleyLedgerEra era) -> SLanguage lang
forall (lang :: Language) era.
PlutusLanguage lang =>
PlutusScriptInEra lang era -> SLanguage lang
Exp.plutusScriptInEraSLanguage PlutusScriptInEra lang (ShelleyLedgerEra era)
anyPlutusScript
            script' = PlutusScriptInEra lang (ShelleyLedgerEra era)
-> PlutusScriptOrReferenceInput lang (ShelleyLedgerEra era)
forall (lang :: Language) era.
PlutusScriptInEra lang era -> PlutusScriptOrReferenceInput lang era
Exp.PScript PlutusScriptInEra lang (ShelleyLedgerEra era)
anyPlutusScript
        redeemer <-
          fromExceptTCli $
            readScriptDataOrFile redeemerFile
        let sw =
              SLanguage lang
-> PlutusScriptOrReferenceInput lang (ShelleyLedgerEra era)
-> PlutusScriptDatum lang 'CertifyingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness
     lang 'CertifyingScript (ShelleyLedgerEra 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 (ShelleyLedgerEra era)
script'
                PlutusScriptDatum lang 'CertifyingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
                HashableScriptData
redeemer
                ExecutionUnits
execUnits
        return $ Exp.AnyPlutusScriptWitness $ Exp.AnyPlutusCertifyingScriptWitness sw
    SimpleReferenceScript (SimpleRefScriptArgs TxIn
refTxIn NoPolicyId
MintPolicyId 'CertItem
NoPolicyId) ->
      AnyWitness (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyWitness (ShelleyLedgerEra era)
 -> RIO e (AnyWitness (ShelleyLedgerEra era)))
-> (SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
    -> AnyWitness (ShelleyLedgerEra era))
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
Exp.AnySimpleScriptWitness (SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
 -> RIO e (AnyWitness (ShelleyLedgerEra era)))
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ TxIn -> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
forall era. TxIn -> SimpleScriptOrReferenceInput era
Exp.SReferenceScript TxIn
refTxIn
    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 $
          Exp.AnyPlutusScriptWitness $
            Exp.AnyPlutusCertifyingScriptWitness $
              Exp.PlutusScriptWitness
                lang
                (Exp.PReferenceScript refInput)
                Exp.NoScriptDatum
                redeemer
                execUnits