Review changes

cardano-api/CHANGELOG.md

@@ -329,7 +329,7 @@
   (feature, compatible)
   [PR 410](https://github.com/IntersectMBO/cardano-api/pull/410)
 
-- Implement Era GADT and UseEra class as an alternative to the existing era handling code
+- Implement Era GADT and IsEra class as an alternative to the existing era handling code
   (feature, compatible)
   [PR 402](https://github.com/IntersectMBO/cardano-api/pull/402)
 

cardano-api/internal/Cardano/Api/Experimental/Eras.hs

@@ -9,34 +9,46 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE TypeOperators #-}
 
 -- | This module defines the protocol versions corresponding to the eras in the Cardano blockchain.
 module Cardano.Api.Experimental.Eras
   ( BabbageEra
   , ConwayEra
   , Era (..)
   , ToConstrainedLedgerEra
-  , UseEra
-  , ApiErasToLedgerEras
+  , IsEra
+  , ApiEraToLedgerEra
   , AvailableErasToSbe
   , ApiEraToExperimentalEra
   , DeprecatedEra (..)
+  , EraCommonConstraints
+  , EraShimConstraints
+  , obtainCommonConstraints
+  , obtainShimConstraints
   , useEra
-  , protocolVersionToSbe
+  , eraToSbe
   , babbageEraOnwardsToEra
   , sbeToEra
   )
 where
 
 import           Cardano.Api.Eon.BabbageEraOnwards
-import           Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..))
+import           Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..), ShelleyLedgerEra)
 import qualified Cardano.Api.Eras.Core as Api
 import           Cardano.Api.Via.ShowOf
+import qualified Cardano.Api.ReexposeLedger as L
+import qualified Cardano.Ledger.Api as L
+import qualified Cardano.Ledger.UTxO as L
+import qualified Cardano.Ledger.SafeHash as L
+import           Cardano.Ledger.Hashes
 
 import qualified Cardano.Ledger.Babbage as Ledger
 import qualified Cardano.Ledger.Conway as Ledger
+import qualified Cardano.Ledger.Core as Ledger
 
 import           Data.Kind
+import Control.Monad.Error.Class
 import           Prettyprinter
 
 -- | Users typically interact with the latest features on the mainnet or experiment with features
@@ -60,15 +72,15 @@ type family ToConstrainedLedgerEra era = (r :: Type) | r -> era where
   ToConstrainedLedgerEra BabbageEra = Ledger.Babbage
   ToConstrainedLedgerEra ConwayEra = Ledger.Conway
 
-type family ApiErasToLedgerEras era = (r :: Type) | r -> era where
-  ApiErasToLedgerEras Api.BabbageEra = Ledger.Babbage
-  ApiErasToLedgerEras Api.ConwayEra = Ledger.Conway
+type family ApiEraToLedgerEra era = (r :: Type) | r -> era where
+  ApiEraToLedgerEra Api.BabbageEra = Ledger.Babbage
+  ApiEraToLedgerEra Api.ConwayEra = Ledger.Conway
 
 -- | Represents the eras in Cardano's blockchain.
 -- This type represents eras currently on mainnet and new eras which are
 -- in development.
 --
--- After a hardfork, the from which we hardfork from gets deprecated and
+-- After a hardfork, the era from which we hardfork from gets deprecated and
 -- after deprecation period, gets removed. During deprecation period,
 -- consumers of cardano-api should update their codebase to the mainnet era.
 data Era era where
@@ -77,6 +89,8 @@ data Era era where
   -- | The upcoming era in development.
   ConwayEra :: Era ConwayEra
 
+deriving instance Show (Era era)
+
 -- | How to deprecate an era
 --
 --   1. Add DEPRECATED pragma to the era type tag and the era constructor at the same time:
@@ -95,33 +109,33 @@ data Era era where
 --   ConwayEra :: Era ConwayEra
 -- @
 --
---   3. Add new 'UseEra' instance and update the deprecated era instance to produce a compile-time error:
+--   3. Add new 'IsEra' instance and update the deprecated era instance to produce a compile-time error:
 -- @
--- instance TypeError ('Text "UseEra BabbageEra: Deprecated. Update to ConwayEra") => UseEra BabbageEra where
+-- instance TypeError ('Text "IsEra BabbageEra: Deprecated. Update to ConwayEra") => IsEra BabbageEra where
 --   useEra = error "unreachable"
 --
--- instance UseEra ConwayEra where
+-- instance IsEra ConwayEra where
 --   useEra = ConwayEra
 -- @
-protocolVersionToSbe
+eraToSbe
   :: Era era
   -> ShelleyBasedEra (AvailableErasToSbe era)
-protocolVersionToSbe BabbageEra = ShelleyBasedEraBabbage
-protocolVersionToSbe ConwayEra = ShelleyBasedEraConway
+eraToSbe BabbageEra = ShelleyBasedEraBabbage
+eraToSbe ConwayEra = ShelleyBasedEraConway
 
 newtype DeprecatedEra era
   = DeprecatedEra (ShelleyBasedEra era)
   deriving Show
 
 deriving via (ShowOf (DeprecatedEra era)) instance Pretty (DeprecatedEra era)
 
-sbeToEra :: ShelleyBasedEra era -> Either (DeprecatedEra era) (Era (ApiEraToExperimentalEra era))
+sbeToEra :: MonadError (DeprecatedEra era) m => ShelleyBasedEra era -> m (Era (ApiEraToExperimentalEra era))
 sbeToEra ShelleyBasedEraConway = return ConwayEra
 sbeToEra ShelleyBasedEraBabbage = return BabbageEra
-sbeToEra e@ShelleyBasedEraAlonzo = Left $ DeprecatedEra e
-sbeToEra e@ShelleyBasedEraMary = Left $ DeprecatedEra e
-sbeToEra e@ShelleyBasedEraAllegra = Left $ DeprecatedEra e
-sbeToEra e@ShelleyBasedEraShelley = Left $ DeprecatedEra e
+sbeToEra e@ShelleyBasedEraAlonzo = throwError $ DeprecatedEra e
+sbeToEra e@ShelleyBasedEraMary = throwError $ DeprecatedEra e
+sbeToEra e@ShelleyBasedEraAllegra = throwError $ DeprecatedEra e
+sbeToEra e@ShelleyBasedEraShelley = throwError $ DeprecatedEra e
 
 babbageEraOnwardsToEra :: BabbageEraOnwards era -> Era (ApiEraToExperimentalEra era)
 babbageEraOnwardsToEra BabbageEraOnwardsBabbage = BabbageEra
@@ -130,11 +144,44 @@ babbageEraOnwardsToEra BabbageEraOnwardsConway = ConwayEra
 -------------------------------------------------------------------------
 
 -- | Type class interface for the 'Era' type.
-class UseEra era where
+class IsEra era where
   useEra :: Era era
 
-instance UseEra BabbageEra where
+instance IsEra BabbageEra where
   useEra = BabbageEra
 
-instance UseEra ConwayEra where
+instance IsEra ConwayEra where
   useEra = ConwayEra
+
+
+obtainShimConstraints
+  :: BabbageEraOnwards era
+  -> (EraShimConstraints era => a)
+  -> a
+obtainShimConstraints BabbageEraOnwardsBabbage x = x
+obtainShimConstraints BabbageEraOnwardsConway x = x
+
+-- We need these constraints in order to propagate the new
+-- experimental api without changing the existing api
+type EraShimConstraints era =
+  ( ToConstrainedLedgerEra (ApiEraToExperimentalEra era) ~ ShelleyLedgerEra era
+  , AvailableErasToSbe (ApiEraToExperimentalEra era) ~ era
+  , L.EraTx (ApiEraToLedgerEra era)
+  )
+
+obtainCommonConstraints
+  :: Era era
+  -> (EraCommonConstraints era => a)
+  -> a
+obtainCommonConstraints BabbageEra x = x
+obtainCommonConstraints ConwayEra x = x
+
+type EraCommonConstraints era =
+  ( L.AlonzoEraTx (ToConstrainedLedgerEra era)
+  , L.BabbageEraTxBody (ToConstrainedLedgerEra era)
+  , L.EraTx (ToConstrainedLedgerEra era)
+  , L.EraUTxO (ToConstrainedLedgerEra era)
+  , Ledger.EraCrypto (ToConstrainedLedgerEra era) ~ L.StandardCrypto
+  , ShelleyLedgerEra (AvailableErasToSbe era) ~ ToConstrainedLedgerEra era
+  , L.HashAnnotated (Ledger.TxBody (ToConstrainedLedgerEra era)) EraIndependentTxBody L.StandardCrypto
+  )

cardano-api/internal/Cardano/Api/Experimental/Tx.hs

@@ -17,15 +17,10 @@ module Cardano.Api.Experimental.Tx
   , makeKeyWitness
   , signTx
   , convertTxBodyToUnsignedTx
-  , EraCommonConstraints
-  , EraShimConstraints
-  , obtainShimConstraints
-  , obtainCommonConstraints
   , hashTxBody
   )
 where
 
-import           Cardano.Api.Eon.BabbageEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras.Case
 import           Cardano.Api.Experimental.Eras
@@ -44,7 +39,6 @@ import qualified Cardano.Ledger.Core as Ledger
 import           Cardano.Ledger.Hashes
 import qualified Cardano.Ledger.Keys as L
 import qualified Cardano.Ledger.SafeHash as L
-import qualified Cardano.Ledger.UTxO as L
 
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
@@ -55,7 +49,7 @@ import           Lens.Micro
 newtype UnsignedTx era
   = UnsignedTx (Ledger.Tx (ToConstrainedLedgerEra era))
 
-instance UseEra era => Show (UnsignedTx era) where
+instance IsEra era => Show (UnsignedTx era) where
   showsPrec p (UnsignedTx tx) = case useEra @era of
     BabbageEra -> showsPrec p (tx :: Ledger.Tx Ledger.Babbage)
     ConwayEra -> showsPrec p (tx :: Ledger.Tx Ledger.Conway)
@@ -68,7 +62,7 @@ makeUnsignedTx
   -> TxBodyContent BuildTx (AvailableErasToSbe era)
   -> Either TxBodyError (UnsignedTx era)
 makeUnsignedTx era bc = obtainCommonConstraints era $ do
-  let sbe = protocolVersionToSbe era
+  let sbe = eraToSbe era
 
   -- cardano-api types
   let apiTxOuts = txOuts bc
@@ -138,7 +132,7 @@ eraSpecificLedgerTxBody
   -> TxBodyContent BuildTx (AvailableErasToSbe era)
   -> Either TxBodyError (Ledger.TxBody (ToConstrainedLedgerEra era))
 eraSpecificLedgerTxBody BabbageEra ledgerbody bc = do
-  let sbe = protocolVersionToSbe BabbageEra
+  let sbe = eraToSbe BabbageEra
 
   setUpdateProposal <- convTxUpdateProposal sbe (txUpdateProposal bc)
 
@@ -196,22 +190,6 @@ signTx era bootstrapWits shelleyKeyWits (UnsignedTx unsigned) =
         signedTx = unsigned & L.witsTxL .~ (keyWits <> currentScriptWitnesses)
      in signedTx
 
-obtainCommonConstraints
-  :: Era era
-  -> (EraCommonConstraints era => a)
-  -> a
-obtainCommonConstraints BabbageEra x = x
-obtainCommonConstraints ConwayEra x = x
-
-type EraCommonConstraints era =
-  ( L.AlonzoEraTx (ToConstrainedLedgerEra era)
-  , L.BabbageEraTxBody (ToConstrainedLedgerEra era)
-  , L.EraTx (ToConstrainedLedgerEra era)
-  , L.EraUTxO (ToConstrainedLedgerEra era)
-  , Ledger.EraCrypto (ToConstrainedLedgerEra era) ~ L.StandardCrypto
-  , ShelleyLedgerEra (AvailableErasToSbe era) ~ ToConstrainedLedgerEra era
-  , L.HashAnnotated (Ledger.TxBody (ToConstrainedLedgerEra era)) EraIndependentTxBody L.StandardCrypto
-  )
 
 -- Compatibility related. Will be removed once the old api has been deprecated and deleted.
 
@@ -225,18 +203,3 @@ convertTxBodyToUnsignedTx sbe txbody =
          in UnsignedTx $ obtainShimConstraints w unsignedLedgerTx
     )
     sbe
-
--- We need these constraints in order to propagate the new
--- experimental api without changing the existing api
-type EraShimConstraints era =
-  ( ToConstrainedLedgerEra (ApiEraToExperimentalEra era) ~ ShelleyLedgerEra era
-  , AvailableErasToSbe (ApiEraToExperimentalEra era) ~ era
-  , L.EraTx (ApiErasToLedgerEras era)
-  )
-
-obtainShimConstraints
-  :: BabbageEraOnwards era
-  -> (EraShimConstraints era => a)
-  -> a
-obtainShimConstraints BabbageEraOnwardsBabbage x = x
-obtainShimConstraints BabbageEraOnwardsConway x = x

cardano-api/internal/Cardano/Api/Fees.hs

@@ -59,6 +59,7 @@ import           Cardano.Api.Eras.Case
 import           Cardano.Api.Eras.Core
 import           Cardano.Api.Error
 import           Cardano.Api.Experimental.Eras (sbeToEra)
+import           Cardano.Api.Experimental.Eras (obtainShimConstraints)
 import qualified Cardano.Api.Experimental.Eras as Exp
 import           Cardano.Api.Experimental.Tx
 import           Cardano.Api.Feature
@@ -959,7 +960,7 @@ data BalancedTxBody era where
     -> BalancedTxBody era
 
 deriving instance
-  (Exp.UseEra (Exp.ApiEraToExperimentalEra era), IsShelleyBasedEra era) => Show (BalancedTxBody era)
+  (Exp.IsEra (Exp.ApiEraToExperimentalEra era), IsShelleyBasedEra era) => Show (BalancedTxBody era)
 
 newtype RequiredShelleyKeyWitnesses
   = RequiredShelleyKeyWitnesses {unRequiredShelleyKeyWitnesses :: Int}

cardano-api/src/Cardano/Api/Experimental.hs

@@ -19,13 +19,13 @@ module Cardano.Api.Experimental
   , ConwayEra
   , Era (..)
   , ToConstrainedLedgerEra
-  , UseEra
-  , ApiErasToLedgerEras
+  , IsEra
+  , ApiEraToLedgerEra
   , AvailableErasToSbe
   , ApiEraToExperimentalEra
   , DeprecatedEra (..)
   , useEra
-  , protocolVersionToSbe
+  , eraToSbe
   , babbageEraOnwardsToEra
   , sbeToEra
   )