{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}


-- | Cardano eras, sometimes we have to distinguish them.
--
module Cardano.Api.Eras
  ( -- * Eras
    ByronEra
  , ShelleyEra
  , AllegraEra
  , MaryEra
  , AlonzoEra
  , CardanoEra(..)
  , IsCardanoEra(..)
  , AnyCardanoEra(..)
  , anyCardanoEra
  , InAnyCardanoEra(..)

    -- * Deprecated aliases
  , Byron
  , Shelley
  , Allegra
  , Mary

    -- * Shelley-based eras
  , ShelleyBasedEra(..)
  , IsShelleyBasedEra(..)
  , InAnyShelleyBasedEra(..)
  , shelleyBasedToCardanoEra

    -- ** Mapping to era types from the Shelley ledger library
  , ShelleyLedgerEra

    -- * Cardano eras, as Byron vs Shelley-based
  , CardanoEraStyle(..)
  , cardanoEraStyle

    -- * Data family instances
  , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra,
           AsByron,    AsShelley,    AsAllegra,    AsMary)
  ) where

import           Prelude

import           Data.Aeson (ToJSON, toJSON)
import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))

import           Ouroboros.Consensus.Shelley.Eras as Ledger (StandardAllegra, StandardAlonzo,
                   StandardMary, StandardShelley)

import           Cardano.Api.HasTypeProxy


-- | A type used as a tag to distinguish the Byron era.
data ByronEra

-- | A type used as a tag to distinguish the Shelley era.
data ShelleyEra

-- | A type used as a tag to distinguish the Allegra era.
data AllegraEra

-- | A type used as a tag to distinguish the Mary era.
data MaryEra

-- | A type used as a tag to distinguish the Alonzo era.
data AlonzoEra

instance HasTypeProxy ByronEra where
    data AsType ByronEra = AsByronEra
    proxyToAsType :: Proxy ByronEra -> AsType ByronEra
proxyToAsType Proxy ByronEra
_ = AsType ByronEra
AsByronEra

instance HasTypeProxy ShelleyEra where
    data AsType ShelleyEra = AsShelleyEra
    proxyToAsType :: Proxy ShelleyEra -> AsType ShelleyEra
proxyToAsType Proxy ShelleyEra
_ = AsType ShelleyEra
AsShelleyEra

instance HasTypeProxy AllegraEra where
    data AsType AllegraEra = AsAllegraEra
    proxyToAsType :: Proxy AllegraEra -> AsType AllegraEra
proxyToAsType Proxy AllegraEra
_ = AsType AllegraEra
AsAllegraEra

instance HasTypeProxy MaryEra where
    data AsType MaryEra = AsMaryEra
    proxyToAsType :: Proxy MaryEra -> AsType MaryEra
proxyToAsType Proxy MaryEra
_ = AsType MaryEra
AsMaryEra

instance HasTypeProxy AlonzoEra where
    data AsType AlonzoEra = AsAlonzoEra
    proxyToAsType :: Proxy AlonzoEra -> AsType AlonzoEra
proxyToAsType Proxy AlonzoEra
_ = AsType AlonzoEra
AsAlonzoEra


-- ----------------------------------------------------------------------------
-- Deprecated aliases
--

type Byron   = ByronEra
type Shelley = ShelleyEra
type Allegra = AllegraEra
type Mary    = MaryEra

{-# DEPRECATED Byron   "Use 'ByronEra' or 'ByronAddr' as appropriate" #-}
{-# DEPRECATED Shelley "Use 'ShelleyEra' or 'ShelleyAddr' as appropriate" #-}
{-# DEPRECATED Allegra "Use 'AllegraEra' instead" #-}
{-# DEPRECATED Mary    "Use 'MaryEra' instead" #-}

pattern AsByron   :: AsType ByronEra
pattern $bAsByron :: AsType ByronEra
$mAsByron :: forall r. AsType ByronEra -> (Void# -> r) -> (Void# -> r) -> r
AsByron    = AsByronEra

pattern AsShelley :: AsType ShelleyEra
pattern $bAsShelley :: AsType ShelleyEra
$mAsShelley :: forall r. AsType ShelleyEra -> (Void# -> r) -> (Void# -> r) -> r
AsShelley  = AsShelleyEra

pattern AsAllegra :: AsType AllegraEra
pattern $bAsAllegra :: AsType AllegraEra
$mAsAllegra :: forall r. AsType AllegraEra -> (Void# -> r) -> (Void# -> r) -> r
AsAllegra  = AsAllegraEra

pattern AsMary    :: AsType MaryEra
pattern $bAsMary :: AsType MaryEra
$mAsMary :: forall r. AsType MaryEra -> (Void# -> r) -> (Void# -> r) -> r
AsMary     = AsMaryEra

{-# DEPRECATED AsByron   "Use 'AsByronEra' instead" #-}
{-# DEPRECATED AsShelley "Use 'AsShelleyEra' instead" #-}
{-# DEPRECATED AsAllegra "Use 'AsAllegraEra' instead" #-}
{-# DEPRECATED AsMary    "Use 'AsMaryEra' instead" #-}

-- ----------------------------------------------------------------------------
-- Value level representation for Cardano eras
--

-- | This GADT provides a value-level representation of all the Cardano eras.
-- This enables pattern matching on the era to allow them to be treated in a
-- non-uniform way.
--
-- This can be used in combination with the 'IsCardanoEra' class to get access
-- to this value.
--
-- In combination this can often enable code that handles all eras, and does
-- so uniformly where possible, and non-uniformly where necessary.
--
data CardanoEra era where
     ByronEra   :: CardanoEra ByronEra
     ShelleyEra :: CardanoEra ShelleyEra
     AllegraEra :: CardanoEra AllegraEra
     MaryEra    :: CardanoEra MaryEra
     AlonzoEra  :: CardanoEra AlonzoEra
     -- when you add era here, change `instance Bounded AnyCardanoEra`

deriving instance Eq   (CardanoEra era)
deriving instance Ord  (CardanoEra era)
deriving instance Show (CardanoEra era)

instance ToJSON (CardanoEra era) where
   toJSON :: CardanoEra era -> Value
toJSON CardanoEra era
ByronEra   = Value
"Byron"
   toJSON CardanoEra era
ShelleyEra = Value
"Shelley"
   toJSON CardanoEra era
AllegraEra = Value
"Allegra"
   toJSON CardanoEra era
MaryEra    = Value
"Mary"
   toJSON CardanoEra era
AlonzoEra  = Value
"Alonzo"

instance TestEquality CardanoEra where
    testEquality :: CardanoEra a -> CardanoEra b -> Maybe (a :~: b)
testEquality CardanoEra a
ByronEra   CardanoEra b
ByronEra   = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality CardanoEra a
ShelleyEra CardanoEra b
ShelleyEra = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality CardanoEra a
AllegraEra CardanoEra b
AllegraEra = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality CardanoEra a
MaryEra    CardanoEra b
MaryEra    = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality CardanoEra a
AlonzoEra  CardanoEra b
AlonzoEra  = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality CardanoEra a
_          CardanoEra b
_          = Maybe (a :~: b)
forall a. Maybe a
Nothing


-- | The class of Cardano eras. This allows uniform handling of all Cardano
-- eras, but also non-uniform by making case distinctions on the 'CardanoEra'
-- constructors, or the 'CardanoEraStyle' constructors via `cardanoEraStyle`.
--
class HasTypeProxy era => IsCardanoEra era where
   cardanoEra      :: CardanoEra era

instance IsCardanoEra ByronEra where
   cardanoEra :: CardanoEra ByronEra
cardanoEra      = CardanoEra ByronEra
ByronEra

instance IsCardanoEra ShelleyEra where
   cardanoEra :: CardanoEra ShelleyEra
cardanoEra      = CardanoEra ShelleyEra
ShelleyEra

instance IsCardanoEra AllegraEra where
   cardanoEra :: CardanoEra AllegraEra
cardanoEra      = CardanoEra AllegraEra
AllegraEra

instance IsCardanoEra MaryEra where
   cardanoEra :: CardanoEra MaryEra
cardanoEra      = CardanoEra MaryEra
MaryEra

instance IsCardanoEra AlonzoEra where
   cardanoEra :: CardanoEra AlonzoEra
cardanoEra      = CardanoEra AlonzoEra
AlonzoEra

data AnyCardanoEra where
     AnyCardanoEra :: IsCardanoEra era  -- Provide class constraint
                   => CardanoEra era    -- and explicit value.
                   -> AnyCardanoEra

deriving instance Show AnyCardanoEra

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

instance Bounded AnyCardanoEra where
   minBound :: AnyCardanoEra
minBound = CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
   maxBound :: AnyCardanoEra
maxBound = CardanoEra AlonzoEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra

instance Enum AnyCardanoEra where

   -- [e..] = [e..maxBound]
   enumFrom :: AnyCardanoEra -> [AnyCardanoEra]
enumFrom AnyCardanoEra
e = AnyCardanoEra -> AnyCardanoEra -> [AnyCardanoEra]
forall a. Enum a => a -> a -> [a]
enumFromTo AnyCardanoEra
e AnyCardanoEra
forall a. Bounded a => a
maxBound

   fromEnum :: AnyCardanoEra -> Int
fromEnum = \case
      AnyCardanoEra CardanoEra era
ByronEra   -> Int
0
      AnyCardanoEra CardanoEra era
ShelleyEra -> Int
1
      AnyCardanoEra CardanoEra era
AllegraEra -> Int
2
      AnyCardanoEra CardanoEra era
MaryEra    -> Int
3
      AnyCardanoEra CardanoEra era
AlonzoEra  -> Int
4

   toEnum :: Int -> AnyCardanoEra
toEnum = \case
      Int
0 -> CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
      Int
1 -> CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
      Int
2 -> CardanoEra AllegraEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
      Int
3 -> CardanoEra MaryEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
      Int
4 -> CardanoEra AlonzoEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra
      Int
n ->
         String -> AnyCardanoEra
forall a. HasCallStack => String -> a
error (String -> AnyCardanoEra) -> String -> AnyCardanoEra
forall a b. (a -> b) -> a -> b
$
            String
"AnyCardanoEra.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 AnyCardanoEra where
   toJSON :: AnyCardanoEra -> Value
toJSON (AnyCardanoEra CardanoEra era
era) = CardanoEra era -> Value
forall a. ToJSON a => a -> Value
toJSON CardanoEra era
era

-- | Like the 'AnyCardanoEra' constructor but does not demand a 'IsCardanoEra'
-- class constraint.
--
anyCardanoEra :: CardanoEra era -> AnyCardanoEra
anyCardanoEra :: CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
ByronEra   = CardanoEra ByronEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ByronEra
ByronEra
anyCardanoEra CardanoEra era
ShelleyEra = CardanoEra ShelleyEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra ShelleyEra
ShelleyEra
anyCardanoEra CardanoEra era
AllegraEra = CardanoEra AllegraEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AllegraEra
AllegraEra
anyCardanoEra CardanoEra era
MaryEra    = CardanoEra MaryEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra MaryEra
MaryEra
anyCardanoEra CardanoEra era
AlonzoEra  = CardanoEra AlonzoEra -> AnyCardanoEra
forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra AlonzoEra
AlonzoEra

-- | This pairs up some era-dependent type with a 'CardanoEra' 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 InAnyCardanoEra thing where
     InAnyCardanoEra :: IsCardanoEra era  -- Provide class constraint
                     => CardanoEra era    -- and explicit value.
                     -> thing era
                     -> InAnyCardanoEra thing


-- ----------------------------------------------------------------------------
-- 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

deriving instance Eq   (ShelleyBasedEra era)
deriving instance Ord  (ShelleyBasedEra era)
deriving instance Show (ShelleyBasedEra era)

-- | 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

-- | 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 :: IsShelleyBasedEra era -- Provide class constraint
                          => ShelleyBasedEra era   -- and explicit value.
                          -> thing era
                          -> InAnyShelleyBasedEra thing


-- | Converts a 'ShelleyBasedEra' to the broader 'CardanoEra'.
shelleyBasedToCardanoEra :: ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra :: ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra ShelleyBasedEra era
ShelleyBasedEraShelley = CardanoEra era
CardanoEra ShelleyEra
ShelleyEra
shelleyBasedToCardanoEra ShelleyBasedEra era
ShelleyBasedEraAllegra = CardanoEra era
CardanoEra AllegraEra
AllegraEra
shelleyBasedToCardanoEra ShelleyBasedEra era
ShelleyBasedEraMary    = CardanoEra era
CardanoEra MaryEra
MaryEra
shelleyBasedToCardanoEra ShelleyBasedEra era
ShelleyBasedEraAlonzo  = CardanoEra era
CardanoEra AlonzoEra
AlonzoEra


-- ----------------------------------------------------------------------------
-- Cardano eras factored as Byron vs Shelley-based
--

-- | This is the same essential information as 'CardanoEra' but instead of a
-- flat set of alternative eras, it is factored into the legcy Byron era and
-- the current Shelley-based eras.
--
-- This way of factoring the eras is useful because in many cases the
-- major differences are between the Byron and Shelley-based eras, and
-- the Shelley-based eras can often be treated uniformly.
--
data CardanoEraStyle era where
     LegacyByronEra  :: CardanoEraStyle ByronEra
     ShelleyBasedEra :: IsShelleyBasedEra era -- Also provide class constraint
                     => ShelleyBasedEra era
                     -> CardanoEraStyle era

deriving instance Eq   (CardanoEraStyle era)
deriving instance Ord  (CardanoEraStyle era)
deriving instance Show (CardanoEraStyle era)

-- | The 'CardanoEraStyle' for a 'CardanoEra'.
--
cardanoEraStyle :: CardanoEra era -> CardanoEraStyle era
cardanoEraStyle :: CardanoEra era -> CardanoEraStyle era
cardanoEraStyle CardanoEra era
ByronEra   = CardanoEraStyle era
CardanoEraStyle ByronEra
LegacyByronEra
cardanoEraStyle CardanoEra era
ShelleyEra = ShelleyBasedEra ShelleyEra -> CardanoEraStyle ShelleyEra
forall era.
IsShelleyBasedEra era =>
ShelleyBasedEra era -> CardanoEraStyle era
ShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
cardanoEraStyle CardanoEra era
AllegraEra = ShelleyBasedEra AllegraEra -> CardanoEraStyle AllegraEra
forall era.
IsShelleyBasedEra era =>
ShelleyBasedEra era -> CardanoEraStyle era
ShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
cardanoEraStyle CardanoEra era
MaryEra    = ShelleyBasedEra MaryEra -> CardanoEraStyle MaryEra
forall era.
IsShelleyBasedEra era =>
ShelleyBasedEra era -> CardanoEraStyle era
ShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary
cardanoEraStyle CardanoEra era
AlonzoEra  = ShelleyBasedEra AlonzoEra -> CardanoEraStyle AlonzoEra
forall era.
IsShelleyBasedEra era =>
ShelleyBasedEra era -> CardanoEraStyle era
ShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo


-- ----------------------------------------------------------------------------
-- 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 where

  ShelleyLedgerEra ShelleyEra = Ledger.StandardShelley
  ShelleyLedgerEra AllegraEra = Ledger.StandardAllegra
  ShelleyLedgerEra MaryEra    = Ledger.StandardMary
  ShelleyLedgerEra AlonzoEra  = Ledger.StandardAlonzo