{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-unsafe-ledger-internal #-}
#endif

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

  -- ** Byron
  ByronEra,

  -- ** Shelley
  ShelleyEra,
  ttlToValidityInterval,

  -- ** 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, upgradeMultiSig)
import Cardano.Ledger.Allegra.TxAuxData (AllegraTxAuxData (..))
import Cardano.Ledger.Allegra.TxBody (
  AllegraEraTxBody (..),
  AllegraTxBodyRaw (..),
  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 (..), AlonzoTxBodyRaw (..), 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.Babbage.TxBody (BabbageTxBodyRaw (..))
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 (ConwayTxBodyRaw (..), TxBody (..))
import Cardano.Ledger.Conway.TxCert (ConwayTxCertUpgradeError)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.Scripts
import Cardano.Ledger.Dijkstra.Tx (DijkstraTx (..), Tx (..))
import Cardano.Ledger.Dijkstra.TxBody (TxBody (..), upgradeProposals)
import Cardano.Ledger.Dijkstra.TxCert (DijkstraTxCertUpgradeError)
import Cardano.Ledger.Internal.Era (EraHasName (..))
import Cardano.Ledger.Keys (HasKeyRole (..))
import Cardano.Ledger.Mary (MaryEra, TxBody (..))
import Cardano.Ledger.Mary.TxBody (MaryEraTxBody (..))
import Cardano.Ledger.MemoBytes (getMemoRawType, 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 (..), ShelleyTxBodyRaw (..))
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 qualified Data.Set as 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 l (PreviousEra era) ->
    Either (TxUpgradeError era) (Tx l 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 l (PreviousEra era) ->
    Either (TxBodyUpgradeError era) (TxBody l 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

  -- | Upgrade a native script from the previous era.
  upgradeNativeScript :: NativeScript (PreviousEra era) -> NativeScript era

instance EraApi ShelleyEra where
  upgradeTx :: forall (l :: TxLevel).
EraTx (PreviousEra ShelleyEra) =>
Tx l (PreviousEra ShelleyEra)
-> Either (TxUpgradeError ShelleyEra) (Tx l ShelleyEra)
upgradeTx =
    [Char] -> Tx l ByronEra -> Either Void (Tx l 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 :: forall (l :: TxLevel).
EraTxBody (PreviousEra ShelleyEra) =>
TxBody l (PreviousEra ShelleyEra)
-> Either (TxBodyUpgradeError ShelleyEra) (TxBody l ShelleyEra)
upgradeTxBody =
    [Char]
-> TxBody l (PreviousEra ShelleyEra)
-> Either (TxBodyUpgradeError ShelleyEra) (TxBody l ShelleyEra)
forall a. HasCallStack => [Char] -> a
error ([Char]
 -> TxBody l (PreviousEra ShelleyEra)
 -> Either (TxBodyUpgradeError ShelleyEra) (TxBody l ShelleyEra))
-> [Char]
-> TxBody l (PreviousEra ShelleyEra)
-> Either (TxBodyUpgradeError ShelleyEra) (TxBody l 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"

  upgradeNativeScript :: NativeScript (PreviousEra ShelleyEra) -> NativeScript ShelleyEra
upgradeNativeScript =
    [Char] -> NativeScript ByronEra -> MultiSig ShelleyEra
forall a. HasCallStack => [Char] -> a
error
      [Char]
"Calling this function will cause a compilation error, since there is no `NativeScript` in the ByronEra"

instance EraApi AllegraEra where
  upgradeTx :: forall (l :: TxLevel).
EraTx (PreviousEra AllegraEra) =>
Tx l (PreviousEra AllegraEra)
-> Either (TxUpgradeError AllegraEra) (Tx l AllegraEra)
upgradeTx (MkShelleyTx (ShelleyTx TxBody TopTx ShelleyEra
txb TxWits ShelleyEra
txwits StrictMaybe (TxAuxData ShelleyEra)
txAux)) =
    (ShelleyTx l AllegraEra -> Tx l AllegraEra)
-> Either (TxUpgradeError AllegraEra) (ShelleyTx l AllegraEra)
-> Either (TxUpgradeError AllegraEra) (Tx l 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 l AllegraEra -> Tx l AllegraEra
forall (t :: TxLevel). ShelleyTx t AllegraEra -> Tx t AllegraEra
MkAllegraTx (Either (TxUpgradeError AllegraEra) (ShelleyTx l AllegraEra)
 -> Either (TxUpgradeError AllegraEra) (Tx l AllegraEra))
-> Either (TxUpgradeError AllegraEra) (ShelleyTx l AllegraEra)
-> Either (TxUpgradeError AllegraEra) (Tx l AllegraEra)
forall a b. (a -> b) -> a -> b
$
      TxBody TopTx AllegraEra
-> TxWits AllegraEra
-> StrictMaybe (TxAuxData AllegraEra)
-> ShelleyTx TopTx AllegraEra
TxBody TopTx AllegraEra
-> ShelleyTxWits AllegraEra
-> StrictMaybe (AllegraTxAuxData AllegraEra)
-> ShelleyTx l AllegraEra
forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx
        (TxBody TopTx AllegraEra
 -> ShelleyTxWits AllegraEra
 -> StrictMaybe (AllegraTxAuxData AllegraEra)
 -> ShelleyTx l AllegraEra)
-> Either Void (TxBody TopTx AllegraEra)
-> Either
     Void
     (ShelleyTxWits AllegraEra
      -> StrictMaybe (AllegraTxAuxData AllegraEra)
      -> ShelleyTx l AllegraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody TopTx (PreviousEra AllegraEra)
-> Either (TxBodyUpgradeError AllegraEra) (TxBody TopTx AllegraEra)
forall era (l :: TxLevel).
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody l (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody l era)
forall (l :: TxLevel).
EraTxBody (PreviousEra AllegraEra) =>
TxBody l (PreviousEra AllegraEra)
-> Either (TxBodyUpgradeError AllegraEra) (TxBody l AllegraEra)
upgradeTxBody TxBody TopTx (PreviousEra AllegraEra)
TxBody TopTx ShelleyEra
txb
        Either
  Void
  (ShelleyTxWits AllegraEra
   -> StrictMaybe (AllegraTxAuxData AllegraEra)
   -> ShelleyTx l AllegraEra)
-> Either Void (ShelleyTxWits AllegraEra)
-> Either
     Void
     (StrictMaybe (AllegraTxAuxData AllegraEra)
      -> ShelleyTx l 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 l AllegraEra)
-> Either Void (StrictMaybe (AllegraTxAuxData AllegraEra))
-> Either Void (ShelleyTx l 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 :: forall (l :: TxLevel).
EraTxBody (PreviousEra AllegraEra) =>
TxBody l (PreviousEra AllegraEra)
-> Either (TxBodyUpgradeError AllegraEra) (TxBody l AllegraEra)
upgradeTxBody TxBody l (PreviousEra AllegraEra)
txBody =
    case TxBody l ShelleyEra -> RawType (TxBody l ShelleyEra)
forall t. Memoized t => t -> RawType t
getMemoRawType TxBody l (PreviousEra AllegraEra)
TxBody l ShelleyEra
txBody of
      ShelleyTxBodyRaw {} -> do
        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 l (PreviousEra AllegraEra)
TxBody l ShelleyEra
txBody TxBody l ShelleyEra
-> Getting
     (StrictSeq (TxCert (PreviousEra AllegraEra)))
     (TxBody l ShelleyEra)
     (StrictSeq (TxCert (PreviousEra AllegraEra)))
-> StrictSeq (TxCert (PreviousEra AllegraEra))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert (PreviousEra AllegraEra)))
  (TxBody l ShelleyEra)
  (StrictSeq (TxCert (PreviousEra AllegraEra)))
(StrictSeq (TxCert ShelleyEra)
 -> Const
      (StrictSeq (TxCert (PreviousEra AllegraEra)))
      (StrictSeq (TxCert ShelleyEra)))
-> TxBody l ShelleyEra
-> Const
     (StrictSeq (TxCert (PreviousEra AllegraEra))) (TxBody l ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxCert ShelleyEra))
certsTxBodyL)
        pure . asSTxTopLevel $
          Allegra.AllegraTxBody
            { Allegra.atbInputs = txBody ^. inputsTxBodyL
            , Allegra.atbOutputs = upgradeTxOut <$> (txBody ^. outputsTxBodyL)
            , Allegra.atbCerts = certs
            , Allegra.atbWithdrawals = txBody ^. withdrawalsTxBodyL
            , Allegra.atbTxFee = txBody ^. feeTxBodyL
            , Allegra.atbValidityInterval = ttlToValidityInterval (txBody ^. ttlTxBodyL)
            , Allegra.atbUpdate = upgradeUpdate () <$> (txBody ^. updateTxBodyL)
            , Allegra.atbAuxDataHash = txBody ^. auxDataHashTxBodyL
            }

  upgradeTxAuxData :: EraTxAuxData (PreviousEra AllegraEra) =>
TxAuxData (PreviousEra AllegraEra) -> TxAuxData AllegraEra
upgradeTxAuxData (ShelleyTxAuxData Map Word64 Metadatum
md) = Map Word64 Metadatum
-> StrictSeq (NativeScript AllegraEra)
-> AllegraTxAuxData AllegraEra
forall era.
(Era era, EncCBOR (NativeScript era)) =>
Map Word64 Metadatum
-> StrictSeq (NativeScript era) -> AllegraTxAuxData era
AllegraTxAuxData Map Word64 Metadatum
md StrictSeq (Timelock AllegraEra)
StrictSeq (NativeScript 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)

  upgradeNativeScript :: NativeScript (PreviousEra AllegraEra) -> NativeScript AllegraEra
upgradeNativeScript = NativeScript (PreviousEra AllegraEra) -> NativeScript AllegraEra
NativeScript ShelleyEra -> NativeScript AllegraEra
upgradeMultiSig

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)

instance EraApi MaryEra where
  upgradeTx :: forall (l :: TxLevel).
EraTx (PreviousEra MaryEra) =>
Tx l (PreviousEra MaryEra)
-> Either (TxUpgradeError MaryEra) (Tx l MaryEra)
upgradeTx (MkAllegraTx (ShelleyTx TxBody TopTx AllegraEra
txb TxWits AllegraEra
txwits StrictMaybe (TxAuxData AllegraEra)
txAux)) =
    (ShelleyTx l MaryEra -> Tx l MaryEra)
-> Either (TxUpgradeError MaryEra) (ShelleyTx l MaryEra)
-> Either (TxUpgradeError MaryEra) (Tx l 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 l MaryEra -> Tx l MaryEra
forall (t :: TxLevel). ShelleyTx t MaryEra -> Tx t MaryEra
MkMaryTx (Either (TxUpgradeError MaryEra) (ShelleyTx l MaryEra)
 -> Either (TxUpgradeError MaryEra) (Tx l MaryEra))
-> Either (TxUpgradeError MaryEra) (ShelleyTx l MaryEra)
-> Either (TxUpgradeError MaryEra) (Tx l MaryEra)
forall a b. (a -> b) -> a -> b
$
      TxBody TopTx MaryEra
-> TxWits MaryEra
-> StrictMaybe (TxAuxData MaryEra)
-> ShelleyTx TopTx MaryEra
TxBody TopTx MaryEra
-> ShelleyTxWits MaryEra
-> StrictMaybe (AllegraTxAuxData MaryEra)
-> ShelleyTx l MaryEra
forall era.
TxBody TopTx era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx TopTx era
ShelleyTx
        (TxBody TopTx MaryEra
 -> ShelleyTxWits MaryEra
 -> StrictMaybe (AllegraTxAuxData MaryEra)
 -> ShelleyTx l MaryEra)
-> Either Void (TxBody TopTx MaryEra)
-> Either
     Void
     (ShelleyTxWits MaryEra
      -> StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx l MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody TopTx (PreviousEra MaryEra)
-> Either (TxBodyUpgradeError MaryEra) (TxBody TopTx MaryEra)
forall era (l :: TxLevel).
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody l (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody l era)
forall (l :: TxLevel).
EraTxBody (PreviousEra MaryEra) =>
TxBody l (PreviousEra MaryEra)
-> Either (TxBodyUpgradeError MaryEra) (TxBody l MaryEra)
upgradeTxBody TxBody TopTx AllegraEra
TxBody TopTx (PreviousEra MaryEra)
txb
        Either
  Void
  (ShelleyTxWits MaryEra
   -> StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx l MaryEra)
-> Either Void (ShelleyTxWits MaryEra)
-> Either
     Void
     (StrictMaybe (AllegraTxAuxData MaryEra) -> ShelleyTx l 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 l MaryEra)
-> Either Void (StrictMaybe (AllegraTxAuxData MaryEra))
-> Either Void (ShelleyTx l 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 :: forall (l :: TxLevel).
EraTxBody (PreviousEra MaryEra) =>
TxBody l (PreviousEra MaryEra)
-> Either (TxBodyUpgradeError MaryEra) (TxBody l MaryEra)
upgradeTxBody TxBody l (PreviousEra MaryEra)
atb =
    case TxBody l AllegraEra -> RawType (TxBody l AllegraEra)
forall t. Memoized t => t -> RawType t
getMemoRawType TxBody l AllegraEra
TxBody l (PreviousEra MaryEra)
atb of
      AllegraTxBodyRaw {} -> do
        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 TopTx AllegraEra -> StrictSeq (TxCert AllegraEra)
(EraTxOut AllegraEra, EraTxCert AllegraEra) =>
TxBody TopTx AllegraEra -> StrictSeq (TxCert AllegraEra)
Allegra.atbCerts TxBody l (PreviousEra MaryEra)
TxBody TopTx AllegraEra
atb)
        pure $
          MaryTxBody
            { mtbInputs = Allegra.atbInputs atb
            , mtbOutputs = upgradeTxOut <$> Allegra.atbOutputs atb
            , mtbCerts = certs
            , mtbWithdrawals = Allegra.atbWithdrawals atb
            , mtbTxFee = Allegra.atbTxFee atb
            , mtbValidityInterval = Allegra.atbValidityInterval atb
            , mtbUpdate = upgradeUpdate () <$> Allegra.atbUpdate atb
            , mtbAuxDataHash = Allegra.atbAuxDataHash atb
            , mtbMint = mempty
            }

  upgradeTxAuxData :: EraTxAuxData (PreviousEra MaryEra) =>
TxAuxData (PreviousEra MaryEra) -> TxAuxData MaryEra
upgradeTxAuxData (AllegraTxAuxData Map Word64 Metadatum
md StrictSeq (NativeScript AllegraEra)
scripts) = Map Word64 Metadatum
-> StrictSeq (NativeScript MaryEra) -> AllegraTxAuxData MaryEra
forall era.
(Era era, EncCBOR (NativeScript era)) =>
Map Word64 Metadatum
-> StrictSeq (NativeScript era) -> AllegraTxAuxData era
AllegraTxAuxData Map Word64 Metadatum
md (StrictSeq (NativeScript MaryEra) -> AllegraTxAuxData MaryEra)
-> StrictSeq (NativeScript MaryEra) -> AllegraTxAuxData MaryEra
forall a b. (a -> b) -> a -> b
$ 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)
-> StrictSeq (Script (PreviousEra MaryEra))
-> StrictSeq (Timelock MaryEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript AllegraEra)
StrictSeq (Script (PreviousEra MaryEra))
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)

  upgradeNativeScript :: NativeScript (PreviousEra MaryEra) -> NativeScript MaryEra
upgradeNativeScript = Timelock AllegraEra -> Timelock MaryEra
NativeScript (PreviousEra MaryEra) -> NativeScript MaryEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock

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 :: forall (l :: TxLevel).
EraTx (PreviousEra AlonzoEra) =>
Tx l (PreviousEra AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (Tx l AlonzoEra)
upgradeTx (MkMaryTx (ShelleyTx TxBody TopTx MaryEra
body TxWits MaryEra
wits StrictMaybe (TxAuxData MaryEra)
aux)) =
    (AlonzoTx l AlonzoEra -> Tx l AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (AlonzoTx l AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (Tx l 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 l AlonzoEra -> Tx l AlonzoEra
forall (l :: TxLevel). AlonzoTx l AlonzoEra -> Tx l AlonzoEra
MkAlonzoTx (Either (TxUpgradeError AlonzoEra) (AlonzoTx l AlonzoEra)
 -> Either (TxUpgradeError AlonzoEra) (Tx l AlonzoEra))
-> Either (TxUpgradeError AlonzoEra) (AlonzoTx l AlonzoEra)
-> Either (TxUpgradeError AlonzoEra) (Tx l AlonzoEra)
forall a b. (a -> b) -> a -> b
$
      TxBody TopTx AlonzoEra
-> TxWits AlonzoEra
-> IsValid
-> StrictMaybe (TxAuxData AlonzoEra)
-> AlonzoTx TopTx AlonzoEra
TxBody TopTx AlonzoEra
-> AlonzoTxWits AlonzoEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData AlonzoEra)
-> AlonzoTx l AlonzoEra
forall era.
TxBody TopTx era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx TopTx era
AlonzoTx
        (TxBody TopTx AlonzoEra
 -> AlonzoTxWits AlonzoEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
 -> AlonzoTx l AlonzoEra)
-> Either AlonzoTxUpgradeError (TxBody TopTx AlonzoEra)
-> Either
     AlonzoTxUpgradeError
     (AlonzoTxWits AlonzoEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
      -> AlonzoTx l AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AlonzoTxBodyUpgradeError -> AlonzoTxUpgradeError)
-> Either AlonzoTxBodyUpgradeError (TxBody TopTx AlonzoEra)
-> Either AlonzoTxUpgradeError (TxBody TopTx 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 TopTx (PreviousEra AlonzoEra)
-> Either (TxBodyUpgradeError AlonzoEra) (TxBody TopTx AlonzoEra)
forall era (l :: TxLevel).
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody l (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody l era)
forall (l :: TxLevel).
EraTxBody (PreviousEra AlonzoEra) =>
TxBody l (PreviousEra AlonzoEra)
-> Either (TxBodyUpgradeError AlonzoEra) (TxBody l AlonzoEra)
upgradeTxBody TxBody TopTx (PreviousEra AlonzoEra)
TxBody TopTx MaryEra
body)
        Either
  AlonzoTxUpgradeError
  (AlonzoTxWits AlonzoEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData AlonzoEra)
   -> AlonzoTx l AlonzoEra)
-> Either AlonzoTxUpgradeError (AlonzoTxWits AlonzoEra)
-> Either
     AlonzoTxUpgradeError
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx l 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 l AlonzoEra)
-> Either AlonzoTxUpgradeError IsValid
-> Either
     AlonzoTxUpgradeError
     (StrictMaybe (AlonzoTxAuxData AlonzoEra) -> AlonzoTx l 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 l AlonzoEra)
-> Either
     AlonzoTxUpgradeError (StrictMaybe (AlonzoTxAuxData AlonzoEra))
-> Either AlonzoTxUpgradeError (AlonzoTx l 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 :: forall (l :: TxLevel).
EraTxBody (PreviousEra AlonzoEra) =>
TxBody l (PreviousEra AlonzoEra)
-> Either (TxBodyUpgradeError AlonzoEra) (TxBody l AlonzoEra)
upgradeTxBody
    TxBody l (PreviousEra AlonzoEra)
txb =
      case TxBody l MaryEra -> RawType (TxBody l MaryEra)
forall t. Memoized t => t -> RawType t
getMemoRawType TxBody l (PreviousEra AlonzoEra)
TxBody l MaryEra
txb of
        AllegraTxBodyRaw
          { Set TxIn
atbrInputs :: Set TxIn
atbrInputs :: forall era ma. AllegraTxBodyRaw ma TopTx era -> Set TxIn
atbrInputs
          , StrictSeq (TxOut MaryEra)
atbrOutputs :: StrictSeq (TxOut MaryEra)
atbrOutputs :: forall era ma.
AllegraTxBodyRaw ma TopTx era -> StrictSeq (TxOut era)
atbrOutputs
          , StrictSeq (TxCert MaryEra)
atbrCerts :: StrictSeq (TxCert MaryEra)
atbrCerts :: forall era ma.
AllegraTxBodyRaw ma TopTx era -> StrictSeq (TxCert era)
atbrCerts
          , Withdrawals
atbrWithdrawals :: Withdrawals
atbrWithdrawals :: forall era ma. AllegraTxBodyRaw ma TopTx era -> Withdrawals
atbrWithdrawals
          , Coin
atbrFee :: Coin
atbrFee :: forall era ma. AllegraTxBodyRaw ma TopTx era -> Coin
atbrFee
          , ValidityInterval
atbrValidityInterval :: ValidityInterval
atbrValidityInterval :: forall era ma. AllegraTxBodyRaw ma TopTx era -> ValidityInterval
atbrValidityInterval
          , StrictMaybe (Update MaryEra)
atbrUpdate :: StrictMaybe (Update MaryEra)
atbrUpdate :: forall era ma.
AllegraTxBodyRaw ma TopTx era -> StrictMaybe (Update era)
atbrUpdate
          , StrictMaybe TxAuxDataHash
atbrAuxDataHash :: StrictMaybe TxAuxDataHash
atbrAuxDataHash :: forall era ma.
AllegraTxBodyRaw ma TopTx era -> StrictMaybe TxAuxDataHash
atbrAuxDataHash
          , MultiAsset
atbrMint :: MultiAsset
atbrMint :: forall era ma. AllegraTxBodyRaw ma TopTx era -> ma
atbrMint
          } -> do
            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)
atbrCerts

            updates <- traverse upgradeUpdateEither atbrUpdate
            pure $
              AlonzoTxBody
                { atbInputs = atbrInputs
                , atbOutputs = upgradeTxOut <$> atbrOutputs
                , atbCerts = certs
                , atbWithdrawals = atbrWithdrawals
                , atbTxFee = atbrFee
                , atbValidityInterval = atbrValidityInterval
                , atbUpdate = updates
                , atbAuxDataHash = atbrAuxDataHash
                , atbMint = atbrMint
                , atbCollateral = mempty
                , atbReqSignerHashes = mempty
                , atbScriptIntegrityHash = SNothing
                , atbTxNetworkId = 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 GenesisRole) (PParamsUpdate MaryEra)
m) =
                Map (KeyHash GenesisRole) (PParamsUpdate AlonzoEra)
-> ProposedPPUpdates AlonzoEra
forall era.
Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates
                  (Map (KeyHash GenesisRole) (PParamsUpdate AlonzoEra)
 -> ProposedPPUpdates AlonzoEra)
-> Either
     AlonzoTxBodyUpgradeError
     (Map (KeyHash GenesisRole) (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 GenesisRole) (PParamsUpdate MaryEra)
-> Either
     AlonzoTxBodyUpgradeError
     (Map (KeyHash GenesisRole) (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 GenesisRole) a -> f (Map (KeyHash GenesisRole) 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, AtMostEra "Mary" era, HasCallStack) =>
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 GenesisRole) (PParamsUpdate MaryEra)
m

  upgradeTxAuxData :: EraTxAuxData (PreviousEra AlonzoEra) =>
TxAuxData (PreviousEra AlonzoEra) -> TxAuxData AlonzoEra
upgradeTxAuxData (AllegraTxAuxData Map Word64 Metadatum
md StrictSeq (NativeScript MaryEra)
scripts) =
    forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @AllegraEra (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
        , atadrNativeScripts :: StrictSeq (NativeScript AlonzoEra)
atadrNativeScripts = NativeScript (PreviousEra AlonzoEra) -> NativeScript AlonzoEra
forall era.
EraApi era =>
NativeScript (PreviousEra era) -> NativeScript era
upgradeNativeScript (NativeScript (PreviousEra AlonzoEra) -> NativeScript AlonzoEra)
-> StrictSeq (NativeScript (PreviousEra AlonzoEra))
-> StrictSeq (NativeScript AlonzoEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript (PreviousEra AlonzoEra))
StrictSeq (NativeScript 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)

  upgradeNativeScript :: NativeScript (PreviousEra AlonzoEra) -> NativeScript AlonzoEra
upgradeNativeScript = Timelock MaryEra -> Timelock AlonzoEra
NativeScript (PreviousEra AlonzoEra) -> NativeScript AlonzoEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock

-- | 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 (PreviousEra era), AlonzoEraScript era, EraApi era) =>
  AlonzoTxAuxData (PreviousEra era) ->
  AlonzoTxAuxData era
translateAlonzoTxAuxData :: forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era,
 EraApi era) =>
AlonzoTxAuxData (PreviousEra era) -> AlonzoTxAuxData era
translateAlonzoTxAuxData AlonzoTxAuxData {Map Word64 Metadatum
atadMetadata :: Map Word64 Metadatum
atadMetadata :: forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> Map Word64 Metadatum
atadMetadata, StrictSeq (NativeScript (PreviousEra era))
atadNativeScripts :: StrictSeq (NativeScript (PreviousEra era))
atadNativeScripts :: forall era.
(HasCallStack, AlonzoEraScript era) =>
AlonzoTxAuxData era -> StrictSeq (NativeScript era)
atadNativeScripts, 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
    , atadNativeScripts :: StrictSeq (NativeScript era)
atadNativeScripts = NativeScript (PreviousEra era) -> NativeScript era
forall era.
EraApi era =>
NativeScript (PreviousEra era) -> NativeScript era
upgradeNativeScript (NativeScript (PreviousEra era) -> NativeScript era)
-> StrictSeq (NativeScript (PreviousEra era))
-> StrictSeq (NativeScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (NativeScript (PreviousEra era))
atadNativeScripts
    , 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 :: forall (l :: TxLevel).
EraTx (PreviousEra BabbageEra) =>
Tx l (PreviousEra BabbageEra)
-> Either (TxUpgradeError BabbageEra) (Tx l BabbageEra)
upgradeTx (MkAlonzoTx (AlonzoTx TxBody TopTx AlonzoEra
b TxWits AlonzoEra
w IsValid
valid StrictMaybe (TxAuxData AlonzoEra)
aux)) =
    (AlonzoTx l BabbageEra -> Tx l BabbageEra)
-> Either (TxUpgradeError BabbageEra) (AlonzoTx l BabbageEra)
-> Either (TxUpgradeError BabbageEra) (Tx l 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 l BabbageEra -> Tx l BabbageEra
forall (l :: TxLevel). AlonzoTx l BabbageEra -> Tx l BabbageEra
MkBabbageTx (Either (TxUpgradeError BabbageEra) (AlonzoTx l BabbageEra)
 -> Either (TxUpgradeError BabbageEra) (Tx l BabbageEra))
-> Either (TxUpgradeError BabbageEra) (AlonzoTx l BabbageEra)
-> Either (TxUpgradeError BabbageEra) (Tx l BabbageEra)
forall a b. (a -> b) -> a -> b
$
      TxBody TopTx BabbageEra
-> TxWits BabbageEra
-> IsValid
-> StrictMaybe (TxAuxData BabbageEra)
-> AlonzoTx TopTx BabbageEra
TxBody TopTx BabbageEra
-> AlonzoTxWits BabbageEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData BabbageEra)
-> AlonzoTx l BabbageEra
forall era.
TxBody TopTx era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx TopTx era
AlonzoTx
        (TxBody TopTx BabbageEra
 -> AlonzoTxWits BabbageEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData BabbageEra)
 -> AlonzoTx l BabbageEra)
-> Either BabbageTxUpgradeError (TxBody TopTx BabbageEra)
-> Either
     BabbageTxUpgradeError
     (AlonzoTxWits BabbageEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData BabbageEra)
      -> AlonzoTx l BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BabbageTxBodyUpgradeError -> BabbageTxUpgradeError)
-> Either BabbageTxBodyUpgradeError (TxBody TopTx BabbageEra)
-> Either BabbageTxUpgradeError (TxBody TopTx 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 TopTx (PreviousEra BabbageEra)
-> Either (TxBodyUpgradeError BabbageEra) (TxBody TopTx BabbageEra)
forall era (l :: TxLevel).
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody l (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody l era)
forall (l :: TxLevel).
EraTxBody (PreviousEra BabbageEra) =>
TxBody l (PreviousEra BabbageEra)
-> Either (TxBodyUpgradeError BabbageEra) (TxBody l BabbageEra)
upgradeTxBody TxBody TopTx (PreviousEra BabbageEra)
TxBody TopTx AlonzoEra
b)
        Either
  BabbageTxUpgradeError
  (AlonzoTxWits BabbageEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData BabbageEra)
   -> AlonzoTx l BabbageEra)
-> Either BabbageTxUpgradeError (AlonzoTxWits BabbageEra)
-> Either
     BabbageTxUpgradeError
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData BabbageEra)
      -> AlonzoTx l 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 l BabbageEra)
-> Either BabbageTxUpgradeError IsValid
-> Either
     BabbageTxUpgradeError
     (StrictMaybe (AlonzoTxAuxData BabbageEra) -> AlonzoTx l 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 l BabbageEra)
-> Either
     BabbageTxUpgradeError (StrictMaybe (AlonzoTxAuxData BabbageEra))
-> Either BabbageTxUpgradeError (AlonzoTx l 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 :: forall (l :: TxLevel).
EraTxBody (PreviousEra BabbageEra) =>
TxBody l (PreviousEra BabbageEra)
-> Either (TxBodyUpgradeError BabbageEra) (TxBody l BabbageEra)
upgradeTxBody TxBody l (PreviousEra BabbageEra)
txBody =
    case TxBody l AlonzoEra -> RawType (TxBody l AlonzoEra)
forall t. Memoized t => t -> RawType t
getMemoRawType TxBody l (PreviousEra BabbageEra)
TxBody l AlonzoEra
txBody of
      AlonzoTxBodyRaw {} -> do
        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 l (PreviousEra BabbageEra)
TxBody l AlonzoEra
txBody TxBody l AlonzoEra
-> Getting
     (StrictSeq (TxCert (PreviousEra BabbageEra)))
     (TxBody l AlonzoEra)
     (StrictSeq (TxCert (PreviousEra BabbageEra)))
-> StrictSeq (TxCert (PreviousEra BabbageEra))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert (PreviousEra BabbageEra)))
  (TxBody l AlonzoEra)
  (StrictSeq (TxCert (PreviousEra BabbageEra)))
(StrictSeq (TxCert AlonzoEra)
 -> Const
      (StrictSeq (TxCert (PreviousEra BabbageEra)))
      (StrictSeq (TxCert AlonzoEra)))
-> TxBody l AlonzoEra
-> Const
     (StrictSeq (TxCert (PreviousEra BabbageEra))) (TxBody l AlonzoEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l AlonzoEra) (StrictSeq (TxCert AlonzoEra))
certsTxBodyL)
        updates <- traverse upgradeUpdateEither (txBody ^. updateTxBodyL)
        pure $
          BabbageTxBody
            { btbInputs = txBody ^. inputsTxBodyL
            , btbOutputs =
                mkSized (eraProtVerLow @BabbageEra) . upgradeTxOut <$> (txBody ^. outputsTxBodyL)
            , btbCerts = certs
            , btbWithdrawals = txBody ^. withdrawalsTxBodyL
            , btbTxFee = txBody ^. feeTxBodyL
            , btbValidityInterval = txBody ^. vldtTxBodyL
            , btbUpdate = updates
            , btbAuxDataHash = txBody ^. auxDataHashTxBodyL
            , btbMint = txBody ^. mintTxBodyL
            , btbCollateral = txBody ^. collateralInputsTxBodyL
            , btbReqSignerHashes = txBody ^. reqSignerHashesTxBodyL
            , btbScriptIntegrityHash = txBody ^. scriptIntegrityHashTxBodyL
            , btbTxNetworkId = txBody ^. networkIdTxBodyL
            , btbReferenceInputs = mempty
            , btbCollateralReturn = SNothing
            , btbTotalCollateral = 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 GenesisRole) (PParamsUpdate AlonzoEra)
m) =
            Map (KeyHash GenesisRole) (PParamsUpdate BabbageEra)
-> ProposedPPUpdates BabbageEra
forall era.
Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates
              (Map (KeyHash GenesisRole) (PParamsUpdate BabbageEra)
 -> ProposedPPUpdates BabbageEra)
-> Either
     BabbageTxBodyUpgradeError
     (Map (KeyHash GenesisRole) (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 GenesisRole) (PParamsUpdate AlonzoEra)
-> Either
     BabbageTxBodyUpgradeError
     (Map (KeyHash GenesisRole) (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 GenesisRole) a -> f (Map (KeyHash GenesisRole) 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 GenesisRole) (PParamsUpdate AlonzoEra)
m

  upgradeTxAuxData :: EraTxAuxData (PreviousEra BabbageEra) =>
TxAuxData (PreviousEra BabbageEra) -> TxAuxData BabbageEra
upgradeTxAuxData = TxAuxData (PreviousEra BabbageEra) -> TxAuxData BabbageEra
AlonzoTxAuxData (PreviousEra BabbageEra)
-> AlonzoTxAuxData BabbageEra
forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era,
 EraApi era) =>
AlonzoTxAuxData (PreviousEra era) -> AlonzoTxAuxData era
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)
      }

  upgradeNativeScript :: NativeScript (PreviousEra BabbageEra) -> NativeScript BabbageEra
upgradeNativeScript = Timelock AlonzoEra -> Timelock BabbageEra
NativeScript (PreviousEra BabbageEra) -> NativeScript BabbageEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock

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 :: forall (l :: TxLevel).
EraTx (PreviousEra ConwayEra) =>
Tx l (PreviousEra ConwayEra)
-> Either (TxUpgradeError ConwayEra) (Tx l ConwayEra)
upgradeTx (MkBabbageTx (AlonzoTx TxBody TopTx BabbageEra
b TxWits BabbageEra
w IsValid
valid StrictMaybe (TxAuxData BabbageEra)
aux)) =
    (AlonzoTx l ConwayEra -> Tx l ConwayEra)
-> Either (TxUpgradeError ConwayEra) (AlonzoTx l ConwayEra)
-> Either (TxUpgradeError ConwayEra) (Tx l 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 l ConwayEra -> Tx l ConwayEra
forall (l :: TxLevel). AlonzoTx l ConwayEra -> Tx l ConwayEra
MkConwayTx (Either (TxUpgradeError ConwayEra) (AlonzoTx l ConwayEra)
 -> Either (TxUpgradeError ConwayEra) (Tx l ConwayEra))
-> Either (TxUpgradeError ConwayEra) (AlonzoTx l ConwayEra)
-> Either (TxUpgradeError ConwayEra) (Tx l ConwayEra)
forall a b. (a -> b) -> a -> b
$
      TxBody TopTx ConwayEra
-> TxWits ConwayEra
-> IsValid
-> StrictMaybe (TxAuxData ConwayEra)
-> AlonzoTx TopTx ConwayEra
TxBody TopTx ConwayEra
-> AlonzoTxWits ConwayEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData ConwayEra)
-> AlonzoTx l ConwayEra
forall era.
TxBody TopTx era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx TopTx era
AlonzoTx
        (TxBody TopTx ConwayEra
 -> AlonzoTxWits ConwayEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData ConwayEra)
 -> AlonzoTx l ConwayEra)
-> Either ConwayTxBodyUpgradeError (TxBody TopTx ConwayEra)
-> Either
     ConwayTxBodyUpgradeError
     (AlonzoTxWits ConwayEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData ConwayEra)
      -> AlonzoTx l ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody TopTx (PreviousEra ConwayEra)
-> Either (TxBodyUpgradeError ConwayEra) (TxBody TopTx ConwayEra)
forall era (l :: TxLevel).
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody l (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody l era)
forall (l :: TxLevel).
EraTxBody (PreviousEra ConwayEra) =>
TxBody l (PreviousEra ConwayEra)
-> Either (TxBodyUpgradeError ConwayEra) (TxBody l ConwayEra)
upgradeTxBody TxBody TopTx (PreviousEra ConwayEra)
TxBody TopTx BabbageEra
b
        Either
  ConwayTxBodyUpgradeError
  (AlonzoTxWits ConwayEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData ConwayEra)
   -> AlonzoTx l ConwayEra)
-> Either ConwayTxBodyUpgradeError (AlonzoTxWits ConwayEra)
-> Either
     ConwayTxBodyUpgradeError
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData ConwayEra) -> AlonzoTx l 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 l ConwayEra)
-> Either ConwayTxBodyUpgradeError IsValid
-> Either
     ConwayTxBodyUpgradeError
     (StrictMaybe (AlonzoTxAuxData ConwayEra) -> AlonzoTx l 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 l ConwayEra)
-> Either
     ConwayTxBodyUpgradeError (StrictMaybe (AlonzoTxAuxData ConwayEra))
-> Either ConwayTxBodyUpgradeError (AlonzoTx l 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 :: forall (l :: TxLevel).
EraTxBody (PreviousEra ConwayEra) =>
TxBody l (PreviousEra ConwayEra)
-> Either (TxBodyUpgradeError ConwayEra) (TxBody l ConwayEra)
upgradeTxBody TxBody l (PreviousEra ConwayEra)
btb =
    case TxBody l BabbageEra -> RawType (TxBody l BabbageEra)
forall t. Memoized t => t -> RawType t
getMemoRawType TxBody l (PreviousEra ConwayEra)
TxBody l BabbageEra
btb of
      BabbageTxBodyRaw {} -> 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 TopTx BabbageEra -> StrictMaybe (Update BabbageEra)
btbUpdate TxBody l (PreviousEra ConwayEra)
TxBody TopTx 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
        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 TopTx BabbageEra -> StrictSeq (TxCert BabbageEra)
btbCerts TxBody l (PreviousEra ConwayEra)
TxBody TopTx BabbageEra
btb)
        let (duplicates, certsOSet) = OSet.fromStrictSeqDuplicates certs
        unless (null duplicates) $ Left $ CTBUEContainsDuplicateCerts duplicates
        pure $
          ConwayTxBody
            { ctbSpendInputs = btbInputs btb
            , ctbOutputs = unsafeMapSized upgradeTxOut <$> btbOutputs btb
            , ctbCerts = certsOSet
            , ctbWithdrawals = btbWithdrawals btb
            , ctbTxfee = btbTxFee btb
            , ctbVldt = btbValidityInterval btb
            , ctbAdHash = btbAuxDataHash btb
            , ctbMint = btbMint btb
            , ctbCollateralInputs = btbCollateral btb
            , ctbReqSignerHashes = btbReqSignerHashes btb
            , ctbScriptIntegrityHash = btbScriptIntegrityHash btb
            , ctbTxNetworkId = btbTxNetworkId btb
            , ctbReferenceInputs = btbReferenceInputs btb
            , ctbCollateralReturn = unsafeMapSized upgradeTxOut <$> btbCollateralReturn btb
            , ctbTotalCollateral = btbTotalCollateral btb
            , ctbCurrentTreasuryValue = SNothing
            , ctbProposalProcedures = OSet.empty
            , ctbVotingProcedures = VotingProcedures mempty
            , ctbTreasuryDonation = Coin 0
            }

  upgradeTxAuxData :: EraTxAuxData (PreviousEra ConwayEra) =>
TxAuxData (PreviousEra ConwayEra) -> TxAuxData ConwayEra
upgradeTxAuxData = TxAuxData (PreviousEra ConwayEra) -> TxAuxData ConwayEra
AlonzoTxAuxData (PreviousEra ConwayEra)
-> AlonzoTxAuxData ConwayEra
forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era,
 EraApi era) =>
AlonzoTxAuxData (PreviousEra era) -> AlonzoTxAuxData era
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)
      }

  upgradeNativeScript :: NativeScript (PreviousEra ConwayEra) -> NativeScript ConwayEra
upgradeNativeScript = Timelock BabbageEra -> Timelock ConwayEra
NativeScript (PreviousEra ConwayEra) -> NativeScript ConwayEra
forall era1 era2.
(Era era1, Era era2) =>
Timelock era1 -> Timelock era2
translateTimelock

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

instance EraApi DijkstraEra where
  type TxUpgradeError DijkstraEra = TxBodyUpgradeError DijkstraEra
  type TxBodyUpgradeError DijkstraEra = DijkstraTxBodyUpgradeError
  upgradeTx :: forall (l :: TxLevel).
EraTx (PreviousEra DijkstraEra) =>
Tx l (PreviousEra DijkstraEra)
-> Either (TxUpgradeError DijkstraEra) (Tx l DijkstraEra)
upgradeTx (MkConwayTx (AlonzoTx TxBody TopTx ConwayEra
b TxWits ConwayEra
w IsValid
valid StrictMaybe (TxAuxData ConwayEra)
aux)) =
    (DijkstraTx l DijkstraEra -> Tx l DijkstraEra)
-> Either (TxUpgradeError DijkstraEra) (DijkstraTx l DijkstraEra)
-> Either (TxUpgradeError DijkstraEra) (Tx l 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 DijkstraTx l DijkstraEra -> Tx l DijkstraEra
forall (l :: TxLevel). DijkstraTx l DijkstraEra -> Tx l DijkstraEra
MkDijkstraTx (Either (TxUpgradeError DijkstraEra) (DijkstraTx l DijkstraEra)
 -> Either (TxUpgradeError DijkstraEra) (Tx l DijkstraEra))
-> Either (TxUpgradeError DijkstraEra) (DijkstraTx l DijkstraEra)
-> Either (TxUpgradeError DijkstraEra) (Tx l DijkstraEra)
forall a b. (a -> b) -> a -> b
$
      TxBody TopTx DijkstraEra
-> TxWits DijkstraEra
-> IsValid
-> StrictMaybe (TxAuxData DijkstraEra)
-> DijkstraTx TopTx DijkstraEra
TxBody TopTx DijkstraEra
-> AlonzoTxWits DijkstraEra
-> IsValid
-> StrictMaybe (AlonzoTxAuxData DijkstraEra)
-> DijkstraTx l DijkstraEra
forall era.
TxBody TopTx era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> DijkstraTx TopTx era
DijkstraTx
        (TxBody TopTx DijkstraEra
 -> AlonzoTxWits DijkstraEra
 -> IsValid
 -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
 -> DijkstraTx l DijkstraEra)
-> Either DijkstraTxBodyUpgradeError (TxBody TopTx DijkstraEra)
-> Either
     DijkstraTxBodyUpgradeError
     (AlonzoTxWits DijkstraEra
      -> IsValid
      -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
      -> DijkstraTx l DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBody TopTx (PreviousEra DijkstraEra)
-> Either
     (TxBodyUpgradeError DijkstraEra) (TxBody TopTx DijkstraEra)
forall era (l :: TxLevel).
(EraApi era, EraTxBody (PreviousEra era)) =>
TxBody l (PreviousEra era)
-> Either (TxBodyUpgradeError era) (TxBody l era)
forall (l :: TxLevel).
EraTxBody (PreviousEra DijkstraEra) =>
TxBody l (PreviousEra DijkstraEra)
-> Either (TxBodyUpgradeError DijkstraEra) (TxBody l DijkstraEra)
upgradeTxBody TxBody TopTx (PreviousEra DijkstraEra)
TxBody TopTx ConwayEra
b
        Either
  DijkstraTxBodyUpgradeError
  (AlonzoTxWits DijkstraEra
   -> IsValid
   -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
   -> DijkstraTx l DijkstraEra)
-> Either DijkstraTxBodyUpgradeError (AlonzoTxWits DijkstraEra)
-> Either
     DijkstraTxBodyUpgradeError
     (IsValid
      -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
      -> DijkstraTx l DijkstraEra)
forall a b.
Either DijkstraTxBodyUpgradeError (a -> b)
-> Either DijkstraTxBodyUpgradeError a
-> Either DijkstraTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AlonzoTxWits DijkstraEra
-> Either DijkstraTxBodyUpgradeError (AlonzoTxWits DijkstraEra)
forall a. a -> Either DijkstraTxBodyUpgradeError 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
  DijkstraTxBodyUpgradeError
  (IsValid
   -> StrictMaybe (AlonzoTxAuxData DijkstraEra)
   -> DijkstraTx l DijkstraEra)
-> Either DijkstraTxBodyUpgradeError IsValid
-> Either
     DijkstraTxBodyUpgradeError
     (StrictMaybe (AlonzoTxAuxData DijkstraEra)
      -> DijkstraTx l DijkstraEra)
forall a b.
Either DijkstraTxBodyUpgradeError (a -> b)
-> Either DijkstraTxBodyUpgradeError a
-> Either DijkstraTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IsValid -> Either DijkstraTxBodyUpgradeError IsValid
forall a. a -> Either DijkstraTxBodyUpgradeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsValid
valid
        Either
  DijkstraTxBodyUpgradeError
  (StrictMaybe (AlonzoTxAuxData DijkstraEra)
   -> DijkstraTx l DijkstraEra)
-> Either
     DijkstraTxBodyUpgradeError
     (StrictMaybe (AlonzoTxAuxData DijkstraEra))
-> Either DijkstraTxBodyUpgradeError (DijkstraTx l DijkstraEra)
forall a b.
Either DijkstraTxBodyUpgradeError (a -> b)
-> Either DijkstraTxBodyUpgradeError a
-> Either DijkstraTxBodyUpgradeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StrictMaybe (AlonzoTxAuxData DijkstraEra)
-> Either
     DijkstraTxBodyUpgradeError
     (StrictMaybe (AlonzoTxAuxData DijkstraEra))
forall a. a -> Either DijkstraTxBodyUpgradeError 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 :: forall (l :: TxLevel).
EraTxBody (PreviousEra DijkstraEra) =>
TxBody l (PreviousEra DijkstraEra)
-> Either (TxBodyUpgradeError DijkstraEra) (TxBody l DijkstraEra)
upgradeTxBody TxBody l (PreviousEra DijkstraEra)
txBody =
    case TxBody l ConwayEra -> RawType (TxBody l ConwayEra)
forall t. Memoized t => t -> RawType t
getMemoRawType TxBody l (PreviousEra DijkstraEra)
TxBody l ConwayEra
txBody of
      ConwayTxBodyRaw {OSet (TxCert ConwayEra)
OSet (ProposalProcedure ConwayEra)
Set (KeyHash Guard)
Set TxIn
StrictMaybe ScriptIntegrityHash
StrictMaybe TxAuxDataHash
StrictMaybe (Sized (TxOut ConwayEra))
StrictMaybe Coin
StrictMaybe Network
ValidityInterval
Withdrawals
VotingProcedures ConwayEra
Coin
MultiAsset
StrictSeq (Sized (TxOut ConwayEra))
ctbrSpendInputs :: Set TxIn
ctbrCollateralInputs :: Set TxIn
ctbrReferenceInputs :: Set TxIn
ctbrOutputs :: StrictSeq (Sized (TxOut ConwayEra))
ctbrCollateralReturn :: StrictMaybe (Sized (TxOut ConwayEra))
ctbrTotalCollateral :: StrictMaybe Coin
ctbrCerts :: OSet (TxCert ConwayEra)
ctbrWithdrawals :: Withdrawals
ctbrFee :: Coin
ctbrVldt :: ValidityInterval
ctbrReqSignerHashes :: Set (KeyHash Guard)
ctbrMint :: MultiAsset
ctbrScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
ctbrAuxDataHash :: StrictMaybe TxAuxDataHash
ctbrNetworkId :: StrictMaybe Network
ctbrVotingProcedures :: VotingProcedures ConwayEra
ctbrProposalProcedures :: OSet (ProposalProcedure ConwayEra)
ctbrCurrentTreasuryValue :: StrictMaybe Coin
ctbrTreasuryDonation :: Coin
ctbrTreasuryDonation :: forall era. ConwayTxBodyRaw TopTx era -> Coin
ctbrCurrentTreasuryValue :: forall era. ConwayTxBodyRaw TopTx era -> StrictMaybe Coin
ctbrProposalProcedures :: forall era.
ConwayTxBodyRaw TopTx era -> OSet (ProposalProcedure era)
ctbrVotingProcedures :: forall era. ConwayTxBodyRaw TopTx era -> VotingProcedures era
ctbrNetworkId :: forall era. ConwayTxBodyRaw TopTx era -> StrictMaybe Network
ctbrAuxDataHash :: forall era. ConwayTxBodyRaw TopTx era -> StrictMaybe TxAuxDataHash
ctbrScriptIntegrityHash :: forall era.
ConwayTxBodyRaw TopTx era -> StrictMaybe ScriptIntegrityHash
ctbrMint :: forall era. ConwayTxBodyRaw TopTx era -> MultiAsset
ctbrReqSignerHashes :: forall era. ConwayTxBodyRaw TopTx era -> Set (KeyHash Guard)
ctbrVldt :: forall era. ConwayTxBodyRaw TopTx era -> ValidityInterval
ctbrFee :: forall era. ConwayTxBodyRaw TopTx era -> Coin
ctbrWithdrawals :: forall era. ConwayTxBodyRaw TopTx era -> Withdrawals
ctbrCerts :: forall era. ConwayTxBodyRaw TopTx era -> OSet (TxCert era)
ctbrTotalCollateral :: forall era. ConwayTxBodyRaw TopTx era -> StrictMaybe Coin
ctbrCollateralReturn :: forall era.
ConwayTxBodyRaw TopTx era -> StrictMaybe (Sized (TxOut era))
ctbrOutputs :: forall era.
ConwayTxBodyRaw TopTx era -> StrictSeq (Sized (TxOut era))
ctbrReferenceInputs :: forall era. ConwayTxBodyRaw TopTx era -> Set TxIn
ctbrCollateralInputs :: forall era. ConwayTxBodyRaw TopTx era -> Set TxIn
ctbrSpendInputs :: forall era. ConwayTxBodyRaw TopTx era -> Set TxIn
..} -> do
        certs <- (TxCert (PreviousEra DijkstraEra)
 -> Either DijkstraTxBodyUpgradeError (TxCert DijkstraEra))
-> StrictSeq (TxCert (PreviousEra DijkstraEra))
-> Either
     DijkstraTxBodyUpgradeError (StrictSeq (TxCert DijkstraEra))
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 ((DijkstraTxCertUpgradeError -> DijkstraTxBodyUpgradeError)
-> Either DijkstraTxCertUpgradeError (TxCert DijkstraEra)
-> Either DijkstraTxBodyUpgradeError (TxCert DijkstraEra)
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 DijkstraTxCertUpgradeError -> DijkstraTxBodyUpgradeError
DTBUETxCert (Either DijkstraTxCertUpgradeError (TxCert DijkstraEra)
 -> Either DijkstraTxBodyUpgradeError (TxCert DijkstraEra))
-> (TxCert (PreviousEra DijkstraEra)
    -> Either DijkstraTxCertUpgradeError (TxCert DijkstraEra))
-> TxCert (PreviousEra DijkstraEra)
-> Either DijkstraTxBodyUpgradeError (TxCert DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert (PreviousEra DijkstraEra)
-> Either (TxCertUpgradeError DijkstraEra) (TxCert DijkstraEra)
TxCert (PreviousEra DijkstraEra)
-> Either DijkstraTxCertUpgradeError (TxCert DijkstraEra)
forall era.
(EraTxCert era, EraTxCert (PreviousEra era)) =>
TxCert (PreviousEra era)
-> Either (TxCertUpgradeError era) (TxCert era)
upgradeTxCert) (StrictSeq (TxCert (PreviousEra DijkstraEra))
 -> Either
      DijkstraTxBodyUpgradeError (StrictSeq (TxCert DijkstraEra)))
-> StrictSeq (TxCert (PreviousEra DijkstraEra))
-> Either
     DijkstraTxBodyUpgradeError (StrictSeq (TxCert DijkstraEra))
forall a b. (a -> b) -> a -> b
$ OSet (TxCert (PreviousEra DijkstraEra))
-> StrictSeq (TxCert (PreviousEra DijkstraEra))
forall a. OSet a -> StrictSeq a
OSet.toStrictSeq OSet (TxCert (PreviousEra DijkstraEra))
OSet (TxCert ConwayEra)
ctbrCerts
        pure $
          DijkstraTxBody
            { dtbSpendInputs = ctbrSpendInputs
            , dtbOutputs = unsafeMapSized upgradeTxOut <$> ctbrOutputs
            , dtbCerts = OSet.fromStrictSeq certs
            , dtbWithdrawals = ctbrWithdrawals
            , dtbTxfee = ctbrFee
            , dtbVldt = ctbrVldt
            , dtbAdHash = ctbrAuxDataHash
            , dtbMint = ctbrMint
            , dtbCollateralInputs = ctbrCollateralInputs
            , dtbGuards = OSet.fromSet $ Set.map (KeyHashObj . coerceKeyRole) ctbrReqSignerHashes
            , dtbScriptIntegrityHash = ctbrScriptIntegrityHash
            , dtbTxNetworkId = ctbrNetworkId
            , dtbReferenceInputs = ctbrReferenceInputs
            , dtbCollateralReturn = unsafeMapSized upgradeTxOut <$> ctbrCollateralReturn
            , dtbTotalCollateral = ctbrTotalCollateral
            , dtbCurrentTreasuryValue = ctbrCurrentTreasuryValue
            , dtbProposalProcedures = OSet.mapL upgradeProposals ctbrProposalProcedures
            , dtbVotingProcedures = coerce ctbrVotingProcedures
            , dtbTreasuryDonation = ctbrTreasuryDonation
            , dtbSubTransactions = mempty
            }

  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 (PreviousEra DijkstraEra)
-> AlonzoTxAuxData DijkstraEra
forall era.
(AlonzoEraScript (PreviousEra era), AlonzoEraScript era,
 EraApi era) =>
AlonzoTxAuxData (PreviousEra era) -> AlonzoTxAuxData era
translateAlonzoTxAuxData

  upgradeNativeScript :: NativeScript (PreviousEra DijkstraEra) -> NativeScript DijkstraEra
upgradeNativeScript = NativeScript (PreviousEra DijkstraEra) -> NativeScript DijkstraEra
NativeScript ConwayEra -> NativeScript DijkstraEra
upgradeTimelock