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

module Cardano.CLI.EraBased.Script.Vote.Read
  ( readVotingProceduresFiles
  , readVoteScriptWitness
  )
where

import Cardano.Api
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.EraBased.Script.Type qualified as Exp
import Cardano.CLI.Read
import Cardano.CLI.Type.Common (AnySLanguage (..))
import Cardano.CLI.Type.Governance

import Control.Monad

readVoteScriptWitness
  :: forall era e
   . Exp.IsEra era
  => (VoteFile In, Maybe (ScriptRequirements Exp.VoterItem))
  -> CIO e (VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))
readVoteScriptWitness :: forall era e.
IsEra era =>
(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))
-> CIO e (VotingProcedures era, AnyWitness (LedgerEra era))
readVoteScriptWitness (VoteFile 'In
voteFp, Maybe (ScriptRequirements 'VoterItem)
Nothing) = do
  VotingProcedures era
votProceds <-
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    RIO e (VotingProcedures era))
-> RIO e (VotingProcedures era)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> ConwayEraOnwards era)
-> Era era -> ConwayEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
Exp.useEra @era) ((ConwayEraOnwardsConstraints era => RIO e (VotingProcedures era))
 -> RIO e (VotingProcedures era))
-> (ConwayEraOnwardsConstraints era =>
    RIO e (VotingProcedures era))
-> RIO e (VotingProcedures era)
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
-> RIO e (VotingProcedures era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
 -> RIO e (VotingProcedures era))
-> IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
-> RIO e (VotingProcedures era)
forall a b. (a -> b) -> a -> b
$
        VoteFile 'In
-> IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope VoteFile 'In
voteFp
  (VotingProcedures era, AnyWitness (LedgerEra era))
-> RIO e (VotingProcedures era, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (VotingProcedures era
votProceds, AnyWitness (LedgerEra era)
forall era. AnyWitness era
Exp.AnyKeyWitnessPlaceholder)
readVoteScriptWitness (VoteFile 'In
voteFp, Just ScriptRequirements 'VoterItem
certScriptReq) = do
  VotingProcedures era
votProceds <-
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    RIO e (VotingProcedures era))
-> RIO e (VotingProcedures era)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert (Era era -> ConwayEraOnwards era)
-> Era era -> ConwayEraOnwards era
forall a b. (a -> b) -> a -> b
$ forall era. IsEra era => Era era
Exp.useEra @era) ((ConwayEraOnwardsConstraints era => RIO e (VotingProcedures era))
 -> RIO e (VotingProcedures era))
-> (ConwayEraOnwardsConstraints era =>
    RIO e (VotingProcedures era))
-> RIO e (VotingProcedures era)
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
-> RIO e (VotingProcedures era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
 -> RIO e (VotingProcedures era))
-> IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
-> RIO e (VotingProcedures era)
forall a b. (a -> b) -> a -> b
$
        VoteFile 'In
-> IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope VoteFile 'In
voteFp
  case ScriptRequirements 'VoterItem
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)

      (VotingProcedures era, AnyWitness (LedgerEra era))
-> RIO e (VotingProcedures era, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( VotingProcedures era
votProceds
        , AnyWitness (LedgerEra era)
s
        )
    OnDiskPlutusScript
      (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In
scriptFp NoScriptDatum
OptionalDatum 'VoterItem
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)
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 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
            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
        let 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
        (VotingProcedures era, AnyWitness (LedgerEra era))
-> RIO e (VotingProcedures era, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( VotingProcedures era
votProceds
          , 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)
sw
          )
    PlutusReferenceScript
      ( PlutusRefScriptCliArgs
          TxIn
refTxIn
          (AnySLanguage SLanguage lang
lang)
          NoScriptDatum
OptionalDatum 'VoterItem
Exp.NoScriptDatumAllowed
          NoPolicyId
MintPolicyId 'VoterItem
Exp.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

        (VotingProcedures era, AnyWitness (LedgerEra era))
-> RIO e (VotingProcedures era, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( VotingProcedures era
votProceds
          , 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
          )
    SimpleReferenceScript (SimpleRefScriptArgs TxIn
refTxIn MintPolicyId 'VoterItem
_) ->
      (VotingProcedures era, AnyWitness (LedgerEra era))
-> RIO e (VotingProcedures era, AnyWitness (LedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( VotingProcedures era
votProceds
        , 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
        )

-- Because the 'Voter' type is contained only in the 'VotingProcedures'
-- type, we must read a single vote as 'VotingProcedures'. The cli will
-- not read vote files with multiple votes in them because this will
-- complicate the code further in terms of contructing the redeemer map
-- when it comes to script witnessed votes.
readVotingProceduresFiles
  :: Exp.IsEra era
  => [(VoteFile In, Maybe (ScriptRequirements Exp.VoterItem))]
  -> CIO e [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))]
readVotingProceduresFiles :: forall era e.
IsEra era =>
[(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> CIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
readVotingProceduresFiles [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
files =
  [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
-> ((VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))
    -> RIO e (VotingProcedures era, AnyWitness (LedgerEra era)))
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
files (VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))
-> RIO e (VotingProcedures era, AnyWitness (LedgerEra era))
(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))
-> CIO e (VotingProcedures era, AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))
-> CIO e (VotingProcedures era, AnyWitness (LedgerEra era))
readVoteScriptWitness