Merge pull request #312 from input-output-hk/newhoggy/new-MaryEraOnly…

…-eon

New `MaryEraOnly` eon. Disjoint functions

cardano-api/cardano-api.cabal

@@ -66,6 +66,7 @@ library internal
                         Cardano.Api.Eon.ByronToAlonzoEra
                         Cardano.Api.Eon.ByronToMaryEra
                         Cardano.Api.Eon.ConwayEraOnwards
+                        Cardano.Api.Eon.MaryEraOnly
                         Cardano.Api.Eon.MaryEraOnwards
                         Cardano.Api.Eon.ShelleyBasedEra
                         Cardano.Api.Eon.ShelleyEraOnly

cardano-api/internal/Cardano/Api/Eon/MaryEraOnly.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Cardano.Api.Eon.MaryEraOnly
+  ( MaryEraOnly(..)
+  , maryEraOnlyConstraints
+  , maryEraOnlyToCardanoEra
+  , maryEraOnlyToShelleyBasedEra
+
+  , MaryEraOnlyConstraints
+  ) where
+
+import           Cardano.Api.Eon.ShelleyBasedEra
+import           Cardano.Api.Eras.Core
+import           Cardano.Api.Modes
+import           Cardano.Api.Query.Types
+
+import           Cardano.Binary
+import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
+import qualified Cardano.Crypto.Hash.Class as C
+import qualified Cardano.Crypto.VRF as C
+import qualified Cardano.Ledger.Api as L
+import qualified Cardano.Ledger.BaseTypes as L
+import qualified Cardano.Ledger.Core as L
+import qualified Cardano.Ledger.Mary.Value as L
+import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
+import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
+import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
+import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
+
+import           Data.Aeson
+import           Data.Typeable (Typeable)
+
+data MaryEraOnly era where
+  MaryEraOnlyMary  :: MaryEraOnly MaryEra
+
+deriving instance Show (MaryEraOnly era)
+deriving instance Eq (MaryEraOnly era)
+
+instance Eon MaryEraOnly where
+  inEonForEra no yes = \case
+    ByronEra    -> no
+    ShelleyEra  -> no
+    AllegraEra  -> no
+    MaryEra     -> yes MaryEraOnlyMary
+    AlonzoEra   -> no
+    BabbageEra  -> no
+    ConwayEra   -> no
+
+instance ToCardanoEra MaryEraOnly where
+  toCardanoEra = \case
+    MaryEraOnlyMary    -> MaryEra
+
+type MaryEraOnlyConstraints era =
+  ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era)))
+  , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed
+  , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
+  , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era)
+  , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
+  , L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
+  , L.Era (ShelleyLedgerEra era)
+  , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
+  , L.EraPParams (ShelleyLedgerEra era)
+  , L.EraTx (ShelleyLedgerEra era)
+  , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
+  , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.MaryEraTxBody (ShelleyLedgerEra era)
+  , L.ShelleyEraTxBody (ShelleyLedgerEra era)
+  , L.ShelleyEraTxCert (ShelleyLedgerEra era)
+  , L.Value (ShelleyLedgerEra era) ~ L.MaryValue L.StandardCrypto
+
+  , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
+  , FromCBOR (DebugLedgerState era)
+  , IsCardanoEra era
+  , IsShelleyBasedEra era
+  , ToJSON (DebugLedgerState era)
+  , Typeable era
+  )
+
+maryEraOnlyConstraints :: ()
+  => MaryEraOnly era
+  -> (MaryEraOnlyConstraints era => a)
+  -> a
+maryEraOnlyConstraints = \case
+  MaryEraOnlyMary    -> id
+
+maryEraOnlyToCardanoEra :: MaryEraOnly era -> CardanoEra era
+maryEraOnlyToCardanoEra = shelleyBasedToCardanoEra . maryEraOnlyToShelleyBasedEra
+
+maryEraOnlyToShelleyBasedEra :: MaryEraOnly era -> ShelleyBasedEra era
+maryEraOnlyToShelleyBasedEra = \case
+  MaryEraOnlyMary    -> ShelleyBasedEraMary

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

@@ -19,11 +19,16 @@ module Cardano.Api.Eras.Case
   , caseShelleyToAlonzoOrBabbageEraOnwards
   , caseShelleyToBabbageOrConwayEraOnwards
 
+    -- Case on MaryEraOnwards
+  , caseMaryEraOnlyOrAlonzoEraOnwards
+
     -- Case on AlonzoEraOnwards
   , caseAlonzoOnlyOrBabbageEraOnwards
 
     -- Proofs
   , noByronEraInShelleyBasedEra
+  , disjointAlonzoEraOnlyAndBabbageEraOnwards
+  , disjointByronEraOnlyAndShelleyBasedEra
 
     -- Conversions
   , shelleyToAllegraEraToByronToAllegraEra
@@ -43,6 +48,7 @@ import           Cardano.Api.Eon.ByronToAllegraEra
 import           Cardano.Api.Eon.ByronToAlonzoEra
 import           Cardano.Api.Eon.ByronToMaryEra
 import           Cardano.Api.Eon.ConwayEraOnwards
+import           Cardano.Api.Eon.MaryEraOnly
 import           Cardano.Api.Eon.MaryEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eon.ShelleyEraOnly
@@ -188,6 +194,17 @@ caseShelleyToBabbageOrConwayEraOnwards l r = \case
   ShelleyBasedEraBabbage -> l ShelleyToBabbageEraBabbage
   ShelleyBasedEraConway  -> r ConwayEraOnwardsConway
 
+caseMaryEraOnlyOrAlonzoEraOnwards :: ()
+  => (MaryEraOnly era -> a)
+  -> (AlonzoEraOnwards era -> a)
+  -> MaryEraOnwards era
+  -> a
+caseMaryEraOnlyOrAlonzoEraOnwards l r = \case
+  MaryEraOnwardsMary    -> l MaryEraOnlyMary
+  MaryEraOnwardsAlonzo  -> r AlonzoEraOnwardsAlonzo
+  MaryEraOnwardsBabbage -> r AlonzoEraOnwardsBabbage
+  MaryEraOnwardsConway  -> r AlonzoEraOnwardsConway
+
 caseAlonzoOnlyOrBabbageEraOnwards :: ()
   => (AlonzoEraOnly era -> a)
   -> (BabbageEraOnwards era -> a)
@@ -198,8 +215,17 @@ caseAlonzoOnlyOrBabbageEraOnwards l r = \case
   AlonzoEraOnwardsBabbage -> r BabbageEraOnwardsBabbage
   AlonzoEraOnwardsConway  -> r BabbageEraOnwardsConway
 
+{-# DEPRECATED noByronEraInShelleyBasedEra "Use disjointByronEraOnlyAndShelleyBasedEra instead" #-}
 noByronEraInShelleyBasedEra :: ShelleyBasedEra era -> ByronEraOnly era -> a
-noByronEraInShelleyBasedEra sbe ByronEraOnlyByron = case sbe of {}
+noByronEraInShelleyBasedEra = flip disjointByronEraOnlyAndShelleyBasedEra
+
+disjointByronEraOnlyAndShelleyBasedEra :: ByronEraOnly era -> ShelleyBasedEra era -> a
+disjointByronEraOnlyAndShelleyBasedEra ByronEraOnlyByron sbe = case sbe of {}
+
+disjointAlonzoEraOnlyAndBabbageEraOnwards :: AlonzoEraOnly era -> BabbageEraOnwards era -> a
+disjointAlonzoEraOnlyAndBabbageEraOnwards eonL eonR =
+  case eonL of
+    AlonzoEraOnlyAlonzo -> case eonR of {}
 
 shelleyToAllegraEraToByronToAllegraEra :: ShelleyToAllegraEra era -> ByronToAllegraEra era
 shelleyToAllegraEraToByronToAllegraEra = \case

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

@@ -2656,7 +2656,7 @@ convWithdrawals txWithdrawals =
 
 convTransactionFee :: ShelleyBasedEra era -> TxFee era -> Ledger.Coin
 convTransactionFee sbe = \case
-  TxFeeImplicit w  -> noByronEraInShelleyBasedEra sbe w
+  TxFeeImplicit w  -> disjointByronEraOnlyAndShelleyBasedEra w sbe
   TxFeeExplicit _ fee -> toShelleyLovelace fee
 
 convValidityInterval

cardano-api/src/Cardano/Api.hs

@@ -110,6 +110,11 @@ module Cardano.Api (
     -- ** From Allegra
 
     -- ** From Mary
+    MaryEraOnly(..),
+    maryEraOnlyConstraints,
+    maryEraOnlyToCardanoEra,
+    maryEraOnlyToShelleyBasedEra,
+
     MaryEraOnwards(..),
     maryEraOnwardsConstraints,
     maryEraOnwardsToCardanoEra,
@@ -1026,6 +1031,7 @@ import           Cardano.Api.Eon.ByronToAllegraEra
 import           Cardano.Api.Eon.ByronToAlonzoEra
 import           Cardano.Api.Eon.ByronToMaryEra
 import           Cardano.Api.Eon.ConwayEraOnwards
+import           Cardano.Api.Eon.MaryEraOnly
 import           Cardano.Api.Eon.MaryEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eon.ShelleyEraOnly