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

module Cardano.CLI.EraBased.Script.Withdrawal.Read
  ( readWithdrawalScriptWitness
  )
where

import Cardano.Api
import Cardano.Api.Experimental
  ( AnyWitness (..)
  , IsEra (..)
  , LedgerEra
  , NoScriptDatum (..)
  , WitnessableItem (..)
  )
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.Read
import Cardano.CLI.Type.Common (AnySLanguage (..))

readWithdrawalScriptWitness
  :: forall e era
   . IsEra era
  => (StakeAddress, Coin, Maybe (ScriptRequirements WithdrawalItem))
  -> CIO e (StakeAddress, Coin, AnyWitness (LedgerEra era))
readWithdrawalScriptWitness :: forall e era.
IsEra era =>
(StakeAddress, Coin, Maybe (ScriptRequirements 'WithdrawalItem))
-> CIO e (StakeAddress, Coin, AnyWitness (LedgerEra era))
readWithdrawalScriptWitness (StakeAddress
stakeAddr, Coin
withdrawalAmt, Maybe (ScriptRequirements 'WithdrawalItem)
Nothing) =
  (StakeAddress, Coin, AnyWitness (LedgerEra era))
-> RIO e (StakeAddress, Coin, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeAddress
stakeAddr, Coin
withdrawalAmt, AnyWitness (LedgerEra era)
forall era. AnyWitness era
Exp.AnyKeyWitnessPlaceholder)
readWithdrawalScriptWitness (StakeAddress
stakeAddr, Coin
withdrawalAmt, Just ScriptRequirements 'WithdrawalItem
certScriptReq) =
  case ScriptRequirements 'WithdrawalItem
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
      AnyWitness (LedgerEra era)
sWit <- 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
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
<$> 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)

      (StakeAddress, Coin, AnyWitness (LedgerEra era))
-> RIO e (StakeAddress, Coin, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( StakeAddress
stakeAddr
        , Coin
withdrawalAmt
        , AnyWitness (LedgerEra era)
sWit
        )
    OnDiskPlutusScript (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In
scriptFp NoScriptDatum
OptionalDatum 'WithdrawalItem
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
      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 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
          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
          sw :: PlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
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
Exp.PlutusScriptWitness
              SLanguage lang
lang
              PlutusScriptOrReferenceInput lang (LedgerEra era)
pScript
              PlutusScriptDatum lang 'CertifyingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
              HashableScriptData
redeemer
              ExecutionUnits
execUnits
      (StakeAddress, Coin, AnyWitness (LedgerEra era))
-> RIO e (StakeAddress, Coin, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( StakeAddress
stakeAddr
        , Coin
withdrawalAmt
        , AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
AnyPlutusScriptWitness (AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
            PlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
-> AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'CertifyingScript era
-> AnyPlutusScriptWitness lang 'CertifyingScript era
AnyPlutusCertifyingScriptWitness PlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
sw
        )
    SimpleReferenceScript (SimpleRefScriptArgs TxIn
refTxIn NoPolicyId
MintPolicyId 'WithdrawalItem
NoPolicyId) ->
      (StakeAddress, Coin, AnyWitness (LedgerEra era))
-> RIO e (StakeAddress, Coin, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( StakeAddress
stakeAddr
        , Coin
withdrawalAmt
        , SimpleScriptOrReferenceInput (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
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
        )
    PlutusReferenceScript
      ( PlutusRefScriptCliArgs
          TxIn
refTxIn
          (AnySLanguage SLanguage lang
lang)
          NoScriptDatum
OptionalDatum 'WithdrawalItem
NoScriptDatumAllowed
          NoPolicyId
MintPolicyId 'WithdrawalItem
NoPolicyId
          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 sWit :: AnyWitness (LedgerEra era)
sWit =
              AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
                PlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
-> AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'CertifyingScript era
-> AnyPlutusScriptWitness lang 'CertifyingScript era
AnyPlutusCertifyingScriptWitness (PlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
 -> AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era))
-> PlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
-> AnyPlutusScriptWitness lang 'CertifyingScript (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
                  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
Exp.PlutusScriptWitness
                    SLanguage lang
lang
                    (TxIn -> PlutusScriptOrReferenceInput lang (LedgerEra era)
forall (lang :: Language) era.
TxIn -> PlutusScriptOrReferenceInput lang era
Exp.PReferenceScript TxIn
refTxIn)
                    PlutusScriptDatum lang 'CertifyingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
                    HashableScriptData
redeemer
                    ExecutionUnits
execUnits
        (StakeAddress, Coin, AnyWitness (LedgerEra era))
-> RIO e (StakeAddress, Coin, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( StakeAddress
stakeAddr
          , Coin
withdrawalAmt
          , AnyWitness (LedgerEra era)
sWit
          )