{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# 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.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 (AnySLanguage (..))
import Cardano.CLI.Type.Governance

import Control.Monad

readVoteScriptWitness
  :: forall era e
   . Exp.IsEra era
  => (VoteFile In, Maybe AnyNonAssetScript)
  -> CIO e (VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))
readVoteScriptWitness :: forall era e.
IsEra era =>
(VoteFile 'In, Maybe AnyNonAssetScript)
-> CIO e (VotingProcedures era, AnyWitness (LedgerEra era))
readVoteScriptWitness (VoteFile 'In
voteFp, Maybe AnyNonAssetScript
Nothing) = do
  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
  return (votProceds, Exp.AnyKeyWitnessPlaceholder)
readVoteScriptWitness (VoteFile 'In
voteFp, Just AnyNonAssetScript
certScriptReq) = do
  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 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 (votProceds, s)
        ReferenceSimpleScript TxIn
refTxIn ->
          (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
            )
    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 script <-
            forall e era.
IsEra era =>
FilePath -> CIO e (AnyPlutusScript (LedgerEra era))
readFilePlutusScript @_ @era FilePath
plutusScriptFp
          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)
script
              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)
script
          let 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
            ( votProceds
            , Exp.AnyPlutusScriptWitness $ AnyPlutusCertifyingScriptWitness sw
            )
        ReferencePlutusNonAssetScript TxIn
refTxIn (AnySLanguage SLanguage lang
lang) ScriptDataOrFile
redeemerFile ExecutionUnits
execUnits -> do
          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
            ( votProceds
            , Exp.AnyPlutusScriptWitness $
                AnyPlutusCertifyingScriptWitness $
                  Exp.Plutus.PlutusScriptWitness
                    lang
                    (Exp.Plutus.PReferenceScript refTxIn)
                    Exp.Plutus.NoScriptDatum
                    redeemer
                    execUnits
            )

-- 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 AnyNonAssetScript)]
  -> CIO e [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))]
readVotingProceduresFiles :: forall era e.
IsEra era =>
[(VoteFile 'In, Maybe AnyNonAssetScript)]
-> CIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
readVotingProceduresFiles [(VoteFile 'In, Maybe AnyNonAssetScript)]
files =
  [(VoteFile 'In, Maybe AnyNonAssetScript)]
-> ((VoteFile 'In, Maybe AnyNonAssetScript)
    -> 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 AnyNonAssetScript)]
files (VoteFile 'In, Maybe AnyNonAssetScript)
-> RIO e (VotingProcedures era, AnyWitness (LedgerEra era))
(VoteFile 'In, Maybe AnyNonAssetScript)
-> CIO e (VotingProcedures era, AnyWitness (LedgerEra era))
forall era e.
IsEra era =>
(VoteFile 'In, Maybe AnyNonAssetScript)
-> CIO e (VotingProcedures era, AnyWitness (LedgerEra era))
readVoteScriptWitness