{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# 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

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Script.Proposal.Type
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 (ScriptRequirements Exp.ProposalItem))
  -> CIO e (Proposal era, Exp.AnyWitness (Exp.LedgerEra era))
readProposalScriptWitness :: forall e era.
IsEra era =>
(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
readProposalScriptWitness (ProposalFile 'In
propFp, Maybe (ScriptRequirements 'ProposalItem)
Nothing) = do
  Proposal era
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
  (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, AnyWitness (LedgerEra era)
forall era. AnyWitness era
Exp.AnyKeyWitnessPlaceholder)
readProposalScriptWitness (ProposalFile 'In
propFp, Just ScriptRequirements 'ProposalItem
certScriptReq) =
  do
    Proposal era
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 ScriptRequirements 'ProposalItem
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)
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)

        (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
          , AnyWitness (LedgerEra era)
s
          )
      OnDiskPlutusScript
        (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In
scriptFp NoScriptDatum
OptionalDatum 'ProposalItem
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 PlutusScriptInEra lang (LedgerEra era)
plutusScript <-
            forall e era.
IsEra era =>
FilePath -> CIO e (AnyPlutusScript (LedgerEra era))
readFilePlutusScript @_ @era FilePath
plutusScriptFp
          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)
plutusScript
          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 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)
plutusScript
              sw :: PlutusScriptWitness lang 'ProposingScript (LedgerEra era)
sw =
                SLanguage lang
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
-> PlutusScriptDatum lang 'ProposingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang 'ProposingScript (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 'ProposingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
                  HashableScriptData
redeemer
                  ExecutionUnits
execUnits
          (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
            , AnyPlutusScriptWitness lang 'ProposingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness lang 'ProposingScript (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness lang 'ProposingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
                PlutusScriptWitness lang 'ProposingScript (LedgerEra era)
-> AnyPlutusScriptWitness lang 'ProposingScript (LedgerEra era)
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'ProposingScript era
-> AnyPlutusScriptWitness lang 'ProposingScript era
AnyPlutusProposingScriptWitness PlutusScriptWitness lang 'ProposingScript (LedgerEra era)
sw
            )
      SimpleReferenceScript (SimpleRefScriptArgs TxIn
refTxIn NoPolicyId
MintPolicyId 'ProposalItem
NoPolicyId) ->
        (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
          )
      PlutusReferenceScript
        ( PlutusRefScriptCliArgs
            TxIn
refTxIn
            (AnySLanguage SLanguage lang
lang)
            NoScriptDatum
OptionalDatum 'ProposalItem
Exp.NoScriptDatumAllowed
            NoPolicyId
MintPolicyId 'ProposalItem
NoPolicyId
            ScriptDataOrFile
redeemerFile
            ExecutionUnits
execUnits
          ) -> do
          let pScript :: PlutusScriptOrReferenceInput lang (LedgerEra era)
pScript = TxIn -> PlutusScriptOrReferenceInput lang (LedgerEra era)
forall (lang :: Language) era.
TxIn -> PlutusScriptOrReferenceInput lang era
Exp.PReferenceScript TxIn
refTxIn
          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

          (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
            , AnyPlutusScriptWitness lang 'ProposingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness lang 'ProposingScript (LedgerEra era)
 -> AnyWitness (LedgerEra era))
-> AnyPlutusScriptWitness lang 'ProposingScript (LedgerEra era)
-> AnyWitness (LedgerEra era)
forall a b. (a -> b) -> a -> b
$
                PlutusScriptWitness lang 'ProposingScript (LedgerEra era)
-> AnyPlutusScriptWitness lang 'ProposingScript (LedgerEra era)
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'ProposingScript era
-> AnyPlutusScriptWitness lang 'ProposingScript era
AnyPlutusProposingScriptWitness
                  ( SLanguage lang
-> PlutusScriptOrReferenceInput lang (LedgerEra era)
-> PlutusScriptDatum lang 'ProposingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness lang 'ProposingScript (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 'ProposingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
                      HashableScriptData
redeemer
                      ExecutionUnits
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 (ScriptRequirements Exp.ProposalItem))
  -> CIO e (Proposal era, Exp.AnyWitness (Exp.LedgerEra era))
readProposal :: forall era e.
IsEra era =>
(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
readProposal (ProposalFile 'In
fp, Maybe (ScriptRequirements 'ProposalItem)
mScriptWit) = do
  (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
forall e era.
IsEra era =>
(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))
-> CIO e (Proposal era, AnyWitness (LedgerEra era))
readProposalScriptWitness (ProposalFile 'In
fp, Maybe (ScriptRequirements 'ProposalItem)
mScriptWit)

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