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

module Cardano.CLI.EraBased.Script.Proposal.Read
  ( readProposal
  , readProposalScriptWitness
  , readTxGovernanceActions
  , ProposalError (..)
  )
where

import Cardano.Api
import Cardano.Api.Experimental (obtainCommonConstraints)
import Cardano.Api.Experimental qualified as Exp
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.Read
import Cardano.CLI.Type.Common

readProposalScriptWitness
  :: forall e era
   . Exp.IsEra era
  => (ProposalFile In, Maybe AnyNonAssetScript)
  -> CIO e (Proposal era, Exp.AnyWitness (Exp.LedgerEra era))
readProposalScriptWitness :: forall e era.
IsEra era =>
(ProposalFile 'In, Maybe AnyNonAssetScript)
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
readProposalScriptWitness (ProposalFile 'In
propFp, Maybe AnyNonAssetScript
Nothing) = do
  proposal <-
    Era era
-> (EraCommonConstraints era => RIO e (Proposal era))
-> RIO e (Proposal era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((EraCommonConstraints era => RIO e (Proposal era))
 -> RIO e (Proposal era))
-> (EraCommonConstraints era => RIO e (Proposal era))
-> RIO e (Proposal era)
forall a b. (a -> b) -> a -> b
$
      forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError TextEnvelopeError) (IO (Either (FileError TextEnvelopeError) (Proposal era))
 -> RIO e (Proposal era))
-> IO (Either (FileError TextEnvelopeError) (Proposal era))
-> RIO e (Proposal era)
forall a b. (a -> b) -> a -> b
$
        ProposalFile 'In
-> IO (Either (FileError TextEnvelopeError) (Proposal era))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope ProposalFile 'In
propFp
  return (proposal, Exp.AnyKeyWitnessPlaceholder)
readProposalScriptWitness (ProposalFile 'In
propFp, Just AnyNonAssetScript
certScriptReq) =
  do
    proposal <-
      Era era
-> (EraCommonConstraints era => RIO e (Proposal era))
-> RIO e (Proposal era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((EraCommonConstraints era => RIO e (Proposal era))
 -> RIO e (Proposal era))
-> (EraCommonConstraints era => RIO e (Proposal era))
-> RIO e (Proposal era)
forall a b. (a -> b) -> a -> b
$
        forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError TextEnvelopeError) (IO (Either (FileError TextEnvelopeError) (Proposal era))
 -> RIO e (Proposal era))
-> IO (Either (FileError TextEnvelopeError) (Proposal era))
-> RIO e (Proposal era)
forall a b. (a -> b) -> a -> b
$
          ProposalFile 'In
-> IO (Either (FileError TextEnvelopeError) (Proposal era))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope ProposalFile 'In
propFp
    case certScriptReq of
      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
            s <-
              SimpleScriptOrReferenceInput (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
Exp.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)
            return (proposal, s)
          ReferenceSimpleScript TxIn
refTxIn ->
            (Proposal era, AnyWitness (LedgerEra era))
-> RIO e (Proposal era, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
              ( Proposal era
proposal
              , 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
              )
      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 plutusScript <-
              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)
plutusScript
            redeemer <-
              fromExceptTCli $
                readScriptDataOrFile redeemerFile

            let pScript = PlutusScriptInEra lang (LedgerEra era)
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
forall (lang :: Language) era.
PlutusScriptInEra lang era -> PlutusScriptOrReferenceInput lang era
Exp.Plutus.PScript PlutusScriptInEra lang (LedgerEra era)
plutusScript
                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
Exp.Plutus.PlutusScriptWitness
                    SLanguage lang
lang
                    PlutusScriptOrReferenceInput lang (LedgerEra era)
pScript
                    PlutusScriptDatum lang purpose
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.Plutus.NoScriptDatum
                    HashableScriptData
redeemer
                    ExecutionUnits
execUnits
            return
              ( proposal
              , Exp.AnyPlutusScriptWitness $
                  AnyPlutusProposingScriptWitness sw
              )
          ReferencePlutusNonAssetScript TxIn
refTxIn (AnySLanguage SLanguage lang
lang) ScriptDataOrFile
redeemerFile ExecutionUnits
execUnits -> do
            let pScript :: PlutusScriptOrReferenceInput lang era
pScript = TxIn -> PlutusScriptOrReferenceInput lang era
forall (lang :: Language) era.
TxIn -> PlutusScriptOrReferenceInput lang era
Exp.Plutus.PReferenceScript TxIn
refTxIn
            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
              ( proposal
              , Exp.AnyPlutusScriptWitness $
                  AnyPlutusProposingScriptWitness
                    ( Exp.Plutus.PlutusScriptWitness
                        lang
                        pScript
                        Exp.Plutus.NoScriptDatum
                        redeemer
                        execUnits
                    )
              )

newtype ProposalError
  = ProposalErrorFile (FileError CliScriptWitnessError)
  deriving Int -> ProposalError -> ShowS
[ProposalError] -> ShowS
ProposalError -> FilePath
(Int -> ProposalError -> ShowS)
-> (ProposalError -> FilePath)
-> ([ProposalError] -> ShowS)
-> Show ProposalError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProposalError -> ShowS
showsPrec :: Int -> ProposalError -> ShowS
$cshow :: ProposalError -> FilePath
show :: ProposalError -> FilePath
$cshowList :: [ProposalError] -> ShowS
showList :: [ProposalError] -> ShowS
Show

instance Error ProposalError where
  prettyError :: forall ann. ProposalError -> Doc ann
prettyError = ProposalError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow

readProposal
  :: Exp.IsEra era
  => (ProposalFile In, Maybe AnyNonAssetScript)
  -> CIO e (Proposal era, Exp.AnyWitness (Exp.LedgerEra era))
readProposal :: forall era e.
IsEra era =>
(ProposalFile 'In, Maybe AnyNonAssetScript)
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
readProposal (ProposalFile 'In
fp, Maybe AnyNonAssetScript
mScriptWit) = do
  (ProposalFile 'In, Maybe AnyNonAssetScript)
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
forall e era.
IsEra era =>
(ProposalFile 'In, Maybe AnyNonAssetScript)
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
readProposalScriptWitness (ProposalFile 'In
fp, Maybe AnyNonAssetScript
mScriptWit)

readTxGovernanceActions
  :: Exp.IsEra era
  => [(ProposalFile In, Maybe AnyNonAssetScript)]
  -> CIO e [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))]
readTxGovernanceActions :: forall era e.
IsEra era =>
[(ProposalFile 'In, Maybe AnyNonAssetScript)]
-> CIO e [(Proposal era, AnyWitness (LedgerEra era))]
readTxGovernanceActions = ((ProposalFile 'In, Maybe AnyNonAssetScript)
 -> RIO e (Proposal era, AnyWitness (LedgerEra era)))
-> [(ProposalFile 'In, Maybe AnyNonAssetScript)]
-> RIO e [(Proposal era, 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 (ProposalFile 'In, Maybe AnyNonAssetScript)
-> RIO e (Proposal era, AnyWitness (LedgerEra era))
(ProposalFile 'In, Maybe AnyNonAssetScript)
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
(ProposalFile 'In, Maybe AnyNonAssetScript)
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
readProposal