{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Cardano.Ledger.Api.Era (
  -- * Eras
  Era (
    PreviousEra,
    ProtVerLow,
    ProtVerHigh
  ),
  EraApi (..),
  eraName,

  -- ** Byron
  ByronEra,

  -- ** Shelley
  ShelleyEra,

  -- ** Allegra
  AllegraEra,

  -- ** Mary
  MaryEra,

  -- ** Alonzo
  AlonzoEra,

  -- ** Babbage
  BabbageEra,

  -- ** Conway
  ConwayEra,

  -- ** Dijkstra
  DijkstraEra,

  -- ** Latest Known
  LatestKnownEra,

  -- * Protocol version

  -- ** Value level
  eraProtVerHigh,
  eraProtVerLow,

  -- ** Type level constraints
  AtLeastEra,
  AtMostEra,
  ExactEra,
  ProtVerAtLeast,
  ProtVerAtMost,
  ProtVerInBounds,
  atLeastEra,
  atMostEra,
) where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Allegra.Scripts (translateTimelock)
import Cardano.Ledger.Allegra.TxAuxData (AllegraTxAuxData (..))
import Cardano.Ledger.Allegra.TxBody (AllegraEraTxBody (..), ValidityInterval (..))
import qualified Cardano.Ledger.Allegra.TxBody as Allegra (TxBody (..))
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.PParams (AlonzoPParams (appExtraEntropy), appD)
import Cardano.Ledger.Alonzo.Scripts (AlonzoEraScript, upgradePlutusPurposeAsIx)
import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..), AlonzoTxAuxDataRaw (..))
import Cardano.Ledger.Alonzo.TxBody (AlonzoEraTxBody (..), TxBody (..))
import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..), Redeemers (..), TxDats (..), unRedeemers)
import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.Babbage.PParams (upgradeBabbagePParams)
import Cardano.Ledger.Babbage.Tx
import Cardano.Ledger.BaseTypes (StrictMaybe (..), isSJust)
import Cardano.Ledger.Binary (mkSized, unsafeMapSized)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway (ConwayEra, Tx (..))
import Cardano.Ledger.Conway.Governance (VotingProcedures (..))
import Cardano.Ledger.Conway.TxBody (TxBody (..))
import Cardano.Ledger.Conway.TxCert (ConwayTxCertUpgradeError)
import Cardano.Ledger.Core
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.Tx (Tx (..))
import Cardano.Ledger.Dijkstra.TxBody (TxBody (..), upgradeProposals)
import Cardano.Ledger.Mary (MaryEra, TxBody (..))
import Cardano.Ledger.Mary.TxBody (MaryEraTxBody (..))
import Cardano.Ledger.MemoBytes (mkMemoizedEra)
import Cardano.Ledger.Plutus.Data (upgradeData)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.PParams
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxAuxData (ShelleyTxAuxData (..))
import Cardano.Ledger.Shelley.TxBody (ShelleyEraTxBody (..))
import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits (..))
import Cardano.Ledger.Slot (SlotNo)
import Control.Arrow (left)
import Control.Monad (unless, when)
import Data.Bifunctor (Bifunctor (first))
import Data.Coerce (coerce)
import Data.Default (def)
import Data.Kind (Type)
import qualified Data.Map.Strict as Map
import qualified Data.OSet.Strict as OSet
import Data.Set (Set)
import Data.Void (Void, absurd)
import Lens.Micro

-- | Sometimes it is useful to specify that a type corresponds to a latest era that is
-- currently implemented
type LatestKnownEra = DijkstraEra

class
  ( EraTx era
  , EraTxOut era
  , EraTxBody era
  , EraTxAuxData era
  , EraTxWits era
  , EraScript era
  , EraPParams era
  , EraBlockBody era
  , EraTxCert era
  ) =>
  EraApi era
  where
  -- | Upgrade transactions from the previous era.
  -- This will preseve the values in corresponding Haskell structures where possible,
  -- however it will not preserve the binary representation for memoized types.
  -- If binary representation and validity of signatures, scriptIntegrityHash and
  --  auxDataHash must be retained, then the corresponding
  -- `binaryUpgradeTx`, `binaryUpgradeTxBody`, `binaryUpgradeTxAuxData` and `binaryUpgradeTxWits` functions
  -- should be used instead.
  -- Compare the two types of upgrade:
  -- - `upgrade[Tx, TxBody, TxAuxData, TxWits]` will use the Haskell representation, but will not
  --   preserve the serialised form. However, they will be suitable for iterated
  --   translation through eras.
  -- - `binaryUpgrade[Tx, TxBody, TxAuxData, TxWits]` will preserve the binary representation, but are
  --   not guaranteed to work through multiple eras - that is, the serialised
  --   representation from era n is guaranteed valid in era n + 1, but not
  --   necessarily in era n + 2.
  --
  -- See below an example of how the upgrade function can change the underlying serialization:
  --
  -- >>> import Cardano.Ledger.Api.Era (BabbageEra, ConwayEra)
  -- >>> import Test.QuickCheck
  -- >>> import Test.Cardano.Ledger.Babbage.Arbitrary ()
  -- >>> import Cardano.Ledger.Plutus.Data
  -- >>> import Cardano.Ledger.Alonzo.TxWits (unTxDats)
  -- >>> import Cardano.Ledger.MemoBytes (getMemoRawBytes)
  -- >>> import Cardano.Ledger.Binary (serialize)
  --
  -- Let's generate an arbitrary Babbage TxWits:
  -- >>> witsBabbage <- generate $ arbitrary @(TxWits BabbageEra)
  --
  -- Now we upgrade it to Conway using the upgrade functionality in this module:
  -- >>> witsUpgraded = upgradeTxWits witsBabbage
  --
  -- We can check that the values in the data structures have been preserved.
  -- For simplicity, let's check the txDats:
  -- let dats = Map.map unData . unTxDats . txdats
  -- in dats witsBabbage == dats witsUpgraded
  -- True
  --
  -- However, the upgraded value will have a different serialized binary representation than the original,
  -- because the serialization of TxWits changed from Babbage to Conway
  -- >>> getMemoRawBytes witsBabbage == getMemoRawBytes witsUpgraded
  -- False
  -- >>> serialize (eraProtVerHigh @BabbageEra) witsBabbage == serialize (eraProtVerHigh @BabbageEra) witsUpgraded
  -- False
  type TxUpgradeError era :: Type

  type TxUpgradeError era = Void

  type TxBodyUpgradeError era :: Type
  type TxBodyUpgradeError era = Void

  -- | Upgrade a transaction from the previous era.
  -- /Warning/ - This may not preserve the underlying binary representation.
  -- Use `binaryUpgradeTx` instead, if you need to preserve the serialised form.
  upgradeTx ::
    EraTx (PreviousEra era) =>
    Tx (PreviousEra era) ->
    Either (TxUpgradeError era) (Tx era)

  -- | Upgrade a transaction body from the previous era.
  -- /Warning/ - This may not preserve the underlying binary representation.
  -- Use `binaryUpgradeTxBody` instead, if you need to preserve the serialised form.
  upgradeTxBody ::
    EraTxBody (PreviousEra era) =>
    TxBody (PreviousEra era) ->
    Either (TxBodyUpgradeError era) (TxBody era)

  -- | Upgrade txAuxData from the previous era.
  -- /Warning/ - This may not preserve the underlying binary representation.
  -- Use `binaryUpgradeTxAuxData` instead, if you need to preserve the serialised form.
  upgradeTxAuxData :: EraTxAuxData (PreviousEra era) => TxAuxData (PreviousEra era) -> TxAuxData era

  -- | Upgrade txWits from the previous era.
  -- /Warning/ - This may not preserve the underlying binary representation.
  -- Use `binaryUpgradeTxWits` instead, if you need to preserve the serialised form.
  upgradeTxWits :: EraTxWits (PreviousEra era) => TxWits (PreviousEra era) -> TxWits era

instance EraApi ShelleyEra where
  upgradeTx :: EraTx (PreviousEra ShelleyEra) =>
Tx (PreviousEra ShelleyEra)
-> Either (TxUpgradeError ShelleyEra) (Tx ShelleyEra)
upgradeTx =
    [Char] -> Tx ByronEra -> Either Void (Tx ShelleyEra)
forall a. HasCallStack => [Char] -> a
error
      [Char]
"Calling this function will cause a compilation error, since there is no Tx instance for Byron"

  upgradeTxBody :: EraTxBody (PreviousEra ShelleyEra) =>
TxBody (PreviousEra ShelleyEra)
-> Either (TxBodyUpgradeError ShelleyEra) (TxBody ShelleyEra)
upgradeTxBody =
    [Char]
-> TxBody (PreviousEra ShelleyEra)
-> Either (TxBodyUpgradeError ShelleyEra) (TxBody ShelleyEra)
forall a. HasCallStack => [Char] -> a
error ([Char]
 -> TxBody (PreviousEra ShelleyEra)
 -> Either (TxBodyUpgradeError ShelleyEra) (TxBody ShelleyEra))
-> [Char]
-> TxBody (PreviousEra ShelleyEra)
-> Either (TxBodyUpgradeError ShelleyEra) (TxBody ShelleyEra)
forall a b. (a -> b) -> a -> b
$
      [Char]
"Calling this function will cause a compilation error, "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"since there is no `EraTxBody` instance for `ByronEra`"

  -- Calling this partial function will result in compilation error, since ByronEra has
  -- no instance for EraTxOut type class.
  upgradeTxAuxData :: EraTxAuxData (PreviousEra ShelleyEra) =>
TxAuxData (PreviousEra ShelleyEra) -> TxAuxData ShelleyEra
upgradeTxAuxData = [Char] -> TxAuxData ByronEra -> ShelleyTxAuxData ShelleyEra
forall a. HasCallStack => [Char] -> a
error [Char]
"It is not possible to translate Byron TxOut with 'upgradeTxOut'"

  upgradeTxWits :: EraTxWits (PreviousEra ShelleyEra) =>
TxWits (PreviousEra ShelleyEra) -> TxWits ShelleyEra
upgradeTxWits =
    [Char] -> TxWits ByronEra -> ShelleyTxWits ShelleyEra
forall a. HasCallStack => [Char] -> a
error
      [Char]
"Calling this function will cause a compilation error, since there is no TxWits instance for ByronEra"

instance EraApi AllegraEra where
  upgradeTx :: EraTx (PreviousEra AllegraEra) =>
Tx (PreviousEra AllegraEra)
-> Either (TxUpgradeError AllegraEra) (Tx AllegraEra)
upgradeTx (MkShelleyTx (ShelleyTx TxBody ShelleyEra
txb TxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
txAux)) =
    (ShelleyTx AllegraEra -> Tx AllegraEra)
-> Either (TxUpgradeError AllegraEra) (ShelleyTx AllegraEra)
-> Either (TxUpgradeError AllegraEra) (Tx AllegraEra)
forall a b.
(a -> b)
-> Either (TxUpgradeError AllegraEra) a
-> Either (TxUpgradeError AllegraEra) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShelleyTx AllegraEra -> Tx AllegraEra
MkAllegraTx (Either (TxUpgradeError AllegraEra) (ShelleyTx AllegraEra)
 -> Either (TxUpgradeError AllegraEra) (Tx AllegraEra))
-> Either (TxUpgradeError AllegraEra) (ShelleyTx AllegraEra)
-> Either (TxUpgradeError AllegraEra) (Tx AllegraEra)
forall a b. (a -> b) -> a -> b
$
      TxBody AllegraEra
-> TxWits AllegraEra
-> StrictMaybe (TxAuxData AllegraEra)
-> ShelleyTx AllegraEra
TxBody AllegraEra
-> ShelleyTxWits AllegraEra
-> StrictMaybe (AllegraTxAuxData AllegraEra)
-> ShelleyTx AllegraEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
        (TxBody AllegraEra
 -> ShelleyTxWits AllegraEra
 -> StrictMaybe (AllegraTxAuxData AllegraEra)
 -> ShelleyTx AllegraEra)
-> Either Void (TxBody AllegraEra)
-> Either
     Void
     (ShelleyTxWits AllegraEra
      -> StrictMaybe (AllegraTxAuxData AllegraEra)
      -> ShelleyTx AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody (PreviousEra AllegraEra)
-> Either (TxBodyUpgradeError AllegraEra) (TxBody AllegraEra)
forall era.
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txb
        Either
  Void
  (ShelleyTxWits AllegraEra
   -> StrictMaybe (AllegraTxAuxData AllegraEra)
   -> ShelleyTx AllegraEra)
-> Either Void (ShelleyTxWits AllegraEra)
-> Either
     Void
     (StrictMaybe (AllegraTxAuxData AllegraEra) -> ShelleyTx AllegraEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShelleyTxWits AllegraEra -> Either Void (ShelleyTxWits AllegraEra)
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxWits (PreviousEra AllegraEra) -> TxWits AllegraEra
forall era.
(EraApi era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits (PreviousEra AllegraEra)
TxWits ShelleyEra
txwits)
        Either
  Void
  (StrictMaybe (AllegraTxAuxData AllegraEra) -> ShelleyTx AllegraEra)
-> Either Void (StrictMaybe (AllegraTxAuxData AllegraEra))
-> Either Void (ShelleyTx AllegraEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AllegraTxAuxData AllegraEra)
-> Either Void (StrictMaybe (AllegraTxAuxData AllegraEra))
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxAuxData (PreviousEra AllegraEra) -> AllegraTxAuxData AllegraEra)
-> StrictMaybe (TxAuxData (PreviousEra AllegraEra))
-> StrictMaybe (AllegraTxAuxData AllegraEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData (PreviousEra AllegraEra) -> AllegraTxAuxData AllegraEra
TxAuxData (PreviousEra AllegraEra) -> TxAuxData AllegraEra
forall era.
(EraApi era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData (PreviousEra AllegraEra))
StrictMaybe (TxAuxData ShelleyEra)
txAux)

  upgradeTxBody :: EraTxBody (PreviousEra AllegraEra) =>
TxBody (PreviousEra AllegraEra)
-> Either (TxBodyUpgradeError AllegraEra) (TxBody AllegraEra)
upgradeTxBody TxBody (PreviousEra AllegraEra)
txBody = do
    StrictSeq (TxCert AllegraEra)
certs <- (TxCert (PreviousEra AllegraEra)
 -> Either Void (TxCert AllegraEra))
-> StrictSeq (TxCert (PreviousEra AllegraEra))
-> Either Void (StrictSeq (TxCert AllegraEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictSeq a -> f (StrictSeq b)
traverse TxCert (PreviousEra AllegraEra) -> Either Void (TxCert AllegraEra)
TxCert (PreviousEra AllegraEra)
-> Either (TxCertUpgradeError AllegraEra) (TxCert AllegraEra)
forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert (TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txBody TxBody ShelleyEra
-> Getting
     (StrictSeq (TxCert (PreviousEra AllegraEra)))
     (TxBody ShelleyEra)
     (StrictSeq (TxCert (PreviousEra AllegraEra)))
-> StrictSeq (TxCert (PreviousEra AllegraEra))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert (PreviousEra AllegraEra)))
  (TxBody ShelleyEra)
  (StrictSeq (TxCert (PreviousEra AllegraEra)))
(StrictSeq (TxCert ShelleyEra)
 -> Const
      (StrictSeq (TxCert (PreviousEra AllegraEra)))
      (StrictSeq (TxCert ShelleyEra)))
-> TxBody ShelleyEra
-> Const
     (StrictSeq (TxCert (PreviousEra AllegraEra))) (TxBody ShelleyEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody ShelleyEra) (StrictSeq (TxCert ShelleyEra))
certsTxBodyL)
    TxBody AllegraEra -> Either Void (TxBody AllegraEra)
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBody AllegraEra -> Either Void (TxBody AllegraEra))
-> TxBody AllegraEra -> Either Void (TxBody AllegraEra)
forall a b. (a -> b) -> a -> b
$
      Allegra.AllegraTxBody
        { atbInputs :: Set TxIn
Allegra.atbInputs = TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txBody TxBody ShelleyEra
-> Getting (Set TxIn) (TxBody ShelleyEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody ShelleyEra) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ShelleyEra) (Set TxIn)
inputsTxBodyL
        , atbOutputs :: StrictSeq (TxOut AllegraEra)
Allegra.atbOutputs = TxOut (PreviousEra AllegraEra) -> TxOut AllegraEra
TxOut (PreviousEra AllegraEra) -> ShelleyTxOut AllegraEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (TxOut (PreviousEra AllegraEra) -> ShelleyTxOut AllegraEra)
-> StrictSeq (TxOut (PreviousEra AllegraEra))
-> StrictSeq (ShelleyTxOut AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txBody TxBody ShelleyEra
-> Getting
     (StrictSeq (TxOut (PreviousEra AllegraEra)))
     (TxBody ShelleyEra)
     (StrictSeq (TxOut (PreviousEra AllegraEra)))
-> StrictSeq (TxOut (PreviousEra AllegraEra))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut (PreviousEra AllegraEra)))
  (TxBody ShelleyEra)
  (StrictSeq (TxOut (PreviousEra AllegraEra)))
(StrictSeq (TxOut ShelleyEra)
 -> Const
      (StrictSeq (TxOut (PreviousEra AllegraEra)))
      (StrictSeq (TxOut ShelleyEra)))
-> TxBody ShelleyEra
-> Const
     (StrictSeq (TxOut (PreviousEra AllegraEra))) (TxBody ShelleyEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ShelleyEra) (StrictSeq (TxOut ShelleyEra))
outputsTxBodyL)
        , atbCerts :: StrictSeq (TxCert AllegraEra)
Allegra.atbCerts = StrictSeq (TxCert AllegraEra)
certs
        , atbWithdrawals :: Withdrawals
Allegra.atbWithdrawals = TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txBody TxBody ShelleyEra
-> Getting Withdrawals (TxBody ShelleyEra) Withdrawals
-> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody ShelleyEra) Withdrawals
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody ShelleyEra) Withdrawals
withdrawalsTxBodyL
        , atbTxFee :: Coin
Allegra.atbTxFee = TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txBody TxBody ShelleyEra -> Getting Coin (TxBody ShelleyEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody ShelleyEra) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody ShelleyEra) Coin
feeTxBodyL
        , atbValidityInterval :: ValidityInterval
Allegra.atbValidityInterval = SlotNo -> ValidityInterval
ttlToValidityInterval (TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txBody TxBody ShelleyEra
-> Getting SlotNo (TxBody ShelleyEra) SlotNo -> SlotNo
forall s a. s -> Getting a s a -> a
^. Getting SlotNo (TxBody ShelleyEra) SlotNo
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody era) SlotNo
Lens' (TxBody ShelleyEra) SlotNo
ttlTxBodyL)
        , atbUpdate :: StrictMaybe (Update AllegraEra)
Allegra.atbUpdate = UpgradePParams StrictMaybe AllegraEra
-> Update (PreviousEra AllegraEra) -> Update AllegraEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> Update (PreviousEra era) -> Update era
upgradeUpdate () (Update ShelleyEra -> Update AllegraEra)
-> StrictMaybe (Update ShelleyEra)
-> StrictMaybe (Update AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txBody TxBody ShelleyEra
-> Getting
     (StrictMaybe (Update ShelleyEra))
     (TxBody ShelleyEra)
     (StrictMaybe (Update ShelleyEra))
-> StrictMaybe (Update ShelleyEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Update ShelleyEra))
  (TxBody ShelleyEra)
  (StrictMaybe (Update ShelleyEra))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody ShelleyEra) (StrictMaybe (Update ShelleyEra))
updateTxBodyL)
        , atbAuxDataHash :: StrictMaybe TxAuxDataHash
Allegra.atbAuxDataHash = TxBody (PreviousEra AllegraEra)
TxBody ShelleyEra
txBody TxBody ShelleyEra
-> Getting
     (StrictMaybe TxAuxDataHash)
     (TxBody ShelleyEra)
     (StrictMaybe TxAuxDataHash)
-> StrictMaybe TxAuxDataHash
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe TxAuxDataHash)
  (TxBody ShelleyEra)
  (StrictMaybe TxAuxDataHash)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
Lens' (TxBody ShelleyEra) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL
        }
    where
      ttlToValidityInterval :: SlotNo -> ValidityInterval
      ttlToValidityInterval :: SlotNo -> ValidityInterval
ttlToValidityInterval SlotNo
ttl = StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
ttl)

  upgradeTxAuxData :: EraTxAuxData (PreviousEra AllegraEra) =>
TxAuxData (PreviousEra AllegraEra) -> TxAuxData AllegraEra
upgradeTxAuxData (ShelleyTxAuxData Map Word64 Metadatum
md) = Map Word64 Metadatum
-> StrictSeq (Timelock AllegraEra) -> AllegraTxAuxData AllegraEra
forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData Map Word64 Metadatum
md StrictSeq (Timelock AllegraEra)
forall a. Monoid a => a
mempty

  upgradeTxWits :: EraTxWits (PreviousEra AllegraEra) =>
TxWits (PreviousEra AllegraEra) -> TxWits AllegraEra
upgradeTxWits TxWits (PreviousEra AllegraEra)
stw =
    Set (WitVKey 'Witness)
-> Map ScriptHash (Script AllegraEra)
-> Set BootstrapWitness
-> ShelleyTxWits AllegraEra
forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits
      (ShelleyTxWits ShelleyEra -> Set (WitVKey 'Witness)
forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
addrWits TxWits (PreviousEra AllegraEra)
ShelleyTxWits ShelleyEra
stw)
      (Script (PreviousEra AllegraEra) -> Timelock AllegraEra
Script (PreviousEra AllegraEra) -> Script AllegraEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra AllegraEra) -> Timelock AllegraEra)
-> Map ScriptHash (Script (PreviousEra AllegraEra))
-> Map ScriptHash (Timelock AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyTxWits ShelleyEra -> Map ScriptHash (Script ShelleyEra)
forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
scriptWits TxWits (PreviousEra AllegraEra)
ShelleyTxWits ShelleyEra
stw)
      (ShelleyTxWits ShelleyEra -> Set BootstrapWitness
forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
bootWits TxWits (PreviousEra AllegraEra)
ShelleyTxWits ShelleyEra
stw)

instance EraApi MaryEra where
  upgradeTx :: EraTx (PreviousEra MaryEra) =>
Tx (PreviousEra MaryEra)
-> Either (TxUpgradeError MaryEra) (Tx MaryEra)
upgradeTx (MkAllegraTx (ShelleyTx TxBody AllegraEra
txb TxWits AllegraEra
txwits StrictMaybe (TxAuxData AllegraEra)
txAux)) =
    (ShelleyTx MaryEra -> Tx MaryEra)
-> Either (TxUpgradeError MaryEra) (ShelleyTx MaryEra)
-> Either (TxUpgradeError MaryEra) (Tx MaryEra)
forall a b.
(a -> b)
-> Either (TxUpgradeError MaryEra) a
-> Either (TxUpgradeError MaryEra) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShelleyTx MaryEra -> Tx MaryEra
MkMaryTx (Either (TxUpgradeError MaryEra) (ShelleyTx MaryEra)
 -> Either (TxUpgradeError MaryEra) (Tx MaryEra))
-> Either (TxUpgradeError MaryEra) (ShelleyTx MaryEra)
-> Either (TxUpgradeError MaryEra) (Tx MaryEra)
forall a b. (a -> b) -> a -> b
$
      TxBody MaryEra
-> TxWits MaryEra
-> StrictMaybe (TxAuxData MaryEra)
-> ShelleyTx MaryEra
TxBody MaryEra
-> ShelleyTxWits MaryEra
-> StrictMaybe (AllegraTxAuxData MaryEra)
-> ShelleyTx MaryEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
        (TxBody MaryEra
 -> ShelleyTxWits MaryEra
 -> StrictMaybe (AllegraTxAuxData MaryEra)
 -> ShelleyTx MaryEra)
-> Either Void (TxBody MaryEra)
-> Either
     Void
     (ShelleyTxWits MaryEra
      -> StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody (PreviousEra MaryEra)
-> Either (TxBodyUpgradeError MaryEra) (TxBody MaryEra)
forall era.
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody AllegraEra
TxBody (PreviousEra MaryEra)
txb
        Either
  Void
  (ShelleyTxWits MaryEra
   -> StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx MaryEra)
-> Either Void (ShelleyTxWits MaryEra)
-> Either
     Void (StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx MaryEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShelleyTxWits MaryEra -> Either Void (ShelleyTxWits MaryEra)
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxWits (PreviousEra MaryEra) -> TxWits MaryEra
forall era.
(EraApi era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits AllegraEra
TxWits (PreviousEra MaryEra)
txwits)
        Either
  Void (StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx MaryEra)
-> Either Void (StrictMaybe (AllegraTxAuxData MaryEra))
-> Either Void (ShelleyTx MaryEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AllegraTxAuxData MaryEra)
-> Either Void (StrictMaybe (AllegraTxAuxData MaryEra))
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxAuxData (PreviousEra MaryEra) -> AllegraTxAuxData MaryEra)
-> StrictMaybe (TxAuxData (PreviousEra MaryEra))
-> StrictMaybe (AllegraTxAuxData MaryEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData (PreviousEra MaryEra) -> AllegraTxAuxData MaryEra
TxAuxData (PreviousEra MaryEra) -> TxAuxData MaryEra
forall era.
(EraApi era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData AllegraEra)
StrictMaybe (TxAuxData (PreviousEra MaryEra))
txAux)

  upgradeTxBody :: EraTxBody (PreviousEra MaryEra) =>
TxBody (PreviousEra MaryEra)
-> Either (TxBodyUpgradeError MaryEra) (TxBody MaryEra)
upgradeTxBody TxBody (PreviousEra MaryEra)
atb = do
    StrictSeq (TxCert MaryEra)
certs <- (TxCert (PreviousEra MaryEra) -> Either Void (TxCert MaryEra))
-> StrictSeq (TxCert (PreviousEra MaryEra))
-> Either Void (StrictSeq (TxCert MaryEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictSeq a -> f (StrictSeq b)
traverse TxCert (PreviousEra MaryEra) -> Either Void (TxCert MaryEra)
TxCert (PreviousEra MaryEra)
-> Either (TxCertUpgradeError MaryEra) (TxCert MaryEra)
forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert (TxBody AllegraEra -> StrictSeq (TxCert AllegraEra)
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody AllegraEra -> StrictSeq (TxCert AllegraEra)
Allegra.atbCerts TxBody AllegraEra
TxBody (PreviousEra MaryEra)
atb)
    TxBody MaryEra -> Either Void (TxBody MaryEra)
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBody MaryEra -> Either Void (TxBody MaryEra))
-> TxBody MaryEra -> Either Void (TxBody MaryEra)
forall a b. (a -> b) -> a -> b
$
      MaryTxBody
        { mtbInputs :: Set TxIn
mtbInputs = TxBody AllegraEra -> Set TxIn
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody AllegraEra -> Set TxIn
Allegra.atbInputs TxBody AllegraEra
TxBody (PreviousEra MaryEra)
atb
        , mtbOutputs :: StrictSeq (TxOut MaryEra)
mtbOutputs = TxOut (PreviousEra MaryEra) -> TxOut MaryEra
TxOut (PreviousEra MaryEra) -> ShelleyTxOut MaryEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (TxOut (PreviousEra MaryEra) -> ShelleyTxOut MaryEra)
-> StrictSeq (TxOut (PreviousEra MaryEra))
-> StrictSeq (ShelleyTxOut MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody AllegraEra -> StrictSeq (TxOut AllegraEra)
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody AllegraEra -> StrictSeq (TxOut AllegraEra)
Allegra.atbOutputs TxBody AllegraEra
TxBody (PreviousEra MaryEra)
atb
        , mtbCerts :: StrictSeq (TxCert MaryEra)
mtbCerts = StrictSeq (TxCert MaryEra)
certs
        , mtbWithdrawals :: Withdrawals
mtbWithdrawals = TxBody AllegraEra -> Withdrawals
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody AllegraEra -> Withdrawals
Allegra.atbWithdrawals TxBody AllegraEra
TxBody (PreviousEra MaryEra)
atb
        , mtbTxFee :: Coin
mtbTxFee = TxBody AllegraEra -> Coin
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody AllegraEra -> Coin
Allegra.atbTxFee TxBody AllegraEra
TxBody (PreviousEra MaryEra)
atb
        , mtbValidityInterval :: ValidityInterval
mtbValidityInterval = TxBody AllegraEra -> ValidityInterval
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody AllegraEra -> ValidityInterval
Allegra.atbValidityInterval TxBody AllegraEra
TxBody (PreviousEra MaryEra)
atb
        , mtbUpdate :: StrictMaybe (Update MaryEra)
mtbUpdate = UpgradePParams StrictMaybe MaryEra
-> Update (PreviousEra MaryEra) -> Update MaryEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> Update (PreviousEra era) -> Update era
upgradeUpdate () (Update AllegraEra -> Update MaryEra)
-> StrictMaybe (Update AllegraEra) -> StrictMaybe (Update MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody AllegraEra -> StrictMaybe (Update AllegraEra)
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody AllegraEra -> StrictMaybe (Update AllegraEra)
Allegra.atbUpdate TxBody AllegraEra
TxBody (PreviousEra MaryEra)
atb
        , mtbAuxDataHash :: StrictMaybe TxAuxDataHash
mtbAuxDataHash = TxBody AllegraEra -> StrictMaybe TxAuxDataHash
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody AllegraEra -> StrictMaybe TxAuxDataHash
Allegra.atbAuxDataHash TxBody AllegraEra
TxBody (PreviousEra MaryEra)
atb
        , mtbMint :: MultiAsset
mtbMint = MultiAsset
forall a. Monoid a => a
mempty
        }

  upgradeTxAuxData :: EraTxAuxData (PreviousEra MaryEra) =>
TxAuxData (PreviousEra MaryEra) -> TxAuxData MaryEra
upgradeTxAuxData (AllegraTxAuxData Map Word64 Metadatum
md StrictSeq (Timelock AllegraEra)
scripts) = Map Word64 Metadatum
-> StrictSeq (Timelock MaryEra) -> AllegraTxAuxData MaryEra
forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData Map Word64 Metadatum
md (StrictSeq (Timelock MaryEra) -> AllegraTxAuxData MaryEra)
-> StrictSeq (Timelock MaryEra) -> AllegraTxAuxData MaryEra
forall a b. (a -> b) -> a -> b
$ Timelock AllegraEra -> Timelock MaryEra
Script (PreviousEra MaryEra) -> Script MaryEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Timelock AllegraEra -> Timelock MaryEra)
-> StrictSeq (Timelock AllegraEra) -> StrictSeq (Timelock MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock AllegraEra)
scripts

  upgradeTxWits :: EraTxWits (PreviousEra MaryEra) =>
TxWits (PreviousEra MaryEra) -> TxWits MaryEra
upgradeTxWits TxWits (PreviousEra MaryEra)
stw =
    Set (WitVKey 'Witness)
-> Map ScriptHash (Script MaryEra)
-> Set BootstrapWitness
-> ShelleyTxWits MaryEra
forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits
      (ShelleyTxWits AllegraEra -> Set (WitVKey 'Witness)
forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
addrWits TxWits (PreviousEra MaryEra)
ShelleyTxWits AllegraEra
stw)
      (Script (PreviousEra MaryEra) -> Timelock MaryEra
Script (PreviousEra MaryEra) -> Script MaryEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra MaryEra) -> Timelock MaryEra)
-> Map ScriptHash (Script (PreviousEra MaryEra))
-> Map ScriptHash (Timelock MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyTxWits AllegraEra -> Map ScriptHash (Script AllegraEra)
forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
scriptWits TxWits (PreviousEra MaryEra)
ShelleyTxWits AllegraEra
stw)
      (ShelleyTxWits AllegraEra -> Set BootstrapWitness
forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
bootWits TxWits (PreviousEra MaryEra)
ShelleyTxWits AllegraEra
stw)

newtype AlonzoTxUpgradeError = ATUEBodyUpgradeError AlonzoTxBodyUpgradeError
  deriving (Int -> AlonzoTxUpgradeError -> [Char] -> [Char]
[AlonzoTxUpgradeError] -> [Char] -> [Char]
AlonzoTxUpgradeError -> [Char]
(Int -> AlonzoTxUpgradeError -> [Char] -> [Char])
-> (AlonzoTxUpgradeError -> [Char])
-> ([AlonzoTxUpgradeError] -> [Char] -> [Char])
-> Show AlonzoTxUpgradeError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> AlonzoTxUpgradeError -> [Char] -> [Char]
showsPrec :: Int -> AlonzoTxUpgradeError -> [Char] -> [Char]
$cshow :: AlonzoTxUpgradeError -> [Char]
show :: AlonzoTxUpgradeError -> [Char]
$cshowList :: [AlonzoTxUpgradeError] -> [Char] -> [Char]
showList :: [AlonzoTxUpgradeError] -> [Char] -> [Char]
Show)

data AlonzoTxBodyUpgradeError
  = -- | The TxBody contains a protocol parameter update that attempts to update
    -- the min UTxO. Since this doesn't exist in Alonzo, we fail if an attempt is
    -- made to update it.
    ATBUEMinUTxOUpdated
  deriving (Int -> AlonzoTxBodyUpgradeError -> [Char] -> [Char]
[AlonzoTxBodyUpgradeError] -> [Char] -> [Char]
AlonzoTxBodyUpgradeError -> [Char]
(Int -> AlonzoTxBodyUpgradeError -> [Char] -> [Char])
-> (AlonzoTxBodyUpgradeError -> [Char])
-> ([AlonzoTxBodyUpgradeError] -> [Char] -> [Char])
-> Show AlonzoTxBodyUpgradeError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> AlonzoTxBodyUpgradeError -> [Char] -> [Char]
showsPrec :: Int -> AlonzoTxBodyUpgradeError -> [Char] -> [Char]
$cshow :: AlonzoTxBodyUpgradeError -> [Char]
show :: AlonzoTxBodyUpgradeError -> [Char]
$cshowList :: [AlonzoTxBodyUpgradeError] -> [Char] -> [Char]
showList :: [AlonzoTxBodyUpgradeError] -> [Char] -> [Char]
Show)

instance EraApi AlonzoEra where
  type TxUpgradeError AlonzoEra = AlonzoTxUpgradeError
  type TxBodyUpgradeError AlonzoEra = AlonzoTxBodyUpgradeError

  upgradeTx :: EraTx (PreviousEra AlonzoEra) =>
Tx (PreviousEra AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (Tx AlonzoEra)
upgradeTx (MkMaryTx (ShelleyTx TxBody MaryEra
body TxWits MaryEra
wits StrictMaybe (TxAuxData MaryEra)
aux)) =
    (AlonzoTx AlonzoEra -> Tx AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (AlonzoTx AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (Tx AlonzoEra)
forall a b.
(a -> b)
-> Either (TxUpgradeError AlonzoEra) a
-> Either (TxUpgradeError AlonzoEra) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AlonzoTx AlonzoEra -> Tx AlonzoEra
MkAlonzoTx (Either (TxUpgradeError AlonzoEra) (AlonzoTx AlonzoEra)
 -> Either (TxUpgradeError AlonzoEra) (Tx AlonzoEra))
-> Either (TxUpgradeError AlonzoEra) (AlonzoTx AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (Tx AlonzoEra)
forall a b. (a -> b) -> a -> b
$
      TxBody AlonzoEra
-> TxWits AlonzoEra
-> IsValid
-> StrictMaybe (TxAuxData AlonzoEra)
-> AlonzoTx AlonzoEra
TxBody AlonzoEra
-> AlonzoTxWits AlonzoEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData AlonzoEra)
-> AlonzoTx AlonzoEra
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
        (TxBody AlonzoEra
 -> AlonzoTxWits AlonzoEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
 -> AlonzoTx AlonzoEra)
-> Either AlonzoTxUpgradeError (TxBody AlonzoEra)
-> Either
     AlonzoTxUpgradeError
     (AlonzoTxWits AlonzoEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
      -> AlonzoTx AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AlonzoTxBodyUpgradeError -> AlonzoTxUpgradeError)
-> Either AlonzoTxBodyUpgradeError (TxBody AlonzoEra)
-> Either AlonzoTxUpgradeError (TxBody AlonzoEra)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left AlonzoTxBodyUpgradeError -> AlonzoTxUpgradeError
ATUEBodyUpgradeError (TxBody (PreviousEra AlonzoEra)
-> Either (TxBodyUpgradeError AlonzoEra) (TxBody AlonzoEra)
forall era.
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody (PreviousEra AlonzoEra)
TxBody MaryEra
body)
        Either
  AlonzoTxUpgradeError
  (AlonzoTxWits AlonzoEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
   -> AlonzoTx AlonzoEra)
-> Either AlonzoTxUpgradeError (AlonzoTxWits AlonzoEra)
-> Either
     AlonzoTxUpgradeError
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx AlonzoEra)
forall a b.
Either AlonzoTxUpgradeError (a -> b)
-> Either AlonzoTxUpgradeError a -> Either AlonzoTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AlonzoTxWits AlonzoEra
-> Either AlonzoTxUpgradeError (AlonzoTxWits AlonzoEra)
forall a. a -> Either AlonzoTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxWits (PreviousEra AlonzoEra) -> TxWits AlonzoEra
forall era.
(EraApi era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits (PreviousEra AlonzoEra)
TxWits MaryEra
wits)
        Either
  AlonzoTxUpgradeError
  (IsValid
   -> StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx AlonzoEra)
-> Either AlonzoTxUpgradeError IsValid
-> Either
     AlonzoTxUpgradeError
     (StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx AlonzoEra)
forall a b.
Either AlonzoTxUpgradeError (a -> b)
-> Either AlonzoTxUpgradeError a -> Either AlonzoTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IsValid -> Either AlonzoTxUpgradeError IsValid
forall a. a -> Either AlonzoTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IsValid
IsValid Bool
True)
        Either
  AlonzoTxUpgradeError
  (StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx AlonzoEra)
-> Either
     AlonzoTxUpgradeError (StrictMaybe (AlonzoTxAuxData AlonzoEra))
-> Either AlonzoTxUpgradeError (AlonzoTx AlonzoEra)
forall a b.
Either AlonzoTxUpgradeError (a -> b)
-> Either AlonzoTxUpgradeError a -> Either AlonzoTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AlonzoTxAuxData AlonzoEra)
-> Either
     AlonzoTxUpgradeError (StrictMaybe (AlonzoTxAuxData AlonzoEra))
forall a. a -> Either AlonzoTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxAuxData (PreviousEra AlonzoEra) -> AlonzoTxAuxData AlonzoEra)
-> StrictMaybe (TxAuxData (PreviousEra AlonzoEra))
-> StrictMaybe (AlonzoTxAuxData AlonzoEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData (PreviousEra AlonzoEra) -> TxAuxData AlonzoEra
TxAuxData (PreviousEra AlonzoEra) -> AlonzoTxAuxData AlonzoEra
forall era.
(EraApi era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData (PreviousEra AlonzoEra))
StrictMaybe (TxAuxData MaryEra)
aux)

  upgradeTxBody :: EraTxBody (PreviousEra AlonzoEra) =>
TxBody (PreviousEra AlonzoEra)
-> Either (TxBodyUpgradeError AlonzoEra) (TxBody AlonzoEra)
upgradeTxBody
    MaryTxBody
      { Set TxIn
mtbInputs :: (EraTxOut MaryEra, EraTxCert MaryEra) => TxBody MaryEra -> Set TxIn
mtbInputs :: Set TxIn
mtbInputs
      , StrictSeq (TxOut MaryEra)
mtbOutputs :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> StrictSeq (TxOut MaryEra)
mtbOutputs :: StrictSeq (TxOut MaryEra)
mtbOutputs
      , StrictSeq (TxCert MaryEra)
mtbCerts :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> StrictSeq (TxCert MaryEra)
mtbCerts :: StrictSeq (TxCert MaryEra)
mtbCerts
      , Withdrawals
mtbWithdrawals :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> Withdrawals
mtbWithdrawals :: Withdrawals
mtbWithdrawals
      , Coin
mtbTxFee :: (EraTxOut MaryEra, EraTxCert MaryEra) => TxBody MaryEra -> Coin
mtbTxFee :: Coin
mtbTxFee
      , ValidityInterval
mtbValidityInterval :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> ValidityInterval
mtbValidityInterval :: ValidityInterval
mtbValidityInterval
      , StrictMaybe (Update MaryEra)
mtbUpdate :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> StrictMaybe (Update MaryEra)
mtbUpdate :: StrictMaybe (Update MaryEra)
mtbUpdate
      , StrictMaybe TxAuxDataHash
mtbAuxDataHash :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> StrictMaybe TxAuxDataHash
mtbAuxDataHash :: StrictMaybe TxAuxDataHash
mtbAuxDataHash
      , MultiAsset
mtbMint :: (EraTxOut MaryEra, EraTxCert MaryEra) =>
TxBody MaryEra -> MultiAsset
mtbMint :: MultiAsset
mtbMint
      } = do
      StrictSeq (TxCert AlonzoEra)
certs <-
        (TxCert (PreviousEra AlonzoEra)
 -> Either AlonzoTxBodyUpgradeError (TxCert AlonzoEra))
-> StrictSeq (TxCert (PreviousEra AlonzoEra))
-> Either AlonzoTxBodyUpgradeError (StrictSeq (TxCert AlonzoEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictSeq a -> f (StrictSeq b)
traverse
          ((Void -> AlonzoTxBodyUpgradeError)
-> Either Void (TxCert AlonzoEra)
-> Either AlonzoTxBodyUpgradeError (TxCert AlonzoEra)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Void -> AlonzoTxBodyUpgradeError
forall a. Void -> a
absurd (Either Void (TxCert AlonzoEra)
 -> Either AlonzoTxBodyUpgradeError (TxCert AlonzoEra))
-> (TxCert (PreviousEra AlonzoEra)
    -> Either Void (TxCert AlonzoEra))
-> TxCert (PreviousEra AlonzoEra)
-> Either AlonzoTxBodyUpgradeError (TxCert AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert (PreviousEra AlonzoEra) -> Either Void (TxCert AlonzoEra)
TxCert (PreviousEra AlonzoEra)
-> Either (TxCertUpgradeError AlonzoEra) (TxCert AlonzoEra)
forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert)
          StrictSeq (TxCert (PreviousEra AlonzoEra))
StrictSeq (TxCert MaryEra)
mtbCerts

      StrictMaybe (Update AlonzoEra)
updates <- (Update MaryEra
 -> Either AlonzoTxBodyUpgradeError (Update AlonzoEra))
-> StrictMaybe (Update MaryEra)
-> Either AlonzoTxBodyUpgradeError (StrictMaybe (Update AlonzoEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
traverse Update MaryEra
-> Either AlonzoTxBodyUpgradeError (Update AlonzoEra)
upgradeUpdateEither StrictMaybe (Update MaryEra)
mtbUpdate
      TxBody AlonzoEra
-> Either AlonzoTxBodyUpgradeError (TxBody AlonzoEra)
forall a. a -> Either AlonzoTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBody AlonzoEra
 -> Either AlonzoTxBodyUpgradeError (TxBody AlonzoEra))
-> TxBody AlonzoEra
-> Either AlonzoTxBodyUpgradeError (TxBody AlonzoEra)
forall a b. (a -> b) -> a -> b
$
        AlonzoTxBody
          { atbInputs :: Set TxIn
atbInputs = Set TxIn
mtbInputs
          , atbOutputs :: StrictSeq (TxOut AlonzoEra)
atbOutputs = TxOut (PreviousEra AlonzoEra) -> TxOut AlonzoEra
TxOut (PreviousEra AlonzoEra) -> AlonzoTxOut AlonzoEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (TxOut (PreviousEra AlonzoEra) -> AlonzoTxOut AlonzoEra)
-> StrictSeq (TxOut (PreviousEra AlonzoEra))
-> StrictSeq (AlonzoTxOut AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (TxOut (PreviousEra AlonzoEra))
StrictSeq (TxOut MaryEra)
mtbOutputs
          , atbCerts :: StrictSeq (TxCert AlonzoEra)
atbCerts = StrictSeq (TxCert AlonzoEra)
certs
          , atbWithdrawals :: Withdrawals
atbWithdrawals = Withdrawals
mtbWithdrawals
          , atbTxFee :: Coin
atbTxFee = Coin
mtbTxFee
          , atbValidityInterval :: ValidityInterval
atbValidityInterval = ValidityInterval
mtbValidityInterval
          , atbUpdate :: StrictMaybe (Update AlonzoEra)
atbUpdate = StrictMaybe (Update AlonzoEra)
updates
          , atbAuxDataHash :: StrictMaybe TxAuxDataHash
atbAuxDataHash = StrictMaybe TxAuxDataHash
mtbAuxDataHash
          , atbMint :: MultiAsset
atbMint = MultiAsset
mtbMint
          , atbCollateral :: Set TxIn
atbCollateral = Set TxIn
forall a. Monoid a => a
mempty
          , atbReqSignerHashes :: Set (KeyHash 'Witness)
atbReqSignerHashes = Set (KeyHash 'Witness)
forall a. Monoid a => a
mempty
          , atbScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
atbScriptIntegrityHash = StrictMaybe ScriptIntegrityHash
forall a. StrictMaybe a
SNothing
          , atbTxNetworkId :: StrictMaybe Network
atbTxNetworkId = StrictMaybe Network
forall a. StrictMaybe a
SNothing
          }
      where
        upgradeUpdateEither ::
          Update MaryEra ->
          Either AlonzoTxBodyUpgradeError (Update AlonzoEra)
        upgradeUpdateEither :: Update MaryEra
-> Either AlonzoTxBodyUpgradeError (Update AlonzoEra)
upgradeUpdateEither (Update ProposedPPUpdates MaryEra
pp EpochNo
epoch) =
          ProposedPPUpdates AlonzoEra -> EpochNo -> Update AlonzoEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update (ProposedPPUpdates AlonzoEra -> EpochNo -> Update AlonzoEra)
-> Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
-> Either AlonzoTxBodyUpgradeError (EpochNo -> Update AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProposedPPUpdates MaryEra
-> Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
upgradeProposedPPUpdates ProposedPPUpdates MaryEra
pp Either AlonzoTxBodyUpgradeError (EpochNo -> Update AlonzoEra)
-> Either AlonzoTxBodyUpgradeError EpochNo
-> Either AlonzoTxBodyUpgradeError (Update AlonzoEra)
forall a b.
Either AlonzoTxBodyUpgradeError (a -> b)
-> Either AlonzoTxBodyUpgradeError a
-> Either AlonzoTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EpochNo -> Either AlonzoTxBodyUpgradeError EpochNo
forall a. a -> Either AlonzoTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochNo
epoch

        upgradeProposedPPUpdates ::
          ProposedPPUpdates MaryEra ->
          Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
        upgradeProposedPPUpdates :: ProposedPPUpdates MaryEra
-> Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
upgradeProposedPPUpdates (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
m) =
          Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates
            (Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
 -> ProposedPPUpdates AlonzoEra)
-> Either
     AlonzoTxBodyUpgradeError
     (Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra))
-> Either AlonzoTxBodyUpgradeError (ProposedPPUpdates AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PParamsUpdate MaryEra
 -> Either AlonzoTxBodyUpgradeError (PParamsUpdate AlonzoEra))
-> Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
-> Either
     AlonzoTxBodyUpgradeError
     (Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Map (KeyHash 'Genesis) a -> f (Map (KeyHash 'Genesis) b)
traverse
              ( \PParamsUpdate MaryEra
ppu -> do
                  Bool
-> Either AlonzoTxBodyUpgradeError ()
-> Either AlonzoTxBodyUpgradeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe Coin -> Bool
forall a. StrictMaybe a -> Bool
isSJust (StrictMaybe Coin -> Bool) -> StrictMaybe Coin -> Bool
forall a b. (a -> b) -> a -> b
$ PParamsUpdate MaryEra
ppu PParamsUpdate MaryEra
-> Getting
     (StrictMaybe Coin) (PParamsUpdate MaryEra) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (PParamsUpdate MaryEra) (StrictMaybe Coin)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate MaryEra) (StrictMaybe Coin)
ppuMinUTxOValueL) (Either AlonzoTxBodyUpgradeError ()
 -> Either AlonzoTxBodyUpgradeError ())
-> Either AlonzoTxBodyUpgradeError ()
-> Either AlonzoTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$
                    AlonzoTxBodyUpgradeError -> Either AlonzoTxBodyUpgradeError ()
forall a b. a -> Either a b
Left AlonzoTxBodyUpgradeError
ATBUEMinUTxOUpdated
                  PParamsUpdate AlonzoEra
-> Either AlonzoTxBodyUpgradeError (PParamsUpdate AlonzoEra)
forall a. a -> Either AlonzoTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParamsUpdate AlonzoEra
 -> Either AlonzoTxBodyUpgradeError (PParamsUpdate AlonzoEra))
-> PParamsUpdate AlonzoEra
-> Either AlonzoTxBodyUpgradeError (PParamsUpdate AlonzoEra)
forall a b. (a -> b) -> a -> b
$ UpgradePParams StrictMaybe AlonzoEra
-> PParamsUpdate (PreviousEra AlonzoEra) -> PParamsUpdate AlonzoEra
forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
UpgradePParams StrictMaybe era
-> PParamsUpdate (PreviousEra era) -> PParamsUpdate era
upgradePParamsUpdate UpgradePParams StrictMaybe AlonzoEra
UpgradeAlonzoPParams StrictMaybe
forall a. Default a => a
def PParamsUpdate (PreviousEra AlonzoEra)
PParamsUpdate MaryEra
ppu
              )
              Map (KeyHash 'Genesis) (PParamsUpdate MaryEra)
m

  upgradeTxAuxData :: EraTxAuxData (PreviousEra AlonzoEra) =>
TxAuxData (PreviousEra AlonzoEra) -> TxAuxData AlonzoEra
upgradeTxAuxData (AllegraTxAuxData Map Word64 Metadatum
md StrictSeq (Timelock MaryEra)
scripts) =
    forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @AlonzoEra (RawType (TxAuxData AlonzoEra) -> TxAuxData AlonzoEra)
-> RawType (TxAuxData AlonzoEra) -> TxAuxData AlonzoEra
forall a b. (a -> b) -> a -> b
$
      AlonzoTxAuxDataRaw
        { atadrMetadata :: Map Word64 Metadatum
atadrMetadata = Map Word64 Metadatum
md
        , atadrTimelock :: StrictSeq (Timelock AlonzoEra)
atadrTimelock = Timelock MaryEra -> Timelock AlonzoEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock (Timelock MaryEra -> Timelock AlonzoEra)
-> StrictSeq (Timelock MaryEra) -> StrictSeq (Timelock AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock MaryEra)
scripts
        , atadrPlutus :: Map Language (NonEmpty PlutusBinary)
atadrPlutus = Map Language (NonEmpty PlutusBinary)
forall a. Monoid a => a
mempty
        }

  upgradeTxWits :: EraTxWits (PreviousEra AlonzoEra) =>
TxWits (PreviousEra AlonzoEra) -> TxWits AlonzoEra
upgradeTxWits (ShelleyTxWits {Set (WitVKey 'Witness)
addrWits :: forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
addrWits :: Set (WitVKey 'Witness)
addrWits, Map ScriptHash (Script MaryEra)
scriptWits :: forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
scriptWits :: Map ScriptHash (Script MaryEra)
scriptWits, Set BootstrapWitness
bootWits :: forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
bootWits :: Set BootstrapWitness
bootWits}) =
    Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script AlonzoEra)
-> TxDats AlonzoEra
-> Redeemers AlonzoEra
-> AlonzoTxWits AlonzoEra
forall era.
AlonzoEraScript era =>
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
AlonzoTxWits Set (WitVKey 'Witness)
addrWits Set BootstrapWitness
bootWits (Script (PreviousEra AlonzoEra) -> Script AlonzoEra
Script (PreviousEra AlonzoEra) -> AlonzoScript AlonzoEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra AlonzoEra) -> AlonzoScript AlonzoEra)
-> Map ScriptHash (Script (PreviousEra AlonzoEra))
-> Map ScriptHash (AlonzoScript AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ScriptHash (Script (PreviousEra AlonzoEra))
Map ScriptHash (Script MaryEra)
scriptWits) TxDats AlonzoEra
forall a. Monoid a => a
mempty (Map (PlutusPurpose AsIx AlonzoEra) (Data AlonzoEra, ExUnits)
-> Redeemers AlonzoEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers Map (AlonzoPlutusPurpose AsIx AlonzoEra) (Data AlonzoEra, ExUnits)
Map (PlutusPurpose AsIx AlonzoEra) (Data AlonzoEra, ExUnits)
forall a. Monoid a => a
mempty)

-- | Upgrade redeemers from one era to another. The underlying data structure
-- will remain identical, but the memoised serialisation may change to reflect
-- the versioned serialisation of the new era.
upgradeRedeemers ::
  forall era.
  (AlonzoEraScript (PreviousEra era), AlonzoEraScript era) =>
  Redeemers (PreviousEra era) ->
  Redeemers era
upgradeRedeemers :: forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era) =>
Redeemers (PreviousEra era) -> Redeemers era
upgradeRedeemers =
  Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers
    (Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era)
-> (Redeemers (PreviousEra era)
    -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Redeemers (PreviousEra era)
-> Redeemers era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlutusPurpose AsIx (PreviousEra era) -> PlutusPurpose AsIx era)
-> Map (PlutusPurpose AsIx (PreviousEra era)) (Data era, ExUnits)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys PlutusPurpose AsIx (PreviousEra era) -> PlutusPurpose AsIx era
forall era.
(AlonzoEraScript era, AlonzoEraScript (PreviousEra era)) =>
PlutusPurpose AsIx (PreviousEra era) -> PlutusPurpose AsIx era
upgradePlutusPurposeAsIx
    (Map (PlutusPurpose AsIx (PreviousEra era)) (Data era, ExUnits)
 -> Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> (Redeemers (PreviousEra era)
    -> Map (PlutusPurpose AsIx (PreviousEra era)) (Data era, ExUnits))
-> Redeemers (PreviousEra era)
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Data (PreviousEra era), ExUnits) -> (Data era, ExUnits))
-> Map
     (PlutusPurpose AsIx (PreviousEra era))
     (Data (PreviousEra era), ExUnits)
-> Map (PlutusPurpose AsIx (PreviousEra era)) (Data era, ExUnits)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Data (PreviousEra era) -> Data era)
-> (Data (PreviousEra era), ExUnits) -> (Data era, ExUnits)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Data (PreviousEra era) -> Data era
forall era1 era2. (Era era1, Era era2) => Data era1 -> Data era2
upgradeData)
    (Map
   (PlutusPurpose AsIx (PreviousEra era))
   (Data (PreviousEra era), ExUnits)
 -> Map (PlutusPurpose AsIx (PreviousEra era)) (Data era, ExUnits))
-> (Redeemers (PreviousEra era)
    -> Map
         (PlutusPurpose AsIx (PreviousEra era))
         (Data (PreviousEra era), ExUnits))
-> Redeemers (PreviousEra era)
-> Map (PlutusPurpose AsIx (PreviousEra era)) (Data era, ExUnits)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redeemers (PreviousEra era)
-> Map
     (PlutusPurpose AsIx (PreviousEra era))
     (Data (PreviousEra era), ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers

-- | Upgrade 'TxDats' from one era to another. The underlying data structure
-- will remain identical, but the memoised serialisation may change to reflect
-- the versioned serialisation of the new era.
upgradeTxDats ::
  (Era era1, Era era2) =>
  TxDats era1 ->
  TxDats era2
upgradeTxDats :: forall era1 era2.
(Era era1, Era era2) =>
TxDats era1 -> TxDats era2
upgradeTxDats (TxDats Map DataHash (Data era1)
datMap) = Map DataHash (Data era2) -> TxDats era2
forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats (Map DataHash (Data era2) -> TxDats era2)
-> Map DataHash (Data era2) -> TxDats era2
forall a b. (a -> b) -> a -> b
$ (Data era1 -> Data era2)
-> Map DataHash (Data era1) -> Map DataHash (Data era2)
forall a b. (a -> b) -> Map DataHash a -> Map DataHash b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Data era1 -> Data era2
forall era1 era2. (Era era1, Era era2) => Data era1 -> Data era2
upgradeData Map DataHash (Data era1)
datMap

translateAlonzoTxAuxData ::
  (AlonzoEraScript era1, AlonzoEraScript era2) =>
  AlonzoTxAuxData era1 ->
  AlonzoTxAuxData era2
translateAlonzoTxAuxData :: forall era1 era2.
(AlonzoEraScript era1, AlonzoEraScript era2) =>
AlonzoTxAuxData era1 -> AlonzoTxAuxData era2
translateAlonzoTxAuxData AlonzoTxAuxData {Map Word64 Metadatum
atadMetadata :: Map Word64 Metadatum
atadMetadata :: forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> Map Word64 Metadatum
atadMetadata, StrictSeq (Timelock era1)
atadTimelock :: StrictSeq (Timelock era1)
atadTimelock :: forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> StrictSeq (Timelock era)
atadTimelock, Map Language (NonEmpty PlutusBinary)
atadPlutus :: Map Language (NonEmpty PlutusBinary)
atadPlutus :: forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> Map Language (NonEmpty PlutusBinary)
atadPlutus} =
  AlonzoTxAuxData
    { atadMetadata :: Map Word64 Metadatum
atadMetadata = Map Word64 Metadatum
atadMetadata
    , atadTimelock :: StrictSeq (Timelock era2)
atadTimelock = Timelock era1 -> Timelock era2
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock (Timelock era1 -> Timelock era2)
-> StrictSeq (Timelock era1) -> StrictSeq (Timelock era2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock era1)
atadTimelock
    , atadPlutus :: Map Language (NonEmpty PlutusBinary)
atadPlutus = Map Language (NonEmpty PlutusBinary)
atadPlutus
    }

newtype BabbageTxUpgradeError
  = BTUEBodyUpgradeError BabbageTxBodyUpgradeError
  deriving (BabbageTxUpgradeError -> BabbageTxUpgradeError -> Bool
(BabbageTxUpgradeError -> BabbageTxUpgradeError -> Bool)
-> (BabbageTxUpgradeError -> BabbageTxUpgradeError -> Bool)
-> Eq BabbageTxUpgradeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BabbageTxUpgradeError -> BabbageTxUpgradeError -> Bool
== :: BabbageTxUpgradeError -> BabbageTxUpgradeError -> Bool
$c/= :: BabbageTxUpgradeError -> BabbageTxUpgradeError -> Bool
/= :: BabbageTxUpgradeError -> BabbageTxUpgradeError -> Bool
Eq, Int -> BabbageTxUpgradeError -> [Char] -> [Char]
[BabbageTxUpgradeError] -> [Char] -> [Char]
BabbageTxUpgradeError -> [Char]
(Int -> BabbageTxUpgradeError -> [Char] -> [Char])
-> (BabbageTxUpgradeError -> [Char])
-> ([BabbageTxUpgradeError] -> [Char] -> [Char])
-> Show BabbageTxUpgradeError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> BabbageTxUpgradeError -> [Char] -> [Char]
showsPrec :: Int -> BabbageTxUpgradeError -> [Char] -> [Char]
$cshow :: BabbageTxUpgradeError -> [Char]
show :: BabbageTxUpgradeError -> [Char]
$cshowList :: [BabbageTxUpgradeError] -> [Char] -> [Char]
showList :: [BabbageTxUpgradeError] -> [Char] -> [Char]
Show)

data BabbageTxBodyUpgradeError
  = -- | The update attempts to update the decentralistion parameter, which is
    -- dropped in Babbage.
    BTBUEUpdatesD
  | -- | The update attempts to update the extra entropy, which is dropped in
    --   Babbage.
    BTBUEUpdatesExtraEntropy
  deriving (BabbageTxBodyUpgradeError -> BabbageTxBodyUpgradeError -> Bool
(BabbageTxBodyUpgradeError -> BabbageTxBodyUpgradeError -> Bool)
-> (BabbageTxBodyUpgradeError -> BabbageTxBodyUpgradeError -> Bool)
-> Eq BabbageTxBodyUpgradeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BabbageTxBodyUpgradeError -> BabbageTxBodyUpgradeError -> Bool
== :: BabbageTxBodyUpgradeError -> BabbageTxBodyUpgradeError -> Bool
$c/= :: BabbageTxBodyUpgradeError -> BabbageTxBodyUpgradeError -> Bool
/= :: BabbageTxBodyUpgradeError -> BabbageTxBodyUpgradeError -> Bool
Eq, Int -> BabbageTxBodyUpgradeError -> [Char] -> [Char]
[BabbageTxBodyUpgradeError] -> [Char] -> [Char]
BabbageTxBodyUpgradeError -> [Char]
(Int -> BabbageTxBodyUpgradeError -> [Char] -> [Char])
-> (BabbageTxBodyUpgradeError -> [Char])
-> ([BabbageTxBodyUpgradeError] -> [Char] -> [Char])
-> Show BabbageTxBodyUpgradeError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> BabbageTxBodyUpgradeError -> [Char] -> [Char]
showsPrec :: Int -> BabbageTxBodyUpgradeError -> [Char] -> [Char]
$cshow :: BabbageTxBodyUpgradeError -> [Char]
show :: BabbageTxBodyUpgradeError -> [Char]
$cshowList :: [BabbageTxBodyUpgradeError] -> [Char] -> [Char]
showList :: [BabbageTxBodyUpgradeError] -> [Char] -> [Char]
Show)

instance EraApi BabbageEra where
  type TxUpgradeError BabbageEra = BabbageTxUpgradeError
  type TxBodyUpgradeError BabbageEra = BabbageTxBodyUpgradeError

  upgradeTx :: EraTx (PreviousEra BabbageEra) =>
Tx (PreviousEra BabbageEra)
-> Either (TxUpgradeError BabbageEra) (Tx BabbageEra)
upgradeTx (MkAlonzoTx (AlonzoTx TxBody AlonzoEra
b TxWits AlonzoEra
w IsValid
valid StrictMaybe (TxAuxData AlonzoEra)
aux)) =
    (AlonzoTx BabbageEra -> Tx BabbageEra)
-> Either (TxUpgradeError BabbageEra) (AlonzoTx BabbageEra)
-> Either (TxUpgradeError BabbageEra) (Tx BabbageEra)
forall a b.
(a -> b)
-> Either (TxUpgradeError BabbageEra) a
-> Either (TxUpgradeError BabbageEra) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AlonzoTx BabbageEra -> Tx BabbageEra
MkBabbageTx (Either (TxUpgradeError BabbageEra) (AlonzoTx BabbageEra)
 -> Either (TxUpgradeError BabbageEra) (Tx BabbageEra))
-> Either (TxUpgradeError BabbageEra) (AlonzoTx BabbageEra)
-> Either (TxUpgradeError BabbageEra) (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$
      TxBody BabbageEra
-> TxWits BabbageEra
-> IsValid
-> StrictMaybe (TxAuxData BabbageEra)
-> AlonzoTx BabbageEra
TxBody BabbageEra
-> AlonzoTxWits BabbageEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData BabbageEra)
-> AlonzoTx BabbageEra
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
        (TxBody BabbageEra
 -> AlonzoTxWits BabbageEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData BabbageEra)
 -> AlonzoTx BabbageEra)
-> Either BabbageTxUpgradeError (TxBody BabbageEra)
-> Either
     BabbageTxUpgradeError
     (AlonzoTxWits BabbageEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData BabbageEra)
      -> AlonzoTx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BabbageTxBodyUpgradeError -> BabbageTxUpgradeError)
-> Either BabbageTxBodyUpgradeError (TxBody BabbageEra)
-> Either BabbageTxUpgradeError (TxBody BabbageEra)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left BabbageTxBodyUpgradeError -> BabbageTxUpgradeError
BTUEBodyUpgradeError (TxBody (PreviousEra BabbageEra)
-> Either (TxBodyUpgradeError BabbageEra) (TxBody BabbageEra)
forall era.
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
b)
        Either
  BabbageTxUpgradeError
  (AlonzoTxWits BabbageEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData BabbageEra)
   -> AlonzoTx BabbageEra)
-> Either BabbageTxUpgradeError (AlonzoTxWits BabbageEra)
-> Either
     BabbageTxUpgradeError
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData BabbageEra) -> AlonzoTx BabbageEra)
forall a b.
Either BabbageTxUpgradeError (a -> b)
-> Either BabbageTxUpgradeError a -> Either BabbageTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AlonzoTxWits BabbageEra
-> Either BabbageTxUpgradeError (AlonzoTxWits BabbageEra)
forall a. a -> Either BabbageTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxWits (PreviousEra BabbageEra) -> TxWits BabbageEra
forall era.
(EraApi era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits (PreviousEra BabbageEra)
TxWits AlonzoEra
w)
        Either
  BabbageTxUpgradeError
  (IsValid
   -> StrictMaybe (AlonzoTxAuxData BabbageEra) -> AlonzoTx BabbageEra)
-> Either BabbageTxUpgradeError IsValid
-> Either
     BabbageTxUpgradeError
     (StrictMaybe (AlonzoTxAuxData BabbageEra) -> AlonzoTx BabbageEra)
forall a b.
Either BabbageTxUpgradeError (a -> b)
-> Either BabbageTxUpgradeError a -> Either BabbageTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IsValid -> Either BabbageTxUpgradeError IsValid
forall a. a -> Either BabbageTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsValid
valid
        Either
  BabbageTxUpgradeError
  (StrictMaybe (AlonzoTxAuxData BabbageEra) -> AlonzoTx BabbageEra)
-> Either
     BabbageTxUpgradeError (StrictMaybe (AlonzoTxAuxData BabbageEra))
-> Either BabbageTxUpgradeError (AlonzoTx BabbageEra)
forall a b.
Either BabbageTxUpgradeError (a -> b)
-> Either BabbageTxUpgradeError a -> Either BabbageTxUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AlonzoTxAuxData BabbageEra)
-> Either
     BabbageTxUpgradeError (StrictMaybe (AlonzoTxAuxData BabbageEra))
forall a. a -> Either BabbageTxUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxAuxData (PreviousEra BabbageEra) -> AlonzoTxAuxData BabbageEra)
-> StrictMaybe (TxAuxData (PreviousEra BabbageEra))
-> StrictMaybe (AlonzoTxAuxData BabbageEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData (PreviousEra BabbageEra) -> TxAuxData BabbageEra
TxAuxData (PreviousEra BabbageEra) -> AlonzoTxAuxData BabbageEra
forall era.
(EraApi era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData (PreviousEra BabbageEra))
StrictMaybe (TxAuxData AlonzoEra)
aux)

  upgradeTxBody :: EraTxBody (PreviousEra BabbageEra) =>
TxBody (PreviousEra BabbageEra)
-> Either (TxBodyUpgradeError BabbageEra) (TxBody BabbageEra)
upgradeTxBody TxBody (PreviousEra BabbageEra)
txBody = do
    StrictSeq (TxCert BabbageEra)
certs <-
      (TxCert (PreviousEra BabbageEra)
 -> Either BabbageTxBodyUpgradeError (TxCert BabbageEra))
-> StrictSeq (TxCert (PreviousEra BabbageEra))
-> Either BabbageTxBodyUpgradeError (StrictSeq (TxCert BabbageEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictSeq a -> f (StrictSeq b)
traverse
        ((Void -> BabbageTxBodyUpgradeError)
-> Either Void (TxCert BabbageEra)
-> Either BabbageTxBodyUpgradeError (TxCert BabbageEra)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Void -> BabbageTxBodyUpgradeError
forall a. Void -> a
absurd (Either Void (TxCert BabbageEra)
 -> Either BabbageTxBodyUpgradeError (TxCert BabbageEra))
-> (TxCert (PreviousEra BabbageEra)
    -> Either Void (TxCert BabbageEra))
-> TxCert (PreviousEra BabbageEra)
-> Either BabbageTxBodyUpgradeError (TxCert BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert (PreviousEra BabbageEra) -> Either Void (TxCert BabbageEra)
TxCert (PreviousEra BabbageEra)
-> Either (TxCertUpgradeError BabbageEra) (TxCert BabbageEra)
forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert)
        (TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting
     (StrictSeq (TxCert (PreviousEra BabbageEra)))
     (TxBody AlonzoEra)
     (StrictSeq (TxCert (PreviousEra BabbageEra)))
-> StrictSeq (TxCert (PreviousEra BabbageEra))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert (PreviousEra BabbageEra)))
  (TxBody AlonzoEra)
  (StrictSeq (TxCert (PreviousEra BabbageEra)))
(StrictSeq (TxCert AlonzoEra)
 -> Const
      (StrictSeq (TxCert (PreviousEra BabbageEra)))
      (StrictSeq (TxCert AlonzoEra)))
-> TxBody AlonzoEra
-> Const
     (StrictSeq (TxCert (PreviousEra BabbageEra))) (TxBody AlonzoEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody AlonzoEra) (StrictSeq (TxCert AlonzoEra))
certsTxBodyL)
    StrictMaybe (Update BabbageEra)
updates <- (Update AlonzoEra
 -> Either BabbageTxBodyUpgradeError (Update BabbageEra))
-> StrictMaybe (Update AlonzoEra)
-> Either
     BabbageTxBodyUpgradeError (StrictMaybe (Update BabbageEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictMaybe a -> f (StrictMaybe b)
traverse Update AlonzoEra
-> Either BabbageTxBodyUpgradeError (Update BabbageEra)
upgradeUpdateEither (TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting
     (StrictMaybe (Update AlonzoEra))
     (TxBody AlonzoEra)
     (StrictMaybe (Update AlonzoEra))
-> StrictMaybe (Update AlonzoEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Update AlonzoEra))
  (TxBody AlonzoEra)
  (StrictMaybe (Update AlonzoEra))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody AlonzoEra) (StrictMaybe (Update AlonzoEra))
updateTxBodyL)
    TxBody BabbageEra
-> Either BabbageTxBodyUpgradeError (TxBody BabbageEra)
forall a. a -> Either BabbageTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBody BabbageEra
 -> Either BabbageTxBodyUpgradeError (TxBody BabbageEra))
-> TxBody BabbageEra
-> Either BabbageTxBodyUpgradeError (TxBody BabbageEra)
forall a b. (a -> b) -> a -> b
$
      BabbageTxBody
        { btbInputs :: Set TxIn
btbInputs = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody AlonzoEra) (Set TxIn)
inputsTxBodyL
        , btbOutputs :: StrictSeq (Sized (TxOut BabbageEra))
btbOutputs =
            Version
-> BabbageTxOut BabbageEra -> Sized (BabbageTxOut BabbageEra)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerLow @BabbageEra) (BabbageTxOut BabbageEra -> Sized (BabbageTxOut BabbageEra))
-> (TxOut (PreviousEra BabbageEra) -> BabbageTxOut BabbageEra)
-> TxOut (PreviousEra BabbageEra)
-> Sized (BabbageTxOut BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut (PreviousEra BabbageEra) -> TxOut BabbageEra
TxOut (PreviousEra BabbageEra) -> BabbageTxOut BabbageEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (TxOut (PreviousEra BabbageEra) -> Sized (BabbageTxOut BabbageEra))
-> StrictSeq (TxOut (PreviousEra BabbageEra))
-> StrictSeq (Sized (BabbageTxOut BabbageEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting
     (StrictSeq (TxOut (PreviousEra BabbageEra)))
     (TxBody AlonzoEra)
     (StrictSeq (TxOut (PreviousEra BabbageEra)))
-> StrictSeq (TxOut (PreviousEra BabbageEra))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut (PreviousEra BabbageEra)))
  (TxBody AlonzoEra)
  (StrictSeq (TxOut (PreviousEra BabbageEra)))
(StrictSeq (TxOut AlonzoEra)
 -> Const
      (StrictSeq (TxOut (PreviousEra BabbageEra)))
      (StrictSeq (TxOut AlonzoEra)))
-> TxBody AlonzoEra
-> Const
     (StrictSeq (TxOut (PreviousEra BabbageEra))) (TxBody AlonzoEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody AlonzoEra) (StrictSeq (TxOut AlonzoEra))
outputsTxBodyL)
        , btbCerts :: StrictSeq (TxCert BabbageEra)
btbCerts = StrictSeq (TxCert BabbageEra)
certs
        , btbWithdrawals :: Withdrawals
btbWithdrawals = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting Withdrawals (TxBody AlonzoEra) Withdrawals
-> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody AlonzoEra) Withdrawals
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody AlonzoEra) Withdrawals
withdrawalsTxBodyL
        , btbTxFee :: Coin
btbTxFee = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra -> Getting Coin (TxBody AlonzoEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody AlonzoEra) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody AlonzoEra) Coin
feeTxBodyL
        , btbValidityInterval :: ValidityInterval
btbValidityInterval = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting ValidityInterval (TxBody AlonzoEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody AlonzoEra) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody AlonzoEra) ValidityInterval
vldtTxBodyL
        , btbUpdate :: StrictMaybe (Update BabbageEra)
btbUpdate = StrictMaybe (Update BabbageEra)
updates
        , btbAuxDataHash :: StrictMaybe TxAuxDataHash
btbAuxDataHash = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting
     (StrictMaybe TxAuxDataHash)
     (TxBody AlonzoEra)
     (StrictMaybe TxAuxDataHash)
-> StrictMaybe TxAuxDataHash
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe TxAuxDataHash)
  (TxBody AlonzoEra)
  (StrictMaybe TxAuxDataHash)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictMaybe TxAuxDataHash)
Lens' (TxBody AlonzoEra) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL
        , btbMint :: MultiAsset
btbMint = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting MultiAsset (TxBody AlonzoEra) MultiAsset -> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody AlonzoEra) MultiAsset
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody AlonzoEra) MultiAsset
mintTxBodyL
        , btbCollateral :: Set TxIn
btbCollateral = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn)
forall era. AlonzoEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody AlonzoEra) (Set TxIn)
collateralInputsTxBodyL
        , btbReqSignerHashes :: Set (KeyHash 'Witness)
btbReqSignerHashes = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting
     (Set (KeyHash 'Witness))
     (TxBody AlonzoEra)
     (Set (KeyHash 'Witness))
-> Set (KeyHash 'Witness)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (KeyHash 'Witness))
  (TxBody AlonzoEra)
  (Set (KeyHash 'Witness))
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness))
Lens' (TxBody AlonzoEra) (Set (KeyHash 'Witness))
reqSignerHashesTxBodyL
        , btbScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
btbScriptIntegrityHash = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting
     (StrictMaybe ScriptIntegrityHash)
     (TxBody AlonzoEra)
     (StrictMaybe ScriptIntegrityHash)
-> StrictMaybe ScriptIntegrityHash
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe ScriptIntegrityHash)
  (TxBody AlonzoEra)
  (StrictMaybe ScriptIntegrityHash)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe ScriptIntegrityHash)
Lens' (TxBody AlonzoEra) (StrictMaybe ScriptIntegrityHash)
scriptIntegrityHashTxBodyL
        , btbTxNetworkId :: StrictMaybe Network
btbTxNetworkId = TxBody (PreviousEra BabbageEra)
TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting
     (StrictMaybe Network) (TxBody AlonzoEra) (StrictMaybe Network)
-> StrictMaybe Network
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Network) (TxBody AlonzoEra) (StrictMaybe Network)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Network)
Lens' (TxBody AlonzoEra) (StrictMaybe Network)
networkIdTxBodyL
        , btbReferenceInputs :: Set TxIn
btbReferenceInputs = Set TxIn
forall a. Monoid a => a
mempty
        , btbCollateralReturn :: StrictMaybe (Sized (TxOut BabbageEra))
btbCollateralReturn = StrictMaybe (Sized (TxOut BabbageEra))
StrictMaybe (Sized (BabbageTxOut BabbageEra))
forall a. StrictMaybe a
SNothing
        , btbTotalCollateral :: StrictMaybe Coin
btbTotalCollateral = StrictMaybe Coin
forall a. StrictMaybe a
SNothing
        }
    where
      upgradeUpdateEither ::
        Update AlonzoEra ->
        Either BabbageTxBodyUpgradeError (Update BabbageEra)
      upgradeUpdateEither :: Update AlonzoEra
-> Either BabbageTxBodyUpgradeError (Update BabbageEra)
upgradeUpdateEither (Update ProposedPPUpdates AlonzoEra
pp EpochNo
epoch) =
        ProposedPPUpdates BabbageEra -> EpochNo -> Update BabbageEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update (ProposedPPUpdates BabbageEra -> EpochNo -> Update BabbageEra)
-> Either BabbageTxBodyUpgradeError (ProposedPPUpdates BabbageEra)
-> Either BabbageTxBodyUpgradeError (EpochNo -> Update BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProposedPPUpdates AlonzoEra
-> Either BabbageTxBodyUpgradeError (ProposedPPUpdates BabbageEra)
upgradeProposedPPUpdates ProposedPPUpdates AlonzoEra
pp Either BabbageTxBodyUpgradeError (EpochNo -> Update BabbageEra)
-> Either BabbageTxBodyUpgradeError EpochNo
-> Either BabbageTxBodyUpgradeError (Update BabbageEra)
forall a b.
Either BabbageTxBodyUpgradeError (a -> b)
-> Either BabbageTxBodyUpgradeError a
-> Either BabbageTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EpochNo -> Either BabbageTxBodyUpgradeError EpochNo
forall a. a -> Either BabbageTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochNo
epoch

      -- Note that here we use 'upgradeBabbagePParams False' in order to
      -- preserve 'CoinsPerUTxOWord', in spite of the value now being
      -- semantically incorrect. Anything else will result in an invalid
      -- transaction.
      upgradeProposedPPUpdates ::
        ProposedPPUpdates AlonzoEra ->
        Either BabbageTxBodyUpgradeError (ProposedPPUpdates BabbageEra)
      upgradeProposedPPUpdates :: ProposedPPUpdates AlonzoEra
-> Either BabbageTxBodyUpgradeError (ProposedPPUpdates BabbageEra)
upgradeProposedPPUpdates (ProposedPPUpdates Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
m) =
        Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
-> ProposedPPUpdates BabbageEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates
          (Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
 -> ProposedPPUpdates BabbageEra)
-> Either
     BabbageTxBodyUpgradeError
     (Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra))
-> Either BabbageTxBodyUpgradeError (ProposedPPUpdates BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PParamsUpdate AlonzoEra
 -> Either BabbageTxBodyUpgradeError (PParamsUpdate BabbageEra))
-> Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
-> Either
     BabbageTxBodyUpgradeError
     (Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Map (KeyHash 'Genesis) a -> f (Map (KeyHash 'Genesis) b)
traverse
            ( \(PParamsUpdate PParamsHKD StrictMaybe AlonzoEra
pphkd) -> do
                Bool
-> Either BabbageTxBodyUpgradeError ()
-> Either BabbageTxBodyUpgradeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe UnitInterval -> Bool
forall a. StrictMaybe a -> Bool
isSJust (StrictMaybe UnitInterval -> Bool)
-> StrictMaybe UnitInterval -> Bool
forall a b. (a -> b) -> a -> b
$ AlonzoPParams StrictMaybe AlonzoEra -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
appD PParamsHKD StrictMaybe AlonzoEra
AlonzoPParams StrictMaybe AlonzoEra
pphkd) (Either BabbageTxBodyUpgradeError ()
 -> Either BabbageTxBodyUpgradeError ())
-> Either BabbageTxBodyUpgradeError ()
-> Either BabbageTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$
                  BabbageTxBodyUpgradeError -> Either BabbageTxBodyUpgradeError ()
forall a b. a -> Either a b
Left BabbageTxBodyUpgradeError
BTBUEUpdatesD
                Bool
-> Either BabbageTxBodyUpgradeError ()
-> Either BabbageTxBodyUpgradeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe Nonce -> Bool
forall a. StrictMaybe a -> Bool
isSJust (StrictMaybe Nonce -> Bool) -> StrictMaybe Nonce -> Bool
forall a b. (a -> b) -> a -> b
$ AlonzoPParams StrictMaybe AlonzoEra -> HKD StrictMaybe Nonce
forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Nonce
appExtraEntropy PParamsHKD StrictMaybe AlonzoEra
AlonzoPParams StrictMaybe AlonzoEra
pphkd) (Either BabbageTxBodyUpgradeError ()
 -> Either BabbageTxBodyUpgradeError ())
-> Either BabbageTxBodyUpgradeError ()
-> Either BabbageTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$
                  BabbageTxBodyUpgradeError -> Either BabbageTxBodyUpgradeError ()
forall a b. a -> Either a b
Left BabbageTxBodyUpgradeError
BTBUEUpdatesExtraEntropy
                PParamsUpdate BabbageEra
-> Either BabbageTxBodyUpgradeError (PParamsUpdate BabbageEra)
forall a. a -> Either BabbageTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParamsUpdate BabbageEra
 -> Either BabbageTxBodyUpgradeError (PParamsUpdate BabbageEra))
-> (BabbagePParams StrictMaybe BabbageEra
    -> PParamsUpdate BabbageEra)
-> BabbagePParams StrictMaybe BabbageEra
-> Either BabbageTxBodyUpgradeError (PParamsUpdate BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParamsHKD StrictMaybe BabbageEra -> PParamsUpdate BabbageEra
BabbagePParams StrictMaybe BabbageEra -> PParamsUpdate BabbageEra
forall era. PParamsHKD StrictMaybe era -> PParamsUpdate era
PParamsUpdate (BabbagePParams StrictMaybe BabbageEra
 -> Either BabbageTxBodyUpgradeError (PParamsUpdate BabbageEra))
-> BabbagePParams StrictMaybe BabbageEra
-> Either BabbageTxBodyUpgradeError (PParamsUpdate BabbageEra)
forall a b. (a -> b) -> a -> b
$ Bool
-> PParamsHKD StrictMaybe AlonzoEra
-> BabbagePParams StrictMaybe BabbageEra
forall (f :: * -> *).
HKDFunctor f =>
Bool -> PParamsHKD f AlonzoEra -> BabbagePParams f BabbageEra
upgradeBabbagePParams Bool
False PParamsHKD StrictMaybe AlonzoEra
pphkd
            )
            Map (KeyHash 'Genesis) (PParamsUpdate AlonzoEra)
m

  upgradeTxAuxData :: EraTxAuxData (PreviousEra BabbageEra) =>
TxAuxData (PreviousEra BabbageEra) -> TxAuxData BabbageEra
upgradeTxAuxData = TxAuxData (PreviousEra BabbageEra) -> TxAuxData BabbageEra
AlonzoTxAuxData AlonzoEra -> AlonzoTxAuxData BabbageEra
forall era1 era2.
(AlonzoEraScript era1, AlonzoEraScript era2) =>
AlonzoTxAuxData era1 -> AlonzoTxAuxData era2
translateAlonzoTxAuxData

  upgradeTxWits :: EraTxWits (PreviousEra BabbageEra) =>
TxWits (PreviousEra BabbageEra) -> TxWits BabbageEra
upgradeTxWits TxWits (PreviousEra BabbageEra)
atw =
    AlonzoTxWits
      { txwitsVKey :: Set (WitVKey 'Witness)
txwitsVKey = AlonzoTxWits AlonzoEra -> Set (WitVKey 'Witness)
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness)
txwitsVKey TxWits (PreviousEra BabbageEra)
AlonzoTxWits AlonzoEra
atw
      , txwitsBoot :: Set BootstrapWitness
txwitsBoot = AlonzoTxWits AlonzoEra -> Set BootstrapWitness
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set BootstrapWitness
txwitsBoot TxWits (PreviousEra BabbageEra)
AlonzoTxWits AlonzoEra
atw
      , txscripts :: Map ScriptHash (Script BabbageEra)
txscripts = Script (PreviousEra BabbageEra) -> Script BabbageEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra BabbageEra) -> Script BabbageEra)
-> Map ScriptHash (Script (PreviousEra BabbageEra))
-> Map ScriptHash (Script BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AlonzoTxWits (PreviousEra BabbageEra)
-> Map ScriptHash (Script (PreviousEra BabbageEra))
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map ScriptHash (Script era)
txscripts TxWits (PreviousEra BabbageEra)
AlonzoTxWits (PreviousEra BabbageEra)
atw
      , txdats :: TxDats BabbageEra
txdats = TxDats AlonzoEra -> TxDats BabbageEra
forall era1 era2.
(Era era1, Era era2) =>
TxDats era1 -> TxDats era2
upgradeTxDats (AlonzoTxWits AlonzoEra -> TxDats AlonzoEra
forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats TxWits (PreviousEra BabbageEra)
AlonzoTxWits AlonzoEra
atw)
      , txrdmrs :: Redeemers BabbageEra
txrdmrs = Redeemers (PreviousEra BabbageEra) -> Redeemers BabbageEra
forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era) =>
Redeemers (PreviousEra era) -> Redeemers era
upgradeRedeemers (AlonzoTxWits AlonzoEra -> Redeemers AlonzoEra
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs TxWits (PreviousEra BabbageEra)
AlonzoTxWits AlonzoEra
atw)
      }

data ConwayTxBodyUpgradeError
  = CTBUETxCert ConwayTxCertUpgradeError
  | -- | The TxBody contains an update proposal from a pre-Conway era. Since
    --   this can only have come from the genesis delegates, we just discard it.
    CTBUEContainsUpdate
  | -- | In eras prior to Conway duplicate certificates where allowed
    CTBUEContainsDuplicateCerts (Set (TxCert ConwayEra))
  deriving (ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
(ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool)
-> (ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool)
-> Eq ConwayTxBodyUpgradeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
== :: ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
$c/= :: ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
/= :: ConwayTxBodyUpgradeError -> ConwayTxBodyUpgradeError -> Bool
Eq, Int -> ConwayTxBodyUpgradeError -> [Char] -> [Char]
[ConwayTxBodyUpgradeError] -> [Char] -> [Char]
ConwayTxBodyUpgradeError -> [Char]
(Int -> ConwayTxBodyUpgradeError -> [Char] -> [Char])
-> (ConwayTxBodyUpgradeError -> [Char])
-> ([ConwayTxBodyUpgradeError] -> [Char] -> [Char])
-> Show ConwayTxBodyUpgradeError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ConwayTxBodyUpgradeError -> [Char] -> [Char]
showsPrec :: Int -> ConwayTxBodyUpgradeError -> [Char] -> [Char]
$cshow :: ConwayTxBodyUpgradeError -> [Char]
show :: ConwayTxBodyUpgradeError -> [Char]
$cshowList :: [ConwayTxBodyUpgradeError] -> [Char] -> [Char]
showList :: [ConwayTxBodyUpgradeError] -> [Char] -> [Char]
Show)

instance EraApi ConwayEra where
  type TxUpgradeError ConwayEra = TxBodyUpgradeError ConwayEra
  type TxBodyUpgradeError ConwayEra = ConwayTxBodyUpgradeError

  upgradeTx :: EraTx (PreviousEra ConwayEra) =>
Tx (PreviousEra ConwayEra)
-> Either (TxUpgradeError ConwayEra) (Tx ConwayEra)
upgradeTx (MkBabbageTx (AlonzoTx TxBody BabbageEra
b TxWits BabbageEra
w IsValid
valid StrictMaybe (TxAuxData BabbageEra)
aux)) =
    (AlonzoTx ConwayEra -> Tx ConwayEra)
-> Either (TxUpgradeError ConwayEra) (AlonzoTx ConwayEra)
-> Either (TxUpgradeError ConwayEra) (Tx ConwayEra)
forall a b.
(a -> b)
-> Either (TxUpgradeError ConwayEra) a
-> Either (TxUpgradeError ConwayEra) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AlonzoTx ConwayEra -> Tx ConwayEra
MkConwayTx (Either (TxUpgradeError ConwayEra) (AlonzoTx ConwayEra)
 -> Either (TxUpgradeError ConwayEra) (Tx ConwayEra))
-> Either (TxUpgradeError ConwayEra) (AlonzoTx ConwayEra)
-> Either (TxUpgradeError ConwayEra) (Tx ConwayEra)
forall a b. (a -> b) -> a -> b
$
      TxBody ConwayEra
-> TxWits ConwayEra
-> IsValid
-> StrictMaybe (TxAuxData ConwayEra)
-> AlonzoTx ConwayEra
TxBody ConwayEra
-> AlonzoTxWits ConwayEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData ConwayEra)
-> AlonzoTx ConwayEra
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
        (TxBody ConwayEra
 -> AlonzoTxWits ConwayEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData ConwayEra)
 -> AlonzoTx ConwayEra)
-> Either ConwayTxBodyUpgradeError (TxBody ConwayEra)
-> Either
     ConwayTxBodyUpgradeError
     (AlonzoTxWits ConwayEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData ConwayEra)
      -> AlonzoTx ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody (PreviousEra ConwayEra)
-> Either (TxBodyUpgradeError ConwayEra) (TxBody ConwayEra)
forall era.
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
b
        Either
  ConwayTxBodyUpgradeError
  (AlonzoTxWits ConwayEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData ConwayEra)
   -> AlonzoTx ConwayEra)
-> Either ConwayTxBodyUpgradeError (AlonzoTxWits ConwayEra)
-> Either
     ConwayTxBodyUpgradeError
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData ConwayEra) -> AlonzoTx ConwayEra)
forall a b.
Either ConwayTxBodyUpgradeError (a -> b)
-> Either ConwayTxBodyUpgradeError a
-> Either ConwayTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AlonzoTxWits ConwayEra
-> Either ConwayTxBodyUpgradeError (AlonzoTxWits ConwayEra)
forall a. a -> Either ConwayTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxWits (PreviousEra ConwayEra) -> TxWits ConwayEra
forall era.
(EraApi era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits (PreviousEra ConwayEra)
TxWits BabbageEra
w)
        Either
  ConwayTxBodyUpgradeError
  (IsValid
   -> StrictMaybe (AlonzoTxAuxData ConwayEra) -> AlonzoTx ConwayEra)
-> Either ConwayTxBodyUpgradeError IsValid
-> Either
     ConwayTxBodyUpgradeError
     (StrictMaybe (AlonzoTxAuxData ConwayEra) -> AlonzoTx ConwayEra)
forall a b.
Either ConwayTxBodyUpgradeError (a -> b)
-> Either ConwayTxBodyUpgradeError a
-> Either ConwayTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IsValid -> Either ConwayTxBodyUpgradeError IsValid
forall a. a -> Either ConwayTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsValid
valid
        Either
  ConwayTxBodyUpgradeError
  (StrictMaybe (AlonzoTxAuxData ConwayEra) -> AlonzoTx ConwayEra)
-> Either
     ConwayTxBodyUpgradeError (StrictMaybe (AlonzoTxAuxData ConwayEra))
-> Either ConwayTxBodyUpgradeError (AlonzoTx ConwayEra)
forall a b.
Either ConwayTxBodyUpgradeError (a -> b)
-> Either ConwayTxBodyUpgradeError a
-> Either ConwayTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AlonzoTxAuxData ConwayEra)
-> Either
     ConwayTxBodyUpgradeError (StrictMaybe (AlonzoTxAuxData ConwayEra))
forall a. a -> Either ConwayTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxAuxData (PreviousEra ConwayEra) -> AlonzoTxAuxData ConwayEra)
-> StrictMaybe (TxAuxData (PreviousEra ConwayEra))
-> StrictMaybe (AlonzoTxAuxData ConwayEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData (PreviousEra ConwayEra) -> TxAuxData ConwayEra
TxAuxData (PreviousEra ConwayEra) -> AlonzoTxAuxData ConwayEra
forall era.
(EraApi era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData (PreviousEra ConwayEra))
StrictMaybe (TxAuxData BabbageEra)
aux)

  upgradeTxBody :: EraTxBody (PreviousEra ConwayEra) =>
TxBody (PreviousEra ConwayEra)
-> Either (TxBodyUpgradeError ConwayEra) (TxBody ConwayEra)
upgradeTxBody TxBody (PreviousEra ConwayEra)
btb = do
    Bool
-> Either ConwayTxBodyUpgradeError ()
-> Either ConwayTxBodyUpgradeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe (Update BabbageEra) -> Bool
forall a. StrictMaybe a -> Bool
isSJust (TxBody BabbageEra -> StrictMaybe (Update BabbageEra)
btbUpdate TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb)) (Either ConwayTxBodyUpgradeError ()
 -> Either ConwayTxBodyUpgradeError ())
-> Either ConwayTxBodyUpgradeError ()
-> Either ConwayTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$ ConwayTxBodyUpgradeError -> Either ConwayTxBodyUpgradeError ()
forall a b. a -> Either a b
Left ConwayTxBodyUpgradeError
CTBUEContainsUpdate
    StrictSeq (TxCert ConwayEra)
certs <- (TxCert (PreviousEra ConwayEra)
 -> Either ConwayTxBodyUpgradeError (TxCert ConwayEra))
-> StrictSeq (TxCert (PreviousEra ConwayEra))
-> Either ConwayTxBodyUpgradeError (StrictSeq (TxCert ConwayEra))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> StrictSeq a -> f (StrictSeq b)
traverse ((ConwayTxCertUpgradeError -> ConwayTxBodyUpgradeError)
-> Either ConwayTxCertUpgradeError (TxCert ConwayEra)
-> Either ConwayTxBodyUpgradeError (TxCert ConwayEra)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ConwayTxCertUpgradeError -> ConwayTxBodyUpgradeError
CTBUETxCert (Either ConwayTxCertUpgradeError (TxCert ConwayEra)
 -> Either ConwayTxBodyUpgradeError (TxCert ConwayEra))
-> (TxCert (PreviousEra ConwayEra)
    -> Either ConwayTxCertUpgradeError (TxCert ConwayEra))
-> TxCert (PreviousEra ConwayEra)
-> Either ConwayTxBodyUpgradeError (TxCert ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert (PreviousEra ConwayEra)
-> Either (TxCertUpgradeError ConwayEra) (TxCert ConwayEra)
TxCert (PreviousEra ConwayEra)
-> Either ConwayTxCertUpgradeError (TxCert ConwayEra)
forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert) (TxBody BabbageEra -> StrictSeq (TxCert BabbageEra)
btbCerts TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb)
    let (Set (TxCert ConwayEra)
duplicates, OSet (TxCert ConwayEra)
certsOSet) = StrictSeq (TxCert ConwayEra)
-> (Set (TxCert ConwayEra), OSet (TxCert ConwayEra))
forall a. Ord a => StrictSeq a -> (Set a, OSet a)
OSet.fromStrictSeqDuplicates StrictSeq (TxCert ConwayEra)
certs
    Bool
-> Either ConwayTxBodyUpgradeError ()
-> Either ConwayTxBodyUpgradeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set (TxCert ConwayEra) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (TxCert ConwayEra)
duplicates) (Either ConwayTxBodyUpgradeError ()
 -> Either ConwayTxBodyUpgradeError ())
-> Either ConwayTxBodyUpgradeError ()
-> Either ConwayTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$ ConwayTxBodyUpgradeError -> Either ConwayTxBodyUpgradeError ()
forall a b. a -> Either a b
Left (ConwayTxBodyUpgradeError -> Either ConwayTxBodyUpgradeError ())
-> ConwayTxBodyUpgradeError -> Either ConwayTxBodyUpgradeError ()
forall a b. (a -> b) -> a -> b
$ Set (TxCert ConwayEra) -> ConwayTxBodyUpgradeError
CTBUEContainsDuplicateCerts Set (TxCert ConwayEra)
duplicates
    TxBody ConwayEra
-> Either ConwayTxBodyUpgradeError (TxBody ConwayEra)
forall a. a -> Either ConwayTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBody ConwayEra
 -> Either ConwayTxBodyUpgradeError (TxBody ConwayEra))
-> TxBody ConwayEra
-> Either ConwayTxBodyUpgradeError (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$
      ConwayTxBody
        { ctbSpendInputs :: Set TxIn
ctbSpendInputs = TxBody BabbageEra -> Set TxIn
btbInputs TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbOutputs :: StrictSeq (Sized (TxOut ConwayEra))
ctbOutputs = (TxOut (PreviousEra ConwayEra) -> BabbageTxOut ConwayEra)
-> Sized (TxOut (PreviousEra ConwayEra))
-> Sized (BabbageTxOut ConwayEra)
forall a b. (a -> b) -> Sized a -> Sized b
unsafeMapSized TxOut (PreviousEra ConwayEra) -> TxOut ConwayEra
TxOut (PreviousEra ConwayEra) -> BabbageTxOut ConwayEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (Sized (TxOut (PreviousEra ConwayEra))
 -> Sized (BabbageTxOut ConwayEra))
-> StrictSeq (Sized (TxOut (PreviousEra ConwayEra)))
-> StrictSeq (Sized (BabbageTxOut ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody BabbageEra -> StrictSeq (Sized (TxOut BabbageEra))
btbOutputs TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbCerts :: OSet (TxCert ConwayEra)
ctbCerts = OSet (TxCert ConwayEra)
certsOSet
        , ctbWithdrawals :: Withdrawals
ctbWithdrawals = TxBody BabbageEra -> Withdrawals
btbWithdrawals TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbTxfee :: Coin
ctbTxfee = TxBody BabbageEra -> Coin
btbTxFee TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbVldt :: ValidityInterval
ctbVldt = TxBody BabbageEra -> ValidityInterval
btbValidityInterval TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbAdHash :: StrictMaybe TxAuxDataHash
ctbAdHash = TxBody BabbageEra -> StrictMaybe TxAuxDataHash
btbAuxDataHash TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbMint :: MultiAsset
ctbMint = TxBody BabbageEra -> MultiAsset
btbMint TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbCollateralInputs :: Set TxIn
ctbCollateralInputs = TxBody BabbageEra -> Set TxIn
btbCollateral TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbReqSignerHashes :: Set (KeyHash 'Witness)
ctbReqSignerHashes = TxBody BabbageEra -> Set (KeyHash 'Witness)
btbReqSignerHashes TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
ctbScriptIntegrityHash = TxBody BabbageEra -> StrictMaybe ScriptIntegrityHash
btbScriptIntegrityHash TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbTxNetworkId :: StrictMaybe Network
ctbTxNetworkId = TxBody BabbageEra -> StrictMaybe Network
btbTxNetworkId TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbReferenceInputs :: Set TxIn
ctbReferenceInputs = TxBody BabbageEra -> Set TxIn
btbReferenceInputs TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbCollateralReturn :: StrictMaybe (Sized (TxOut ConwayEra))
ctbCollateralReturn = (TxOut (PreviousEra ConwayEra) -> BabbageTxOut ConwayEra)
-> Sized (TxOut (PreviousEra ConwayEra))
-> Sized (BabbageTxOut ConwayEra)
forall a b. (a -> b) -> Sized a -> Sized b
unsafeMapSized TxOut (PreviousEra ConwayEra) -> TxOut ConwayEra
TxOut (PreviousEra ConwayEra) -> BabbageTxOut ConwayEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (Sized (TxOut (PreviousEra ConwayEra))
 -> Sized (BabbageTxOut ConwayEra))
-> StrictMaybe (Sized (TxOut (PreviousEra ConwayEra)))
-> StrictMaybe (Sized (BabbageTxOut ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody BabbageEra -> StrictMaybe (Sized (TxOut BabbageEra))
btbCollateralReturn TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbTotalCollateral :: StrictMaybe Coin
ctbTotalCollateral = TxBody BabbageEra -> StrictMaybe Coin
btbTotalCollateral TxBody (PreviousEra ConwayEra)
TxBody BabbageEra
btb
        , ctbCurrentTreasuryValue :: StrictMaybe Coin
ctbCurrentTreasuryValue = StrictMaybe Coin
forall a. StrictMaybe a
SNothing
        , ctbProposalProcedures :: OSet (ProposalProcedure ConwayEra)
ctbProposalProcedures = OSet (ProposalProcedure ConwayEra)
forall a. OSet a
OSet.empty
        , ctbVotingProcedures :: VotingProcedures ConwayEra
ctbVotingProcedures = Map Voter (Map GovActionId (VotingProcedure ConwayEra))
-> VotingProcedures ConwayEra
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures Map Voter (Map GovActionId (VotingProcedure ConwayEra))
forall a. Monoid a => a
mempty
        , ctbTreasuryDonation :: Coin
ctbTreasuryDonation = Integer -> Coin
Coin Integer
0
        }

  upgradeTxAuxData :: EraTxAuxData (PreviousEra ConwayEra) =>
TxAuxData (PreviousEra ConwayEra) -> TxAuxData ConwayEra
upgradeTxAuxData = TxAuxData (PreviousEra ConwayEra) -> TxAuxData ConwayEra
AlonzoTxAuxData BabbageEra -> AlonzoTxAuxData ConwayEra
forall era1 era2.
(AlonzoEraScript era1, AlonzoEraScript era2) =>
AlonzoTxAuxData era1 -> AlonzoTxAuxData era2
translateAlonzoTxAuxData

  upgradeTxWits :: EraTxWits (PreviousEra ConwayEra) =>
TxWits (PreviousEra ConwayEra) -> TxWits ConwayEra
upgradeTxWits TxWits (PreviousEra ConwayEra)
atw =
    AlonzoTxWits
      { txwitsVKey :: Set (WitVKey 'Witness)
txwitsVKey = AlonzoTxWits BabbageEra -> Set (WitVKey 'Witness)
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness)
txwitsVKey TxWits (PreviousEra ConwayEra)
AlonzoTxWits BabbageEra
atw
      , txwitsBoot :: Set BootstrapWitness
txwitsBoot = AlonzoTxWits BabbageEra -> Set BootstrapWitness
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set BootstrapWitness
txwitsBoot TxWits (PreviousEra ConwayEra)
AlonzoTxWits BabbageEra
atw
      , txscripts :: Map ScriptHash (Script ConwayEra)
txscripts = Script (PreviousEra ConwayEra) -> Script ConwayEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra ConwayEra) -> Script ConwayEra)
-> Map ScriptHash (Script (PreviousEra ConwayEra))
-> Map ScriptHash (Script ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AlonzoTxWits (PreviousEra ConwayEra)
-> Map ScriptHash (Script (PreviousEra ConwayEra))
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map ScriptHash (Script era)
txscripts TxWits (PreviousEra ConwayEra)
AlonzoTxWits (PreviousEra ConwayEra)
atw
      , txdats :: TxDats ConwayEra
txdats = TxDats BabbageEra -> TxDats ConwayEra
forall era1 era2.
(Era era1, Era era2) =>
TxDats era1 -> TxDats era2
upgradeTxDats (AlonzoTxWits BabbageEra -> TxDats BabbageEra
forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats TxWits (PreviousEra ConwayEra)
AlonzoTxWits BabbageEra
atw)
      , txrdmrs :: Redeemers ConwayEra
txrdmrs = Redeemers (PreviousEra ConwayEra) -> Redeemers ConwayEra
forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era) =>
Redeemers (PreviousEra era) -> Redeemers era
upgradeRedeemers (AlonzoTxWits BabbageEra -> Redeemers BabbageEra
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs TxWits (PreviousEra ConwayEra)
AlonzoTxWits BabbageEra
atw)
      }

instance EraApi DijkstraEra where
  type TxUpgradeError DijkstraEra = TxBodyUpgradeError DijkstraEra
  upgradeTx :: EraTx (PreviousEra DijkstraEra) =>
Tx (PreviousEra DijkstraEra)
-> Either (TxUpgradeError DijkstraEra) (Tx DijkstraEra)
upgradeTx (MkConwayTx (AlonzoTx TxBody ConwayEra
b TxWits ConwayEra
w IsValid
valid StrictMaybe (TxAuxData ConwayEra)
aux)) =
    (AlonzoTx DijkstraEra -> Tx DijkstraEra)
-> Either (TxUpgradeError DijkstraEra) (AlonzoTx DijkstraEra)
-> Either (TxUpgradeError DijkstraEra) (Tx DijkstraEra)
forall a b.
(a -> b)
-> Either (TxUpgradeError DijkstraEra) a
-> Either (TxUpgradeError DijkstraEra) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AlonzoTx DijkstraEra -> Tx DijkstraEra
MkDijkstraTx (Either (TxUpgradeError DijkstraEra) (AlonzoTx DijkstraEra)
 -> Either (TxUpgradeError DijkstraEra) (Tx DijkstraEra))
-> Either (TxUpgradeError DijkstraEra) (AlonzoTx DijkstraEra)
-> Either (TxUpgradeError DijkstraEra) (Tx DijkstraEra)
forall a b. (a -> b) -> a -> b
$
      TxBody DijkstraEra
-> TxWits DijkstraEra
-> IsValid
-> StrictMaybe (TxAuxData DijkstraEra)
-> AlonzoTx DijkstraEra
TxBody DijkstraEra
-> AlonzoTxWits DijkstraEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData DijkstraEra)
-> AlonzoTx DijkstraEra
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx
        (TxBody DijkstraEra
 -> AlonzoTxWits DijkstraEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
 -> AlonzoTx DijkstraEra)
-> Either Void (TxBody DijkstraEra)
-> Either
     Void
     (AlonzoTxWits DijkstraEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
      -> AlonzoTx DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody (PreviousEra DijkstraEra)
-> Either (TxBodyUpgradeError DijkstraEra) (TxBody DijkstraEra)
forall era.
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody era)
upgradeTxBody TxBody (PreviousEra DijkstraEra)
TxBody ConwayEra
b
        Either
  Void
  (AlonzoTxWits DijkstraEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
   -> AlonzoTx DijkstraEra)
-> Either Void (AlonzoTxWits DijkstraEra)
-> Either
     Void
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
      -> AlonzoTx DijkstraEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AlonzoTxWits DijkstraEra -> Either Void (AlonzoTxWits DijkstraEra)
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxWits (PreviousEra DijkstraEra) -> TxWits DijkstraEra
forall era.
(EraApi era, EraTxWits (PreviousEra era)) =>
TxWits (PreviousEra era) -> TxWits era
upgradeTxWits TxWits (PreviousEra DijkstraEra)
TxWits ConwayEra
w)
        Either
  Void
  (IsValid
   -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
   -> AlonzoTx DijkstraEra)
-> Either Void IsValid
-> Either
     Void
     (StrictMaybe (AlonzoTxAuxData DijkstraEra) -> AlonzoTx DijkstraEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IsValid -> Either Void IsValid
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsValid
valid
        Either
  Void
  (StrictMaybe (AlonzoTxAuxData DijkstraEra) -> AlonzoTx DijkstraEra)
-> Either Void (StrictMaybe (AlonzoTxAuxData DijkstraEra))
-> Either Void (AlonzoTx DijkstraEra)
forall a b. Either Void (a -> b) -> Either Void a -> Either Void b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AlonzoTxAuxData DijkstraEra)
-> Either Void (StrictMaybe (AlonzoTxAuxData DijkstraEra))
forall a. a -> Either Void a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TxAuxData (PreviousEra DijkstraEra)
 -> AlonzoTxAuxData DijkstraEra)
-> StrictMaybe (TxAuxData (PreviousEra DijkstraEra))
-> StrictMaybe (AlonzoTxAuxData DijkstraEra)
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxAuxData (PreviousEra DijkstraEra) -> TxAuxData DijkstraEra
TxAuxData (PreviousEra DijkstraEra) -> AlonzoTxAuxData DijkstraEra
forall era.
(EraApi era, EraTxAuxData (PreviousEra era)) =>
TxAuxData (PreviousEra era) -> TxAuxData era
upgradeTxAuxData StrictMaybe (TxAuxData (PreviousEra DijkstraEra))
StrictMaybe (TxAuxData ConwayEra)
aux)

  upgradeTxBody :: EraTxBody (PreviousEra DijkstraEra) =>
TxBody (PreviousEra DijkstraEra)
-> Either (TxBodyUpgradeError DijkstraEra) (TxBody DijkstraEra)
upgradeTxBody ConwayTxBody {OSet (TxCert ConwayEra)
OSet (ProposalProcedure ConwayEra)
Set (KeyHash 'Witness)
Set TxIn
StrictMaybe ScriptIntegrityHash
StrictMaybe TxAuxDataHash
StrictMaybe (Sized (TxOut ConwayEra))
StrictMaybe Coin
StrictMaybe Network
ValidityInterval
Withdrawals
StrictSeq (Sized (TxOut ConwayEra))
VotingProcedures ConwayEra
Coin
MultiAsset
ctbSpendInputs :: TxBody ConwayEra -> Set TxIn
ctbOutputs :: TxBody ConwayEra -> StrictSeq (Sized (TxOut ConwayEra))
ctbCerts :: TxBody ConwayEra -> OSet (TxCert ConwayEra)
ctbWithdrawals :: TxBody ConwayEra -> Withdrawals
ctbTxfee :: TxBody ConwayEra -> Coin
ctbVldt :: TxBody ConwayEra -> ValidityInterval
ctbAdHash :: TxBody ConwayEra -> StrictMaybe TxAuxDataHash
ctbMint :: TxBody ConwayEra -> MultiAsset
ctbCollateralInputs :: TxBody ConwayEra -> Set TxIn
ctbReqSignerHashes :: TxBody ConwayEra -> Set (KeyHash 'Witness)
ctbScriptIntegrityHash :: TxBody ConwayEra -> StrictMaybe ScriptIntegrityHash
ctbTxNetworkId :: TxBody ConwayEra -> StrictMaybe Network
ctbReferenceInputs :: TxBody ConwayEra -> Set TxIn
ctbCollateralReturn :: TxBody ConwayEra -> StrictMaybe (Sized (TxOut ConwayEra))
ctbTotalCollateral :: TxBody ConwayEra -> StrictMaybe Coin
ctbCurrentTreasuryValue :: TxBody ConwayEra -> StrictMaybe Coin
ctbProposalProcedures :: TxBody ConwayEra -> OSet (ProposalProcedure ConwayEra)
ctbVotingProcedures :: TxBody ConwayEra -> VotingProcedures ConwayEra
ctbTreasuryDonation :: TxBody ConwayEra -> Coin
ctbSpendInputs :: Set TxIn
ctbCollateralInputs :: Set TxIn
ctbReferenceInputs :: Set TxIn
ctbOutputs :: StrictSeq (Sized (TxOut ConwayEra))
ctbCollateralReturn :: StrictMaybe (Sized (TxOut ConwayEra))
ctbTotalCollateral :: StrictMaybe Coin
ctbCerts :: OSet (TxCert ConwayEra)
ctbWithdrawals :: Withdrawals
ctbTxfee :: Coin
ctbVldt :: ValidityInterval
ctbReqSignerHashes :: Set (KeyHash 'Witness)
ctbMint :: MultiAsset
ctbScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
ctbAdHash :: StrictMaybe TxAuxDataHash
ctbTxNetworkId :: StrictMaybe Network
ctbVotingProcedures :: VotingProcedures ConwayEra
ctbProposalProcedures :: OSet (ProposalProcedure ConwayEra)
ctbCurrentTreasuryValue :: StrictMaybe Coin
ctbTreasuryDonation :: Coin
..} = do
    TxBody DijkstraEra
-> Either (TxBodyUpgradeError DijkstraEra) (TxBody DijkstraEra)
forall a. a -> Either (TxBodyUpgradeError DijkstraEra) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBody DijkstraEra
 -> Either (TxBodyUpgradeError DijkstraEra) (TxBody DijkstraEra))
-> TxBody DijkstraEra
-> Either (TxBodyUpgradeError DijkstraEra) (TxBody DijkstraEra)
forall a b. (a -> b) -> a -> b
$
      DijkstraTxBody
        { dtbSpendInputs :: Set TxIn
dtbSpendInputs = Set TxIn
ctbSpendInputs
        , dtbOutputs :: StrictSeq (Sized (TxOut DijkstraEra))
dtbOutputs = (TxOut (PreviousEra DijkstraEra) -> BabbageTxOut DijkstraEra)
-> Sized (TxOut (PreviousEra DijkstraEra))
-> Sized (BabbageTxOut DijkstraEra)
forall a b. (a -> b) -> Sized a -> Sized b
unsafeMapSized TxOut (PreviousEra DijkstraEra) -> TxOut DijkstraEra
TxOut (PreviousEra DijkstraEra) -> BabbageTxOut DijkstraEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (Sized (TxOut (PreviousEra DijkstraEra))
 -> Sized (BabbageTxOut DijkstraEra))
-> StrictSeq (Sized (TxOut (PreviousEra DijkstraEra)))
-> StrictSeq (Sized (BabbageTxOut DijkstraEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Sized (TxOut (PreviousEra DijkstraEra)))
StrictSeq (Sized (TxOut ConwayEra))
ctbOutputs
        , dtbCerts :: OSet (TxCert DijkstraEra)
dtbCerts = (ConwayTxCert ConwayEra -> ConwayTxCert DijkstraEra)
-> OSet (ConwayTxCert ConwayEra) -> OSet (ConwayTxCert DijkstraEra)
forall b a. Ord b => (a -> b) -> OSet a -> OSet b
OSet.mapL ConwayTxCert ConwayEra -> ConwayTxCert DijkstraEra
forall a b. Coercible a b => a -> b
coerce OSet (TxCert ConwayEra)
OSet (ConwayTxCert ConwayEra)
ctbCerts
        , dtbWithdrawals :: Withdrawals
dtbWithdrawals = Withdrawals
ctbWithdrawals
        , dtbTxfee :: Coin
dtbTxfee = Coin
ctbTxfee
        , dtbVldt :: ValidityInterval
dtbVldt = ValidityInterval
ctbVldt
        , dtbAdHash :: StrictMaybe TxAuxDataHash
dtbAdHash = StrictMaybe TxAuxDataHash
ctbAdHash
        , dtbMint :: MultiAsset
dtbMint = MultiAsset
ctbMint
        , dtbCollateralInputs :: Set TxIn
dtbCollateralInputs = Set TxIn
ctbCollateralInputs
        , dtbReqSignerHashes :: Set (KeyHash 'Witness)
dtbReqSignerHashes = Set (KeyHash 'Witness)
ctbReqSignerHashes
        , dtbScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
dtbScriptIntegrityHash = StrictMaybe ScriptIntegrityHash
ctbScriptIntegrityHash
        , dtbTxNetworkId :: StrictMaybe Network
dtbTxNetworkId = StrictMaybe Network
ctbTxNetworkId
        , dtbReferenceInputs :: Set TxIn
dtbReferenceInputs = Set TxIn
ctbReferenceInputs
        , dtbCollateralReturn :: StrictMaybe (Sized (TxOut DijkstraEra))
dtbCollateralReturn = (TxOut (PreviousEra DijkstraEra) -> BabbageTxOut DijkstraEra)
-> Sized (TxOut (PreviousEra DijkstraEra))
-> Sized (BabbageTxOut DijkstraEra)
forall a b. (a -> b) -> Sized a -> Sized b
unsafeMapSized TxOut (PreviousEra DijkstraEra) -> TxOut DijkstraEra
TxOut (PreviousEra DijkstraEra) -> BabbageTxOut DijkstraEra
forall era.
(EraTxOut era, EraTxOut (PreviousEra era)) =>
TxOut (PreviousEra era) -> TxOut era
upgradeTxOut (Sized (TxOut (PreviousEra DijkstraEra))
 -> Sized (BabbageTxOut DijkstraEra))
-> StrictMaybe (Sized (TxOut (PreviousEra DijkstraEra)))
-> StrictMaybe (Sized (BabbageTxOut DijkstraEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe (Sized (TxOut (PreviousEra DijkstraEra)))
StrictMaybe (Sized (TxOut ConwayEra))
ctbCollateralReturn
        , dtbTotalCollateral :: StrictMaybe Coin
dtbTotalCollateral = StrictMaybe Coin
ctbTotalCollateral
        , dtbCurrentTreasuryValue :: StrictMaybe Coin
dtbCurrentTreasuryValue = StrictMaybe Coin
ctbCurrentTreasuryValue
        , dtbProposalProcedures :: OSet (ProposalProcedure DijkstraEra)
dtbProposalProcedures = (ProposalProcedure ConwayEra -> ProposalProcedure DijkstraEra)
-> OSet (ProposalProcedure ConwayEra)
-> OSet (ProposalProcedure DijkstraEra)
forall b a. Ord b => (a -> b) -> OSet a -> OSet b
OSet.mapL ProposalProcedure ConwayEra -> ProposalProcedure DijkstraEra
upgradeProposals OSet (ProposalProcedure ConwayEra)
ctbProposalProcedures
        , dtbVotingProcedures :: VotingProcedures DijkstraEra
dtbVotingProcedures = VotingProcedures ConwayEra -> VotingProcedures DijkstraEra
forall a b. Coercible a b => a -> b
coerce VotingProcedures ConwayEra
ctbVotingProcedures
        , dtbTreasuryDonation :: Coin
dtbTreasuryDonation = Coin
ctbTreasuryDonation
        }

  upgradeTxWits :: EraTxWits (PreviousEra DijkstraEra) =>
TxWits (PreviousEra DijkstraEra) -> TxWits DijkstraEra
upgradeTxWits TxWits (PreviousEra DijkstraEra)
atw =
    AlonzoTxWits
      { txwitsVKey :: Set (WitVKey 'Witness)
txwitsVKey = AlonzoTxWits ConwayEra -> Set (WitVKey 'Witness)
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set (WitVKey 'Witness)
txwitsVKey TxWits (PreviousEra DijkstraEra)
AlonzoTxWits ConwayEra
atw
      , txwitsBoot :: Set BootstrapWitness
txwitsBoot = AlonzoTxWits ConwayEra -> Set BootstrapWitness
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Set BootstrapWitness
txwitsBoot TxWits (PreviousEra DijkstraEra)
AlonzoTxWits ConwayEra
atw
      , txscripts :: Map ScriptHash (Script DijkstraEra)
txscripts = Script (PreviousEra DijkstraEra) -> Script DijkstraEra
forall era.
(EraScript era, EraScript (PreviousEra era)) =>
Script (PreviousEra era) -> Script era
upgradeScript (Script (PreviousEra DijkstraEra) -> Script DijkstraEra)
-> Map ScriptHash (Script (PreviousEra DijkstraEra))
-> Map ScriptHash (Script DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AlonzoTxWits (PreviousEra DijkstraEra)
-> Map ScriptHash (Script (PreviousEra DijkstraEra))
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Map ScriptHash (Script era)
txscripts TxWits (PreviousEra DijkstraEra)
AlonzoTxWits (PreviousEra DijkstraEra)
atw
      , txdats :: TxDats DijkstraEra
txdats = TxDats ConwayEra -> TxDats DijkstraEra
forall era1 era2.
(Era era1, Era era2) =>
TxDats era1 -> TxDats era2
upgradeTxDats (AlonzoTxWits ConwayEra -> TxDats ConwayEra
forall era. AlonzoEraScript era => AlonzoTxWits era -> TxDats era
txdats TxWits (PreviousEra DijkstraEra)
AlonzoTxWits ConwayEra
atw)
      , txrdmrs :: Redeemers DijkstraEra
txrdmrs = Redeemers (PreviousEra DijkstraEra) -> Redeemers DijkstraEra
forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era) =>
Redeemers (PreviousEra era) -> Redeemers era
upgradeRedeemers (AlonzoTxWits ConwayEra -> Redeemers ConwayEra
forall era.
AlonzoEraScript era =>
AlonzoTxWits era -> Redeemers era
txrdmrs TxWits (PreviousEra DijkstraEra)
AlonzoTxWits ConwayEra
atw)
      }

  upgradeTxAuxData :: EraTxAuxData (PreviousEra DijkstraEra) =>
TxAuxData (PreviousEra DijkstraEra) -> TxAuxData DijkstraEra
upgradeTxAuxData = TxAuxData (PreviousEra DijkstraEra) -> TxAuxData DijkstraEra
AlonzoTxAuxData ConwayEra -> AlonzoTxAuxData DijkstraEra
forall era1 era2.
(AlonzoEraScript era1, AlonzoEraScript era2) =>
AlonzoTxAuxData era1 -> AlonzoTxAuxData era2
translateAlonzoTxAuxData