From 35d138b32e81e857429b2c19feacf91c3ab74929 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 13 Dec 2023 13:32:55 -0400 Subject: [PATCH] Implement Era GADT and UseEra class as an alternative to the existing era handling code --- cardano-api/cardano-api.cabal | 2 + .../internal/Cardano/Api/Protocol/Version.hs | 102 ++++++++++++++++++ .../internal/Cardano/Api/ReexposeLedger.hs | 7 +- cardano-api/internal/Cardano/Api/TxBody.hs | 9 ++ cardano-api/src/Cardano/Api/Experimental.hs | 15 +++ 5 files changed, 132 insertions(+), 3 deletions(-) create mode 100644 cardano-api/internal/Cardano/Api/Protocol/Version.hs create mode 100644 cardano-api/src/Cardano/Api/Experimental.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 76c8d41076..adcb079b65 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -118,6 +118,7 @@ library internal Cardano.Api.OperationalCertificate Cardano.Api.Pretty Cardano.Api.Protocol + Cardano.Api.Protocol.Version Cardano.Api.ProtocolParameters Cardano.Api.Query Cardano.Api.Query.Expr @@ -230,6 +231,7 @@ library Cardano.Api.ChainSync.Client Cardano.Api.ChainSync.ClientPipelined Cardano.Api.Crypto.Ed25519Bip32 + Cardano.Api.Experimental Cardano.Api.Shelley -- TODO: Eliminate Cardano.Api.Ledger when -- cardano-api only depends on modules diff --git a/cardano-api/internal/Cardano/Api/Protocol/Version.hs b/cardano-api/internal/Cardano/Api/Protocol/Version.hs new file mode 100644 index 0000000000..83ff820157 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Protocol/Version.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} + +-- | This module defines the protocol versions corresponding to the eras in the Cardano blockchain. +module Cardano.Api.Protocol.Version + ( BabbageEra + , ConwayEra + , Era (..) + , MaxSupportedVersion + , MinSupportedVersion + , SupportedProtocolVersionRange + , UseEra + , VersionToSbe + , getProtocolVersion + , protocolVersionToSbe + ) where + +import Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..)) +import qualified Cardano.Api.Eras.Core as Api + +import GHC.TypeLits + +-- | Users typically interact with the latest features on the mainnet or experiment with features +-- from the upcoming era. Hence, the protocol versions are limited to the current mainnet era +-- and the next era (upcoming era). +-- +-- - 'MinSupportedVersion': Represents the minimum protocol version, aligning with the current +-- era on mainnet (Babbage era). +-- - 'MaxSupportedVersion': Represents the maximum protocol version, corresponding to the next +-- era planned for Cardano's mainnet (Conway era). + +-- | The minimum supported protocol version, corresponding to the Babbage era on Cardano's mainnet. +type MinSupportedVersion = 8 :: Nat + +-- | The maximum supported protocol version, representing the upcoming Conway era. +type MaxSupportedVersion = 9 :: Nat + +type BabbageEra = 8 :: Nat +type ConwayEra = 9 :: Nat + +type SupportedProtocolVersionRange (version :: Nat) = + ( MinSupportedVersion <= version + , version <= MaxSupportedVersion + ) + +-- Allows us to gradually change the api without breaking things. +-- This will eventually be removed. +type family VersionToSbe (version :: Nat) where + VersionToSbe BabbageEra = Api.BabbageEra + VersionToSbe ConwayEra = Api.ConwayEra + +-- | Represents the eras in Cardano's blockchain history. +-- +-- Instead of enumerating every possible era, we use two constructors: +-- 'CurrentEra' and 'UpcomingEra'. This design simplifies the handling +-- of eras, especially for 'cardano-api' consumers who are primarily concerned +-- with the current mainnet era and the next era for an upcoming hardfork. +-- +-- Usage: +-- - 'CurrentEra': Reflects the era currently active on mainnet. +-- - 'UpcomingEra': Represents the era planned for the next hardfork. +-- +-- After a hardfork, 'cardano-api' should be updated promptly to reflect +-- the new mainnet era in 'CurrentEra'. +-- +-- Each era is associated with a specific protocol version: +-- - 'BabbageEra' for 'CurrentEra' +-- - 'ConwayEra' for 'UpcomingEra' +data Era (version :: Nat) where + -- | The era currently active on Cardano's mainnet. + CurrentEra + :: SupportedProtocolVersionRange BabbageEra + => Era BabbageEra + -- | The era planned for the next hardfork on Cardano's mainnet. + UpcomingEra + :: SupportedProtocolVersionRange ConwayEra + => Era ConwayEra + + +protocolVersionToSbe + :: Era version + -> ShelleyBasedEra (VersionToSbe version) +protocolVersionToSbe CurrentEra = ShelleyBasedEraBabbage +protocolVersionToSbe UpcomingEra = ShelleyBasedEraConway + +------------------------------------------------------------------------- + +-- | Type class interface for the 'Era' type. + +class UseEra (version :: Nat) where + getProtocolVersion :: Era version + +instance UseEra BabbageEra where + getProtocolVersion = CurrentEra + +instance UseEra ConwayEra where + getProtocolVersion = UpcomingEra diff --git a/cardano-api/internal/Cardano/Api/ReexposeLedger.hs b/cardano-api/internal/Cardano/Api/ReexposeLedger.hs index 17d3103cc3..536d6475e3 100644 --- a/cardano-api/internal/Cardano/Api/ReexposeLedger.hs +++ b/cardano-api/internal/Cardano/Api/ReexposeLedger.hs @@ -94,6 +94,7 @@ module Cardano.Api.ReexposeLedger , urlToText , textToUrl , portToWord16 + , ProtVer(..) , strictMaybeToMaybe , maybeToStrictMaybe @@ -118,9 +119,9 @@ import Cardano.Ledger.Api.Tx.Cert (pattern AuthCommitteeHotKeyTxCert, pattern ResignCommitteeColdTxCert, pattern RetirePoolTxCert, pattern UnRegDRepTxCert, pattern UnRegDepositTxCert, pattern UnRegTxCert) import Cardano.Ledger.Babbage.Core (CoinPerByte (..)) -import Cardano.Ledger.BaseTypes (DnsName, Network (..), StrictMaybe (..), Url, - boundRational, dnsToText, maybeToStrictMaybe, portToWord16, strictMaybeToMaybe, - textToDns, textToUrl, unboundRational, urlToText) +import Cardano.Ledger.BaseTypes (DnsName, Network (..), ProtVer (..), StrictMaybe (..), + Url, boundRational, dnsToText, maybeToStrictMaybe, portToWord16, + strictMaybeToMaybe, textToDns, textToUrl, unboundRational, urlToText) import Cardano.Ledger.Binary (Annotated (..)) import Cardano.Ledger.CertState (DRepState, csCommitteeCredsL) import Cardano.Ledger.Coin (Coin (..), addDeltaCoin, toDeltaCoin) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index c9eda6488f..7bbac29ae7 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -152,6 +152,15 @@ module Cardano.Api.TxBody ( AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody, AsMaryTxBody), getTxBodyContent, + + -- Temp + validateTxIns, + guardShelleyTxInsOverflow, + validateTxOuts, + validateMetadata, + validateMintValue, + validateTxInsCollateral, + validateProtocolParameters, ) where import Cardano.Api.Address diff --git a/cardano-api/src/Cardano/Api/Experimental.hs b/cardano-api/src/Cardano/Api/Experimental.hs new file mode 100644 index 0000000000..eb5ec60dbe --- /dev/null +++ b/cardano-api/src/Cardano/Api/Experimental.hs @@ -0,0 +1,15 @@ +module Cardano.Api.Experimental + ( -- * New Era interface + BabbageEra + , ConwayEra + , Era + , MaxSupportedVersion + , MinSupportedVersion + , SupportedProtocolVersionRange + , UseEra + , VersionToSbe + , getProtocolVersion + , protocolVersionToSbe + ) where + +import Cardano.Api.Protocol.Version