{-# LANGUAGE ConstraintKinds         #-}
{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE PolyKinds               #-}
{-# LANGUAGE RankNTypes              #-}
{-# LANGUAGE ScopedTypeVariables     #-}
{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Ouroboros.Consensus.Cardano.ShelleyBased (overShelleyBasedLedgerState) where

import           Data.SOP.Strict hiding (All2)
import           Ouroboros.Consensus.Cardano.Block
import           Ouroboros.Consensus.HardFork.Combinator
import qualified Ouroboros.Consensus.Protocol.Praos as Praos
import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos
import           Ouroboros.Consensus.Shelley.HFEras ()
import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
                     ShelleyCompatible)

-- | When the given ledger state corresponds to a Shelley-based era, apply the
-- given function to it.
overShelleyBasedLedgerState ::
     forall c.
     (TPraos.PraosCrypto c, Praos.PraosCrypto c)
  => (   forall era proto. (EraCrypto era ~ c, ShelleyCompatible proto era)
      => LedgerState (ShelleyBlock proto era)
      -> LedgerState (ShelleyBlock proto era)
     )
  -> LedgerState (CardanoBlock c)
  -> LedgerState (CardanoBlock c)
overShelleyBasedLedgerState :: (forall era proto.
 (EraCrypto era ~ c, ShelleyCompatible proto era) =>
 LedgerState (ShelleyBlock proto era)
 -> LedgerState (ShelleyBlock proto era))
-> LedgerState (CardanoBlock c) -> LedgerState (CardanoBlock c)
overShelleyBasedLedgerState forall era proto.
(EraCrypto era ~ c, ShelleyCompatible proto era) =>
LedgerState (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era)
f (HardForkLedgerState st) =
    HardForkState LedgerState (CardanoEras c)
-> LedgerState (CardanoBlock c)
forall (xs :: [*]).
HardForkState LedgerState xs -> LedgerState (HardForkBlock xs)
HardForkLedgerState (HardForkState LedgerState (CardanoEras c)
 -> LedgerState (CardanoBlock c))
-> HardForkState LedgerState (CardanoEras c)
-> LedgerState (CardanoBlock c)
forall a b. (a -> b) -> a -> b
$ Prod HardForkState (LedgerState -.-> LedgerState) (CardanoEras c)
-> HardForkState LedgerState (CardanoEras c)
-> HardForkState LedgerState (CardanoEras c)
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
hap NP (LedgerState -.-> LedgerState) (CardanoEras c)
Prod HardForkState (LedgerState -.-> LedgerState) (CardanoEras c)
fs HardForkState LedgerState (CardanoEras c)
st
  where
    fs :: NP (LedgerState -.-> LedgerState)
             (CardanoEras c)
    fs :: NP (LedgerState -.-> LedgerState) (CardanoEras c)
fs = (LedgerState ByronBlock -> LedgerState ByronBlock)
-> (-.->) LedgerState LedgerState ByronBlock
forall k (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState ByronBlock -> LedgerState ByronBlock
forall a. a -> a
id
        (-.->) LedgerState LedgerState ByronBlock
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (TPraos c) (ShelleyEra c),
       ShelleyBlock (TPraos c) (AllegraEra c),
       ShelleyBlock (TPraos c) (MaryEra c),
       ShelleyBlock (TPraos c) (AlonzoEra c),
       ShelleyBlock (Praos c) (BabbageEra c)]
-> NP (LedgerState -.-> LedgerState) (CardanoEras c)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* (-.->)
  LedgerState LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
forall proto era shelleyEra.
(ShelleyCompatible proto era, EraCrypto era ~ c,
 shelleyEra ~ ShelleyBlock proto era) =>
(-.->) LedgerState LedgerState shelleyEra
injectSingleEra
        (-.->)
  LedgerState LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (TPraos c) (AllegraEra c),
       ShelleyBlock (TPraos c) (MaryEra c),
       ShelleyBlock (TPraos c) (AlonzoEra c),
       ShelleyBlock (Praos c) (BabbageEra c)]
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (TPraos c) (ShelleyEra c),
       ShelleyBlock (TPraos c) (AllegraEra c),
       ShelleyBlock (TPraos c) (MaryEra c),
       ShelleyBlock (TPraos c) (AlonzoEra c),
       ShelleyBlock (Praos c) (BabbageEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* (-.->)
  LedgerState LedgerState (ShelleyBlock (TPraos c) (AllegraEra c))
forall proto era shelleyEra.
(ShelleyCompatible proto era, EraCrypto era ~ c,
 shelleyEra ~ ShelleyBlock proto era) =>
(-.->) LedgerState LedgerState shelleyEra
injectSingleEra
        (-.->)
  LedgerState LedgerState (ShelleyBlock (TPraos c) (AllegraEra c))
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (TPraos c) (MaryEra c),
       ShelleyBlock (TPraos c) (AlonzoEra c),
       ShelleyBlock (Praos c) (BabbageEra c)]
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (TPraos c) (AllegraEra c),
       ShelleyBlock (TPraos c) (MaryEra c),
       ShelleyBlock (TPraos c) (AlonzoEra c),
       ShelleyBlock (Praos c) (BabbageEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* (-.->)
  LedgerState LedgerState (ShelleyBlock (TPraos c) (MaryEra c))
forall proto era shelleyEra.
(ShelleyCompatible proto era, EraCrypto era ~ c,
 shelleyEra ~ ShelleyBlock proto era) =>
(-.->) LedgerState LedgerState shelleyEra
injectSingleEra
        (-.->)
  LedgerState LedgerState (ShelleyBlock (TPraos c) (MaryEra c))
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (TPraos c) (AlonzoEra c),
       ShelleyBlock (Praos c) (BabbageEra c)]
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (TPraos c) (MaryEra c),
       ShelleyBlock (TPraos c) (AlonzoEra c),
       ShelleyBlock (Praos c) (BabbageEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* (-.->)
  LedgerState LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c))
forall proto era shelleyEra.
(ShelleyCompatible proto era, EraCrypto era ~ c,
 shelleyEra ~ ShelleyBlock proto era) =>
(-.->) LedgerState LedgerState shelleyEra
injectSingleEra
        (-.->)
  LedgerState LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c))
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (Praos c) (BabbageEra c)]
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (TPraos c) (AlonzoEra c),
       ShelleyBlock (Praos c) (BabbageEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* (-.->)
  LedgerState LedgerState (ShelleyBlock (Praos c) (BabbageEra c))
forall proto era shelleyEra.
(ShelleyCompatible proto era, EraCrypto era ~ c,
 shelleyEra ~ ShelleyBlock proto era) =>
(-.->) LedgerState LedgerState shelleyEra
injectSingleEra
        (-.->)
  LedgerState LedgerState (ShelleyBlock (Praos c) (BabbageEra c))
-> NP (LedgerState -.-> LedgerState) '[]
-> NP
     (LedgerState -.-> LedgerState)
     '[ShelleyBlock (Praos c) (BabbageEra c)]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (LedgerState -.-> LedgerState) '[]
forall k (a :: k -> *). NP a '[]
Nil

    injectSingleEra ::
      ( ShelleyCompatible proto era, EraCrypto era ~ c
      , shelleyEra ~ ShelleyBlock proto era
      )
      => (LedgerState -.-> LedgerState) shelleyEra
    injectSingleEra :: (-.->) LedgerState LedgerState shelleyEra
injectSingleEra = (LedgerState (ShelleyBlock proto era)
 -> LedgerState (ShelleyBlock proto era))
-> (-.->) LedgerState LedgerState (ShelleyBlock proto era)
forall k (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn LedgerState (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era)
forall era proto.
(EraCrypto era ~ c, ShelleyCompatible proto era) =>
LedgerState (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era)
f