{-# 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.Internal.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.Internal.Eon.Convert
import Cardano.Api.Internal.Eras.Core
import Cardano.Api.Internal.Modes
import Cardano.Api.Internal.Orphans ()
import Cardano.Api.Internal.Pretty (Pretty)

import Cardano.Crypto.Hash.Blake2b qualified as Blake2b
import Cardano.Crypto.Hash.Class qualified as C
import Cardano.Crypto.VRF qualified as C
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.BaseTypes qualified as L
import Cardano.Ledger.Binary (FromCBOR)
import Cardano.Ledger.Core qualified as L
import Cardano.Ledger.SafeHash qualified as L
import Cardano.Ledger.Shelley.Rules qualified as L
import Cardano.Ledger.UTxO qualified as L
import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus
import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
import Ouroboros.Consensus.Shelley.Eras as Consensus
  ( StandardAllegra
  , StandardAlonzo
  , StandardBabbage
  , StandardConway
  , StandardMary
  , StandardShelley
  )
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus

import Control.DeepSeq
import Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
import Data.Text qualified 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)