From d2144850474bfdf37a1a29ccff9188c73ed04d7e Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Thu, 17 Oct 2024 16:52:31 +0200 Subject: [PATCH 1/2] Split off `Internal.Cardano.Write.Eras` --- lib/balance-tx/cardano-balance-tx.cabal | 1 + .../internal/Internal/Cardano/Write/Eras.hs | 321 ++++++++++++++++++ .../lib/internal/Internal/Cardano/Write/Tx.hs | 295 +--------------- .../Internal/Cardano/Write/Tx/Balance.hs | 6 +- .../Write/Tx/Balance/TokenBundleSize.hs | 6 +- .../internal/Internal/Cardano/Write/Tx/Gen.hs | 6 +- .../Internal/Cardano/Write/Tx/Redeemers.hs | 8 +- .../Internal/Cardano/Write/Tx/Sign.hs | 10 +- .../Internal/Cardano/Write/Tx/TxWithUTxO.hs | 6 +- .../Cardano/Write/Tx/TxWithUTxO/Gen.hs | 6 +- .../Write/Tx/Balance/TokenBundleSizeSpec.hs | 22 +- .../Internal/Cardano/Write/Tx/BalanceSpec.hs | 40 ++- .../spec/Internal/Cardano/Write/TxSpec.hs | 6 +- 13 files changed, 406 insertions(+), 327 deletions(-) create mode 100644 lib/balance-tx/lib/internal/Internal/Cardano/Write/Eras.hs diff --git a/lib/balance-tx/cardano-balance-tx.cabal b/lib/balance-tx/cardano-balance-tx.cabal index bbafa81f16f..45cfe4583d1 100644 --- a/lib/balance-tx/cardano-balance-tx.cabal +++ b/lib/balance-tx/cardano-balance-tx.cabal @@ -87,6 +87,7 @@ library internal , text , transformers exposed-modules: + Internal.Cardano.Write.Eras Internal.Cardano.Write.Tx Internal.Cardano.Write.Tx.Balance Internal.Cardano.Write.Tx.Balance.CoinSelection diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Eras.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Eras.hs new file mode 100644 index 00000000000..8006b3ca42b --- /dev/null +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Eras.hs @@ -0,0 +1,321 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +-- | +-- Copyright: © 2024 Cardano Foundation +-- License: Apache-2.0 +-- +-- Recent eras. +module Internal.Cardano.Write.Eras + ( + -- * Eras + BabbageEra + , ConwayEra + + -- ** RecentEra + , RecentEra (..) + , IsRecentEra (..) + , CardanoApiEra + , toRecentEra + , fromRecentEra + , MaybeInRecentEra (..) + , LatestLedgerEra + , RecentEraConstraints + , allRecentEras + + -- ** Existential wrapper + , AnyRecentEra (..) + , toAnyCardanoEra + , fromAnyCardanoEra + + -- ** Helpers for cardano-api compatibility + , cardanoEra + , shelleyBasedEra + , CardanoApi.ShelleyLedgerEra + , cardanoEraFromRecentEra + , shelleyBasedEraFromRecentEra + ) where + +import Prelude + +import Cardano.Ledger.Allegra.Scripts + ( AllegraEraScript + , Timelock + ) +import Cardano.Ledger.Alonzo.Plutus.Context + ( EraPlutusContext + ) +import Cardano.Ledger.Alonzo.Scripts + ( AlonzoEraScript + , AlonzoScript (..) + ) +import Cardano.Ledger.Alonzo.TxWits + ( AlonzoTxWits + ) +import Cardano.Ledger.Alonzo.UTxO + ( AlonzoScriptsNeeded + ) +import Cardano.Ledger.Api.UTxO + ( EraUTxO (ScriptsNeeded) + ) +import Cardano.Ledger.Crypto + ( StandardCrypto + ) +import Cardano.Ledger.Mary + ( MaryValue + ) +import Data.Function + ( on + ) +import Data.Generics.Labels + () +import Data.Kind + ( Type + ) +import Data.Maybe + ( fromMaybe + , isJust + ) +import Data.Set + ( Set + ) +import Data.Type.Equality + ( TestEquality (testEquality) + , (:~:) (Refl) + ) +import Data.Typeable + ( Typeable + ) + +import qualified Cardano.Api as CardanoApi +import qualified Cardano.Api.Shelley as CardanoApi +import qualified Cardano.Ledger.Alonzo.Core as Alonzo +import qualified Cardano.Ledger.Api as Ledger +import qualified Cardano.Ledger.Babbage.Tx as Babbage +import qualified Cardano.Ledger.Babbage.TxBody as Babbage +import qualified Cardano.Ledger.Core as Core +import qualified Cardano.Ledger.Shelley.UTxO as Shelley +import qualified Data.Set as Set + +-------------------------------------------------------------------------------- +-- Eras +-------------------------------------------------------------------------------- + +type BabbageEra = Ledger.BabbageEra StandardCrypto +type ConwayEra = Ledger.ConwayEra StandardCrypto + +type LatestLedgerEra = ConwayEra + +-------------------------------------------------------------------------------- +-- RecentEra +-------------------------------------------------------------------------------- + +-- | 'RecentEra' respresents the eras we care about constructing transactions +-- for. +-- +-- To have the same software constructing transactions just before and just +-- after a hard-fork, we need to, at that time, support the two latest eras. We +-- could get away with just supporting one era at other times, but for +-- simplicity we stick with always supporting the two latest eras for now. +-- +-- NOTE: We /could/ let 'era' refer to eras from the ledger rather than from +-- cardano-api. +data RecentEra era where + RecentEraBabbage :: RecentEra BabbageEra + RecentEraConway :: RecentEra ConwayEra + +deriving instance Eq (RecentEra era) +deriving instance Show (RecentEra era) + +instance TestEquality RecentEra where + testEquality RecentEraBabbage RecentEraBabbage = Just Refl + testEquality RecentEraConway RecentEraConway = Just Refl + testEquality RecentEraBabbage RecentEraConway = Nothing + testEquality RecentEraConway RecentEraBabbage = Nothing + +class + ( CardanoApi.IsShelleyBasedEra (CardanoApiEra era) + , CardanoApi.ShelleyLedgerEra (CardanoApiEra era) ~ era + , Typeable era + , RecentEraConstraints era + ) => IsRecentEra era where + recentEra :: RecentEra era + +type family CardanoApiEra era = cardanoApiEra | cardanoApiEra -> era +type instance CardanoApiEra BabbageEra = CardanoApi.BabbageEra +type instance CardanoApiEra ConwayEra = CardanoApi.ConwayEra + +-- | Convenient constraints. Constraints may be dropped as we move to new eras. +-- +-- Adding too many constraints shouldn't be a concern as the point of +-- 'RecentEra' is to work with a small closed set of eras, anyway. +type RecentEraConstraints era = + ( Core.Era era + , Core.EraTx era + , Core.EraCrypto era ~ StandardCrypto + , Core.Script era ~ AlonzoScript era + , Core.Tx era ~ Babbage.AlonzoTx era + , Core.EraTxCert era + , Core.Value era ~ MaryValue StandardCrypto + , Core.TxWits era ~ AlonzoTxWits era + , Alonzo.AlonzoEraPParams era + , Ledger.AlonzoEraTx era + , ScriptsNeeded era ~ AlonzoScriptsNeeded era + , AlonzoEraScript era + , Ledger.Crypto (Core.EraCrypto era) + , Eq (Core.TxOut era) + , Eq (Core.Tx era) + , Babbage.BabbageEraTxBody era + , Alonzo.AlonzoEraTxBody era + , Shelley.EraUTxO era + , Show (Core.TxOut era) + , Show (Core.Tx era) + , Show (Core.PParams era) + , Show (AlonzoScript era) + , EraPlutusContext era + , AllegraEraScript era + , Core.NativeScript era ~ Timelock era + ) + +-- | Returns a proof that the given era is a recent era. +-- +-- Otherwise, returns @Nothing@. +toRecentEra + :: CardanoApi.CardanoEra era + -> Maybe (RecentEra (CardanoApi.ShelleyLedgerEra era)) +toRecentEra = \case + CardanoApi.ConwayEra -> Just RecentEraConway + CardanoApi.BabbageEra -> Just RecentEraBabbage + CardanoApi.AlonzoEra -> Nothing + CardanoApi.MaryEra -> Nothing + CardanoApi.AllegraEra -> Nothing + CardanoApi.ShelleyEra -> Nothing + CardanoApi.ByronEra -> Nothing + +fromRecentEra :: RecentEra era -> CardanoApi.CardanoEra (CardanoApiEra era) +fromRecentEra = \case + RecentEraConway -> CardanoApi.ConwayEra + RecentEraBabbage -> CardanoApi.BabbageEra + +instance IsRecentEra BabbageEra where + recentEra = RecentEraBabbage + +instance IsRecentEra ConwayEra where + recentEra = RecentEraConway + +cardanoEraFromRecentEra + :: RecentEra era + -> CardanoApi.CardanoEra (CardanoApiEra era) +cardanoEraFromRecentEra era = case shelleyBasedEraFromRecentEra era of + CardanoApi.ShelleyBasedEraBabbage -> CardanoApi.toCardanoEra CardanoApi.BabbageEra + CardanoApi.ShelleyBasedEraConway -> CardanoApi.toCardanoEra CardanoApi.ConwayEra + _ -> error "we are expecting only Babbage and Conway" + +shelleyBasedEraFromRecentEra + :: RecentEra era + -> CardanoApi.ShelleyBasedEra (CardanoApiEra era) +shelleyBasedEraFromRecentEra = \case + RecentEraConway -> CardanoApi.ShelleyBasedEraConway + RecentEraBabbage -> CardanoApi.ShelleyBasedEraBabbage + +-- Similar to 'CardanoApi.cardanoEra', but with an 'IsRecentEra era' constraint +-- instead of 'CardanoApi.IsCardanoEra'. +cardanoEra + :: forall era. IsRecentEra era + => CardanoApi.CardanoEra (CardanoApiEra era) +cardanoEra = cardanoEraFromRecentEra $ recentEra @era + +-- | For convenience working with 'IsRecentEra'. +-- +-- Similar to 'CardanoApi.shelleyBasedEra, but with a 'IsRecentEra era' +-- constraint instead of 'CardanoApi.IsShelleyBasedEra'. +shelleyBasedEra + :: forall era. IsRecentEra era + => CardanoApi.ShelleyBasedEra (CardanoApiEra era) +shelleyBasedEra = shelleyBasedEraFromRecentEra $ recentEra @era + +data MaybeInRecentEra (thing :: Type -> Type) + = InNonRecentEraByron + | InNonRecentEraShelley + | InNonRecentEraAllegra + | InNonRecentEraMary + | InNonRecentEraAlonzo + | InRecentEraBabbage (thing BabbageEra) + | InRecentEraConway (thing ConwayEra) + +deriving instance (Eq (a BabbageEra), (Eq (a ConwayEra))) + => Eq (MaybeInRecentEra a) +deriving instance (Show (a BabbageEra), (Show (a ConwayEra))) + => Show (MaybeInRecentEra a) + +-- | An existential type like 'AnyCardanoEra', but for 'RecentEra'. +data AnyRecentEra where + AnyRecentEra + :: IsRecentEra era -- Provide class constraint + => RecentEra era -- and explicit value. + -> AnyRecentEra -- and that's it. + +instance Enum AnyRecentEra where + -- NOTE: We're not starting at 0! 0 would be Byron, which is not a recent + -- era. + fromEnum = fromEnum . toAnyCardanoEra + toEnum n = fromMaybe err . fromAnyCardanoEra $ toEnum n + where + err = error $ unwords + [ "AnyRecentEra.toEnum:", show n + , "doesn't correspond to a recent era." + ] + +instance Bounded AnyRecentEra where + minBound = AnyRecentEra RecentEraBabbage + maxBound = AnyRecentEra RecentEraConway + +instance Ord AnyRecentEra where + compare = compare `on` fromEnum + +instance Show AnyRecentEra where + show (AnyRecentEra era) = "AnyRecentEra " <> show era + +instance Eq AnyRecentEra where + AnyRecentEra e1 == AnyRecentEra e2 = + isJust $ testEquality e1 e2 + +-- | The complete set of recent eras. +-- +allRecentEras :: Set AnyRecentEra +allRecentEras = Set.fromList [minBound .. maxBound] + +toAnyCardanoEra :: AnyRecentEra -> CardanoApi.AnyCardanoEra +toAnyCardanoEra (AnyRecentEra era) = + CardanoApi.AnyCardanoEra (fromRecentEra era) + +fromAnyCardanoEra + :: CardanoApi.AnyCardanoEra + -> Maybe AnyRecentEra +fromAnyCardanoEra = \case + CardanoApi.AnyCardanoEra CardanoApi.ByronEra -> + Nothing + CardanoApi.AnyCardanoEra CardanoApi.ShelleyEra -> + Nothing + CardanoApi.AnyCardanoEra CardanoApi.AllegraEra -> + Nothing + CardanoApi.AnyCardanoEra CardanoApi.MaryEra -> + Nothing + CardanoApi.AnyCardanoEra CardanoApi.AlonzoEra -> + Nothing + CardanoApi.AnyCardanoEra CardanoApi.BabbageEra -> + Just $ AnyRecentEra RecentEraBabbage + CardanoApi.AnyCardanoEra CardanoApi.ConwayEra -> + Just $ AnyRecentEra RecentEraConway diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs index e102c196dca..2179ca97d4a 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs @@ -8,10 +8,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} @@ -28,41 +26,15 @@ -- wallet migration. module Internal.Cardano.Write.Tx ( - -- * Eras - BabbageEra - , ConwayEra - - -- ** RecentEra - , RecentEra (..) - , IsRecentEra (..) - , CardanoApiEra - , toRecentEra - , fromRecentEra - , MaybeInRecentEra (..) - , toRecentEraGADT - , LatestLedgerEra - , RecentEraConstraints - , allRecentEras - -- ** Key witness counts - , KeyWitnessCounts (..) + KeyWitnessCounts (..) -- ** Helpers for cardano-api compatibility - , cardanoEra - , shelleyBasedEra - , CardanoApi.ShelleyLedgerEra - , cardanoEraFromRecentEra - , shelleyBasedEraFromRecentEra , fromCardanoApiTx , toCardanoApiUTxO , fromCardanoApiUTxO , toCardanoApiTx - -- ** Existential wrapper - , AnyRecentEra (..) - , toAnyCardanoEra - , fromAnyCardanoEra - -- ** Misc , StandardCrypto , StandardBabbage @@ -71,6 +43,7 @@ module Internal.Cardano.Write.Tx -- * PParams , PParams , PParamsInAnyRecentEra (..) + , toRecentEraGADT , FeePerByte (..) , getFeePerByte , feeOfBytes @@ -155,30 +128,17 @@ import Cardano.Crypto.Hash ( Hash (UnsafeHash) ) import Cardano.Ledger.Allegra.Scripts - ( AllegraEraScript - , Timelock - , translateTimelock - ) -import Cardano.Ledger.Alonzo.Plutus.Context - ( EraPlutusContext + ( translateTimelock ) import Cardano.Ledger.Alonzo.Scripts - ( AlonzoEraScript - , AlonzoScript (..) - ) -import Cardano.Ledger.Alonzo.TxWits - ( AlonzoTxWits - ) -import Cardano.Ledger.Alonzo.UTxO - ( AlonzoScriptsNeeded + ( AlonzoScript (..) ) import Cardano.Ledger.Api ( coinTxOutL , upgradeTxOut ) import Cardano.Ledger.Api.UTxO - ( EraUTxO (ScriptsNeeded) - , UTxO (..) + ( UTxO (..) ) import Cardano.Ledger.Babbage.TxBody ( BabbageTxOut (..) @@ -234,9 +194,6 @@ import Data.ByteString.Short import Data.Coerce ( coerce ) -import Data.Function - ( on - ) import Data.Generics.Internal.VL.Lens ( over , (^.) @@ -247,26 +204,19 @@ import Data.IntCast ( intCast , intCastMaybe ) -import Data.Kind - ( Type - ) -import Data.Maybe - ( fromMaybe - , isJust - ) -import Data.Set - ( Set - ) -import Data.Type.Equality - ( TestEquality (testEquality) - , (:~:) (Refl) - ) -import Data.Typeable - ( Typeable - ) import GHC.Stack ( HasCallStack ) +import Internal.Cardano.Write.Eras + ( BabbageEra + , CardanoApiEra + , ConwayEra + , IsRecentEra (..) + , LatestLedgerEra + , MaybeInRecentEra (..) + , RecentEra (..) + , shelleyBasedEra + ) import Numeric.Natural ( Natural ) @@ -283,7 +233,6 @@ import qualified Cardano.Ledger.Alonzo.Core as Alonzo import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Api as Ledger import qualified Cardano.Ledger.Babbage as Babbage -import qualified Cardano.Ledger.Babbage.Tx as Babbage import qualified Cardano.Ledger.Babbage.TxBody as Babbage import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Credential as Core @@ -297,220 +246,6 @@ import qualified Cardano.Wallet.Primitive.Types.Tx.Constraints as W ( txOutMaxCoin ) import qualified Data.Map as Map -import qualified Data.Set as Set - --------------------------------------------------------------------------------- --- Eras --------------------------------------------------------------------------------- - -type BabbageEra = Ledger.BabbageEra StandardCrypto -type ConwayEra = Ledger.ConwayEra StandardCrypto - -type LatestLedgerEra = StandardConway - --------------------------------------------------------------------------------- --- RecentEra --------------------------------------------------------------------------------- - --- | 'RecentEra' respresents the eras we care about constructing transactions --- for. --- --- To have the same software constructing transactions just before and just --- after a hard-fork, we need to, at that time, support the two latest eras. We --- could get away with just supporting one era at other times, but for --- simplicity we stick with always supporting the two latest eras for now. --- --- NOTE: We /could/ let 'era' refer to eras from the ledger rather than from --- cardano-api. -data RecentEra era where - RecentEraBabbage :: RecentEra BabbageEra - RecentEraConway :: RecentEra ConwayEra - -deriving instance Eq (RecentEra era) -deriving instance Show (RecentEra era) - -instance TestEquality RecentEra where - testEquality RecentEraBabbage RecentEraBabbage = Just Refl - testEquality RecentEraConway RecentEraConway = Just Refl - testEquality RecentEraBabbage RecentEraConway = Nothing - testEquality RecentEraConway RecentEraBabbage = Nothing - -class - ( CardanoApi.IsShelleyBasedEra (CardanoApiEra era) - , CardanoApi.ShelleyLedgerEra (CardanoApiEra era) ~ era - , Typeable era - , RecentEraConstraints era - ) => IsRecentEra era where - recentEra :: RecentEra era - -type family CardanoApiEra era = cardanoApiEra | cardanoApiEra -> era -type instance CardanoApiEra BabbageEra = CardanoApi.BabbageEra -type instance CardanoApiEra ConwayEra = CardanoApi.ConwayEra - --- | Convenient constraints. Constraints may be dropped as we move to new eras. --- --- Adding too many constraints shouldn't be a concern as the point of --- 'RecentEra' is to work with a small closed set of eras, anyway. -type RecentEraConstraints era = - ( Core.Era era - , Core.EraTx era - , Core.EraCrypto era ~ StandardCrypto - , Core.Script era ~ AlonzoScript era - , Core.Tx era ~ Babbage.AlonzoTx era - , Core.EraTxCert era - , Core.Value era ~ Value - , Core.TxWits era ~ AlonzoTxWits era - , Alonzo.AlonzoEraPParams era - , Ledger.AlonzoEraTx era - , ScriptsNeeded era ~ AlonzoScriptsNeeded era - , AlonzoEraScript era - , Eq (TxOut era) - , Ledger.Crypto (Core.EraCrypto era) - , Show (TxOut era) - , Show (Core.Tx era) - , Eq (Core.Tx era) - , Babbage.BabbageEraTxBody era - , Alonzo.AlonzoEraTxBody era - , Shelley.EraUTxO era - , Show (TxOut era) - , Eq (TxOut era) - , Show (PParams era) - , Show (Script era) - , EraPlutusContext era - , AllegraEraScript era - , Core.NativeScript era ~ Timelock era - ) - --- | Returns a proof that the given era is a recent era. --- --- Otherwise, returns @Nothing@. -toRecentEra - :: CardanoApi.CardanoEra era - -> Maybe (RecentEra (CardanoApi.ShelleyLedgerEra era)) -toRecentEra = \case - CardanoApi.ConwayEra -> Just RecentEraConway - CardanoApi.BabbageEra -> Just RecentEraBabbage - CardanoApi.AlonzoEra -> Nothing - CardanoApi.MaryEra -> Nothing - CardanoApi.AllegraEra -> Nothing - CardanoApi.ShelleyEra -> Nothing - CardanoApi.ByronEra -> Nothing - -fromRecentEra :: RecentEra era -> CardanoApi.CardanoEra (CardanoApiEra era) -fromRecentEra = \case - RecentEraConway -> CardanoApi.ConwayEra - RecentEraBabbage -> CardanoApi.BabbageEra - -instance IsRecentEra BabbageEra where - recentEra = RecentEraBabbage - -instance IsRecentEra ConwayEra where - recentEra = RecentEraConway - -cardanoEraFromRecentEra - :: RecentEra era - -> CardanoApi.CardanoEra (CardanoApiEra era) -cardanoEraFromRecentEra era = case shelleyBasedEraFromRecentEra era of - CardanoApi.ShelleyBasedEraBabbage -> CardanoApi.toCardanoEra CardanoApi.BabbageEra - CardanoApi.ShelleyBasedEraConway -> CardanoApi.toCardanoEra CardanoApi.ConwayEra - _ -> error "we are expecting only Babbage and Conway" - -shelleyBasedEraFromRecentEra - :: RecentEra era - -> CardanoApi.ShelleyBasedEra (CardanoApiEra era) -shelleyBasedEraFromRecentEra = \case - RecentEraConway -> CardanoApi.ShelleyBasedEraConway - RecentEraBabbage -> CardanoApi.ShelleyBasedEraBabbage - --- Similar to 'CardanoApi.cardanoEra', but with an 'IsRecentEra era' constraint --- instead of 'CardanoApi.IsCardanoEra'. -cardanoEra - :: forall era. IsRecentEra era - => CardanoApi.CardanoEra (CardanoApiEra era) -cardanoEra = cardanoEraFromRecentEra $ recentEra @era - --- | For convenience working with 'IsRecentEra'. --- --- Similar to 'CardanoApi.shelleyBasedEra, but with a 'IsRecentEra era' --- constraint instead of 'CardanoApi.IsShelleyBasedEra'. -shelleyBasedEra - :: forall era. IsRecentEra era - => CardanoApi.ShelleyBasedEra (CardanoApiEra era) -shelleyBasedEra = shelleyBasedEraFromRecentEra $ recentEra @era - -data MaybeInRecentEra (thing :: Type -> Type) - = InNonRecentEraByron - | InNonRecentEraShelley - | InNonRecentEraAllegra - | InNonRecentEraMary - | InNonRecentEraAlonzo - | InRecentEraBabbage (thing BabbageEra) - | InRecentEraConway (thing ConwayEra) - -deriving instance (Eq (a BabbageEra), (Eq (a ConwayEra))) - => Eq (MaybeInRecentEra a) -deriving instance (Show (a BabbageEra), (Show (a ConwayEra))) - => Show (MaybeInRecentEra a) - --- | An existential type like 'AnyCardanoEra', but for 'RecentEra'. -data AnyRecentEra where - AnyRecentEra - :: IsRecentEra era -- Provide class constraint - => RecentEra era -- and explicit value. - -> AnyRecentEra -- and that's it. - -instance Enum AnyRecentEra where - -- NOTE: We're not starting at 0! 0 would be Byron, which is not a recent - -- era. - fromEnum = fromEnum . toAnyCardanoEra - toEnum n = fromMaybe err . fromAnyCardanoEra $ toEnum n - where - err = error $ unwords - [ "AnyRecentEra.toEnum:", show n - , "doesn't correspond to a recent era." - ] - -instance Bounded AnyRecentEra where - minBound = AnyRecentEra RecentEraBabbage - maxBound = AnyRecentEra RecentEraConway - -instance Ord AnyRecentEra where - compare = compare `on` fromEnum - -instance Show AnyRecentEra where - show (AnyRecentEra era) = "AnyRecentEra " <> show era - -instance Eq AnyRecentEra where - AnyRecentEra e1 == AnyRecentEra e2 = - isJust $ testEquality e1 e2 - --- | The complete set of recent eras. --- -allRecentEras :: Set AnyRecentEra -allRecentEras = Set.fromList [minBound .. maxBound] - -toAnyCardanoEra :: AnyRecentEra -> CardanoApi.AnyCardanoEra -toAnyCardanoEra (AnyRecentEra era) = - CardanoApi.AnyCardanoEra (fromRecentEra era) - -fromAnyCardanoEra - :: CardanoApi.AnyCardanoEra - -> Maybe AnyRecentEra -fromAnyCardanoEra = \case - CardanoApi.AnyCardanoEra CardanoApi.ByronEra -> - Nothing - CardanoApi.AnyCardanoEra CardanoApi.ShelleyEra -> - Nothing - CardanoApi.AnyCardanoEra CardanoApi.AllegraEra -> - Nothing - CardanoApi.AnyCardanoEra CardanoApi.MaryEra -> - Nothing - CardanoApi.AnyCardanoEra CardanoApi.AlonzoEra -> - Nothing - CardanoApi.AnyCardanoEra CardanoApi.BabbageEra -> - Just $ AnyRecentEra RecentEraBabbage - CardanoApi.AnyCardanoEra CardanoApi.ConwayEra -> - Just $ AnyRecentEra RecentEraConway -------------------------------------------------------------------------------- -- Key witness counts diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs index ad8eed95ec1..0592310ee3b 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs @@ -191,15 +191,17 @@ import GHC.Generics import GHC.Stack ( HasCallStack ) +import Internal.Cardano.Write.Eras + ( IsRecentEra (..) + , RecentEra (..) + ) import Internal.Cardano.Write.Tx ( Address , AssetName , Coin (..) - , IsRecentEra (..) , KeyWitnessCounts (..) , PParams , PolicyId - , RecentEra (..) , StakeCredential , Tx , TxBody diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance/TokenBundleSize.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance/TokenBundleSize.hs index 3ea356ae8a2..3ec3848c302 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance/TokenBundleSize.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance/TokenBundleSize.hs @@ -28,9 +28,11 @@ import Control.Lens import Data.IntCast ( intCastMaybe ) -import Internal.Cardano.Write.Tx +import Internal.Cardano.Write.Eras ( IsRecentEra - , PParams + ) +import Internal.Cardano.Write.Tx + ( PParams , Value , Version ) diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Gen.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Gen.hs index bf8a70757fa..0a357a5f1d4 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Gen.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Gen.hs @@ -27,12 +27,14 @@ import Cardano.Api.Ledger import Data.Maybe ( fromMaybe ) -import Internal.Cardano.Write.Tx +import Internal.Cardano.Write.Eras ( BabbageEra , ConwayEra - , DatumHash , IsRecentEra (..) , RecentEra (..) + ) +import Internal.Cardano.Write.Tx + ( DatumHash , datumHashFromBytes ) import Test.QuickCheck diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Redeemers.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Redeemers.hs index 44434451863..ab07887e959 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Redeemers.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Redeemers.hs @@ -86,11 +86,13 @@ import Fmt import GHC.Generics ( Generic ) -import Internal.Cardano.Write.Tx +import Internal.Cardano.Write.Eras ( IsRecentEra (..) - , PParams - , PolicyId , RecentEra (..) + ) +import Internal.Cardano.Write.Tx + ( PParams + , PolicyId , RewardAccount , TxIn , UTxO diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs index 2b238f7f56e..1a2de6ad5f4 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Sign.hs @@ -86,9 +86,12 @@ import Data.Maybe import Data.Set ( Set ) +import Internal.Cardano.Write.Eras + ( CardanoApiEra + , IsRecentEra (..) + ) import Internal.Cardano.Write.Tx - ( IsRecentEra (..) - , KeyWitnessCounts (..) + ( KeyWitnessCounts (..) , PParams , Script , Tx @@ -116,7 +119,6 @@ import qualified Cardano.Wallet.Primitive.Types.Tx.Constraints as W import qualified Data.Foldable as F import qualified Data.List as L import qualified Data.Map as Map -import qualified Internal.Cardano.Write.Tx as Write -- | Estimate the size of the transaction when fully signed. -- @@ -255,7 +257,7 @@ estimateKeyWitnessCounts utxo tx timelockKeyWitCounts = scriptsAvailableInBody = tx ^. witsTxL . scriptTxWitsL estimateDelegSigningKeys - :: CardanoApi.Certificate (Write.CardanoApiEra era) + :: CardanoApi.Certificate (CardanoApiEra era) -> Integer estimateDelegSigningKeys = \case CardanoApi.ShelleyRelatedCertificate s2b shelleyCert -> diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/TxWithUTxO.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/TxWithUTxO.hs index e9d8cad115e..3a433956e2f 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/TxWithUTxO.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/TxWithUTxO.hs @@ -45,9 +45,11 @@ import Data.Semigroup.Cancellative import Data.Set.NonEmpty ( NESet ) -import Internal.Cardano.Write.Tx +import Internal.Cardano.Write.Eras ( IsRecentEra - , Tx + ) +import Internal.Cardano.Write.Tx + ( Tx , TxIn , UTxO (UTxO) ) diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/TxWithUTxO/Gen.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/TxWithUTxO/Gen.hs index 298f1a2183a..f1ecbd0bf62 100644 --- a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/TxWithUTxO/Gen.hs +++ b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/TxWithUTxO/Gen.hs @@ -30,9 +30,11 @@ import Cardano.Ledger.Api.Tx.Body import Control.Lens ( view ) -import Internal.Cardano.Write.Tx +import Internal.Cardano.Write.Eras ( IsRecentEra - , Tx + ) +import Internal.Cardano.Write.Tx + ( Tx , TxIn , TxOut , UTxO (UTxO) diff --git a/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/Balance/TokenBundleSizeSpec.hs b/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/Balance/TokenBundleSizeSpec.hs index a14916ef693..fd49af5c8a0 100644 --- a/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/Balance/TokenBundleSizeSpec.hs +++ b/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/Balance/TokenBundleSizeSpec.hs @@ -30,12 +30,14 @@ import Data.Monoid.Monus import Data.Word ( Word32 ) -import Internal.Cardano.Write.Tx - ( IsRecentEra (..) - , ProtVer (..) +import Internal.Cardano.Write.Eras + ( BabbageEra + , ConwayEra + , IsRecentEra (..) , RecentEra (..) - , StandardBabbage - , StandardConway + ) +import Internal.Cardano.Write.Tx + ( ProtVer (..) , Version ) import Internal.Cardano.Write.Tx.Balance.TokenBundleSize @@ -171,7 +173,7 @@ unit_assessTokenBundleSize_fixedSizeBundle ] where actualAssessment = assessTokenBundleSize assessor bundle - v = eraProtVerLow @StandardBabbage + v = eraProtVerLow @BabbageEra actualLengthBytes = computeTokenBundleSerializedLengthBytes bundle v counterexampleText = unlines [ "Expected min length bytes:" @@ -268,8 +270,8 @@ instance Arbitrary Version where arbitrary = arbitraryBoundedEnum data PParamsInRecentEra - = PParamsInBabbage (PParams StandardBabbage) - | PParamsInConway (PParams StandardConway) + = PParamsInBabbage (PParams BabbageEra) + | PParamsInConway (PParams ConwayEra) deriving (Show, Eq) instance Arbitrary PParamsInRecentEra where @@ -304,8 +306,8 @@ instance Arbitrary PParamsInRecentEra where babbageTokenBundleSizeAssessor :: TokenBundleSizeAssessor babbageTokenBundleSizeAssessor = mkTokenBundleSizeAssessor - $ (def :: PParams StandardBabbage) - & ppProtocolVersionL .~ (ProtVer (eraProtVerLow @StandardBabbage) 0) + $ (def :: PParams BabbageEra) + & ppProtocolVersionL .~ (ProtVer (eraProtVerLow @BabbageEra) 0) & ppMaxValSizeL .~ maryTokenBundleMaxSizeBytes where maryTokenBundleMaxSizeBytes = 4000 diff --git a/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs b/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs index 10e948a3961..be823f2afdd 100644 --- a/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs +++ b/lib/balance-tx/test/spec/Internal/Cardano/Write/Tx/BalanceSpec.hs @@ -245,16 +245,22 @@ import GHC.Generics import GHC.Stack ( HasCallStack ) -import Internal.Cardano.Write.Tx +import Internal.Cardano.Write.Eras ( AnyRecentEra (..) , BabbageEra , CardanoApiEra - , Coin (..) , ConwayEra + , IsRecentEra (recentEra) + , RecentEra (..) + , cardanoEra + , fromRecentEra + , shelleyBasedEra + , shelleyBasedEraFromRecentEra + ) +import Internal.Cardano.Write.Tx + ( Coin (..) , Datum (..) , FeePerByte (..) - , IsRecentEra (..) - , RecentEra (..) , StandardCrypto , Tx , TxIn @@ -262,9 +268,7 @@ import Internal.Cardano.Write.Tx , TxOutInRecentEra (..) , UTxO (..) , Value - , cardanoEra , fromCardanoApiTx - , recentEra , serializeTx , toCardanoApiTx , unsafeUtxoFromTxOutsInRecentEra @@ -1216,7 +1220,7 @@ prop_balanceTxExistingTotalCollateral -- prop_balanceTxUnableToCreateInput -- TODO: Test with all recent eras [ADP-2997] - :: forall era. era ~ Write.BabbageEra + :: forall era. era ~ BabbageEra => Success (BalanceTxArgs era) -> Property prop_balanceTxUnableToCreateInput @@ -1640,7 +1644,7 @@ prop_bootstrapWitnesses -- TODO [ADO-2997] Test this property in all recent eras. -- https://cardanofoundation.atlassian.net/browse/ADP-2997 prop_updateTx - :: forall era. era ~ Write.BabbageEra + :: forall era. era ~ BabbageEra => Tx era -> Set W.TxIn -> Set W.TxIn @@ -1830,8 +1834,8 @@ data Wallet era = Wallet UTxOAssumptions (UTxO era) AnyChangeAddressGenWithState -- Ideally merge with 'updateTx' addExtraTxIns :: [W.TxIn] - -> PartialTx Write.BabbageEra - -> PartialTx Write.BabbageEra + -> PartialTx BabbageEra + -> PartialTx BabbageEra addExtraTxIns extraIns = #tx . bodyTxL . inputsTxBodyL %~ (<> toLedgerInputs extraIns) where @@ -1893,7 +1897,7 @@ balanceTxWithDummyChangeState utxoAssumptions utxo seed partialTx = where utxoIndex = constructUTxOIndex $ fromWalletUTxO utxo -deserializeBabbageTx :: ByteString -> Tx Write.BabbageEra +deserializeBabbageTx :: ByteString -> Tx BabbageEra deserializeBabbageTx = fromCardanoApiTx . either (error . show) id @@ -1938,7 +1942,7 @@ mkTestWallet walletUTxO = where utxo = fromWalletUTxO walletUTxO -paymentPartialTx :: [W.TxOut] -> PartialTx Write.BabbageEra +paymentPartialTx :: [W.TxOut] -> PartialTx BabbageEra paymentPartialTx txouts = PartialTx (mkBasicTx body) mempty mempty (StakeKeyDepositMap mempty) mempty where @@ -1983,7 +1987,7 @@ cardanoToWalletTxOut => CardanoApi.TxOut CardanoApi.CtxUTxO (CardanoApiEra era) -> W.TxOut cardanoToWalletTxOut = - toWallet . CardanoApi.toShelleyTxOut (Write.shelleyBasedEra @era) + toWallet . CardanoApi.toShelleyTxOut (shelleyBasedEra @era) where toWallet :: TxOut era -> W.TxOut toWallet x = case recentEra @era of @@ -2334,7 +2338,7 @@ instance forall era. IsRecentEra era => Arbitrary (Wallet era) where <*> CardanoApi.genPaymentCredential -- only vk credentials <*> CardanoApi.genStakeAddressReference where - era = Write.shelleyBasedEraFromRecentEra (recentEra @era) + era = shelleyBasedEraFromRecentEra (recentEra @era) genByronVkAddr :: Gen (CardanoApi.AddressInEra (CardanoApiEra era)) genByronVkAddr = CardanoApi.byronAddressInEra @@ -2361,7 +2365,7 @@ instance forall era. IsRecentEra era => Arbitrary (Wallet era) where <*> pure CardanoApi.TxOutDatumNone <*> pure CardanoApi.ReferenceScriptNone where - era = Write.fromRecentEra (recentEra @era) + era = fromRecentEra (recentEra @era) shrink (Wallet utxoAssumptions utxo changeAddressGen) = [ Wallet utxoAssumptions utxo' changeAddressGen @@ -2392,7 +2396,7 @@ genTxOut = -- `maxBound :: Word64`, however users could supply these. We -- should ideally test what happens, and make it clear what -- code, if any, should validate. - CardanoApi.toShelleyTxOut (Write.shelleyBasedEra @era) + CardanoApi.toShelleyTxOut (shelleyBasedEra @era) <$> CardanoApi.genTxOut (cardanoEra @era) -- | For writing shrinkers in the style of https://stackoverflow.com/a/14006575 @@ -2464,8 +2468,8 @@ shrinkTxBodyBabbage ] where shrinkLedgerTxBody - :: Ledger.TxBody Write.BabbageEra - -> [Ledger.TxBody Write.BabbageEra] + :: Ledger.TxBody BabbageEra + -> [Ledger.TxBody BabbageEra] shrinkLedgerTxBody body = tail [ body & withdrawalsTxBodyL .~ wdrls' diff --git a/lib/balance-tx/test/spec/Internal/Cardano/Write/TxSpec.hs b/lib/balance-tx/test/spec/Internal/Cardano/Write/TxSpec.hs index 059a1e6f687..4ae2e972db7 100644 --- a/lib/balance-tx/test/spec/Internal/Cardano/Write/TxSpec.hs +++ b/lib/balance-tx/test/spec/Internal/Cardano/Write/TxSpec.hs @@ -26,11 +26,13 @@ import Control.Lens import Data.Default ( Default (..) ) -import Internal.Cardano.Write.Tx +import Internal.Cardano.Write.Eras ( AnyRecentEra , BabbageEra , ConwayEra - , computeMinimumCoinForTxOut + ) +import Internal.Cardano.Write.Tx + ( computeMinimumCoinForTxOut , datumHashFromBytes , datumHashToBytes , fromCardanoApiUTxO From b1110a58bf332c85db2762696de7201ad48653a6 Mon Sep 17 00:00:00 2001 From: Heinrich Apfelmus Date: Thu, 17 Oct 2024 18:45:01 +0200 Subject: [PATCH 2/2] Add public module `Cardano.Write.Eras` --- .../Cardano/Wallet/Api/Http/Server/Error.hs | 6 +- .../Api/Http/Server/Error/AssignReedemers.hs | 6 +- .../Cardano/Wallet/Api/Http/Shelley/Server.hs | 16 +++--- lib/api/src/Cardano/Wallet/Api/Types/Era.hs | 6 +- lib/balance-tx/cardano-balance-tx.cabal | 1 + lib/balance-tx/lib/main/Cardano/Write/Eras.hs | 55 +++++++++++++++++++ .../cardano-wallet-benchmarks.cabal | 2 + lib/benchmarks/exe/api-bench.hs | 6 +- .../cardano-wallet-network-layer.cabal | 1 + .../src/Cardano/Wallet/Network.hs | 6 +- .../Cardano/Wallet/Network/Implementation.hs | 6 +- .../Wallet/Network/LocalStateQuery/PParams.hs | 2 +- .../Wallet/Network/LocalStateQuery/UTxO.hs | 6 +- lib/unit/cardano-wallet-unit.cabal | 1 + .../Wallet/DummyTarget/Primitive/Types.hs | 1 + .../unit/Cardano/Wallet/DelegationSpec.hs | 2 +- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 32 +++++------ lib/unit/test/unit/Cardano/WalletSpec.hs | 8 +-- lib/wallet/src/Cardano/Wallet.hs | 24 ++++---- lib/wallet/src/Cardano/Wallet/Delegation.hs | 2 +- .../src/Cardano/Wallet/Shelley/Transaction.hs | 22 ++++---- .../Cardano/Wallet/Transaction/Delegation.hs | 8 +-- .../src/Cardano/Wallet/Transaction/Voting.hs | 8 +-- 23 files changed, 149 insertions(+), 78 deletions(-) create mode 100644 lib/balance-tx/lib/main/Cardano/Write/Eras.hs diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs b/lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs index 6b305e6b3db..75ba432f469 100644 --- a/lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs +++ b/lib/api/src/Cardano/Wallet/Api/Http/Server/Error.hs @@ -214,6 +214,9 @@ import qualified Cardano.Wallet.Api.Types.WalletAssets as ApiWalletAssets import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO +import qualified Cardano.Write.Eras as Write + ( IsRecentEra + ) import qualified Data.Aeson as Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL @@ -222,8 +225,7 @@ import qualified Data.List as L import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Internal.Cardano.Write.Tx as Write - ( IsRecentEra - , serializeTx + ( serializeTx ) import qualified Internal.Cardano.Write.Tx as WriteTx import qualified Internal.Cardano.Write.Tx.Balance as Write diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Server/Error/AssignReedemers.hs b/lib/api/src/Cardano/Wallet/Api/Http/Server/Error/AssignReedemers.hs index 1fbdef9f3c9..8820e5761b5 100644 --- a/lib/api/src/Cardano/Wallet/Api/Http/Server/Error/AssignReedemers.hs +++ b/lib/api/src/Cardano/Wallet/Api/Http/Server/Error/AssignReedemers.hs @@ -17,12 +17,12 @@ import Cardano.Wallet.Api.Http.Server.Error.IsServerError import Cardano.Wallet.Api.Types.Error ( ApiErrorInfo (..) ) +import Cardano.Write.Eras + ( IsRecentEra (..) + ) import Fmt ( pretty ) -import Internal.Cardano.Write.Tx - ( IsRecentEra (..) - ) import Internal.Cardano.Write.Tx.Balance ( ErrAssignRedeemers (..) ) diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs index aeb96fd08c6..4ff2dd54659 100644 --- a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs @@ -668,6 +668,9 @@ import Cardano.Wallet.Transaction import Cardano.Wallet.Unsafe ( unsafeRunExceptT ) +import Cardano.Write.Eras + ( AnyRecentEra (..) + ) import Control.Arrow ( second , (&&&) @@ -799,9 +802,6 @@ import Fmt import GHC.Generics ( Generic ) -import Internal.Cardano.Write.Tx - ( AnyRecentEra (..) - ) import Internal.Cardano.Write.Tx.Balance ( PartialTx (..) , Redeemer (..) @@ -882,6 +882,12 @@ import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO import qualified Cardano.Wallet.Read as Read import qualified Cardano.Wallet.Read.Hash as Hash import qualified Cardano.Wallet.Registry as Registry +import qualified Cardano.Write.Eras as Write + ( IsRecentEra + , RecentEra + , cardanoEra + , cardanoEraFromRecentEra + ) import qualified Control.Concurrent.Concierge as Concierge import qualified Data.ByteArray as BA import qualified Data.ByteString as BS @@ -893,14 +899,10 @@ import qualified Data.Set as Set import qualified Data.Text as T import qualified Internal.Cardano.Write.Tx as Write ( Datum (DatumHash, NoDatum) - , IsRecentEra , PParamsInAnyRecentEra (PParamsInAnyRecentEra) - , RecentEra , Tx , TxIn , TxOutInRecentEra (TxOutInRecentEra) - , cardanoEra - , cardanoEraFromRecentEra , fromCardanoApiTx , getFeePerByte , pattern PolicyId diff --git a/lib/api/src/Cardano/Wallet/Api/Types/Era.hs b/lib/api/src/Cardano/Wallet/Api/Types/Era.hs index f7c35c9457c..ca9830dea0c 100644 --- a/lib/api/src/Cardano/Wallet/Api/Types/Era.hs +++ b/lib/api/src/Cardano/Wallet/Api/Types/Era.hs @@ -69,12 +69,12 @@ import Text.Show ) import qualified Cardano.Wallet.Read as Read -import qualified Data.Aeson as Aeson -import qualified Data.Set as Set -import qualified Internal.Cardano.Write.Tx as Write +import qualified Cardano.Write.Eras as Write ( allRecentEras , toAnyCardanoEra ) +import qualified Data.Aeson as Aeson +import qualified Data.Set as Set data ApiEra = ApiByron diff --git a/lib/balance-tx/cardano-balance-tx.cabal b/lib/balance-tx/cardano-balance-tx.cabal index 45cfe4583d1..c23edfa841a 100644 --- a/lib/balance-tx/cardano-balance-tx.cabal +++ b/lib/balance-tx/cardano-balance-tx.cabal @@ -40,6 +40,7 @@ library build-depends: , cardano-balance-tx:internal exposed-modules: + Cardano.Write.Eras Cardano.Write.Tx library internal diff --git a/lib/balance-tx/lib/main/Cardano/Write/Eras.hs b/lib/balance-tx/lib/main/Cardano/Write/Eras.hs new file mode 100644 index 00000000000..aedba8fad42 --- /dev/null +++ b/lib/balance-tx/lib/main/Cardano/Write/Eras.hs @@ -0,0 +1,55 @@ +-- | +-- Copyright: © 2024 Cardano Foundation +-- License: Apache-2.0 +-- +module Cardano.Write.Eras + ( + -- * Eras + BabbageEra + , ConwayEra + + -- ** RecentEra + , RecentEra (..) + , IsRecentEra (..) + , CardanoApiEra + , toRecentEra + , fromRecentEra + , MaybeInRecentEra (..) + , LatestLedgerEra + , RecentEraConstraints + , allRecentEras + + -- ** Existential wrapper + , AnyRecentEra (..) + , toAnyCardanoEra + , fromAnyCardanoEra + + -- ** Helpers for cardano-api compatibility + , cardanoEra + , shelleyBasedEra + , ShelleyLedgerEra + , cardanoEraFromRecentEra + , shelleyBasedEraFromRecentEra + ) where + +import Internal.Cardano.Write.Eras + ( AnyRecentEra (..) + , BabbageEra + , CardanoApiEra + , ConwayEra + , IsRecentEra (..) + , LatestLedgerEra + , MaybeInRecentEra (..) + , RecentEra (..) + , RecentEraConstraints + , ShelleyLedgerEra + , allRecentEras + , cardanoEra + , cardanoEraFromRecentEra + , fromAnyCardanoEra + , fromRecentEra + , shelleyBasedEra + , shelleyBasedEraFromRecentEra + , toAnyCardanoEra + , toRecentEra + ) diff --git a/lib/benchmarks/cardano-wallet-benchmarks.cabal b/lib/benchmarks/cardano-wallet-benchmarks.cabal index e1e70c8e525..2292276fb5b 100644 --- a/lib/benchmarks/cardano-wallet-benchmarks.cabal +++ b/lib/benchmarks/cardano-wallet-benchmarks.cabal @@ -108,6 +108,7 @@ benchmark restore , base , bytestring , cardano-addresses + , cardano-balance-tx , cardano-balance-tx:internal , cardano-wallet , cardano-wallet-api @@ -228,6 +229,7 @@ benchmark api , base , bytestring , cardano-api + , cardano-balance-tx , cardano-balance-tx:internal , cardano-wallet , cardano-wallet-benchmarks diff --git a/lib/benchmarks/exe/api-bench.hs b/lib/benchmarks/exe/api-bench.hs index 5952d4fb5c7..2375e9b68da 100644 --- a/lib/benchmarks/exe/api-bench.hs +++ b/lib/benchmarks/exe/api-bench.hs @@ -200,15 +200,15 @@ import qualified Cardano.Wallet.DB.Layer as Sqlite import qualified Cardano.Wallet.Primitive.Types.UTxOStatistics as UTxOStatistics import qualified Cardano.Wallet.Read as Read import qualified Cardano.Wallet.Transaction as Tx +import qualified Cardano.Write.Eras as Write + ( MaybeInRecentEra (InRecentEraBabbage) + ) import qualified Data.Aeson as Aeson import Data.Functor ( (<&>) ) import qualified Data.Map.Strict as Map import qualified Data.Text as T -import qualified Internal.Cardano.Write.Tx as Write - ( MaybeInRecentEra (InRecentEraBabbage) - ) import qualified System.Environment as Sys import qualified System.Exit as Sys diff --git a/lib/network-layer/cardano-wallet-network-layer.cabal b/lib/network-layer/cardano-wallet-network-layer.cabal index f52cf48d6e3..3904edb7851 100644 --- a/lib/network-layer/cardano-wallet-network-layer.cabal +++ b/lib/network-layer/cardano-wallet-network-layer.cabal @@ -70,6 +70,7 @@ library , base , bytestring , cardano-api + , cardano-balance-tx , cardano-balance-tx:internal , cardano-binary , cardano-crypto-class diff --git a/lib/network-layer/src/Cardano/Wallet/Network.hs b/lib/network-layer/src/Cardano/Wallet/Network.hs index 74ba33f7169..1f3bfde2c0d 100644 --- a/lib/network-layer/src/Cardano/Wallet/Network.hs +++ b/lib/network-layer/src/Cardano/Wallet/Network.hs @@ -72,6 +72,9 @@ import Cardano.Wallet.Primitive.Types.StakePoolSummary import Cardano.Wallet.Primitive.Types.Tx.SealedTx ( SealedTx ) +import Cardano.Write.Eras + ( MaybeInRecentEra + ) import Control.Monad.Trans.Except ( ExceptT (..) ) @@ -96,9 +99,6 @@ import Data.Text.Class import GHC.Generics ( Generic ) -import Internal.Cardano.Write.Tx - ( MaybeInRecentEra - ) import qualified Cardano.Wallet.Read as Read import qualified Data.Text as T diff --git a/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs b/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs index 3dc230d117a..602e0aeed15 100644 --- a/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs +++ b/lib/network-layer/src/Cardano/Wallet/Network/Implementation.hs @@ -138,6 +138,9 @@ import Cardano.Wallet.Primitive.Types.StakePoolSummary import Cardano.Wallet.Primitive.Types.Tx ( SealedTx (..) ) +import Cardano.Write.Eras + ( MaybeInRecentEra (..) + ) import Control.Concurrent.Class.MonadSTM ( MonadSTM , STM @@ -264,9 +267,6 @@ import Fmt import GHC.Stack ( HasCallStack ) -import Internal.Cardano.Write.Tx - ( MaybeInRecentEra (..) - ) import Network.Mux ( MuxError (..) , MuxErrorType (..) diff --git a/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/PParams.hs b/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/PParams.hs index 73af1109b77..b23cd5a1bac 100644 --- a/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/PParams.hs +++ b/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/PParams.hs @@ -44,7 +44,7 @@ import Cardano.Wallet.Primitive.Types.ProtocolParameters import Cardano.Wallet.Primitive.Types.SlottingParameters ( SlottingParameters ) -import Internal.Cardano.Write.Tx +import Cardano.Write.Eras ( MaybeInRecentEra (..) ) import Ouroboros.Consensus.Cardano diff --git a/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/UTxO.hs b/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/UTxO.hs index 9ecee629ab9..cccac87f4b8 100644 --- a/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/UTxO.hs +++ b/lib/network-layer/src/Cardano/Wallet/Network/LocalStateQuery/UTxO.hs @@ -23,12 +23,12 @@ import Cardano.Wallet.Network.Implementation.Ouroboros import Cardano.Wallet.Network.LocalStateQuery.Extra ( onAnyEra ) +import Cardano.Write.Eras + ( MaybeInRecentEra (..) + ) import Data.Set ( Set ) -import Internal.Cardano.Write.Tx - ( MaybeInRecentEra (..) - ) import Ouroboros.Consensus.Cardano ( CardanoBlock ) diff --git a/lib/unit/cardano-wallet-unit.cabal b/lib/unit/cardano-wallet-unit.cabal index 7747451a509..ca5478fe8e1 100644 --- a/lib/unit/cardano-wallet-unit.cabal +++ b/lib/unit/cardano-wallet-unit.cabal @@ -45,6 +45,7 @@ library test-common , base , bytestring , cardano-api + , cardano-balance-tx , cardano-balance-tx:internal , cardano-wallet , cardano-wallet-network-layer diff --git a/lib/unit/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs b/lib/unit/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs index e99a2addacb..a04b9b22c30 100644 --- a/lib/unit/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs +++ b/lib/unit/test-common/Cardano/Wallet/DummyTarget/Primitive/Types.hs @@ -91,6 +91,7 @@ import Internal.Cardano.Write.Tx.Gen ( mockPParams ) +import qualified Cardano.Write.Eras as Write import qualified Data.ByteString.Char8 as B8 import qualified Internal.Cardano.Write.Tx as Write diff --git a/lib/unit/test/unit/Cardano/Wallet/DelegationSpec.hs b/lib/unit/test/unit/Cardano/Wallet/DelegationSpec.hs index 6c1b69a5463..befc29f51e1 100644 --- a/lib/unit/test/unit/Cardano/Wallet/DelegationSpec.hs +++ b/lib/unit/test/unit/Cardano/Wallet/DelegationSpec.hs @@ -109,9 +109,9 @@ import Test.QuickCheck.Arbitrary.Generic import qualified Cardano.Wallet as W import qualified Cardano.Wallet.Delegation as WD import qualified Cardano.Wallet.Primitive.Types.Coin as Coin +import qualified Cardano.Write.Eras as Write import qualified Data.ByteString as BS import qualified Data.Set as Set -import qualified Internal.Cardano.Write.Tx as Write spec :: Spec spec = describe "Cardano.Wallet.DelegationSpec" $ do diff --git a/lib/unit/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/unit/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index b5ba2a19755..62c84eba669 100644 --- a/lib/unit/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/unit/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -191,6 +191,14 @@ import Cardano.Wallet.Transaction import Cardano.Wallet.Unsafe ( unsafeFromHex ) +import Cardano.Write.Eras + ( AnyRecentEra (..) + , CardanoApiEra + , IsRecentEra + , RecentEra (..) + , ShelleyLedgerEra + , cardanoEraFromRecentEra + ) import Cardano.Write.Tx ( ErrBalanceTx (..) , ErrBalanceTxUnableToCreateChangeError (..) @@ -267,14 +275,6 @@ import Fmt , (+||) , (||+) ) -import Internal.Cardano.Write.Tx - ( AnyRecentEra (..) - , CardanoApiEra - , IsRecentEra - , RecentEra (..) - , ShelleyLedgerEra - , cardanoEraFromRecentEra - ) import Internal.Cardano.Write.Tx.Gen ( mockPParams ) @@ -352,6 +352,14 @@ import qualified Cardano.Wallet.Address.Derivation.Shelley as Shelley import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap +import qualified Cardano.Write.Eras as Write + ( BabbageEra + , CardanoApiEra + , IsRecentEra + , RecentEra (RecentEraBabbage, RecentEraConway) + , cardanoEraFromRecentEra + , shelleyBasedEraFromRecentEra + ) import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 @@ -361,14 +369,6 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Encoding as T -import qualified Internal.Cardano.Write.Tx as Write - ( BabbageEra - , CardanoApiEra - , IsRecentEra - , RecentEra (RecentEraBabbage, RecentEraConway) - , cardanoEraFromRecentEra - , shelleyBasedEraFromRecentEra - ) spec :: Spec spec = describe "TransactionSpec" $ do diff --git a/lib/unit/test/unit/Cardano/WalletSpec.hs b/lib/unit/test/unit/Cardano/WalletSpec.hs index de9a1da34cb..ac0901073c0 100644 --- a/lib/unit/test/unit/Cardano/WalletSpec.hs +++ b/lib/unit/test/unit/Cardano/WalletSpec.hs @@ -412,6 +412,10 @@ import qualified Cardano.Wallet.Read as Read import qualified Cardano.Wallet.Read.Hash as Hash import qualified Cardano.Wallet.Submissions.Submissions as Smbs import qualified Cardano.Wallet.Submissions.TxStatus as Sbms +import qualified Cardano.Write.Eras as Write + ( AnyRecentEra (AnyRecentEra) + , RecentEra (RecentEraBabbage, RecentEraConway) + ) import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 @@ -420,10 +424,6 @@ import qualified Data.List as L import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Text as T -import qualified Internal.Cardano.Write.Tx as Write - ( AnyRecentEra (AnyRecentEra) - , RecentEra (RecentEraBabbage, RecentEraConway) - ) spec :: Spec spec = describe "Cardano.WalletSpec" $ do diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index aa4d704fc83..7d48babc2b2 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -628,6 +628,10 @@ import Cardano.Wallet.Transaction import Cardano.Wallet.Transaction.Built ( BuiltTx (..) ) +import Cardano.Write.Eras + ( MaybeInRecentEra (..) + , recentEra + ) import Cardano.Write.Tx ( ErrBalanceTx (..) , ErrBalanceTxUnableToCreateChangeError (..) @@ -803,9 +807,7 @@ import GHC.TypeNats ( Nat ) import Internal.Cardano.Write.Tx - ( MaybeInRecentEra (..) - , recentEra - , toRecentEraGADT + ( toRecentEraGADT ) import Internal.Cardano.Write.Tx.Balance ( ChangeAddressGen (..) @@ -865,6 +867,14 @@ import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as TxOut import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO import qualified Cardano.Wallet.Primitive.Types.UTxOStatistics as UTxOStatistics import qualified Cardano.Wallet.Read as Read +import qualified Cardano.Write.Eras as Write + ( AnyRecentEra + , CardanoApiEra + , IsRecentEra (..) + , MaybeInRecentEra (..) + , RecentEra (..) + , cardanoEraFromRecentEra + ) import qualified Data.ByteArray as BA import qualified Data.Delta.Update as Delta import qualified Data.Foldable as F @@ -874,18 +884,12 @@ import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Vector as V import qualified Internal.Cardano.Write.Tx as Write - ( AnyRecentEra - , CardanoApiEra - , ErrInvalidTxOutInEra + ( ErrInvalidTxOutInEra , FeePerByte - , IsRecentEra (..) - , MaybeInRecentEra (..) , PParams , PParamsInAnyRecentEra (PParamsInAnyRecentEra) - , RecentEra (..) , Tx , UTxO (UTxO) - , cardanoEraFromRecentEra , feeOfBytes , forceUTxOToEra , fromCardanoApiTx diff --git a/lib/wallet/src/Cardano/Wallet/Delegation.hs b/lib/wallet/src/Cardano/Wallet/Delegation.hs index 96e7b38f062..8c3addf7066 100644 --- a/lib/wallet/src/Cardano/Wallet/Delegation.hs +++ b/lib/wallet/src/Cardano/Wallet/Delegation.hs @@ -71,8 +71,8 @@ import qualified Cardano.Wallet.DB.Store.Delegations.Layer as Dlgs import qualified Cardano.Wallet.DB.WalletState as WalletState import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Transaction as Tx +import qualified Cardano.Write.Eras as Write import qualified Data.Set as Set -import qualified Internal.Cardano.Write.Tx as Write -- | The data type that represents client's delegation request. -- Stake key registration is made implicit by design: diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs index cba92b44c95..cd3d457b5ee 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs @@ -196,6 +196,10 @@ import Cardano.Wallet.Transaction.Voting import Cardano.Wallet.Util ( HasCallStack ) +import Cardano.Write.Eras + ( CardanoApiEra + , RecentEra (..) + ) import Control.Arrow ( left , second @@ -237,10 +241,6 @@ import Data.Word ( Word64 , Word8 ) -import Internal.Cardano.Write.Tx - ( CardanoApiEra - , RecentEra (..) - ) import Internal.Cardano.Write.Tx.SizeEstimation ( TxSkeleton (..) , TxWitnessTag (..) @@ -268,6 +268,13 @@ import qualified Cardano.Wallet.Primitive.Ledger.Convert as Convert import qualified Cardano.Wallet.Primitive.Ledger.Shelley as Compatibility import qualified Cardano.Wallet.Primitive.Types.AssetId as AssetId import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap +import qualified Cardano.Write.Eras as Write + ( CardanoApiEra + , IsRecentEra (recentEra) + , RecentEra (RecentEraBabbage, RecentEraConway) + , shelleyBasedEra + , shelleyBasedEraFromRecentEra + ) import qualified Data.ByteString as BS import qualified Data.Foldable as F import qualified Data.List as L @@ -275,12 +282,9 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T import qualified Internal.Cardano.Write.Tx as Write - ( CardanoApiEra - , Coin + ( Coin , FeePerByte - , IsRecentEra (recentEra) , PParams - , RecentEra (RecentEraBabbage, RecentEraConway) , Tx , TxOut , computeMinimumCoinForTxOut @@ -288,8 +292,6 @@ import qualified Internal.Cardano.Write.Tx as Write , fromCardanoApiTx , getFeePerByte , isBelowMinimumCoinForTxOut - , shelleyBasedEra - , shelleyBasedEraFromRecentEra , toCardanoApiTx ) import qualified Internal.Cardano.Write.Tx.Sign as Write diff --git a/lib/wallet/src/Cardano/Wallet/Transaction/Delegation.hs b/lib/wallet/src/Cardano/Wallet/Transaction/Delegation.hs index cacff74f486..eb515c57812 100644 --- a/lib/wallet/src/Cardano/Wallet/Transaction/Delegation.hs +++ b/lib/wallet/src/Cardano/Wallet/Transaction/Delegation.hs @@ -40,16 +40,16 @@ import Cardano.Wallet.Primitive.Types.Pool import Cardano.Wallet.Transaction ( DelegationAction (..) ) +import Cardano.Write.Eras + ( CardanoApiEra + , RecentEra (..) + ) import Cryptography.Hash.Blake ( blake2b224 ) import Data.ByteString.Short ( toShort ) -import Internal.Cardano.Write.Tx - ( CardanoApiEra - , RecentEra (RecentEraBabbage, RecentEraConway) - ) import qualified Cardano.Api as Cardano import qualified Cardano.Api.ReexposeLedger as Ledger diff --git a/lib/wallet/src/Cardano/Wallet/Transaction/Voting.hs b/lib/wallet/src/Cardano/Wallet/Transaction/Voting.hs index 00874f9613d..2993a88aa59 100644 --- a/lib/wallet/src/Cardano/Wallet/Transaction/Voting.hs +++ b/lib/wallet/src/Cardano/Wallet/Transaction/Voting.hs @@ -37,16 +37,16 @@ import Cardano.Wallet.Primitive.Types.Coin import Cardano.Wallet.Transaction ( VotingAction (..) ) +import Cardano.Write.Eras + ( CardanoApiEra + , RecentEra (..) + ) import Cryptography.Hash.Blake ( blake2b224 ) import Data.ByteString.Short ( toShort ) -import Internal.Cardano.Write.Tx - ( CardanoApiEra - , RecentEra (RecentEraBabbage, RecentEraConway) - ) import qualified Cardano.Api as Cardano import qualified Cardano.Api.ReexposeLedger as Ledger