{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Cardano.Api
import Cardano.Api.Compatible
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Shelley hiding (VotingProcedures)

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Compatible.Transaction.Command
import Cardano.CLI.EraBased.Script.Certificate.Read
import Cardano.CLI.EraBased.Script.Certificate.Type
import Cardano.CLI.EraBased.Script.Proposal.Type
import Cardano.CLI.EraBased.Script.Vote.Type
  ( VoteScriptWitness (..)
  )
import Cardano.CLI.EraBased.Transaction.Run
import Cardano.CLI.Read
import Cardano.CLI.Type.Common

import Control.Monad
import Lens.Micro

data CompatibleTransactionError
  = forall err. Error err => CompatibleFileError (FileError err)
  | CompatibleProposalError !ProposalError

instance Show CompatibleTransactionError where
  show :: CompatibleTransactionError -> String
show = Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> (CompatibleTransactionError -> Doc Any)
-> CompatibleTransactionError
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompatibleTransactionError -> Doc Any
forall e ann. Error e => e -> Doc ann
forall ann. CompatibleTransactionError -> Doc ann
prettyError

instance Error CompatibleTransactionError where
  prettyError :: forall ann. CompatibleTransactionError -> Doc ann
prettyError = \case
    CompatibleFileError FileError err
e -> FileError err -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError err -> Doc ann
prettyError FileError err
e
    CompatibleProposalError ProposalError
e -> ProposalError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ProposalError
e

runCompatibleTransactionCmd
  :: forall era e
   . CompatibleTransactionCmds era
  -> CIO e ()
runCompatibleTransactionCmd :: forall era e. CompatibleTransactionCmds era -> CIO e ()
runCompatibleTransactionCmd
  ( CreateCompatibleSignedTransaction
      ShelleyBasedEra era
sbe
      [TxIn]
ins
      [TxOutAnyEra]
outs
      Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProposal
      Maybe
  (Featured
     ConwayEraOnwards
     era
     [(ProposalFile 'In, Maybe CliProposalScriptRequirements)])
mProposalProcedure
      [(VoteFile 'In, Maybe CliVoteScriptRequirements)]
mVotes
      [WitnessSigningData]
witnesses
      Maybe NetworkId
mNetworkId
      Coin
fee
      [(CertificateFile, Maybe CliCertificateScriptRequirements)]
certificates
      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
    [SomeSigningWitness]
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

    [TxOut CtxTx era]
allOuts <- IO (Either TxCmdError [TxOut CtxTx era]) -> RIO e [TxOut CtxTx era]
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either TxCmdError [TxOut CtxTx era])
 -> RIO e [TxOut CtxTx era])
-> (ExceptT TxCmdError IO [TxOut CtxTx era]
    -> IO (Either TxCmdError [TxOut CtxTx era]))
-> ExceptT TxCmdError IO [TxOut CtxTx era]
-> RIO e [TxOut CtxTx era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT TxCmdError IO [TxOut CtxTx era]
-> IO (Either TxCmdError [TxOut CtxTx era])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TxCmdError IO [TxOut CtxTx era]
 -> RIO e [TxOut CtxTx era])
-> ExceptT TxCmdError IO [TxOut CtxTx era]
-> RIO e [TxOut CtxTx era]
forall a b. (a -> b) -> a -> b
$ (TxOutAnyEra -> ExceptT TxCmdError IO (TxOut CtxTx era))
-> [TxOutAnyEra] -> ExceptT TxCmdError IO [TxOut CtxTx 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 (ShelleyBasedEra era
-> TxOutAnyEra -> ExceptT TxCmdError IO (TxOut CtxTx era)
forall era.
ShelleyBasedEra era
-> TxOutAnyEra -> ExceptT TxCmdError IO (TxOut CtxTx era)
toTxOutInAnyEra ShelleyBasedEra era
sbe) [TxOutAnyEra]
outs

    [(CertificateFile, Maybe (CertificateScriptWitness era))]
certFilesAndMaybeScriptWits <-
      ExceptT
  (FileError CliScriptWitnessError)
  IO
  [(CertificateFile, Maybe (CertificateScriptWitness era))]
-> RIO e [(CertificateFile, Maybe (CertificateScriptWitness era))]
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT
   (FileError CliScriptWitnessError)
   IO
   [(CertificateFile, Maybe (CertificateScriptWitness era))]
 -> RIO e [(CertificateFile, Maybe (CertificateScriptWitness era))])
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     [(CertificateFile, Maybe (CertificateScriptWitness era))]
-> RIO e [(CertificateFile, Maybe (CertificateScriptWitness era))]
forall a b. (a -> b) -> a -> b
$
        ShelleyBasedEra era
-> [(CertificateFile, Maybe CliCertificateScriptRequirements)]
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     [(CertificateFile, Maybe (CertificateScriptWitness era))]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) era.
MonadIOTransError (FileError CliScriptWitnessError) t m =>
ShelleyBasedEra era
-> [(CertificateFile, Maybe CliCertificateScriptRequirements)]
-> t m [(CertificateFile, Maybe (CertificateScriptWitness era))]
readCertificateScriptWitnesses ShelleyBasedEra era
sbe [(CertificateFile, Maybe CliCertificateScriptRequirements)]
certificates

    [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits <-
      IO [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-> RIO e [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
 -> RIO
      e [(Certificate era, Maybe (ScriptWitness WitCtxStake era))])
-> IO [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-> RIO e [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
forall a b. (a -> b) -> a -> b
$
        [IO (Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-> IO [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
          [ (Certificate era
 -> (Certificate era, Maybe (ScriptWitness WitCtxStake era)))
-> IO (Certificate era)
-> IO (Certificate era, Maybe (ScriptWitness WitCtxStake era))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,CertificateScriptWitness era -> ScriptWitness WitCtxStake era
forall era.
CertificateScriptWitness era -> ScriptWitness WitCtxStake era
cswScriptWitness (CertificateScriptWitness era -> ScriptWitness WitCtxStake era)
-> Maybe (CertificateScriptWitness era)
-> Maybe (ScriptWitness WitCtxStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CertificateScriptWitness era)
mSwit) (IO (Certificate era)
 -> IO (Certificate era, Maybe (ScriptWitness WitCtxStake era)))
-> IO (Certificate era)
-> IO (Certificate era, Maybe (ScriptWitness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$
              IO (Either (FileError TextEnvelopeError) (Certificate era))
-> IO (Certificate 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) (Certificate era))
 -> IO (Certificate era))
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
-> IO (Certificate era)
forall a b. (a -> b) -> a -> b
$
                AsType (Certificate era)
-> File Any 'In
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType (Certificate era)
forall era. AsType (Certificate era)
AsCertificate (File Any 'In
 -> IO (Either (FileError TextEnvelopeError) (Certificate era)))
-> File Any 'In
-> IO (Either (FileError TextEnvelopeError) (Certificate era))
forall a b. (a -> b) -> a -> b
$
                  String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File String
certFile
          | (CertificateFile String
certFile, Maybe (CertificateScriptWitness era)
mSwit) <- [(CertificateFile, Maybe (CertificateScriptWitness era))]
certFilesAndMaybeScriptWits
          ]

    (AnyProtocolUpdate era
protocolUpdates, AnyVote era
votes) :: (AnyProtocolUpdate era, AnyVote era) <-
      (ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era
 -> RIO e (AnyProtocolUpdate era, AnyVote era))
-> (ConwayEraOnwardsConstraints era =>
    ConwayEraOnwards era -> RIO e (AnyProtocolUpdate era, AnyVote era))
-> ShelleyBasedEra era
-> RIO e (AnyProtocolUpdate era, AnyVote era)
forall era a.
(ShelleyToBabbageEraConstraints era =>
 ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
        ( RIO e (AnyProtocolUpdate era, AnyVote era)
-> ShelleyToBabbageEra era
-> RIO e (AnyProtocolUpdate era, AnyVote era)
forall a b. a -> b -> a
const (RIO e (AnyProtocolUpdate era, AnyVote era)
 -> ShelleyToBabbageEra era
 -> RIO e (AnyProtocolUpdate era, AnyVote era))
-> RIO e (AnyProtocolUpdate era, AnyVote era)
-> ShelleyToBabbageEra era
-> RIO e (AnyProtocolUpdate era, AnyVote era)
forall a b. (a -> b) -> a -> b
$ do
            case Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProposal of
              Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
Nothing -> (AnyProtocolUpdate era, AnyVote era)
-> RIO e (AnyProtocolUpdate era, AnyVote era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe, AnyVote era
forall era. AnyVote era
NoVotes)
              Just Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
p -> do
                AnyProtocolUpdate era
pparamUpdate <- Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
-> CIO e (AnyProtocolUpdate era)
forall era e.
Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
-> CIO e (AnyProtocolUpdate era)
readUpdateProposalFile Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
p
                (AnyProtocolUpdate era, AnyVote era)
-> RIO e (AnyProtocolUpdate era, AnyVote era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyProtocolUpdate era
pparamUpdate, AnyVote era
forall era. AnyVote era
NoVotes)
        )
        ( \ConwayEraOnwards era
w ->
            case Maybe
  (Featured
     ConwayEraOnwards
     era
     [(ProposalFile 'In, Maybe CliProposalScriptRequirements)])
mProposalProcedure of
              Maybe
  (Featured
     ConwayEraOnwards
     era
     [(ProposalFile 'In, Maybe CliProposalScriptRequirements)])
Nothing -> (AnyProtocolUpdate era, AnyVote era)
-> RIO e (AnyProtocolUpdate era, AnyVote era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShelleyBasedEra era -> AnyProtocolUpdate era
forall era. ShelleyBasedEra era -> AnyProtocolUpdate era
NoPParamsUpdate ShelleyBasedEra era
sbe, AnyVote era
forall era. AnyVote era
NoVotes)
              Just Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe CliProposalScriptRequirements)]
prop -> do
                AnyProtocolUpdate era
pparamUpdate <- Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe CliProposalScriptRequirements)]
-> CIO e (AnyProtocolUpdate era)
forall era e.
Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe CliProposalScriptRequirements)]
-> CIO e (AnyProtocolUpdate era)
readProposalProcedureFile Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe CliProposalScriptRequirements)]
prop
                [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votesAndWits <- IO
  (Either
     VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> RIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (ConwayEraOnwards era
-> [(VoteFile 'In, Maybe CliVoteScriptRequirements)]
-> IO
     (Either
        VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
forall era.
ConwayEraOnwards era
-> [(VoteFile 'In, Maybe CliVoteScriptRequirements)]
-> IO
     (Either
        VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
readVotingProceduresFiles ConwayEraOnwards era
w [(VoteFile 'In, Maybe CliVoteScriptRequirements)]
mVotes)
                TxVotingProcedures BuildTx era
votingProcedures <-
                  Either (VotesMergingConflict era) (TxVotingProcedures BuildTx era)
-> RIO e (TxVotingProcedures BuildTx era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either (VotesMergingConflict era) (TxVotingProcedures BuildTx era)
 -> RIO e (TxVotingProcedures BuildTx era))
-> Either
     (VotesMergingConflict era) (TxVotingProcedures BuildTx era)
-> RIO e (TxVotingProcedures BuildTx era)
forall a b. (a -> b) -> a -> b
$ [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> Either
     (VotesMergingConflict era) (TxVotingProcedures BuildTx era)
forall build era.
Applicative (BuildTxWith build) =>
[(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> Either (VotesMergingConflict era) (TxVotingProcedures build era)
mkTxVotingProcedures [(VotingProcedures era
v, VoteScriptWitness era -> ScriptWitness WitCtxStake era
forall era. VoteScriptWitness era -> ScriptWitness WitCtxStake era
vswScriptWitness (VoteScriptWitness era -> ScriptWitness WitCtxStake era)
-> Maybe (VoteScriptWitness era)
-> Maybe (ScriptWitness WitCtxStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (VoteScriptWitness era)
mSwit) | (VotingProcedures era
v, Maybe (VoteScriptWitness era)
mSwit) <- [(VotingProcedures era, Maybe (VoteScriptWitness era))]
votesAndWits]
                (AnyProtocolUpdate era, AnyVote era)
-> RIO e (AnyProtocolUpdate era, AnyVote era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyProtocolUpdate era
pparamUpdate, ConwayEraOnwards era
-> TxVotingProcedures BuildTx era -> AnyVote era
forall era.
ConwayEraOnwards era
-> TxVotingProcedures BuildTx era -> AnyVote era
VotingProcedures ConwayEraOnwards era
w TxVotingProcedures BuildTx era
votingProcedures)
        )
        ShelleyBasedEra era
sbe

    let txCerts :: TxCertificates BuildTx era
txCerts = ShelleyBasedEra era
-> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-> TxCertificates BuildTx era
forall build era.
Applicative (BuildTxWith build) =>
ShelleyBasedEra era
-> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-> TxCertificates build era
mkTxCertificates ShelleyBasedEra era
sbe [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
certsAndMaybeScriptWits

    transaction :: Tx era
transaction@(ShelleyTx ShelleyBasedEra era
_ Tx (ShelleyLedgerEra era)
ledgerTx) <-
      Either ProtocolParametersConversionError (Tx era) -> RIO e (Tx era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either ProtocolParametersConversionError (Tx era)
 -> RIO e (Tx era))
-> Either ProtocolParametersConversionError (Tx era)
-> RIO e (Tx era)
forall a b. (a -> b) -> a -> b
$
        ShelleyBasedEra era
-> [TxIn]
-> [TxOut CtxTx era]
-> Coin
-> AnyProtocolUpdate era
-> AnyVote era
-> TxCertificates BuildTx era
-> Either ProtocolParametersConversionError (Tx era)
forall era.
ShelleyBasedEra era
-> [TxIn]
-> [TxOut CtxTx era]
-> Coin
-> AnyProtocolUpdate era
-> AnyVote era
-> TxCertificates BuildTx era
-> Either ProtocolParametersConversionError (Tx era)
createCompatibleTx ShelleyBasedEra era
sbe [TxIn]
ins [TxOut CtxTx era]
allOuts Coin
fee AnyProtocolUpdate era
protocolUpdates AnyVote era
votes TxCertificates BuildTx era
txCerts

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

    let ([ShelleyBootstrapWitnessSigningKeyData]
sksByron, [ShelleyWitnessSigningKey]
sksShelley) = [ByronOrShelleyWitness]
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
partitionSomeWitnesses ([ByronOrShelleyWitness]
 -> ([ShelleyBootstrapWitnessSigningKeyData],
     [ShelleyWitnessSigningKey]))
-> [ByronOrShelleyWitness]
-> ([ShelleyBootstrapWitnessSigningKeyData],
    [ShelleyWitnessSigningKey])
forall a b. (a -> b) -> a -> b
$ (SomeSigningWitness -> ByronOrShelleyWitness)
-> [SomeSigningWitness] -> [ByronOrShelleyWitness]
forall a b. (a -> b) -> [a] -> [b]
map SomeSigningWitness -> ByronOrShelleyWitness
categoriseSomeSigningWitness [SomeSigningWitness]
sks

    [KeyWitness era]
byronWitnesses <-
      [ShelleyBootstrapWitnessSigningKeyData]
-> (ShelleyBootstrapWitnessSigningKeyData
    -> RIO e (KeyWitness era))
-> RIO e [KeyWitness era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ShelleyBootstrapWitnessSigningKeyData]
sksByron ((ShelleyBootstrapWitnessSigningKeyData -> RIO e (KeyWitness era))
 -> RIO e [KeyWitness era])
-> (ShelleyBootstrapWitnessSigningKeyData
    -> RIO e (KeyWitness era))
-> RIO e [KeyWitness era]
forall a b. (a -> b) -> a -> b
$
        Either BootstrapWitnessError (KeyWitness era)
-> RIO e (KeyWitness era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli
          (Either BootstrapWitnessError (KeyWitness era)
 -> RIO e (KeyWitness era))
-> (ShelleyBootstrapWitnessSigningKeyData
    -> Either BootstrapWitnessError (KeyWitness era))
-> ShelleyBootstrapWitnessSigningKeyData
-> RIO e (KeyWitness era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
forall era.
ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness ShelleyBasedEra era
sbe Maybe NetworkId
mNetworkId TxBody (ShelleyLedgerEra era)
txBody

    let newShelleyKeyWits :: [KeyWitness era]
newShelleyKeyWits = ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitness' ShelleyBasedEra era
sbe TxBody (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]
allKeyWits = [KeyWitness era]
newShelleyKeyWits [KeyWitness era] -> [KeyWitness era] -> [KeyWitness era]
forall a. [a] -> [a] -> [a]
++ [KeyWitness era]
byronWitnesses
        signedTx :: Tx era
signedTx = [KeyWitness era] -> Tx era -> Tx era
forall era. [KeyWitness era] -> Tx era -> Tx era
addWitnesses [KeyWitness era]
allKeyWits Tx era
transaction

    IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      ShelleyBasedEra era
-> File () 'Out -> Tx era -> IO (Either (FileError ()) ())
forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCddl ShelleyBasedEra era
sbe File () 'Out
outputFp Tx era
signedTx

readUpdateProposalFile
  :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
  -> CIO e (AnyProtocolUpdate era)
readUpdateProposalFile :: forall era e.
Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
-> CIO e (AnyProtocolUpdate era)
readUpdateProposalFile (Featured ShelleyToBabbageEra era
sToB Maybe UpdateProposalFile
Nothing) =
  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 -> AnyProtocolUpdate era)
-> ShelleyBasedEra era -> AnyProtocolUpdate era
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era -> ShelleyBasedEra era
forall era. ShelleyToBabbageEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyToBabbageEra era
sToB
readUpdateProposalFile (Featured ShelleyToBabbageEra era
sToB (Just UpdateProposalFile
updateProposalFile)) = do
  TxUpdateProposal era
prop <-
    ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
-> RIO e (TxUpdateProposal era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
 -> RIO e (TxUpdateProposal era))
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
-> RIO e (TxUpdateProposal era)
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era
-> UpdateProposalFile
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
forall era.
ShelleyToBabbageEra era
-> UpdateProposalFile
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
readTxUpdateProposal ShelleyToBabbageEra era
sToB UpdateProposalFile
updateProposalFile
  case TxUpdateProposal era
prop of
    TxUpdateProposal era
TxUpdateProposalNone -> 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 -> AnyProtocolUpdate era)
-> ShelleyBasedEra era -> AnyProtocolUpdate era
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era -> ShelleyBasedEra era
forall era. ShelleyToBabbageEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyToBabbageEra era
sToB
    TxUpdateProposal ShelleyToBabbageEra era
_ UpdateProposal
proposal -> 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
$ ShelleyToBabbageEra era -> UpdateProposal -> AnyProtocolUpdate era
forall era.
ShelleyToBabbageEra era -> UpdateProposal -> AnyProtocolUpdate era
ProtocolUpdate ShelleyToBabbageEra era
sToB UpdateProposal
proposal

readProposalProcedureFile
  :: Featured ConwayEraOnwards era [(ProposalFile In, Maybe CliProposalScriptRequirements)]
  -> CIO e (AnyProtocolUpdate era)
readProposalProcedureFile :: forall era e.
Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe CliProposalScriptRequirements)]
-> CIO e (AnyProtocolUpdate era)
readProposalProcedureFile (Featured ConwayEraOnwards era
cEraOnwards []) =
  let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
cEraOnwards
   in 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 (Featured ConwayEraOnwards era
cEraOnwards [(ProposalFile 'In, Maybe CliProposalScriptRequirements)]
proposals) = do
  [(Proposal era, Maybe (ProposalScriptWitness era))]
props <-
    [(ProposalFile 'In, Maybe CliProposalScriptRequirements)]
-> ((ProposalFile 'In, Maybe CliProposalScriptRequirements)
    -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)))
-> RIO e [(Proposal era, Maybe (ProposalScriptWitness era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ProposalFile 'In, Maybe CliProposalScriptRequirements)]
proposals (((ProposalFile 'In, Maybe CliProposalScriptRequirements)
  -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)))
 -> RIO e [(Proposal era, Maybe (ProposalScriptWitness era))])
-> ((ProposalFile 'In, Maybe CliProposalScriptRequirements)
    -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)))
-> RIO e [(Proposal era, Maybe (ProposalScriptWitness era))]
forall a b. (a -> b) -> a -> b
$
      IO
  (Either
     ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
-> RIO e (Proposal era, Maybe (ProposalScriptWitness era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli
        (IO
   (Either
      ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
 -> RIO e (Proposal era, Maybe (ProposalScriptWitness era)))
-> ((ProposalFile 'In, Maybe CliProposalScriptRequirements)
    -> IO
         (Either
            ProposalError (Proposal era, Maybe (ProposalScriptWitness era))))
-> (ProposalFile 'In, Maybe CliProposalScriptRequirements)
-> RIO e (Proposal era, Maybe (ProposalScriptWitness era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayEraOnwards era
-> (ProposalFile 'In, Maybe CliProposalScriptRequirements)
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
forall era.
ConwayEraOnwards era
-> (ProposalFile 'In, Maybe CliProposalScriptRequirements)
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
readProposal ConwayEraOnwards era
cEraOnwards
  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
$
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => AnyProtocolUpdate era)
-> AnyProtocolUpdate era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
cEraOnwards ((ConwayEraOnwardsConstraints era => AnyProtocolUpdate era)
 -> AnyProtocolUpdate era)
-> (ConwayEraOnwardsConstraints era => AnyProtocolUpdate era)
-> AnyProtocolUpdate era
forall a b. (a -> b) -> a -> b
$
      ConwayEraOnwards era
-> TxProposalProcedures BuildTx era -> AnyProtocolUpdate era
forall era.
ConwayEraOnwards era
-> TxProposalProcedures BuildTx era -> AnyProtocolUpdate era
ProposalProcedures ConwayEraOnwards era
cEraOnwards (TxProposalProcedures BuildTx era -> AnyProtocolUpdate era)
-> TxProposalProcedures BuildTx era -> AnyProtocolUpdate era
forall a b. (a -> b) -> a -> b
$
        [(ProposalProcedure (ShelleyLedgerEra era),
  Maybe (ScriptWitness WitCtxStake era))]
-> TxProposalProcedures BuildTx era
forall era build.
(Applicative (BuildTxWith build), IsShelleyBasedEra era) =>
[(ProposalProcedure (ShelleyLedgerEra era),
  Maybe (ScriptWitness WitCtxStake era))]
-> TxProposalProcedures build era
mkTxProposalProcedures
          [(ProposalProcedure (ShelleyLedgerEra era)
govProp, ProposalScriptWitness era -> ScriptWitness WitCtxStake era
forall era.
ProposalScriptWitness era -> ScriptWitness WitCtxStake era
pswScriptWitness (ProposalScriptWitness era -> ScriptWitness WitCtxStake era)
-> Maybe (ProposalScriptWitness era)
-> Maybe (ScriptWitness WitCtxStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ProposalScriptWitness era)
mScriptWit) | (Proposal ProposalProcedure (ShelleyLedgerEra era)
govProp, Maybe (ProposalScriptWitness era)
mScriptWit) <- [(Proposal era, Maybe (ProposalScriptWitness era))]
props]