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

-- | This module provides a way to construct a simple transaction over all eras.
-- It is exposed for testing purposes only.
module Cardano.Api.Tx.Compatible
  ( AnyProtocolUpdate (..)
  , AnyVote (..)
  , createCompatibleSignedTx
  )
where

import           Cardano.Api.Address (StakeCredential)
import           Cardano.Api.Certificate (Certificate)
import           Cardano.Api.Eon.AllegraEraOnwards
import           Cardano.Api.Eon.AlonzoEraOnwards
import           Cardano.Api.Eon.BabbageEraOnwards
import           Cardano.Api.Eon.ConwayEraOnwards
import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eon.ShelleyToBabbageEra
import           Cardano.Api.Eras
import           Cardano.Api.ProtocolParameters
import           Cardano.Api.Script
import           Cardano.Api.Tx.Body
import           Cardano.Api.Tx.Sign
import           Cardano.Api.Value

import qualified Cardano.Ledger.Api as L

import qualified Data.Map.Strict as Map
import           Data.Maybe
import           Data.Maybe.Strict
import           Data.Monoid
import qualified Data.Sequence.Strict as Seq
import           GHC.Exts (IsList (..))
import           Lens.Micro hiding (ix)

data AnyProtocolUpdate era where
  ProtocolUpdate
    :: ShelleyToBabbageEra era
    -> UpdateProposal
    -> AnyProtocolUpdate era
  ProposalProcedures
    :: ConwayEraOnwards era
    -> TxProposalProcedures BuildTx era
    -> AnyProtocolUpdate era
  NoPParamsUpdate
    :: ShelleyBasedEra era
    -> AnyProtocolUpdate era

data AnyVote era where
  VotingProcedures
    :: ConwayEraOnwards era
    -> TxVotingProcedures BuildTx era
    -> AnyVote era
  NoVotes :: AnyVote era

createCompatibleSignedTx
  :: forall era
   . ShelleyBasedEra era
  -> [TxIn]
  -> [TxOut CtxTx era]
  -> [KeyWitness era]
  -> Lovelace
  -- ^ Fee
  -> AnyProtocolUpdate era
  -> AnyVote era
  -> TxCertificates BuildTx era
  -> Either ProtocolParametersConversionError (Tx era)
createCompatibleSignedTx :: forall era.
ShelleyBasedEra era
-> [TxIn]
-> [TxOut CtxTx era]
-> [KeyWitness era]
-> Lovelace
-> AnyProtocolUpdate era
-> AnyVote era
-> TxCertificates BuildTx era
-> Either ProtocolParametersConversionError (Tx era)
createCompatibleSignedTx ShelleyBasedEra era
sbe [TxIn]
ins [TxOut CtxTx era]
outs [KeyWitness era]
witnesses Lovelace
txFee' AnyProtocolUpdate era
anyProtocolUpdate AnyVote era
anyVote TxCertificates BuildTx era
txCertificates' =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either ProtocolParametersConversionError (Tx era))
-> Either ProtocolParametersConversionError (Tx era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either ProtocolParametersConversionError (Tx era))
 -> Either ProtocolParametersConversionError (Tx era))
-> (ShelleyBasedEraConstraints era =>
    Either ProtocolParametersConversionError (Tx era))
-> Either ProtocolParametersConversionError (Tx era)
forall a b. (a -> b) -> a -> b
$ do
    (Endo (TxBody (ShelleyLedgerEra era))
updateTxBody, [(ScriptWitnessIndex, AnyScriptWitness era)]
extraScriptWitnesses) <-
      case AnyProtocolUpdate era
anyProtocolUpdate of
        ProtocolUpdate ShelleyToBabbageEra era
shelleyToBabbageEra UpdateProposal
updateProposal -> do
          Update (ShelleyLedgerEra era)
ledgerPParamsUpdate <- ShelleyBasedEra era
-> UpdateProposal
-> Either
     ProtocolParametersConversionError (Update (ShelleyLedgerEra era))
forall era.
ShelleyBasedEra era
-> UpdateProposal
-> Either
     ProtocolParametersConversionError (Update (ShelleyLedgerEra era))
toLedgerUpdate ShelleyBasedEra era
sbe UpdateProposal
updateProposal
          let Endo (TxBody (ShelleyLedgerEra era))
updateTxBody :: Endo (L.TxBody (ShelleyLedgerEra era)) =
                ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era =>
    Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall era a.
ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era => a) -> a
shelleyToBabbageEraConstraints ShelleyToBabbageEra era
shelleyToBabbageEra ((ShelleyToBabbageEraConstraints era =>
  Endo (TxBody (ShelleyLedgerEra era)))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (ShelleyToBabbageEraConstraints era =>
    Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
                  (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ \TxBody (ShelleyLedgerEra era)
txb ->
                    TxBody (ShelleyLedgerEra era)
txb TxBody (ShelleyLedgerEra era)
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Update (ShelleyLedgerEra era))
 -> Identity (StrictMaybe (Update (ShelleyLedgerEra era))))
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (StrictMaybe (Update (ShelleyLedgerEra era)))
L.updateTxBodyL ((StrictMaybe (Update (ShelleyLedgerEra era))
  -> Identity (StrictMaybe (Update (ShelleyLedgerEra era))))
 -> TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> StrictMaybe (Update (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Update (ShelleyLedgerEra era)
-> StrictMaybe (Update (ShelleyLedgerEra era))
forall a. a -> StrictMaybe a
SJust Update (ShelleyLedgerEra era)
ledgerPParamsUpdate

          (Endo (TxBody (ShelleyLedgerEra era)),
 [(ScriptWitnessIndex, AnyScriptWitness era)])
-> Either
     ProtocolParametersConversionError
     (Endo (TxBody (ShelleyLedgerEra era)),
      [(ScriptWitnessIndex, AnyScriptWitness era)])
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Endo (TxBody (ShelleyLedgerEra era))
updateTxBody, [])
        NoPParamsUpdate ShelleyBasedEra era
_ -> do
          (Endo (TxBody (ShelleyLedgerEra era)),
 [(ScriptWitnessIndex, AnyScriptWitness era)])
-> Either
     ProtocolParametersConversionError
     (Endo (TxBody (ShelleyLedgerEra era)),
      [(ScriptWitnessIndex, AnyScriptWitness era)])
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Endo (TxBody (ShelleyLedgerEra era))
forall a. Monoid a => a
mempty, [])
        ProposalProcedures ConwayEraOnwards era
conwayOnwards TxProposalProcedures BuildTx era
proposalProcedures -> do
          let proposals :: OSet (ProposalProcedure (ShelleyLedgerEra era))
proposals = TxProposalProcedures BuildTx era
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
forall build era.
TxProposalProcedures build era
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
convProposalProcedures TxProposalProcedures BuildTx era
proposalProcedures
              proposalWitnesses :: [(ScriptWitnessIndex, AnyScriptWitness era)]
proposalWitnesses =
                [ (ScriptWitnessIndex
ix, ScriptWitness WitCtxStake era -> AnyScriptWitness era
forall witctx era.
Typeable witctx =>
ScriptWitness witctx era -> AnyScriptWitness era
AnyScriptWitness ScriptWitness WitCtxStake era
witness)
                | (ScriptWitnessIndex
ix, ProposalProcedure (ShelleyLedgerEra era)
_, ScriptWitness WitCtxStake era
witness) <- TxProposalProcedures BuildTx era
-> [(ScriptWitnessIndex, ProposalProcedure (ShelleyLedgerEra era),
     ScriptWitness WitCtxStake era)]
forall era.
TxProposalProcedures BuildTx era
-> [(ScriptWitnessIndex, ProposalProcedure (ShelleyLedgerEra era),
     ScriptWitness WitCtxStake era)]
indexTxProposalProcedures TxProposalProcedures BuildTx era
proposalProcedures
                ]
              referenceInputs :: [TxIn StandardCrypto]
referenceInputs =
                [ TxIn -> TxIn StandardCrypto
toShelleyTxIn TxIn
txIn
                | (ScriptWitnessIndex
_, AnyScriptWitness ScriptWitness witctx era
sWit) <- [(ScriptWitnessIndex, AnyScriptWitness era)]
proposalWitnesses
                , TxIn
txIn <- Maybe TxIn -> [TxIn]
forall a. Maybe a -> [a]
maybeToList (Maybe TxIn -> [TxIn]) -> Maybe TxIn -> [TxIn]
forall a b. (a -> b) -> a -> b
$ ScriptWitness witctx era -> Maybe TxIn
forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getScriptWitnessReferenceInput ScriptWitness witctx era
sWit
                ]
              -- append proposal reference inputs & set proposal procedures
              Endo (TxBody (ShelleyLedgerEra era))
updateTxBody :: Endo (L.TxBody (ShelleyLedgerEra era)) =
                ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
conwayOnwards ((ConwayEraOnwardsConstraints era =>
  Endo (TxBody (ShelleyLedgerEra era)))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (ConwayEraOnwardsConstraints era =>
    Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
                  (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
                    ((Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
 -> Identity (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
L.referenceInputsTxBodyL ((Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
  -> Identity (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
 -> TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
    -> Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
forall a. Semigroup a => a -> a -> a
<> [Item (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))]
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
forall l. IsList l => [Item l] -> l
fromList [Item (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))]
[TxIn StandardCrypto]
referenceInputs))
                      (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((OSet (ProposalProcedure (ShelleyLedgerEra era))
 -> Identity (OSet (ProposalProcedure (ShelleyLedgerEra era))))
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (OSet (ProposalProcedure (ShelleyLedgerEra era)))
L.proposalProceduresTxBodyL ((OSet (ProposalProcedure (ShelleyLedgerEra era))
  -> Identity (OSet (ProposalProcedure (ShelleyLedgerEra era))))
 -> TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> OSet (ProposalProcedure (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OSet (ProposalProcedure (ShelleyLedgerEra era))
proposals)

          (Endo (TxBody (ShelleyLedgerEra era)),
 [(ScriptWitnessIndex, AnyScriptWitness era)])
-> Either
     ProtocolParametersConversionError
     (Endo (TxBody (ShelleyLedgerEra era)),
      [(ScriptWitnessIndex, AnyScriptWitness era)])
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Endo (TxBody (ShelleyLedgerEra era))
updateTxBody, [(ScriptWitnessIndex, AnyScriptWitness era)]
proposalWitnesses)

    let txbody :: TxBody (ShelleyLedgerEra era)
txbody =
          ShelleyBasedEra era
-> [TxIn]
-> [TxOut CtxTx era]
-> Lovelace
-> TxBody (ShelleyLedgerEra era)
forall era ctx.
ShelleyBasedEra era
-> [TxIn]
-> [TxOut ctx era]
-> Lovelace
-> TxBody (ShelleyLedgerEra era)
createCommonTxBody ShelleyBasedEra era
sbe [TxIn]
ins [TxOut CtxTx era]
outs Lovelace
txFee'
            TxBody (ShelleyLedgerEra era)
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& [Endo (TxBody (ShelleyLedgerEra era))]
-> TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era)
forall {a}. [Endo a] -> a -> a
appEndos [Endo (TxBody (ShelleyLedgerEra era))
setCerts, Endo (TxBody (ShelleyLedgerEra era))
setRefInputs, Endo (TxBody (ShelleyLedgerEra era))
updateTxBody]

        updateVotingProcedures :: Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era)
updateVotingProcedures =
          case AnyVote era
anyVote of
            AnyVote era
NoVotes -> Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era)
forall a. a -> a
id
            VotingProcedures ConwayEraOnwards era
conwayOnwards TxVotingProcedures BuildTx era
procedures ->
              ConwayEraOnwards era
-> VotingProcedures (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
overwriteVotingProcedures ConwayEraOnwards era
conwayOnwards (TxVotingProcedures BuildTx era
-> VotingProcedures (ShelleyLedgerEra era)
forall build era.
TxVotingProcedures build era
-> VotingProcedures (ShelleyLedgerEra era)
convVotingProcedures TxVotingProcedures BuildTx era
procedures)

        apiScriptWitnesses :: [(ScriptWitnessIndex, AnyScriptWitness era)]
apiScriptWitnesses =
          [ (ScriptWitnessIndex
ix, ScriptWitness WitCtxStake era -> AnyScriptWitness era
forall witctx era.
Typeable witctx =>
ScriptWitness witctx era -> AnyScriptWitness era
AnyScriptWitness ScriptWitness WitCtxStake era
witness)
          | (ScriptWitnessIndex
ix, Certificate era
_, StakeCredential
_, ScriptWitness ScriptWitnessInCtx WitCtxStake
_ ScriptWitness WitCtxStake era
witness) <- [(ScriptWitnessIndex, Certificate era, StakeCredential,
  Witness WitCtxStake era)]
indexedTxCerts
          ]

    Tx era -> Either ProtocolParametersConversionError (Tx era)
forall a. a -> Either ProtocolParametersConversionError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Tx era -> Either ProtocolParametersConversionError (Tx era))
-> (Tx (ShelleyLedgerEra era) -> Tx era)
-> Tx (ShelleyLedgerEra era)
-> Either ProtocolParametersConversionError (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
sbe
      (Tx (ShelleyLedgerEra era)
 -> Either ProtocolParametersConversionError (Tx era))
-> Tx (ShelleyLedgerEra era)
-> Either ProtocolParametersConversionError (Tx era)
forall a b. (a -> b) -> a -> b
$ TxBody (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era)
forall era. EraTx era => TxBody era -> Tx era
L.mkBasicTx TxBody (ShelleyLedgerEra era)
txbody
        Tx (ShelleyLedgerEra era)
-> (Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era))
-> Tx (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Identity (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx (ShelleyLedgerEra era)) (TxWits (ShelleyLedgerEra era))
L.witsTxL
          ((TxWits (ShelleyLedgerEra era)
  -> Identity (TxWits (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Identity (Tx (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(ScriptWitnessIndex, AnyScriptWitness era)]
-> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
allWitnesses ([(ScriptWitnessIndex, AnyScriptWitness era)]
apiScriptWitnesses [(ScriptWitnessIndex, AnyScriptWitness era)]
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
forall a. Semigroup a => a -> a -> a
<> [(ScriptWitnessIndex, AnyScriptWitness era)]
extraScriptWitnesses) TxWits (ShelleyLedgerEra era)
(EraTxWits (ShelleyLedgerEra era),
 EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
TxWits (ShelleyLedgerEra era)
allShelleyToBabbageWitnesses
        Tx (ShelleyLedgerEra era)
-> (Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era))
-> Tx (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era)
updateVotingProcedures
 where
  era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
sbe
  appEndos :: [Endo a] -> a -> a
appEndos = Endo a -> a -> a
forall a. Endo a -> a -> a
appEndo (Endo a -> a -> a) -> ([Endo a] -> Endo a) -> [Endo a] -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Endo a] -> Endo a
forall a. Monoid a => [a] -> a
mconcat

  setCerts :: Endo (L.TxBody (ShelleyLedgerEra era))
  setCerts :: Endo (TxBody (ShelleyLedgerEra era))
setCerts =
    CardanoEra era
-> (AlonzoEraOnwards era -> Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon CardanoEra era
era ((AlonzoEraOnwards era -> Endo (TxBody (ShelleyLedgerEra era)))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (AlonzoEraOnwards era -> Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ \AlonzoEraOnwards era
aeo ->
      AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeo ((AlonzoEraOnwardsConstraints era =>
  Endo (TxBody (ShelleyLedgerEra era)))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (AlonzoEraOnwardsConstraints era =>
    Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
          (StrictSeq (TxCert (ShelleyLedgerEra era))
 -> Identity (StrictSeq (TxCert (ShelleyLedgerEra era))))
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (StrictSeq (TxCert (ShelleyLedgerEra era)))
L.certsTxBodyL ((StrictSeq (TxCert (ShelleyLedgerEra era))
  -> Identity (StrictSeq (TxCert (ShelleyLedgerEra era))))
 -> TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> StrictSeq (TxCert (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyBasedEra era
-> TxCertificates BuildTx era
-> StrictSeq (TxCert (ShelleyLedgerEra era))
forall era build.
ShelleyBasedEra era
-> TxCertificates build era
-> StrictSeq (TxCert (ShelleyLedgerEra era))
convCertificates ShelleyBasedEra era
sbe TxCertificates BuildTx era
txCertificates'

  setRefInputs :: Endo (L.TxBody (ShelleyLedgerEra era))
  setRefInputs :: Endo (TxBody (ShelleyLedgerEra era))
setRefInputs = do
    let refInputs :: [TxIn StandardCrypto]
refInputs =
          [ TxIn -> TxIn StandardCrypto
toShelleyTxIn TxIn
refInput
          | (ScriptWitnessIndex
_, Certificate era
_, StakeCredential
_, ScriptWitness ScriptWitnessInCtx WitCtxStake
_ ScriptWitness WitCtxStake era
wit) <- [(ScriptWitnessIndex, Certificate era, StakeCredential,
  Witness WitCtxStake era)]
indexedTxCerts
          , TxIn
refInput <- Maybe TxIn -> [TxIn]
forall a. Maybe a -> [a]
maybeToList (Maybe TxIn -> [TxIn]) -> Maybe TxIn -> [TxIn]
forall a b. (a -> b) -> a -> b
$ ScriptWitness WitCtxStake era -> Maybe TxIn
forall witctx era. ScriptWitness witctx era -> Maybe TxIn
getScriptWitnessReferenceInput ScriptWitness WitCtxStake era
wit
          ]

    CardanoEra era
-> (BabbageEraOnwards era -> Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon CardanoEra era
era ((BabbageEraOnwards era -> Endo (TxBody (ShelleyLedgerEra era)))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (BabbageEraOnwards era -> Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ \BabbageEraOnwards era
beo ->
      BabbageEraOnwards era
-> (BabbageEraOnwardsConstraints era =>
    Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall era a.
BabbageEraOnwards era
-> (BabbageEraOnwardsConstraints era => a) -> a
babbageEraOnwardsConstraints BabbageEraOnwards era
beo ((BabbageEraOnwardsConstraints era =>
  Endo (TxBody (ShelleyLedgerEra era)))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (BabbageEraOnwardsConstraints era =>
    Endo (TxBody (ShelleyLedgerEra era)))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
        (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
 -> Endo (TxBody (ShelleyLedgerEra era)))
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> Endo (TxBody (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
          (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
 -> Identity (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
L.referenceInputsTxBodyL ((Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
  -> Identity (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
 -> TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))]
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
forall l. IsList l => [Item l] -> l
fromList [Item (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))]
[TxIn StandardCrypto]
refInputs

  overwriteVotingProcedures
    :: ConwayEraOnwards era
    -> L.VotingProcedures (ShelleyLedgerEra era)
    -> L.Tx (ShelleyLedgerEra era)
    -> L.Tx (ShelleyLedgerEra era)
  overwriteVotingProcedures :: ConwayEraOnwards era
-> VotingProcedures (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
overwriteVotingProcedures ConwayEraOnwards era
conwayOnwards VotingProcedures (ShelleyLedgerEra era)
votingProcedures =
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era))
-> Tx (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
conwayOnwards ((ConwayEraOnwardsConstraints era =>
  Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era))
 -> Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era))
-> (ConwayEraOnwardsConstraints era =>
    Tx (ShelleyLedgerEra era) -> Tx (ShelleyLedgerEra era))
-> Tx (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
      ((TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Identity (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (ShelleyLedgerEra era)) (TxBody (ShelleyLedgerEra era))
L.bodyTxL ((TxBody (ShelleyLedgerEra era)
  -> Identity (TxBody (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Identity (Tx (ShelleyLedgerEra era)))
-> ((VotingProcedures (ShelleyLedgerEra era)
     -> Identity (VotingProcedures (ShelleyLedgerEra era)))
    -> TxBody (ShelleyLedgerEra era)
    -> Identity (TxBody (ShelleyLedgerEra era)))
-> (VotingProcedures (ShelleyLedgerEra era)
    -> Identity (VotingProcedures (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Identity (Tx (ShelleyLedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingProcedures (ShelleyLedgerEra era)
 -> Identity (VotingProcedures (ShelleyLedgerEra era)))
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens'
  (TxBody (ShelleyLedgerEra era))
  (VotingProcedures (ShelleyLedgerEra era))
L.votingProceduresTxBodyL) ((VotingProcedures (ShelleyLedgerEra era)
  -> Identity (VotingProcedures (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Identity (Tx (ShelleyLedgerEra era)))
-> VotingProcedures (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
-> Tx (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ VotingProcedures (ShelleyLedgerEra era)
votingProcedures

  indexedTxCerts :: [(ScriptWitnessIndex, Certificate era, StakeCredential, Witness WitCtxStake era)]
  indexedTxCerts :: [(ScriptWitnessIndex, Certificate era, StakeCredential,
  Witness WitCtxStake era)]
indexedTxCerts = TxCertificates BuildTx era
-> [(ScriptWitnessIndex, Certificate era, StakeCredential,
     Witness WitCtxStake era)]
forall era.
TxCertificates BuildTx era
-> [(ScriptWitnessIndex, Certificate era, StakeCredential,
     Witness WitCtxStake era)]
indexTxCertificates TxCertificates BuildTx era
txCertificates'

  allWitnesses
    :: [(ScriptWitnessIndex, AnyScriptWitness era)]
    -> L.TxWits (ShelleyLedgerEra era)
    -> L.TxWits (ShelleyLedgerEra era)
  allWitnesses :: [(ScriptWitnessIndex, AnyScriptWitness era)]
-> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
allWitnesses [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnesses =
    [Endo (TxWits (ShelleyLedgerEra era))]
-> TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era)
forall {a}. [Endo a] -> a -> a
appEndos
      [ CardanoEra era
-> (AlonzoEraOnwards era -> Endo (TxWits (ShelleyLedgerEra era)))
-> Endo (TxWits (ShelleyLedgerEra era))
forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon
          CardanoEra era
era
          ( \AlonzoEraOnwards era
aeo -> AlonzoEraOnwards era
-> (AlonzoEraOnwardsConstraints era =>
    Endo (TxWits (ShelleyLedgerEra era)))
-> Endo (TxWits (ShelleyLedgerEra era))
forall era a.
AlonzoEraOnwards era -> (AlonzoEraOnwardsConstraints era => a) -> a
alonzoEraOnwardsConstraints AlonzoEraOnwards era
aeo ((AlonzoEraOnwardsConstraints era =>
  Endo (TxWits (ShelleyLedgerEra era)))
 -> Endo (TxWits (ShelleyLedgerEra era)))
-> (AlonzoEraOnwardsConstraints era =>
    Endo (TxWits (ShelleyLedgerEra era)))
-> Endo (TxWits (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> Endo (TxWits (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
 -> Endo (TxWits (ShelleyLedgerEra era)))
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> Endo (TxWits (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ do
              let sData :: TxBodyScriptData era
sData = ShelleyBasedEra era
-> [TxOut CtxTx era]
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
-> TxBodyScriptData era
forall era.
ShelleyBasedEra era
-> [TxOut CtxTx era]
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
-> TxBodyScriptData era
convScriptData ShelleyBasedEra era
sbe [TxOut CtxTx era]
outs [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnesses
              let (TxDats (ShelleyLedgerEra era)
datums, Redeemers (ShelleyLedgerEra era)
redeemers) = case TxBodyScriptData era
sData of
                    TxBodyScriptData AlonzoEraOnwards era
_ TxDats (ShelleyLedgerEra era)
ds Redeemers (ShelleyLedgerEra era)
rs -> (TxDats (ShelleyLedgerEra era)
ds, Redeemers (ShelleyLedgerEra era)
rs)
                    TxBodyScriptData era
TxBodyNoScriptData -> (TxDats (ShelleyLedgerEra era)
forall a. Monoid a => a
mempty, Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (Data (ShelleyLedgerEra era), ExUnits)
-> Redeemers (ShelleyLedgerEra era)
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
L.Redeemers Map
  (PlutusPurpose AsIx (ShelleyLedgerEra era))
  (Data (ShelleyLedgerEra era), ExUnits)
forall a. Monoid a => a
mempty)
              ((TxDats (ShelleyLedgerEra era)
 -> Identity (TxDats (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens'
  (TxWits (ShelleyLedgerEra era)) (TxDats (ShelleyLedgerEra era))
L.datsTxWitsL ((TxDats (ShelleyLedgerEra era)
  -> Identity (TxDats (ShelleyLedgerEra era)))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> TxDats (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxDats (ShelleyLedgerEra era)
datums) (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Redeemers (ShelleyLedgerEra era)
 -> Identity (Redeemers (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens'
  (TxWits (ShelleyLedgerEra era)) (Redeemers (ShelleyLedgerEra era))
L.rdmrsTxWitsL ((Redeemers (ShelleyLedgerEra era)
  -> Identity (Redeemers (ShelleyLedgerEra era)))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> (Redeemers (ShelleyLedgerEra era)
    -> Redeemers (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
-> Redeemers (ShelleyLedgerEra era)
forall a. Semigroup a => a -> a -> a
<> Redeemers (ShelleyLedgerEra era)
redeemers))
          )
      , CardanoEra era
-> (AllegraEraOnwards era -> Endo (TxWits (ShelleyLedgerEra era)))
-> Endo (TxWits (ShelleyLedgerEra era))
forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon
          CardanoEra era
era
          ( \AllegraEraOnwards era
aeo -> AllegraEraOnwards era
-> (AllegraEraOnwardsConstraints era =>
    Endo (TxWits (ShelleyLedgerEra era)))
-> Endo (TxWits (ShelleyLedgerEra era))
forall era a.
AllegraEraOnwards era
-> (AllegraEraOnwardsConstraints era => a) -> a
allegraEraOnwardsConstraints AllegraEraOnwards era
aeo ((AllegraEraOnwardsConstraints era =>
  Endo (TxWits (ShelleyLedgerEra era)))
 -> Endo (TxWits (ShelleyLedgerEra era)))
-> (AllegraEraOnwardsConstraints era =>
    Endo (TxWits (ShelleyLedgerEra era)))
-> Endo (TxWits (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> Endo (TxWits (ShelleyLedgerEra era))
forall a. (a -> a) -> Endo a
Endo ((TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
 -> Endo (TxWits (ShelleyLedgerEra era)))
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> Endo (TxWits (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ do
              let ledgerScripts :: [Script (ShelleyLedgerEra era)]
ledgerScripts = [(ScriptWitnessIndex, AnyScriptWitness era)]
-> [Script (ShelleyLedgerEra era)]
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera) =>
[(ScriptWitnessIndex, AnyScriptWitness era)] -> [Script ledgerera]
convScripts [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnesses
              (Map
   (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
   (Script (ShelleyLedgerEra era))
 -> Identity
      (Map
         (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
         (Script (ShelleyLedgerEra era))))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
Lens'
  (TxWits (ShelleyLedgerEra era))
  (Map
     (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
     (Script (ShelleyLedgerEra era)))
L.scriptTxWitsL
                ((Map
    (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
    (Script (ShelleyLedgerEra era))
  -> Identity
       (Map
          (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
          (Script (ShelleyLedgerEra era))))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> Map
     (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
     (Script (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(ScriptHash (EraCrypto (ShelleyLedgerEra era)),
  Script (ShelleyLedgerEra era))]
-> Map
     (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
     (Script (ShelleyLedgerEra era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (Script (ShelleyLedgerEra era)
-> ScriptHash (EraCrypto (ShelleyLedgerEra era))
forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
L.hashScript Script (ShelleyLedgerEra era)
sw, Script (ShelleyLedgerEra era)
sw)
                  | Script (ShelleyLedgerEra era)
sw <- [Script (ShelleyLedgerEra era)]
ledgerScripts
                  ]
          )
      ]

  allShelleyToBabbageWitnesses
    :: L.EraTxWits (ShelleyLedgerEra era)
    => L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
    => L.TxWits (ShelleyLedgerEra era)
  allShelleyToBabbageWitnesses :: (EraTxWits (ShelleyLedgerEra era),
 EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
TxWits (ShelleyLedgerEra era)
allShelleyToBabbageWitnesses = do
    let shelleyKeywitnesses :: Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))
shelleyKeywitnesses =
          [Item (Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era))))]
-> Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))
forall l. IsList l => [Item l] -> l
fromList [Item (Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era))))
WitVKey 'Witness StandardCrypto
w | ShelleyKeyWitness ShelleyBasedEra era
_ WitVKey 'Witness StandardCrypto
w <- [KeyWitness era]
witnesses]
    let shelleyBootstrapWitnesses :: Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))
shelleyBootstrapWitnesses =
          [Item (Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era))))]
-> Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))
forall l. IsList l => [Item l] -> l
fromList [Item (Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era))))
BootstrapWitness StandardCrypto
w | ShelleyBootstrapWitness ShelleyBasedEra era
_ BootstrapWitness StandardCrypto
w <- [KeyWitness era]
witnesses]
    TxWits (ShelleyLedgerEra era)
forall era. EraTxWits era => TxWits era
L.mkBasicTxWits
      TxWits (ShelleyLedgerEra era)
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))
 -> Identity
      (Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
Lens'
  (TxWits (ShelleyLedgerEra era))
  (Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era))))
L.addrTxWitsL
        ((Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))
  -> Identity
       (Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))
shelleyKeywitnesses
      TxWits (ShelleyLedgerEra era)
-> (TxWits (ShelleyLedgerEra era) -> TxWits (ShelleyLedgerEra era))
-> TxWits (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))
 -> Identity
      (Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))))
-> TxWits (ShelleyLedgerEra era)
-> Identity (TxWits (ShelleyLedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (BootstrapWitness (EraCrypto era)))
Lens'
  (TxWits (ShelleyLedgerEra era))
  (Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era))))
L.bootAddrTxWitsL
        ((Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))
  -> Identity
       (Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))))
 -> TxWits (ShelleyLedgerEra era)
 -> Identity (TxWits (ShelleyLedgerEra era)))
-> Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))
-> TxWits (ShelleyLedgerEra era)
-> TxWits (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))
shelleyBootstrapWitnesses

createCommonTxBody
  :: ShelleyBasedEra era
  -> [TxIn]
  -> [TxOut ctx era]
  -> Lovelace
  -> L.TxBody (ShelleyLedgerEra era)
createCommonTxBody :: forall era ctx.
ShelleyBasedEra era
-> [TxIn]
-> [TxOut ctx era]
-> Lovelace
-> TxBody (ShelleyLedgerEra era)
createCommonTxBody ShelleyBasedEra era
era [TxIn]
ins [TxOut ctx era]
outs Lovelace
txFee' =
  let txIns' :: [TxIn StandardCrypto]
txIns' = (TxIn -> TxIn StandardCrypto) -> [TxIn] -> [TxIn StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxIn StandardCrypto
toShelleyTxIn [TxIn]
ins
      txOuts' :: [TxOut (ShelleyLedgerEra era)]
txOuts' = (TxOut ctx era -> TxOut (ShelleyLedgerEra era))
-> [TxOut ctx era] -> [TxOut (ShelleyLedgerEra era)]
forall a b. (a -> b) -> [a] -> [b]
map (ShelleyBasedEra era
-> TxOut ctx era -> TxOut (ShelleyLedgerEra era)
forall ctx era ledgerera.
(HasCallStack, ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut ctx era -> TxOut ledgerera
toShelleyTxOutAny ShelleyBasedEra era
era) [TxOut ctx era]
outs
   in ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
era ((ShelleyBasedEraConstraints era => TxBody (ShelleyLedgerEra era))
 -> TxBody (ShelleyLedgerEra era))
-> (ShelleyBasedEraConstraints era =>
    TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
        TxBody (ShelleyLedgerEra era)
forall era. EraTxBody era => TxBody era
L.mkBasicTxBody
          TxBody (ShelleyLedgerEra era)
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
 -> Identity (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
L.inputsTxBodyL
            ((Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
  -> Identity (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
 -> TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))]
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
forall l. IsList l => [Item l] -> l
fromList [Item (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))]
[TxIn StandardCrypto]
txIns'
          TxBody (ShelleyLedgerEra era)
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut (ShelleyLedgerEra era))
 -> Identity (StrictSeq (TxOut (ShelleyLedgerEra era))))
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (StrictSeq (TxOut (ShelleyLedgerEra era)))
L.outputsTxBodyL
            ((StrictSeq (TxOut (ShelleyLedgerEra era))
  -> Identity (StrictSeq (TxOut (ShelleyLedgerEra era))))
 -> TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> StrictSeq (TxOut (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxOut (ShelleyLedgerEra era)]
-> StrictSeq (TxOut (ShelleyLedgerEra era))
forall a. [a] -> StrictSeq a
Seq.fromList [TxOut (ShelleyLedgerEra era)]
txOuts'
          TxBody (ShelleyLedgerEra era)
-> (TxBody (ShelleyLedgerEra era) -> TxBody (ShelleyLedgerEra era))
-> TxBody (ShelleyLedgerEra era)
forall a b. a -> (a -> b) -> b
& (Lovelace -> Identity Lovelace)
-> TxBody (ShelleyLedgerEra era)
-> Identity (TxBody (ShelleyLedgerEra era))
forall era. EraTxBody era => Lens' (TxBody era) Lovelace
Lens' (TxBody (ShelleyLedgerEra era)) Lovelace
L.feeTxBodyL
            ((Lovelace -> Identity Lovelace)
 -> TxBody (ShelleyLedgerEra era)
 -> Identity (TxBody (ShelleyLedgerEra era)))
-> Lovelace
-> TxBody (ShelleyLedgerEra era)
-> TxBody (ShelleyLedgerEra era)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Lovelace
txFee'