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

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
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.Certificate.Type
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.Run
import Cardano.CLI.Read
import Cardano.CLI.Type.Common

import Control.Monad
import Data.ByteString.Short qualified as SBS
import Data.Map.Ordered.Strict qualified as OMap
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
      [TxOutAnyEra]
outs
      Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))
mUpdateProposal
      Maybe
  (Featured
     ConwayEraOnwards
     era
     [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))])
mProposalProcedure
      [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
mVotes
      [WitnessSigningData]
witnesses
      Maybe NetworkId
mNetworkId
      Coin
fee
      [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
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 <- (TxOutAnyEra -> RIO e (TxOut CtxTx era))
-> [TxOutAnyEra] -> RIO e [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 -> CIO e (TxOut CtxTx era)
forall era e.
ShelleyBasedEra era -> TxOutAnyEra -> CIO e (TxOut CtxTx era)
toTxOutInAnyEra ShelleyBasedEra era
sbe) [TxOutAnyEra]
outs

    [(CertificateFile, AnyWitness (ShelleyLedgerEra era))]
certFilesAndMaybeScriptWits <-
      ShelleyBasedEra era
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (ShelleyLedgerEra era))]
forall era e.
ShelleyBasedEra era
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (ShelleyLedgerEra era))]
readCertificateScriptWitnesses' ShelleyBasedEra era
sbe [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
certificates

    [(Certificate (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
certsAndMaybeScriptWits <-
      IO
  [(Certificate (ShelleyLedgerEra era),
    AnyWitness (ShelleyLedgerEra era))]
-> RIO
     e
     [(Certificate (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era))]
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   [(Certificate (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
 -> RIO
      e
      [(Certificate (ShelleyLedgerEra era),
        AnyWitness (ShelleyLedgerEra era))])
-> IO
     [(Certificate (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era))]
-> RIO
     e
     [(Certificate (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era))]
forall a b. (a -> b) -> a -> b
$
        [IO
   (Certificate (ShelleyLedgerEra era),
    AnyWitness (ShelleyLedgerEra era))]
-> IO
     [(Certificate (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra 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 (ShelleyLedgerEra era)
 -> (Certificate (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era)))
-> IO (Certificate (ShelleyLedgerEra era))
-> IO
     (Certificate (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,AnyWitness (ShelleyLedgerEra era)
mSwit) (IO (Certificate (ShelleyLedgerEra era))
 -> IO
      (Certificate (ShelleyLedgerEra era),
       AnyWitness (ShelleyLedgerEra era)))
-> IO (Certificate (ShelleyLedgerEra era))
-> IO
     (Certificate (ShelleyLedgerEra era),
      AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
              IO
  (Either
     (FileError TextEnvelopeError) (Certificate (ShelleyLedgerEra era)))
-> IO (Certificate (ShelleyLedgerEra 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 (ShelleyLedgerEra era)))
 -> IO (Certificate (ShelleyLedgerEra era)))
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (ShelleyLedgerEra era)))
-> IO (Certificate (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
                File Any 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (ShelleyLedgerEra era)))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (File Any 'In
 -> IO
      (Either
         (FileError TextEnvelopeError)
         (Certificate (ShelleyLedgerEra era))))
-> File Any 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (Certificate (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$
                  FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
certFile
          | (CertificateFile FilePath
certFile, AnyWitness (ShelleyLedgerEra era)
mSwit) <- [(CertificateFile, AnyWitness (ShelleyLedgerEra 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 (ScriptRequirements 'ProposalItem))])
mProposalProcedure of
              Maybe
  (Featured
     ConwayEraOnwards
     era
     [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))])
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 (ScriptRequirements 'ProposalItem))]
prop -> do
                AnyProtocolUpdate era
pparamUpdate <- Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e (AnyProtocolUpdate era)
forall e era.
Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> CIO e (AnyProtocolUpdate era)
readProposalProcedureFile Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
prop
                [(VotingProcedures era, AnyWitness (LedgerEra era))]
votesAndWits :: [(OldApi.VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] <-
                  Era era
-> (EraCommonConstraints era =>
    RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
w) ((EraCommonConstraints era =>
  RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
 -> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> (EraCommonConstraints era =>
    RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))])
-> RIO e [(VotingProcedures era, AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$ [(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))]
readVotingProceduresFiles [(VoteFile 'In, Maybe (ScriptRequirements 'VoterItem))]
mVotes
                TxVotingProcedures (LedgerEra era)
votingProcedures :: (Exp.TxVotingProcedures (Exp.LedgerEra era)) <-
                  Era era
-> (EraCommonConstraints era =>
    RIO e (TxVotingProcedures (LedgerEra era)))
-> RIO e (TxVotingProcedures (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
w) ((EraCommonConstraints era =>
  RIO e (TxVotingProcedures (LedgerEra era)))
 -> RIO e (TxVotingProcedures (LedgerEra era)))
-> (EraCommonConstraints era =>
    RIO e (TxVotingProcedures (LedgerEra era)))
-> RIO e (TxVotingProcedures (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                    Either
  (VotesMergingConflict (LedgerEra era))
  (TxVotingProcedures (LedgerEra era))
-> RIO e (TxVotingProcedures (LedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli
                      ( [(VotingProcedures (LedgerEra era), AnyWitness (LedgerEra era))]
-> Either
     (VotesMergingConflict (LedgerEra era))
     (TxVotingProcedures (LedgerEra era))
forall era.
[(VotingProcedures era, AnyWitness era)]
-> Either (VotesMergingConflict era) (TxVotingProcedures era)
Exp.mkTxVotingProcedures
                          [ (Era era
-> (EraCommonConstraints era => VotingProcedures (LedgerEra era))
-> VotingProcedures (LedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
w) ((EraCommonConstraints era => VotingProcedures (LedgerEra era))
 -> VotingProcedures (LedgerEra era))
-> (EraCommonConstraints era => VotingProcedures (LedgerEra era))
-> VotingProcedures (LedgerEra era)
forall a b. (a -> b) -> a -> b
$ VotingProcedures era -> VotingProcedures (ShelleyLedgerEra era)
forall era.
VotingProcedures era -> VotingProcedures (ShelleyLedgerEra era)
OldApi.unVotingProcedures VotingProcedures era
vp, AnyWitness (LedgerEra era)
anyW)
                          | (VotingProcedures era
vp, AnyWitness (LedgerEra era)
anyW) <- [(VotingProcedures era, AnyWitness (LedgerEra 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 (ShelleyLedgerEra era) -> AnyVote era
forall era.
ConwayEraOnwards era
-> TxVotingProcedures (ShelleyLedgerEra era) -> AnyVote era
VotingProcedures ConwayEraOnwards era
w (TxVotingProcedures (ShelleyLedgerEra era) -> AnyVote era)
-> TxVotingProcedures (ShelleyLedgerEra era) -> AnyVote era
forall a b. (a -> b) -> a -> b
$ Era era
-> (EraCommonConstraints era =>
    TxVotingProcedures (ShelleyLedgerEra era))
-> TxVotingProcedures (ShelleyLedgerEra era)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
w) TxVotingProcedures (ShelleyLedgerEra era)
TxVotingProcedures (LedgerEra era)
EraCommonConstraints era =>
TxVotingProcedures (ShelleyLedgerEra era)
votingProcedures)
        )
        ShelleyBasedEra era
sbe

    let txCerts :: TxCertificates (ShelleyLedgerEra era)
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

    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 (ShelleyLedgerEra era)
-> Either ProtocolParametersConversionError (Tx era)
forall era.
ShelleyBasedEra era
-> [TxIn]
-> [TxOut CtxTx era]
-> Coin
-> AnyProtocolUpdate era
-> AnyVote era
-> TxCertificates (ShelleyLedgerEra era)
-> Either ProtocolParametersConversionError (Tx era)
createCompatibleTx ShelleyBasedEra era
sbe [TxIn]
ins [TxOut CtxTx era]
allOuts Coin
fee AnyProtocolUpdate era
protocolUpdates AnyVote era
votes TxCertificates (ShelleyLedgerEra 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 ()) ())
writeTxFileTextEnvelope ShelleyBasedEra era
sbe File () 'Out
outputFp Tx era
signedTx

readCertificateScriptWitnesses'
  :: ShelleyBasedEra era
  -> [(CertificateFile, Maybe (ScriptRequirements Exp.CertItem))]
  -> CIO e [(CertificateFile, Exp.AnyWitness (ShelleyLedgerEra era))]
readCertificateScriptWitnesses' :: forall era e.
ShelleyBasedEra era
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> CIO e [(CertificateFile, AnyWitness (ShelleyLedgerEra era))]
readCertificateScriptWitnesses' ShelleyBasedEra era
sbe =
  ((CertificateFile, Maybe (ScriptRequirements 'CertItem))
 -> RIO e (CertificateFile, AnyWitness (ShelleyLedgerEra era)))
-> [(CertificateFile, Maybe (ScriptRequirements 'CertItem))]
-> 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 (ScriptRequirements 'CertItem)
mSWit) -> do
        case Maybe (ScriptRequirements 'CertItem)
mSWit of
          Maybe (ScriptRequirements 'CertItem)
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 ScriptRequirements 'CertItem
cert -> do
            AnyWitness (ShelleyLedgerEra era)
sWit <- ShelleyBasedEra era
-> ScriptRequirements 'CertItem
-> CIO e (AnyWitness (ShelleyLedgerEra era))
forall era e.
ShelleyBasedEra era
-> ScriptRequirements 'CertItem
-> CIO e (AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitnessSbe ShelleyBasedEra era
sbe ScriptRequirements 'CertItem
cert
            (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)
sWit)
    )

readCertificateScriptWitnessSbe
  :: forall era e
   . ShelleyBasedEra era
  -> ScriptRequirements Exp.CertItem
  -> CIO e (Exp.AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitnessSbe :: forall era e.
ShelleyBasedEra era
-> ScriptRequirements 'CertItem
-> CIO e (AnyWitness (ShelleyLedgerEra era))
readCertificateScriptWitnessSbe ShelleyBasedEra era
sbe (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
  Script SimpleScript'
ss <- FilePath -> CIO e (Script SimpleScript')
forall e. FilePath -> CIO e (Script SimpleScript')
Compatible.readFileSimpleScript FilePath
sFp
  let serialisedSS :: ByteString
serialisedSS = Script SimpleScript' -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Script SimpleScript'
ss
  let Either DecoderError (SimpleScript (ShelleyLedgerEra era))
simpleScriptE :: Either DecoderError (Exp.SimpleScript (ShelleyLedgerEra era)) = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either DecoderError (SimpleScript (ShelleyLedgerEra era)))
-> Either DecoderError (SimpleScript (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either DecoderError (SimpleScript (ShelleyLedgerEra era)))
 -> Either DecoderError (SimpleScript (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    Either DecoderError (SimpleScript (ShelleyLedgerEra era)))
-> Either DecoderError (SimpleScript (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ByteString
-> Either DecoderError (SimpleScript (ShelleyLedgerEra era))
forall era.
EraScript era =>
ByteString -> Either DecoderError (SimpleScript era)
Exp.deserialiseSimpleScript ByteString
serialisedSS
  SimpleScript (ShelleyLedgerEra era)
simpleScript <- Either DecoderError (SimpleScript (ShelleyLedgerEra era))
-> RIO e (SimpleScript (ShelleyLedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli Either DecoderError (SimpleScript (ShelleyLedgerEra era))
simpleScriptE
  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)))
-> AnyWitness (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
Exp.AnySimpleScriptWitness (SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
 -> AnyWitness (ShelleyLedgerEra era))
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ SimpleScript (ShelleyLedgerEra era)
-> SimpleScriptOrReferenceInput (ShelleyLedgerEra era)
forall era. SimpleScript era -> SimpleScriptOrReferenceInput era
Exp.SScript SimpleScript (ShelleyLedgerEra era)
simpleScript
readCertificateScriptWitnessSbe
  ShelleyBasedEra era
sbe
  ( OnDiskPlutusScript
      (OnDiskPlutusScriptCliArgs File ScriptInAnyLang 'In
scriptFp NoScriptDatum
OptionalDatum 'CertItem
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
    Compatible.AnyPlutusScript PlutusScriptVersion lang
plutusScriptVer (PlutusScriptSerialised ShortByteString
sBytes) <-
      FilePath -> CIO e AnyPlutusScript
forall e. FilePath -> CIO e AnyPlutusScript
Compatible.readFilePlutusScript FilePath
plutusScriptFp
    let AnyPlutusScriptLanguage
anyLang :: Exp.AnyPlutusScriptLanguage = case PlutusScriptVersion lang
plutusScriptVer of
          PlutusScriptVersion lang
PlutusScriptV1 -> SLanguage 'PlutusV1 -> AnyPlutusScriptLanguage
forall (lang :: Language).
PlutusLanguage lang =>
SLanguage lang -> AnyPlutusScriptLanguage
Exp.AnyPlutusScriptLanguage SLanguage 'PlutusV1
L.SPlutusV1
          PlutusScriptVersion lang
PlutusScriptV2 -> SLanguage 'PlutusV2 -> AnyPlutusScriptLanguage
forall (lang :: Language).
PlutusLanguage lang =>
SLanguage lang -> AnyPlutusScriptLanguage
Exp.AnyPlutusScriptLanguage SLanguage 'PlutusV2
L.SPlutusV2
          PlutusScriptVersion lang
PlutusScriptV3 -> SLanguage 'PlutusV3 -> AnyPlutusScriptLanguage
forall (lang :: Language).
PlutusLanguage lang =>
SLanguage lang -> AnyPlutusScriptLanguage
Exp.AnyPlutusScriptLanguage SLanguage 'PlutusV3
L.SPlutusV3
          PlutusScriptVersion lang
PlutusScriptV4 -> SLanguage 'PlutusV4 -> AnyPlutusScriptLanguage
forall (lang :: Language).
PlutusLanguage lang =>
SLanguage lang -> AnyPlutusScriptLanguage
Exp.AnyPlutusScriptLanguage SLanguage 'PlutusV4
L.SPlutusV4
        bs :: ByteString
bs = ShortByteString -> ByteString
SBS.fromShort ShortByteString
sBytes

        Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era))
eAnyPlutusScript :: Either DecoderError (Exp.AnyPlutusScript (ShelleyLedgerEra era)) = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era)))
-> Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era)))
 -> Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
    Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era)))
-> Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ByteString
-> AnyPlutusScriptLanguage
-> Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era))
forall era.
Era era =>
ByteString
-> AnyPlutusScriptLanguage
-> Either DecoderError (AnyPlutusScript era)
Exp.decodeAnyPlutusScript ByteString
bs AnyPlutusScriptLanguage
anyLang
    Exp.AnyPlutusScript PlutusScriptInEra lang (ShelleyLedgerEra era)
anyPlutusScript <- Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era))
-> RIO e (AnyPlutusScript (ShelleyLedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli Either DecoderError (AnyPlutusScript (ShelleyLedgerEra era))
eAnyPlutusScript
    let
      lang :: SLanguage lang
lang = PlutusScriptInEra lang (ShelleyLedgerEra era) -> SLanguage lang
forall (lang :: Language) era.
PlutusLanguage lang =>
PlutusScriptInEra lang era -> SLanguage lang
Exp.plutusScriptInEraSLanguage PlutusScriptInEra lang (ShelleyLedgerEra era)
anyPlutusScript
    let script' :: PlutusScriptOrReferenceInput lang (ShelleyLedgerEra era)
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

    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 sw :: PlutusScriptWitness lang 'CertifyingScript (ShelleyLedgerEra era)
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.PlutusScriptWitness
            SLanguage lang
lang
            PlutusScriptOrReferenceInput lang (ShelleyLedgerEra era)
script'
            PlutusScriptDatum lang 'CertifyingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
            HashableScriptData
redeemer
            ExecutionUnits
execUnits
    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)))
-> AnyWitness (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
      AnyPlutusScriptWitness
  lang 'CertifyingScript (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness
   lang 'CertifyingScript (ShelleyLedgerEra era)
 -> AnyWitness (ShelleyLedgerEra era))
-> AnyPlutusScriptWitness
     lang 'CertifyingScript (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
        PlutusScriptWitness lang 'CertifyingScript (ShelleyLedgerEra era)
-> AnyPlutusScriptWitness
     lang 'CertifyingScript (ShelleyLedgerEra era)
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'CertifyingScript era
-> AnyPlutusScriptWitness lang 'CertifyingScript era
Exp.AnyPlutusCertifyingScriptWitness PlutusScriptWitness lang 'CertifyingScript (ShelleyLedgerEra era)
sw
readCertificateScriptWitnessSbe
  ShelleyBasedEra era
_
  ( PlutusReferenceScript
      ( PlutusRefScriptCliArgs
          TxIn
refInput
          (AnySLanguage SLanguage lang
lang)
          NoScriptDatum
OptionalDatum 'CertItem
Exp.NoScriptDatumAllowed
          NoPolicyId
MintPolicyId 'CertItem
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
    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)))
-> AnyWitness (ShelleyLedgerEra era)
-> RIO e (AnyWitness (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
      AnyPlutusScriptWitness
  lang 'CertifyingScript (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
Exp.AnyPlutusScriptWitness (AnyPlutusScriptWitness
   lang 'CertifyingScript (ShelleyLedgerEra era)
 -> AnyWitness (ShelleyLedgerEra era))
-> AnyPlutusScriptWitness
     lang 'CertifyingScript (ShelleyLedgerEra era)
-> AnyWitness (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
        PlutusScriptWitness lang 'CertifyingScript (ShelleyLedgerEra era)
-> AnyPlutusScriptWitness
     lang 'CertifyingScript (ShelleyLedgerEra era)
forall (lang :: Language) era.
Typeable lang =>
PlutusScriptWitness lang 'CertifyingScript era
-> AnyPlutusScriptWitness lang 'CertifyingScript era
Exp.AnyPlutusCertifyingScriptWitness (PlutusScriptWitness lang 'CertifyingScript (ShelleyLedgerEra era)
 -> AnyPlutusScriptWitness
      lang 'CertifyingScript (ShelleyLedgerEra era))
-> PlutusScriptWitness
     lang 'CertifyingScript (ShelleyLedgerEra era)
-> AnyPlutusScriptWitness
     lang 'CertifyingScript (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
          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.PlutusScriptWitness
            SLanguage lang
lang
            (TxIn -> PlutusScriptOrReferenceInput lang (ShelleyLedgerEra era)
forall (lang :: Language) era.
TxIn -> PlutusScriptOrReferenceInput lang era
Exp.PReferenceScript TxIn
refInput)
            PlutusScriptDatum lang 'CertifyingScript
forall (lang :: Language) (purpose :: PlutusScriptPurpose).
PlutusScriptDatum lang purpose
Exp.NoScriptDatum
            HashableScriptData
redeemer
            ExecutionUnits
execUnits
readCertificateScriptWitnessSbe ShelleyBasedEra era
_ (SimpleReferenceScript (SimpleRefScriptArgs TxIn
refTxin NoPolicyId
MintPolicyId 'CertItem
NoPolicyId)) =
  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

-- | Create 'TxCertificates'. Note that 'Certificate era' will be deduplicated. Only Certificates with a
-- stake credential will be in the result.
--
-- 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 (StakeCredential, AnyWitness (ShelleyLedgerEra era)))
-> TxCertificates (ShelleyLedgerEra era)
forall era.
OMap (Certificate era) (Maybe (StakeCredential, AnyWitness era))
-> TxCertificates era
Exp.TxCertificates (OMap
   (Certificate (ShelleyLedgerEra era))
   (Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))
 -> TxCertificates (ShelleyLedgerEra era))
-> ([(Certificate (ShelleyLedgerEra era),
      Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))]
    -> OMap
         (Certificate (ShelleyLedgerEra era))
         (Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era))))
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))]
-> TxCertificates (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Certificate (ShelleyLedgerEra era),
  Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))]
-> OMap
     (Certificate (ShelleyLedgerEra era))
     (Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList ([(Certificate (ShelleyLedgerEra era),
   Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))]
 -> TxCertificates (ShelleyLedgerEra era))
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))]
-> TxCertificates (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ((Certificate (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))
 -> (Certificate (ShelleyLedgerEra era),
     Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era))))
-> [(Certificate (ShelleyLedgerEra era),
     AnyWitness (ShelleyLedgerEra era))]
-> [(Certificate (ShelleyLedgerEra era),
     Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))]
forall a b. (a -> b) -> [a] -> [b]
map (Certificate (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> (Certificate (ShelleyLedgerEra era),
    Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))
getStakeCred [(Certificate (ShelleyLedgerEra era),
  AnyWitness (ShelleyLedgerEra era))]
certs
 where
  getStakeCred
    :: (Exp.Certificate (ShelleyLedgerEra era), Exp.AnyWitness (ShelleyLedgerEra era))
    -> ( Exp.Certificate (ShelleyLedgerEra era)
       , Maybe (StakeCredential, Exp.AnyWitness (ShelleyLedgerEra era))
       )
  getStakeCred :: (Certificate (ShelleyLedgerEra era),
 AnyWitness (ShelleyLedgerEra era))
-> (Certificate (ShelleyLedgerEra era),
    Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era)))
getStakeCred (c :: Certificate (ShelleyLedgerEra era)
c@(Exp.Certificate TxCert (ShelleyLedgerEra era)
cert), AnyWitness (ShelleyLedgerEra era)
wit) =
    (Certificate (ShelleyLedgerEra era)
c, (,AnyWitness (ShelleyLedgerEra era)
wit) (StakeCredential
 -> (StakeCredential, AnyWitness (ShelleyLedgerEra era)))
-> Maybe StakeCredential
-> Maybe (StakeCredential, AnyWitness (ShelleyLedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
  :: 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
  :: forall e era
   . Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptRequirements Exp.ProposalItem))]
  -> CIO e (AnyProtocolUpdate era)
readProposalProcedureFile :: forall e era.
Featured
  ConwayEraOnwards
  era
  [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
-> 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 (ScriptRequirements 'ProposalItem))]
proposals) = do
  let era :: Era era
era = ConwayEraOnwards era -> Era era
forall era. ConwayEraOnwards era -> Era era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
cEraOnwards
  [(Proposal era, AnyWitness (LedgerEra era))]
props :: [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] <-
    Era era
-> (EraCommonConstraints era =>
    RIO e [(Proposal era, AnyWitness (LedgerEra era))])
-> RIO e [(Proposal era, AnyWitness (LedgerEra era))]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  RIO e [(Proposal era, AnyWitness (LedgerEra era))])
 -> RIO e [(Proposal era, AnyWitness (LedgerEra era))])
-> (EraCommonConstraints era =>
    RIO e [(Proposal era, AnyWitness (LedgerEra era))])
-> RIO e [(Proposal era, AnyWitness (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$ ((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 [(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))]
proposals

  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
$
    Era era
-> (EraCommonConstraints era => AnyProtocolUpdate era)
-> AnyProtocolUpdate era
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => AnyProtocolUpdate era)
 -> AnyProtocolUpdate era)
-> (EraCommonConstraints era => AnyProtocolUpdate era)
-> AnyProtocolUpdate era
forall a b. (a -> b) -> a -> b
$
      ConwayEraOnwards era
-> TxProposalProcedures (ShelleyLedgerEra era)
-> AnyProtocolUpdate era
forall era.
ConwayEraOnwards era
-> TxProposalProcedures (ShelleyLedgerEra era)
-> AnyProtocolUpdate era
ProposalProcedures ConwayEraOnwards era
cEraOnwards (TxProposalProcedures (ShelleyLedgerEra era)
 -> AnyProtocolUpdate era)
-> TxProposalProcedures (ShelleyLedgerEra era)
-> AnyProtocolUpdate era
forall a b. (a -> b) -> a -> b
$
        [(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))]
-> TxProposalProcedures (LedgerEra era)
forall era.
IsEra era =>
[(ProposalProcedure (LedgerEra era), AnyWitness (LedgerEra era))]
-> TxProposalProcedures (LedgerEra era)
Exp.mkTxProposalProcedures
          [(ProposalProcedure (ShelleyLedgerEra era)
ProposalProcedure (LedgerEra era)
govProp, AnyWitness (LedgerEra era)
swit) | (Proposal ProposalProcedure (ShelleyLedgerEra era)
govProp, AnyWitness (LedgerEra era)
swit) <- [(Proposal era, AnyWitness (LedgerEra era))]
props]