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

module Cardano.CLI.Compatible.Transaction.Run
  ( runCompatibleTransactionCmd
  )
where

import Cardano.Api hiding (VotingProcedures)
import Cardano.Api qualified as OldApi
import Cardano.Api.Compatible
import Cardano.Api.Compatible.Certificate qualified as Compatible
import Cardano.Api.Experimental (obtainCommonConstraints)
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp
import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus
import Cardano.Api.Experimental.Tx qualified as Exp
import Cardano.Api.Ledger qualified as L hiding
  ( VotingProcedures
  )

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Compatible.Read qualified as Compatible
import Cardano.CLI.Compatible.Transaction.Command
import Cardano.CLI.Compatible.Transaction.TxOut
import Cardano.CLI.EraBased.Script.Proposal.Read
import Cardano.CLI.EraBased.Script.Read.Common
import Cardano.CLI.EraBased.Script.Type
import Cardano.CLI.EraBased.Script.Vote.Read
import Cardano.CLI.EraBased.Transaction.Internal.Common (partitionSomeWitnesses)
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.ProtocolParamsError

import Control.Monad
import Data.Aeson qualified as Aeson
import Data.Bifunctor (first)
import Data.Map.Ordered.Strict qualified as OMap
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text qualified as Text
import Lens.Micro

runCompatibleTransactionCmd
  :: forall era e
   . CompatibleTransactionCmds era
  -> CIO e ()
runCompatibleTransactionCmd :: forall era e. CompatibleTransactionCmds era -> CIO e ()
runCompatibleTransactionCmd
  ( CreateCompatibleSignedTransaction
      ShelleyBasedEra era
sbe
      [TxIn]
ins
      [TxIn]
insCollateral
      [TxOutAnyEra]
outs
      Maybe UpdateProposalFile
mUpdateProposal
      [(ProposalFile 'In, Maybe AnyNonAssetScript)]
proposals
      [(VoteFile 'In, Maybe AnyNonAssetScript)]
mVotes
      [WitnessSigningData]
witnesses
      Maybe NetworkId
mNetworkId
      Coin
fee
      [(CertificateFile, Maybe AnyNonAssetScript)]
certificates
      Maybe ProtocolParamsFile
mProtocolParamsFile
      File () 'Out
outputFp
    ) = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => RIO e ()) -> RIO e ()
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => RIO e ()) -> RIO e ())
-> (ShelleyBasedEraConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    sks <- (WitnessSigningData -> RIO e SomeSigningWitness)
-> [WitnessSigningData] -> RIO e [SomeSigningWitness]
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 (IO (Either ReadWitnessSigningDataError SomeSigningWitness)
-> RIO e SomeSigningWitness
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either ReadWitnessSigningDataError SomeSigningWitness)
 -> RIO e SomeSigningWitness)
-> (WitnessSigningData
    -> IO (Either ReadWitnessSigningDataError SomeSigningWitness))
-> WitnessSigningData
-> RIO e SomeSigningWitness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
readWitnessSigningData) [WitnessSigningData]
witnesses

    (allOuts, extraDatumsMapList) <- mapAndUnzipM (toTxOutInAnyEra sbe) outs
    let extraDatums = [Map DataHash (Data (ShelleyLedgerEra era))]
-> Map DataHash (Data (ShelleyLedgerEra era))
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map DataHash (Data (ShelleyLedgerEra era))]
extraDatumsMapList

    certFilesAndMaybeScriptWits <-
      readCertificateScriptWitnesses' sbe certificates

    certsAndMaybeScriptWits <-
      liftIO $
        sequenceA
          [ fmap (,mSwit) $
              fromEitherIOCli $
                readFileTextEnvelope $
                  File certFile
          | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits
          ]

    (protocolUpdates, votes) :: (AnyProtocolUpdate era, AnyVote era) <-
      inEonForShelleyBasedEra
        ( do
            pparamUpdate <-
              fromMaybe (NoPParamsUpdate sbe) <$> forM mUpdateProposal (readUpdateProposalFile sbe)
            return (pparamUpdate, NoVotes)
        )
        ( \ConwayEraOnwards era
w -> do
            pparamUpdate <- ShelleyBasedEra era
-> [(ProposalFile 'In, Maybe AnyNonAssetScript)]
-> CIO e (AnyProtocolUpdate era)
forall e era.
ShelleyBasedEra era
-> [(ProposalFile 'In, Maybe AnyNonAssetScript)]
-> CIO e (AnyProtocolUpdate era)
readProposalProcedureFile ShelleyBasedEra era
sbe [(ProposalFile 'In, Maybe AnyNonAssetScript)]
proposals
            votesAndWits :: [(OldApi.VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] <-
              obtainCommonConstraints (convert w) $ readVotingProceduresFiles mVotes
            votingProcedures :: (Exp.TxVotingProcedures (Exp.LedgerEra era)) <-
              obtainCommonConstraints (convert w) $
                fromEitherCli
                  ( Exp.mkTxVotingProcedures
                      [ (obtainCommonConstraints (convert w) $ OldApi.unVotingProcedures vp, anyW)
                      | (vp, anyW) <- votesAndWits
                      ]
                  )
            return (pparamUpdate, VotingProcedures w $ obtainCommonConstraints (convert w) votingProcedures)
        )
        sbe

    let txCerts = ShelleyBasedEra era
-> [(Certificate (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> TxCertificates (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> [(Certificate (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> TxCertificates (ShelleyLedgerEra era)
mkTxCertificatesSbe ShelleyBasedEra era
sbe [(Certificate (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
certsAndMaybeScriptWits

    pparams <- forM mProtocolParamsFile $ \(ProtocolParamsFile FilePath
path) -> do
      bytes <- FilePath -> RIO e ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FilePath -> m ByteString
readFileCli FilePath
path
      fromEitherCli $ first (ProtocolParamsErrorJSON path . Text.pack) $ Aeson.eitherDecodeStrict' bytes

    transaction@(ShelleyTx _ ledgerTx) <-
      fromEitherCli $
        createCompatibleTx sbe $
          (defaultCompatibleTxBodyContent sbe)
            { compatibleTxIns = [(txIn, Exp.AnyKeyWitnessPlaceholder) | txIn <- ins]
            , compatibleTxOuts = allOuts
            , compatibleTxSupplementalDatums = extraDatums
            , compatibleTxFee = fee
            , compatibleTxProtocolUpdate = protocolUpdates
            , compatibleTxVotingProcedures = votes
            , compatibleTxCertificates = txCerts
            , compatibleTxInsCollateral = insCollateral
            , compatibleTxProtocolParams = pparams
            }

    let txBody = Tx TopTx (ShelleyLedgerEra era)
ledgerTx Tx TopTx (ShelleyLedgerEra era)
-> Getting
     (TxBody TopTx (ShelleyLedgerEra era))
     (Tx TopTx (ShelleyLedgerEra era))
     (TxBody TopTx (ShelleyLedgerEra era))
-> TxBody TopTx (ShelleyLedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx (ShelleyLedgerEra era))
  (Tx TopTx (ShelleyLedgerEra era))
  (TxBody TopTx (ShelleyLedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens'
  (Tx l (ShelleyLedgerEra era)) (TxBody l (ShelleyLedgerEra era))
L.bodyTxL

    let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks

    byronWitnesses <-
      forM sksByron $
        fromEitherCli
          . mkShelleyBootstrapWitness sbe mNetworkId txBody

    let newShelleyKeyWits = ShelleyBasedEra era
-> TxBody TopTx (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
forall era.
HasCallStack =>
ShelleyBasedEra era
-> TxBody TopTx (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitness' ShelleyBasedEra era
sbe TxBody TopTx (ShelleyLedgerEra era)
txBody (ShelleyWitnessSigningKey -> KeyWitness era)
-> [ShelleyWitnessSigningKey] -> [KeyWitness era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ShelleyWitnessSigningKey]
sksShelley
        allKeyWits = [KeyWitness era]
newShelleyKeyWits [KeyWitness era] -> [KeyWitness era] -> [KeyWitness era]
forall a. [a] -> [a] -> [a]
++ [KeyWitness era]
byronWitnesses
        signedTx = [KeyWitness era] -> Tx era -> Tx era
forall era. [KeyWitness era] -> Tx era -> Tx era
addWitnesses [KeyWitness era]
allKeyWits Tx era
transaction

    fromEitherIOCli $
      writeTxFileTextEnvelope sbe outputFp signedTx

readCertificateScriptWitnesses'
  :: ShelleyBasedEra era
  -> [(CertificateFile, Maybe AnyNonAssetScript)]
  -> CIO e [(CertificateFile, Exp.AnyWitness (ShelleyLedgerEra era))]
readCertificateScriptWitnesses' :: forall era e.
ShelleyBasedEra era
-> [(CertificateFile, Maybe AnyNonAssetScript)]
-> CIO e [(CertificateFile, AnyWitness (ShelleyLedgerEra era))]
readCertificateScriptWitnesses' ShelleyBasedEra era
sbe =
  ((CertificateFile, Maybe AnyNonAssetScript)
 -> RIO e (CertificateFile, AnyWitness (ShelleyLedgerEra era)))
-> [(CertificateFile, Maybe AnyNonAssetScript)]
-> RIO e [(CertificateFile, AnyWitness (ShelleyLedgerEra 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
    ( \(CertificateFile
certFile, Maybe AnyNonAssetScript
mSWit) -> do
        case Maybe AnyNonAssetScript
mSWit of
          Maybe AnyNonAssetScript
Nothing -> (CertificateFile, AnyWitness (ShelleyLedgerEra era))
-> RIO e (CertificateFile, AnyWitness (ShelleyLedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (CertificateFile
certFile, AnyWitness (ShelleyLedgerEra era)
forall era. AnyWitness era
Exp.AnyKeyWitnessPlaceholder)
          Just AnyNonAssetScript
cert -> do
            sWit <- ShelleyBasedEra era
-> AnyNonAssetScript -> CIO e (AnyWitness (ShelleyLedgerEra era))
forall era e.
ShelleyBasedEra era
-> AnyNonAssetScript -> CIO e (AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitnessSbe ShelleyBasedEra era
sbe AnyNonAssetScript
cert
            return (certFile, sWit)
    )

readCertificateScriptWitnessSbe
  :: forall era e
   . ShelleyBasedEra era
  -> AnyNonAssetScript
  -> CIO e (Exp.AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitnessSbe :: forall era e.
ShelleyBasedEra era
-> AnyNonAssetScript -> CIO e (AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitnessSbe ShelleyBasedEra era
sbe (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
      ss <- FilePath -> CIO e (Script SimpleScript')
forall e. FilePath -> CIO e (Script SimpleScript')
Compatible.readFileSimpleScript FilePath
sFp
      let serialisedSS = Script SimpleScript' -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Script SimpleScript'
ss
      let simpleScriptE :: Either DecoderError (Exp.SimpleScript (ShelleyLedgerEra era)) = shelleyBasedEraConstraints sbe $ Exp.deserialiseSimpleScript serialisedSS
      simpleScript <- fromEitherCli simpleScriptE
      return $ Exp.AnySimpleScriptWitness $ Exp.SScript simpleScript
    ReferenceSimpleScript TxIn
refTxin ->
      AnyWitness (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyWitness (ShelleyLedgerEra era)
 -> RIO e (AnyWitness (ShelleyLedgerEra era)))
-> (SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
    -> AnyWitness (ShelleyLedgerEra era))
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
Exp.AnySimpleScriptWitness (SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
 -> RIO e (AnyWitness (ShelleyLedgerEra era)))
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ TxIn -> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
forall era. TxIn -> SimpleScriptOrReferenceInput era
Exp.SReferenceScript TxIn
refTxin
readCertificateScriptWitnessSbe ShelleyBasedEra era
sbe (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 anyPlutusScript <- ShelleyBasedEra era
-> FilePath -> CIO e (AnyPlutusScript (ShelleyLedgerEra era))
forall era e.
ShelleyBasedEra era
-> FilePath -> CIO e (AnyPlutusScript (ShelleyLedgerEra era))
Compatible.readFilePlutusScript ShelleyBasedEra era
sbe FilePath
plutusScriptFp
      let
        lang = PlutusScriptInEra lang (ShelleyLedgerEra era) -> SLanguage lang
forall (lang :: Language) era.
PlutusLanguage lang =>
PlutusScriptInEra lang era -> SLanguage lang
Exp.Plutus.plutusScriptInEraSLanguage PlutusScriptInEra lang (ShelleyLedgerEra era)
anyPlutusScript
      let script' = PlutusScriptInEra lang (ShelleyLedgerEra era)
-> PlutusScriptOrReferenceInput lang (ShelleyLedgerEra era)
forall (lang :: Language) era.
PlutusScriptInEra lang era -> PlutusScriptOrReferenceInput lang era
Exp.PScript PlutusScriptInEra lang (ShelleyLedgerEra era)
anyPlutusScript

      redeemer <-
        fromExceptTCli $
          readScriptDataOrFile redeemerFile

      let sw =
            SLanguage lang
-> PlutusScriptOrReferenceInput lang (ShelleyLedgerEra era)
-> PlutusScriptDatum lang 'CertifyingScript
-> HashableScriptData
-> ExecutionUnits
-> PlutusScriptWitness
     lang 'CertifyingScript (ShelleyLedgerEra 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 (ShelleyLedgerEra era)
script'
              PlutusScriptDatum lang 'CertifyingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.Plutus.NoScriptDatum
              HashableScriptData
redeemer
              ExecutionUnits
execUnits
      return $
        Exp.AnyPlutusScriptWitness $
          Exp.AnyPlutusCertifyingScriptWitness sw
    ReferencePlutusNonAssetScript TxIn
refInput (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 $
        Exp.AnyPlutusScriptWitness $
          Exp.AnyPlutusCertifyingScriptWitness $
            Exp.Plutus.PlutusScriptWitness
              lang
              (Exp.Plutus.PReferenceScript refInput)
              Exp.Plutus.NoScriptDatum
              redeemer
              execUnits

-- | Create 'TxCertificates'. Note that 'Certificate era' will be deduplicated. A witness is attached
-- only to certificates which require one.
--
-- Note that, when building a transaction in Conway era, a witness is not required for staking credential
-- registration, but this is only the case during the transitional period of Conway era and only for staking
-- credential registration certificates without a deposit. Future eras will require a witness for
-- registration certificates, because the one without a deposit will be removed.
mkTxCertificatesSbe
  :: forall era
   . ShelleyBasedEra era
  -> [(Exp.Certificate (ShelleyLedgerEra era), Exp.AnyWitness (ShelleyLedgerEra era))]
  -> Exp.TxCertificates (ShelleyLedgerEra era)
mkTxCertificatesSbe :: forall era.
ShelleyBasedEra era
-> [(Certificate (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> TxCertificates (ShelleyLedgerEra era)
mkTxCertificatesSbe ShelleyBasedEra era
era [(Certificate (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
certs = OMap
  (Certificate (ShelleyLedgerEra era))
  (Maybe (AnyWitness (ShelleyLedgerEra era)))
-> TxCertificates (ShelleyLedgerEra era)
forall era.
OMap (Certificate era) (Maybe (AnyWitness era))
-> TxCertificates era
Exp.TxCertificates (OMap
   (Certificate (ShelleyLedgerEra era))
   (Maybe (AnyWitness (ShelleyLedgerEra era)))
 -> TxCertificates (ShelleyLedgerEra era))
-> ([(Certificate (ShelleyLedgerEra era),
      Maybe (AnyWitness (ShelleyLedgerEra era)))]
    -> OMap
         (Certificate (ShelleyLedgerEra era))
         (Maybe (AnyWitness (ShelleyLedgerEra era))))
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (AnyWitness (ShelleyLedgerEra era)))]
-> TxCertificates (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Certificate (ShelleyLedgerEra era),
  Maybe (AnyWitness (ShelleyLedgerEra era)))]
-> OMap
     (Certificate (ShelleyLedgerEra era))
     (Maybe (AnyWitness (ShelleyLedgerEra era)))
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList ([(Certificate (ShelleyLedgerEra era),
   Maybe (AnyWitness (ShelleyLedgerEra era)))]
 -> TxCertificates (ShelleyLedgerEra era))
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (AnyWitness (ShelleyLedgerEra era)))]
-> TxCertificates (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ((Certificate (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))
 -> (Certificate (ShelleyLedgerEra era),
     Maybe (AnyWitness (ShelleyLedgerEra era))))
-> [(Certificate (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (AnyWitness (ShelleyLedgerEra era)))]
forall a b. (a -> b) -> [a] -> [b]
map (Certificate (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> (Certificate (ShelleyLedgerEra era),
    Maybe (AnyWitness (ShelleyLedgerEra era)))
attachWitness [(Certificate (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
certs
 where
  attachWitness
    :: (Exp.Certificate (ShelleyLedgerEra era), Exp.AnyWitness (ShelleyLedgerEra era))
    -> ( Exp.Certificate (ShelleyLedgerEra era)
       , Maybe (Exp.AnyWitness (ShelleyLedgerEra era))
       )
  attachWitness :: (Certificate (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> (Certificate (ShelleyLedgerEra era),
    Maybe (AnyWitness (ShelleyLedgerEra era)))
attachWitness (c :: Certificate (ShelleyLedgerEra era)
c@(Exp.Certificate TxCert (ShelleyLedgerEra era)
cert), AnyWitness (ShelleyLedgerEra era)
wit) =
    (Certificate (ShelleyLedgerEra era)
c, AnyWitness (ShelleyLedgerEra era)
wit AnyWitness (ShelleyLedgerEra era)
-> Maybe StakeCredential
-> Maybe (AnyWitness (ShelleyLedgerEra era))
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
forall era.
ShelleyBasedEra era
-> TxCert (ShelleyLedgerEra era) -> Maybe StakeCredential
Compatible.getTxCertWitness (ShelleyBasedEra era -> ShelleyBasedEra era
forall era. ShelleyBasedEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyBasedEra era
era) TxCert (ShelleyLedgerEra era)
cert)

readUpdateProposalFile
  :: forall e era
   . ShelleyBasedEra era
  -> UpdateProposalFile
  -> CIO e (AnyProtocolUpdate era)
readUpdateProposalFile :: forall e era.
ShelleyBasedEra era
-> UpdateProposalFile -> CIO e (AnyProtocolUpdate era)
readUpdateProposalFile ShelleyBasedEra era
sbe (UpdateProposalFile FilePath
file) =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley -> ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
forall era.
ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
ProtocolUpdate ShelleyToBabbageEra era
ShelleyToBabbageEra ShelleyEra
ShelleyToBabbageEraShelley (UpdateProposal era -> AnyProtocolUpdate era)
-> RIO e (UpdateProposal era) -> RIO e (AnyProtocolUpdate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO e (UpdateProposal era)
CIO e (UpdateProposal era)
readUpdateProposal
    ShelleyBasedEra era
ShelleyBasedEraAllegra -> ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
forall era.
ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
ProtocolUpdate ShelleyToBabbageEra era
ShelleyToBabbageEra AllegraEra
ShelleyToBabbageEraAllegra (UpdateProposal era -> AnyProtocolUpdate era)
-> RIO e (UpdateProposal era) -> RIO e (AnyProtocolUpdate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO e (UpdateProposal era)
CIO e (UpdateProposal era)
readUpdateProposal
    ShelleyBasedEra era
ShelleyBasedEraMary -> ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
forall era.
ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
ProtocolUpdate ShelleyToBabbageEra era
ShelleyToBabbageEra MaryEra
ShelleyToBabbageEraMary (UpdateProposal era -> AnyProtocolUpdate era)
-> RIO e (UpdateProposal era) -> RIO e (AnyProtocolUpdate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO e (UpdateProposal era)
CIO e (UpdateProposal era)
readUpdateProposal
    ShelleyBasedEra era
ShelleyBasedEraAlonzo -> ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
forall era.
ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
ProtocolUpdate ShelleyToBabbageEra era
ShelleyToBabbageEra AlonzoEra
ShelleyToBabbageEraAlonzo (UpdateProposal era -> AnyProtocolUpdate era)
-> RIO e (UpdateProposal era) -> RIO e (AnyProtocolUpdate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO e (UpdateProposal era)
CIO e (UpdateProposal era)
readUpdateProposal
    ShelleyBasedEra era
ShelleyBasedEraBabbage -> ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
forall era.
ShelleyToBabbageEra era
-> UpdateProposal era -> AnyProtocolUpdate era
ProtocolUpdate ShelleyToBabbageEra era
ShelleyToBabbageEra BabbageEra
ShelleyToBabbageEraBabbage (UpdateProposal era -> AnyProtocolUpdate era)
-> RIO e (UpdateProposal era) -> RIO e (AnyProtocolUpdate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO e (UpdateProposal era)
CIO e (UpdateProposal era)
readUpdateProposal
    ShelleyBasedEra era
ShelleyBasedEraConway -> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era))
-> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
    ShelleyBasedEra era
ShelleyBasedEraDijkstra -> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era))
-> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
 where
  readUpdateProposal :: CIO e (UpdateProposal era)
  readUpdateProposal :: CIO e (UpdateProposal era)
readUpdateProposal =
    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) (UpdateProposal era))
 -> RIO e (UpdateProposal era))
-> IO (Either (FileError TextEnvelopeError) (UpdateProposal era))
-> RIO e (UpdateProposal era)
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError TextEnvelopeError) (UpdateProposal era)))
-> IO (Either (FileError TextEnvelopeError) (UpdateProposal era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  IO (Either (FileError TextEnvelopeError) (UpdateProposal era)))
 -> IO (Either (FileError TextEnvelopeError) (UpdateProposal era)))
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError TextEnvelopeError) (UpdateProposal era)))
-> IO (Either (FileError TextEnvelopeError) (UpdateProposal era))
forall a b. (a -> b) -> a -> b
$
        File (ZonkAny 0) 'In
-> IO (Either (FileError TextEnvelopeError) (UpdateProposal era))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (FilePath -> File (ZonkAny 0) 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
file)

readProposalProcedureFile
  :: forall e era
   . ShelleyBasedEra era
  -> [(ProposalFile In, Maybe AnyNonAssetScript)]
  -> CIO e (AnyProtocolUpdate era)
readProposalProcedureFile :: forall e era.
ShelleyBasedEra era
-> [(ProposalFile 'In, Maybe AnyNonAssetScript)]
-> CIO e (AnyProtocolUpdate era)
readProposalProcedureFile ShelleyBasedEra era
sbe [] = AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era))
-> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
readProposalProcedureFile ShelleyBasedEra era
sbe [(ProposalFile 'In, Maybe AnyNonAssetScript)]
proposals =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley -> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era))
-> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
    ShelleyBasedEra era
ShelleyBasedEraAllegra -> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era))
-> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
    ShelleyBasedEra era
ShelleyBasedEraMary -> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era))
-> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
    ShelleyBasedEra era
ShelleyBasedEraAlonzo -> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era))
-> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
    ShelleyBasedEra era
ShelleyBasedEraBabbage -> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era))
-> AnyProtocolUpdate era -> RIO e (AnyProtocolUpdate era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe
    ShelleyBasedEra era
ShelleyBasedEraConway -> ConwayEraOnwards era
-> TxProposalProcedures (ShelleyLedgerEra era)
-> AnyProtocolUpdate era
forall era.
ConwayEraOnwards era
-> TxProposalProcedures (ShelleyLedgerEra era)
-> AnyProtocolUpdate era
ProposalProcedures ConwayEraOnwards era
ConwayEraOnwards ConwayEra
ConwayEraOnwardsConway (TxProposalProcedures ConwayEra -> AnyProtocolUpdate era)
-> RIO e (TxProposalProcedures ConwayEra)
-> RIO e (AnyProtocolUpdate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO e (TxProposalProcedures (ShelleyLedgerEra ConwayEra))
RIO e (TxProposalProcedures ConwayEra)
forall era'.
IsEra era' =>
CIO e (TxProposalProcedures (ShelleyLedgerEra era'))
readProcedures
    ShelleyBasedEra era
ShelleyBasedEraDijkstra -> ConwayEraOnwards era
-> TxProposalProcedures (ShelleyLedgerEra era)
-> AnyProtocolUpdate era
forall era.
ConwayEraOnwards era
-> TxProposalProcedures (ShelleyLedgerEra era)
-> AnyProtocolUpdate era
ProposalProcedures ConwayEraOnwards era
ConwayEraOnwards DijkstraEra
ConwayEraOnwardsDijkstra (TxProposalProcedures DijkstraEra -> AnyProtocolUpdate era)
-> RIO e (TxProposalProcedures DijkstraEra)
-> RIO e (AnyProtocolUpdate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO e (TxProposalProcedures (ShelleyLedgerEra DijkstraEra))
RIO e (TxProposalProcedures DijkstraEra)
forall era'.
IsEra era' =>
CIO e (TxProposalProcedures (ShelleyLedgerEra era'))
readProcedures
 where
  readProcedures
    :: forall era'
     . Exp.IsEra era'
    => CIO e (Exp.TxProposalProcedures (ShelleyLedgerEra era'))
  readProcedures :: forall era'.
IsEra era' =>
CIO e (TxProposalProcedures (ShelleyLedgerEra era'))
readProcedures = Era era'
-> (EraCommonConstraints era' =>
    RIO e (TxProposalProcedures (ShelleyLedgerEra era')))
-> RIO e (TxProposalProcedures (ShelleyLedgerEra era'))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era') ((EraCommonConstraints era' =>
  RIO e (TxProposalProcedures (ShelleyLedgerEra era')))
 -> RIO e (TxProposalProcedures (ShelleyLedgerEra era')))
-> (EraCommonConstraints era' =>
    RIO e (TxProposalProcedures (ShelleyLedgerEra era')))
-> RIO e (TxProposalProcedures (ShelleyLedgerEra era'))
forall a b. (a -> b) -> a -> b
$ do
    props :: [(Proposal era', Exp.AnyWitness (Exp.LedgerEra era'))] <-
      ((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 [(ProposalFile 'In, Maybe AnyNonAssetScript)]
proposals
    pure $
      Exp.mkTxProposalProcedures
        [(govProp, swit) | (Proposal govProp, swit) <- props]