Rebase changes

cardano-api/CHANGELOG.md

@@ -350,7 +350,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/cardano-api.cabal

@@ -83,6 +83,8 @@ library internal
     Cardano.Api.Eras.Case
     Cardano.Api.Eras.Core
     Cardano.Api.Error
+    Cardano.Api.Experimental.Eras
+    Cardano.Api.Experimental.Tx
     Cardano.Api.Feature
     Cardano.Api.Fees
     Cardano.Api.Genesis
@@ -131,8 +133,6 @@ library internal
     Cardano.Api.ReexposeNetwork
     Cardano.Api.Rewards
     Cardano.Api.Script
-    Cardano.Api.Experimental.Eras
-    Cardano.Api.Experimental.Tx
     Cardano.Api.ScriptData
     Cardano.Api.SerialiseBech32
     Cardano.Api.SerialiseCBOR

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

@@ -9,66 +9,76 @@
 {-# 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
-  , AvailableErasToSbe
+  , LedgerEra
+  , IsEra
+  , ApiEraToLedgerEra
+  , ExperimentalEraToApiEra
   , ApiEraToExperimentalEra
   , DeprecatedEra (..)
+  , EraCommonConstraints
+  , EraShimConstraints
+  , obtainCommonConstraints
+  , obtainShimConstraints
   , useEra
-  , protocolVersionToSbe
+  , eraToSbe
   , babbageEraOnwardsToEra
   , sbeToEra
   )
 where
 
-import           Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..))
+import           Cardano.Api.Eon.BabbageEraOnwards
+import           Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..), ShelleyLedgerEra)
+import           Cardano.Api.Eras.Core (BabbageEra, ConwayEra)
 import qualified Cardano.Api.Eras.Core as Api
+import qualified Cardano.Api.ReexposeLedger as L
 import           Cardano.Api.Via.ShowOf
 
+import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.Babbage as Ledger
 import qualified Cardano.Ledger.Conway as Ledger
-import Cardano.Api.Eon.BabbageEraOnwards
+import qualified Cardano.Ledger.Core as Ledger
+import           Cardano.Ledger.Hashes
+import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
 
+import           Control.Monad.Error.Class
 import           Data.Kind
 import           Prettyprinter
 
 -- | 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).
-data BabbageEra
-
-data ConwayEra
 
 -- Allows us to gradually change the api without breaking things.
 -- This will eventually be removed.
-type family AvailableErasToSbe era = (r :: Type) | r -> era where
-  AvailableErasToSbe BabbageEra = Api.BabbageEra
-  AvailableErasToSbe ConwayEra = Api.ConwayEra
+type family ExperimentalEraToApiEra era = (r :: Type) | r -> era where
+  ExperimentalEraToApiEra BabbageEra = Api.BabbageEra
+  ExperimentalEraToApiEra ConwayEra = Api.ConwayEra
 
 type family ApiEraToExperimentalEra era = (r :: Type) | r -> era where
   ApiEraToExperimentalEra Api.BabbageEra = BabbageEra
   ApiEraToExperimentalEra Api.ConwayEra = ConwayEra
 
-type family ToConstrainedLedgerEra era = (r :: Type) | r -> era where
-  ToConstrainedLedgerEra BabbageEra = Ledger.Babbage
-  ToConstrainedLedgerEra ConwayEra = Ledger.Conway
+type family LedgerEra era = (r :: Type) | r -> era where
+  LedgerEra BabbageEra = Ledger.Babbage
+  LedgerEra 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 +87,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,48 +107,79 @@ 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
+  -> ShelleyBasedEra (ExperimentalEraToApiEra era)
+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
 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 =
+  ( LedgerEra (ApiEraToExperimentalEra era) ~ ShelleyLedgerEra era
+  , ExperimentalEraToApiEra (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 (LedgerEra era)
+  , L.BabbageEraTxBody (LedgerEra era)
+  , L.EraTx (LedgerEra era)
+  , L.EraUTxO (LedgerEra era)
+  , Ledger.EraCrypto (LedgerEra era) ~ L.StandardCrypto
+  , ShelleyLedgerEra (ExperimentalEraToApiEra era) ~ LedgerEra era
+  , L.HashAnnotated (Ledger.TxBody (LedgerEra era)) EraIndependentTxBody L.StandardCrypto
+  )

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

@@ -7,7 +7,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Api.Experimental.Tx
@@ -17,15 +16,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 +38,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
@@ -53,9 +46,9 @@ import           Lens.Micro
 -- | A transaction that can contain everything
 -- except key witnesses
 newtype UnsignedTx era
-  = UnsignedTx (Ledger.Tx (ToConstrainedLedgerEra era))
+  = UnsignedTx (Ledger.Tx (LedgerEra 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)
@@ -65,10 +58,10 @@ newtype UnsignedTxError
 
 makeUnsignedTx
   :: Era era
-  -> TxBodyContent BuildTx (AvailableErasToSbe era)
+  -> TxBodyContent BuildTx (ExperimentalEraToApiEra 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
@@ -134,11 +127,11 @@ makeUnsignedTx era bc = obtainCommonConstraints era $ do
 
 eraSpecificLedgerTxBody
   :: Era era
-  -> Ledger.TxBody (ToConstrainedLedgerEra era)
-  -> TxBodyContent BuildTx (AvailableErasToSbe era)
-  -> Either TxBodyError (Ledger.TxBody (ToConstrainedLedgerEra era))
+  -> Ledger.TxBody (LedgerEra era)
+  -> TxBodyContent BuildTx (ExperimentalEraToApiEra era)
+  -> Either TxBodyError (Ledger.TxBody (LedgerEra era))
 eraSpecificLedgerTxBody BabbageEra ledgerbody bc = do
-  let sbe = protocolVersionToSbe BabbageEra
+  let sbe = eraToSbe BabbageEra
 
   setUpdateProposal <- convTxUpdateProposal sbe (txUpdateProposal bc)
 
@@ -155,7 +148,8 @@ eraSpecificLedgerTxBody ConwayEra ledgerbody bc =
           & L.votingProceduresTxBodyL
             .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured voteProcedures)
           & L.treasuryDonationTxBodyL .~ maybe (L.Coin 0) unFeatured treasuryDonation
-          & L.currentTreasuryValueTxBodyL .~ L.maybeToStrictMaybe (unFeatured <$> currentTresuryValue)
+          & L.currentTreasuryValueTxBodyL
+            .~ L.maybeToStrictMaybe (maybe (Just $ L.Coin 0) unFeatured currentTresuryValue)
 
 hashTxBody
   :: L.HashAnnotated (Ledger.TxBody era) EraIndependentTxBody L.StandardCrypto
@@ -182,7 +176,7 @@ signTx
   -> [L.BootstrapWitness L.StandardCrypto]
   -> [L.WitVKey L.Witness L.StandardCrypto]
   -> UnsignedTx era
-  -> Ledger.Tx (ToConstrainedLedgerEra era)
+  -> Ledger.Tx (LedgerEra era)
 signTx era bootstrapWits shelleyKeyWits (UnsignedTx unsigned) =
   obtainCommonConstraints era $
     let currentScriptWitnesses = unsigned ^. L.witsTxL
@@ -196,23 +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.
 
 convertTxBodyToUnsignedTx
@@ -225,18 +202,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

@@ -58,7 +58,7 @@ import           Cardano.Api.Eon.ShelleyToAlonzoEra
 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, sbeToEra)
 import qualified Cardano.Api.Experimental.Eras as Exp
 import           Cardano.Api.Experimental.Tx
 import           Cardano.Api.Feature
@@ -956,7 +956,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/internal/Cardano/Api/Tx/Body.hs

@@ -139,7 +139,6 @@ module Cardano.Api.Tx.Body
   , convExtraKeyWitnesses
   , convLanguages
   , convMintValue
-  , convProposalProcedures
   , convReferenceInputs
   , convReturnCollateral
   , convScripts