{-# 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 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 ScriptRequirements 'ProposalItem
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
      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
          )
      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 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.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.PScript PlutusScriptInEra lang (LedgerEra era)
plutusScript
              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
          return
            ( proposal
            , Exp.AnyPlutusScriptWitness $
                AnyPlutusProposingScriptWitness 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
          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.PlutusScriptWitness
                      lang
                      pScript
                      Exp.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 (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