{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.Api.Eon.ShelleyBasedEra
  ( -- * Shelley-based eras
    ShelleyBasedEra (..)
  , IsShelleyBasedEra (..)
  , AnyShelleyBasedEra (..)
  , InAnyShelleyBasedEra (..)
  , inAnyShelleyBasedEra
  , inEonForShelleyBasedEra
  , inEonForShelleyBasedEraMaybe
  , forShelleyBasedEraInEon
  , forShelleyBasedEraInEonMaybe
  , forShelleyBasedEraMaybeEon

    -- * Assertions on era
  , requireShelleyBasedEra

    -- ** Mapping to era types from the Shelley ledger library
  , ShelleyLedgerEra
  , eraProtVerLow
  , ShelleyBasedEraConstraints
  , shelleyBasedEraConstraints
  )
where

import           Cardano.Api.Eon.Convert
import           Cardano.Api.Eras.Core
import           Cardano.Api.Modes
import           Cardano.Api.Orphans ()
import           Cardano.Api.Pretty (Pretty)

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           Cardano.Ledger.Binary (FromCBOR)
import qualified Cardano.Ledger.Core as L
import qualified Cardano.Ledger.SafeHash as L
import qualified Cardano.Ledger.Shelley.Rules 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           Ouroboros.Consensus.Shelley.Eras as Consensus (StandardAllegra, StandardAlonzo,
                   StandardBabbage, StandardConway, StandardMary, StandardShelley)
import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus

import           Control.DeepSeq
import           Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
import qualified Data.Text as Text
import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
import           Data.Typeable (Typeable)
import           Text.Pretty (Pretty (..))

-- | Determine the value to use for a feature in a given 'ShelleyBasedEra'.
inEonForShelleyBasedEra
  :: ()
  => Eon eon
  => a
  -> (eon era -> a)
  -> ShelleyBasedEra era
  -> a
inEonForShelleyBasedEra :: forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> ShelleyBasedEra era -> a
inEonForShelleyBasedEra a
no eon era -> a
yes =
  a -> (eon era -> a) -> CardanoEra era -> a
forall a era. a -> (eon era -> a) -> CardanoEra era -> a
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> CardanoEra era -> a
inEonForEra a
no eon era -> a
yes (CardanoEra era -> a)
-> (ShelleyBasedEra era -> CardanoEra era)
-> ShelleyBasedEra era
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra

inEonForShelleyBasedEraMaybe
  :: ()
  => Eon eon
  => (eon era -> a)
  -> ShelleyBasedEra era
  -> Maybe a
inEonForShelleyBasedEraMaybe :: forall (eon :: * -> *) era a.
Eon eon =>
(eon era -> a) -> ShelleyBasedEra era -> Maybe a
inEonForShelleyBasedEraMaybe eon era -> a
yes =
  Maybe a -> (eon era -> Maybe a) -> ShelleyBasedEra era -> Maybe a
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> ShelleyBasedEra era -> a
inEonForShelleyBasedEra Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (eon era -> a) -> eon era -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. eon era -> a
yes)

forShelleyBasedEraMaybeEon
  :: ()
  => Eon eon
  => ShelleyBasedEra era
  -> Maybe (eon era)
forShelleyBasedEraMaybeEon :: forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon =
  Maybe (eon era)
-> (eon era -> Maybe (eon era))
-> CardanoEra era
-> Maybe (eon era)
forall a era. a -> (eon era -> a) -> CardanoEra era -> a
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> CardanoEra era -> a
inEonForEra Maybe (eon era)
forall a. Maybe a
Nothing eon era -> Maybe (eon era)
forall a. a -> Maybe a
Just (CardanoEra era -> Maybe (eon era))
-> (ShelleyBasedEra era -> CardanoEra era)
-> ShelleyBasedEra era
-> Maybe (eon era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra

forShelleyBasedEraInEon
  :: ()
  => Eon eon
  => ShelleyBasedEra era
  -> a
  -> (eon era -> a)
  -> a
forShelleyBasedEraInEon :: forall (eon :: * -> *) era a.
Eon eon =>
ShelleyBasedEra era -> a -> (eon era -> a) -> a
forShelleyBasedEraInEon ShelleyBasedEra era
era a
no eon era -> a
yes =
  a -> (eon era -> a) -> ShelleyBasedEra era -> a
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> ShelleyBasedEra era -> a
inEonForShelleyBasedEra a
no eon era -> a
yes ShelleyBasedEra era
era

forShelleyBasedEraInEonMaybe
  :: ()
  => Eon eon
  => ShelleyBasedEra era
  -> (eon era -> a)
  -> Maybe a
forShelleyBasedEraInEonMaybe :: forall (eon :: * -> *) era a.
Eon eon =>
ShelleyBasedEra era -> (eon era -> a) -> Maybe a
forShelleyBasedEraInEonMaybe ShelleyBasedEra era
era eon era -> a
yes =
  ShelleyBasedEra era -> Maybe a -> (eon era -> Maybe a) -> Maybe a
forall (eon :: * -> *) era a.
Eon eon =>
ShelleyBasedEra era -> a -> (eon era -> a) -> a
forShelleyBasedEraInEon ShelleyBasedEra era
era Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (eon era -> a) -> eon era -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. eon era -> a
yes)

-- ----------------------------------------------------------------------------
-- Shelley-based eras
--

-- | While the Byron and Shelley eras are quite different, there are several
-- eras that are based on Shelley with only minor differences. It is useful
-- to be able to treat the Shelley-based eras in a mostly-uniform way.
--
-- Values of this type witness the fact that the era is Shelley-based. This
-- can be used to constrain the era to being a Shelley-based on. It allows
-- non-uniform handling making case distinctions on the constructor.
data ShelleyBasedEra era where
  ShelleyBasedEraShelley :: ShelleyBasedEra ShelleyEra
  ShelleyBasedEraAllegra :: ShelleyBasedEra AllegraEra
  ShelleyBasedEraMary :: ShelleyBasedEra MaryEra
  ShelleyBasedEraAlonzo :: ShelleyBasedEra AlonzoEra
  ShelleyBasedEraBabbage :: ShelleyBasedEra BabbageEra
  ShelleyBasedEraConway :: ShelleyBasedEra ConwayEra

instance NFData (ShelleyBasedEra era) where
  rnf :: ShelleyBasedEra era -> ()
rnf = \case
    ShelleyBasedEra era
ShelleyBasedEraShelley -> ()
    ShelleyBasedEra era
ShelleyBasedEraAllegra -> ()
    ShelleyBasedEra era
ShelleyBasedEraMary -> ()
    ShelleyBasedEra era
ShelleyBasedEraAlonzo -> ()
    ShelleyBasedEra era
ShelleyBasedEraBabbage -> ()
    ShelleyBasedEra era
ShelleyBasedEraConway -> ()

deriving instance Eq (ShelleyBasedEra era)

deriving instance Ord (ShelleyBasedEra era)

deriving instance Show (ShelleyBasedEra era)

instance Pretty (ShelleyBasedEra era) where
  pretty :: forall ann. ShelleyBasedEra era -> Doc ann
pretty = CardanoEra era -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty (CardanoEra era -> Doc ann)
-> (ShelleyBasedEra era -> CardanoEra era)
-> ShelleyBasedEra era
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra

instance ToJSON (ShelleyBasedEra era) where
  toJSON :: ShelleyBasedEra era -> Value
toJSON = CardanoEra era -> Value
forall a. ToJSON a => a -> Value
toJSON (CardanoEra era -> Value)
-> (ShelleyBasedEra era -> CardanoEra era)
-> ShelleyBasedEra era
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra

instance TestEquality ShelleyBasedEra where
  testEquality :: forall a b.
ShelleyBasedEra a -> ShelleyBasedEra b -> Maybe (a :~: b)
testEquality ShelleyBasedEra a
ShelleyBasedEraShelley ShelleyBasedEra b
ShelleyBasedEraShelley = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality ShelleyBasedEra a
ShelleyBasedEraAllegra ShelleyBasedEra b
ShelleyBasedEraAllegra = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality ShelleyBasedEra a
ShelleyBasedEraMary ShelleyBasedEra b
ShelleyBasedEraMary = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality ShelleyBasedEra a
ShelleyBasedEraAlonzo ShelleyBasedEra b
ShelleyBasedEraAlonzo = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality ShelleyBasedEra a
ShelleyBasedEraBabbage ShelleyBasedEra b
ShelleyBasedEraBabbage = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality ShelleyBasedEra a
ShelleyBasedEraConway ShelleyBasedEra b
ShelleyBasedEraConway = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality ShelleyBasedEra a
_ ShelleyBasedEra b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing

instance Eon ShelleyBasedEra where
  inEonForEra :: forall a era.
a -> (ShelleyBasedEra era -> a) -> CardanoEra era -> a
inEonForEra a
no ShelleyBasedEra era -> a
yes = \case
    CardanoEra era
ByronEra -> a
no
    CardanoEra era
ShelleyEra -> ShelleyBasedEra era -> a
yes ShelleyBasedEra era
ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
    CardanoEra era
AllegraEra -> ShelleyBasedEra era -> a
yes ShelleyBasedEra era
ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
    CardanoEra era
MaryEra -> ShelleyBasedEra era -> a
yes ShelleyBasedEra era
ShelleyBasedEra MaryEra
ShelleyBasedEraMary
    CardanoEra era
AlonzoEra -> ShelleyBasedEra era -> a
yes ShelleyBasedEra era
ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
    CardanoEra era
BabbageEra -> ShelleyBasedEra era -> a
yes ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    CardanoEra era
ConwayEra -> ShelleyBasedEra era -> a
yes ShelleyBasedEra era
ShelleyBasedEra ConwayEra
ShelleyBasedEraConway

instance ToCardanoEra ShelleyBasedEra where
  toCardanoEra :: forall era. ShelleyBasedEra era -> CardanoEra era
toCardanoEra = \case
    ShelleyBasedEra era
ShelleyBasedEraShelley -> CardanoEra era
CardanoEra ShelleyEra
ShelleyEra
    ShelleyBasedEra era
ShelleyBasedEraAllegra -> CardanoEra era
CardanoEra AllegraEra
AllegraEra
    ShelleyBasedEra era
ShelleyBasedEraMary -> CardanoEra era
CardanoEra MaryEra
MaryEra
    ShelleyBasedEra era
ShelleyBasedEraAlonzo -> CardanoEra era
CardanoEra AlonzoEra
AlonzoEra
    ShelleyBasedEra era
ShelleyBasedEraBabbage -> CardanoEra era
CardanoEra BabbageEra
BabbageEra
    ShelleyBasedEra era
ShelleyBasedEraConway -> CardanoEra era
CardanoEra ConwayEra
ConwayEra

instance Convert ShelleyBasedEra CardanoEra where
  convert :: forall era. ShelleyBasedEra era -> CardanoEra era
convert = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra

-- | The class of eras that are based on Shelley. This allows uniform handling
-- of Shelley-based eras, but also non-uniform by making case distinctions on
-- the 'ShelleyBasedEra' constructors.
class IsCardanoEra era => IsShelleyBasedEra era where
  shelleyBasedEra :: ShelleyBasedEra era

instance IsShelleyBasedEra ShelleyEra where
  shelleyBasedEra :: ShelleyBasedEra ShelleyEra
shelleyBasedEra = ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley

instance IsShelleyBasedEra AllegraEra where
  shelleyBasedEra :: ShelleyBasedEra AllegraEra
shelleyBasedEra = ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra

instance IsShelleyBasedEra MaryEra where
  shelleyBasedEra :: ShelleyBasedEra MaryEra
shelleyBasedEra = ShelleyBasedEra MaryEra
ShelleyBasedEraMary

instance IsShelleyBasedEra AlonzoEra where
  shelleyBasedEra :: ShelleyBasedEra AlonzoEra
shelleyBasedEra = ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo

instance IsShelleyBasedEra BabbageEra where
  shelleyBasedEra :: ShelleyBasedEra BabbageEra
shelleyBasedEra = ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage

instance IsShelleyBasedEra ConwayEra where
  shelleyBasedEra :: ShelleyBasedEra ConwayEra
shelleyBasedEra = ShelleyBasedEra ConwayEra
ShelleyBasedEraConway

type ShelleyBasedEraConstraints era =
  ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era)))
  , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed
  , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
  , Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era) ~ ConsensusBlockForEra 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.EraTxOut (ShelleyLedgerEra era)
  , L.EraUTxO (ShelleyLedgerEra era)
  , L.EraTxWits (ShelleyLedgerEra era)
  , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
  , L.ShelleyEraTxCert (ShelleyLedgerEra era)
  , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
  , IsCardanoEra era
  , IsShelleyBasedEra era
  , ToJSON (L.PredicateFailure (L.EraRule "LEDGER" (ShelleyLedgerEra era)))
  , Typeable era
  )

shelleyBasedEraConstraints
  :: ()
  => ShelleyBasedEra era
  -> (ShelleyBasedEraConstraints era => a)
  -> a
shelleyBasedEraConstraints :: forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints = \case
  ShelleyBasedEra era
ShelleyBasedEraShelley -> a -> a
(ShelleyBasedEraConstraints era => a) -> a
forall a. a -> a
id
  ShelleyBasedEra era
ShelleyBasedEraAllegra -> a -> a
(ShelleyBasedEraConstraints era => a) -> a
forall a. a -> a
id
  ShelleyBasedEra era
ShelleyBasedEraMary -> a -> a
(ShelleyBasedEraConstraints era => a) -> a
forall a. a -> a
id
  ShelleyBasedEra era
ShelleyBasedEraAlonzo -> a -> a
(ShelleyBasedEraConstraints era => a) -> a
forall a. a -> a
id
  ShelleyBasedEra era
ShelleyBasedEraBabbage -> a -> a
(ShelleyBasedEraConstraints era => a) -> a
forall a. a -> a
id
  ShelleyBasedEra era
ShelleyBasedEraConway -> a -> a
(ShelleyBasedEraConstraints era => a) -> a
forall a. a -> a
id

data AnyShelleyBasedEra where
  AnyShelleyBasedEra
    :: Typeable era
    => ShelleyBasedEra era
    -> AnyShelleyBasedEra

deriving instance Show AnyShelleyBasedEra

instance Eq AnyShelleyBasedEra where
  AnyShelleyBasedEra ShelleyBasedEra era
sbe == :: AnyShelleyBasedEra -> AnyShelleyBasedEra -> Bool
== AnyShelleyBasedEra ShelleyBasedEra era
sbe' =
    case ShelleyBasedEra era -> ShelleyBasedEra era -> Maybe (era :~: era)
forall a b.
ShelleyBasedEra a -> ShelleyBasedEra b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality ShelleyBasedEra era
sbe ShelleyBasedEra era
sbe' of
      Maybe (era :~: era)
Nothing -> Bool
False
      Just era :~: era
Refl -> Bool
True -- since no constructors share types

instance Bounded AnyShelleyBasedEra where
  minBound :: AnyShelleyBasedEra
minBound = ShelleyBasedEra ShelleyEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
  maxBound :: AnyShelleyBasedEra
maxBound = ShelleyBasedEra ConwayEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ConwayEra
ShelleyBasedEraConway

instance Enum AnyShelleyBasedEra where
  enumFrom :: AnyShelleyBasedEra -> [AnyShelleyBasedEra]
enumFrom AnyShelleyBasedEra
e = AnyShelleyBasedEra -> AnyShelleyBasedEra -> [AnyShelleyBasedEra]
forall a. Enum a => a -> a -> [a]
enumFromTo AnyShelleyBasedEra
e AnyShelleyBasedEra
forall a. Bounded a => a
maxBound

  fromEnum :: AnyShelleyBasedEra -> Int
fromEnum = \case
    AnyShelleyBasedEra ShelleyBasedEra era
ShelleyBasedEraShelley -> Int
1
    AnyShelleyBasedEra ShelleyBasedEra era
ShelleyBasedEraAllegra -> Int
2
    AnyShelleyBasedEra ShelleyBasedEra era
ShelleyBasedEraMary -> Int
3
    AnyShelleyBasedEra ShelleyBasedEra era
ShelleyBasedEraAlonzo -> Int
4
    AnyShelleyBasedEra ShelleyBasedEra era
ShelleyBasedEraBabbage -> Int
5
    AnyShelleyBasedEra ShelleyBasedEra era
ShelleyBasedEraConway -> Int
6

  toEnum :: Int -> AnyShelleyBasedEra
toEnum = \case
    Int
1 -> ShelleyBasedEra ShelleyEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
    Int
2 -> ShelleyBasedEra AllegraEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
    Int
3 -> ShelleyBasedEra MaryEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary
    Int
4 -> ShelleyBasedEra AlonzoEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
    Int
5 -> ShelleyBasedEra BabbageEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    Int
6 -> ShelleyBasedEra ConwayEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
    Int
n ->
      String -> AnyShelleyBasedEra
forall a. HasCallStack => String -> a
error (String -> AnyShelleyBasedEra) -> String -> AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$
        String
"AnyShelleyBasedEra.toEnum: "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not correspond to any known enumerated era."

instance ToJSON AnyShelleyBasedEra where
  toJSON :: AnyShelleyBasedEra -> Value
toJSON (AnyShelleyBasedEra ShelleyBasedEra era
sbe) = ShelleyBasedEra era -> Value
forall a. ToJSON a => a -> Value
toJSON ShelleyBasedEra era
sbe

instance FromJSON AnyShelleyBasedEra where
  parseJSON :: Value -> Parser AnyShelleyBasedEra
parseJSON = String
-> (Text -> Parser AnyShelleyBasedEra)
-> Value
-> Parser AnyShelleyBasedEra
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"AnyShelleyBasedEra" ((Text -> Parser AnyShelleyBasedEra)
 -> Value -> Parser AnyShelleyBasedEra)
-> (Text -> Parser AnyShelleyBasedEra)
-> Value
-> Parser AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$
    \case
      Text
"Shelley" -> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyShelleyBasedEra -> Parser AnyShelleyBasedEra)
-> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ShelleyEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
      Text
"Allegra" -> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyShelleyBasedEra -> Parser AnyShelleyBasedEra)
-> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AllegraEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
      Text
"Mary" -> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyShelleyBasedEra -> Parser AnyShelleyBasedEra)
-> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra MaryEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary
      Text
"Alonzo" -> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyShelleyBasedEra -> Parser AnyShelleyBasedEra)
-> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra AlonzoEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
      Text
"Babbage" -> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyShelleyBasedEra -> Parser AnyShelleyBasedEra)
-> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra BabbageEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
      Text
"Conway" -> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnyShelleyBasedEra -> Parser AnyShelleyBasedEra)
-> AnyShelleyBasedEra -> Parser AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
      Text
wrong -> String -> Parser AnyShelleyBasedEra
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AnyShelleyBasedEra)
-> String -> Parser AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse unknown shelley-based era: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
wrong

-- | This pairs up some era-dependent type with a 'ShelleyBasedEra' value that
-- tells us what era it is, but hides the era type. This is useful when the era
-- is not statically known, for example when deserialising from a file.
data InAnyShelleyBasedEra thing where
  InAnyShelleyBasedEra
    :: Typeable era
    => ShelleyBasedEra era
    -> thing era
    -> InAnyShelleyBasedEra thing

inAnyShelleyBasedEra
  :: ()
  => ShelleyBasedEra era
  -> thing era
  -> InAnyShelleyBasedEra thing
inAnyShelleyBasedEra :: forall era (thing :: * -> *).
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
inAnyShelleyBasedEra ShelleyBasedEra era
sbe thing era
a =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => InAnyShelleyBasedEra thing)
-> InAnyShelleyBasedEra thing
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => InAnyShelleyBasedEra thing)
 -> InAnyShelleyBasedEra thing)
-> (ShelleyBasedEraConstraints era => InAnyShelleyBasedEra thing)
-> InAnyShelleyBasedEra thing
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra era
sbe thing era
a

-- ----------------------------------------------------------------------------
-- Conversion to Shelley ledger library types
--

-- | A type family that connects our era type tags to equivalent type tags used
-- in the Shelley ledger library.
--
-- This type mapping  connect types from this API with types in the Shelley
-- ledger library which allows writing conversion functions in a more generic
-- way.
type family ShelleyLedgerEra era = ledgerera | ledgerera -> era where
  ShelleyLedgerEra ShelleyEra = Consensus.StandardShelley
  ShelleyLedgerEra AllegraEra = Consensus.StandardAllegra
  ShelleyLedgerEra MaryEra = Consensus.StandardMary
  ShelleyLedgerEra AlonzoEra = Consensus.StandardAlonzo
  ShelleyLedgerEra BabbageEra = Consensus.StandardBabbage
  ShelleyLedgerEra ConwayEra = Consensus.StandardConway

-- | Lookup the lower major protocol version for the shelley based era. In other words
-- this is the major protocol version that the era has started in.
eraProtVerLow :: ShelleyBasedEra era -> L.Version
eraProtVerLow :: forall era. ShelleyBasedEra era -> Version
eraProtVerLow = \case
  ShelleyBasedEra era
ShelleyBasedEraShelley -> forall era. Era era => Version
L.eraProtVerLow @L.Shelley
  ShelleyBasedEra era
ShelleyBasedEraAllegra -> forall era. Era era => Version
L.eraProtVerLow @L.Allegra
  ShelleyBasedEra era
ShelleyBasedEraMary -> forall era. Era era => Version
L.eraProtVerLow @L.Mary
  ShelleyBasedEra era
ShelleyBasedEraAlonzo -> forall era. Era era => Version
L.eraProtVerLow @L.Alonzo
  ShelleyBasedEra era
ShelleyBasedEraBabbage -> forall era. Era era => Version
L.eraProtVerLow @L.Babbage
  ShelleyBasedEra era
ShelleyBasedEraConway -> forall era. Era era => Version
L.eraProtVerLow @L.Conway

requireShelleyBasedEra
  :: ()
  => Applicative m
  => CardanoEra era
  -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra :: forall (m :: * -> *) era.
Applicative m =>
CardanoEra era -> m (Maybe (ShelleyBasedEra era))
requireShelleyBasedEra = m (Maybe (ShelleyBasedEra era))
-> (ShelleyBasedEra era -> m (Maybe (ShelleyBasedEra era)))
-> CardanoEra era
-> m (Maybe (ShelleyBasedEra era))
forall a era.
a -> (ShelleyBasedEra era -> a) -> CardanoEra era -> a
forall (eon :: * -> *) a era.
Eon eon =>
a -> (eon era -> a) -> CardanoEra era -> a
inEonForEra (Maybe (ShelleyBasedEra era) -> m (Maybe (ShelleyBasedEra era))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ShelleyBasedEra era)
forall a. Maybe a
Nothing) (Maybe (ShelleyBasedEra era) -> m (Maybe (ShelleyBasedEra era))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ShelleyBasedEra era) -> m (Maybe (ShelleyBasedEra era)))
-> (ShelleyBasedEra era -> Maybe (ShelleyBasedEra era))
-> ShelleyBasedEra era
-> m (Maybe (ShelleyBasedEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> Maybe (ShelleyBasedEra era)
forall a. a -> Maybe a
Just)