{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric  #-}

module Ouroboros.Consensus.HardFork.Combinator.State.Types (
    -- * Main types
    HardForkState(..)
  , Current(..)
  , Past(..)
    -- * Supporting types
  , Translate(..)
  , TranslateForecast(..)
  , TransitionInfo(..)
  ) where

import           Prelude hiding (sequence)

import           Control.Monad.Except
import           Data.SOP.Strict (K)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Forecast
import           Ouroboros.Consensus.HardFork.History (Bound)
import           Ouroboros.Consensus.Ticked

import           Ouroboros.Consensus.HardFork.Combinator.Util.Telescope
                     (Telescope)

{-------------------------------------------------------------------------------
  Types
-------------------------------------------------------------------------------}

-- | Generic hard fork state
--
-- This is used both for the consensus state and the ledger state.
newtype HardForkState f xs = HardForkState {
      HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState :: Telescope (K Past) (Current f) xs
    }

-- | Information about the current era
data Current f blk = Current {
      Current f blk -> Bound
currentStart :: !Bound
    , Current f blk -> f blk
currentState :: !(f blk)
    }
  deriving ((forall x. Current f blk -> Rep (Current f blk) x)
-> (forall x. Rep (Current f blk) x -> Current f blk)
-> Generic (Current f blk)
forall x. Rep (Current f blk) x -> Current f blk
forall x. Current f blk -> Rep (Current f blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) blk x. Rep (Current f blk) x -> Current f blk
forall (f :: * -> *) blk x. Current f blk -> Rep (Current f blk) x
$cto :: forall (f :: * -> *) blk x. Rep (Current f blk) x -> Current f blk
$cfrom :: forall (f :: * -> *) blk x. Current f blk -> Rep (Current f blk) x
Generic)

-- | Information about a past era
data Past = Past {
      Past -> Bound
pastStart :: !Bound
    , Past -> Bound
pastEnd   :: !Bound
    }
  deriving (Past -> Past -> Bool
(Past -> Past -> Bool) -> (Past -> Past -> Bool) -> Eq Past
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Past -> Past -> Bool
$c/= :: Past -> Past -> Bool
== :: Past -> Past -> Bool
$c== :: Past -> Past -> Bool
Eq, Int -> Past -> ShowS
[Past] -> ShowS
Past -> String
(Int -> Past -> ShowS)
-> (Past -> String) -> ([Past] -> ShowS) -> Show Past
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Past] -> ShowS
$cshowList :: [Past] -> ShowS
show :: Past -> String
$cshow :: Past -> String
showsPrec :: Int -> Past -> ShowS
$cshowsPrec :: Int -> Past -> ShowS
Show, (forall x. Past -> Rep Past x)
-> (forall x. Rep Past x -> Past) -> Generic Past
forall x. Rep Past x -> Past
forall x. Past -> Rep Past x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Past x -> Past
$cfrom :: forall x. Past -> Rep Past x
Generic, Context -> Past -> IO (Maybe ThunkInfo)
Proxy Past -> String
(Context -> Past -> IO (Maybe ThunkInfo))
-> (Context -> Past -> IO (Maybe ThunkInfo))
-> (Proxy Past -> String)
-> NoThunks Past
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Past -> String
$cshowTypeOf :: Proxy Past -> String
wNoThunks :: Context -> Past -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Past -> IO (Maybe ThunkInfo)
noThunks :: Context -> Past -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Past -> IO (Maybe ThunkInfo)
NoThunks)

{-------------------------------------------------------------------------------
  Supporting types
-------------------------------------------------------------------------------}

-- | Translate @f x@ to @f y@ across an era transition
--
-- Typically @f@ will be 'LedgerState' or 'WrapChainDepState'.
newtype Translate f x y = Translate {
      Translate f x y -> EpochNo -> f x -> f y
translateWith :: EpochNo -> f x -> f y
    }

-- | Translate (a forecast of) @f x@ to (a forecast of) @f y@
-- across an era transition.
--
-- Typically @f@ will be 'WrapLedgerView'.
--
-- In addition to the 'Bound' of the transition, this is also told the
-- 'SlotNo' we're constructing a forecast for. This enables the translation
-- function to take into account any scheduled changes that the final ledger
-- view in the preceding era might have.
newtype TranslateForecast f g x y = TranslateForecast {
      TranslateForecast f g x y
-> Bound
-> SlotNo
-> f x
-> Except OutsideForecastRange (Ticked (g y))
translateForecastWith ::
           Bound    -- 'Bound' of the transition (start of the new era)
        -> SlotNo   -- 'SlotNo' we're constructing a forecast for
        -> f x
        -> Except OutsideForecastRange (Ticked (g y))
    }

-- | Knowledge in a particular era of the transition to the next era
data TransitionInfo =
    -- | No transition is yet known for this era
    -- We instead record the ledger tip (which must be in /this/ era)
    --
    -- NOTE: If we are forecasting, this will be set to the slot number of the
    -- (past) ledger state in which the forecast was created. This means that
    -- when we construct an 'EpochInfo' using a 'HardForkLedgerView', the
    -- range of that 'EpochInfo' will extend a safe zone from that /past/
    -- ledger state.
    TransitionUnknown !(WithOrigin SlotNo)

    -- | Transition to the next era is known to happen at this 'EpochNo'
  | TransitionKnown !EpochNo

    -- | The transition is impossible
    --
    -- This can be due to one of two reasons:
    --
    -- * We are in the final era
    -- * This era has not actually begun yet (we are forecasting). In this case,
    --   we cannot look past the safe zone of this era and hence, by definition,
    --   the transition to the /next/ era cannot happen.
  | TransitionImpossible
  deriving (Int -> TransitionInfo -> ShowS
[TransitionInfo] -> ShowS
TransitionInfo -> String
(Int -> TransitionInfo -> ShowS)
-> (TransitionInfo -> String)
-> ([TransitionInfo] -> ShowS)
-> Show TransitionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransitionInfo] -> ShowS
$cshowList :: [TransitionInfo] -> ShowS
show :: TransitionInfo -> String
$cshow :: TransitionInfo -> String
showsPrec :: Int -> TransitionInfo -> ShowS
$cshowsPrec :: Int -> TransitionInfo -> ShowS
Show, (forall x. TransitionInfo -> Rep TransitionInfo x)
-> (forall x. Rep TransitionInfo x -> TransitionInfo)
-> Generic TransitionInfo
forall x. Rep TransitionInfo x -> TransitionInfo
forall x. TransitionInfo -> Rep TransitionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransitionInfo x -> TransitionInfo
$cfrom :: forall x. TransitionInfo -> Rep TransitionInfo x
Generic, Context -> TransitionInfo -> IO (Maybe ThunkInfo)
Proxy TransitionInfo -> String
(Context -> TransitionInfo -> IO (Maybe ThunkInfo))
-> (Context -> TransitionInfo -> IO (Maybe ThunkInfo))
-> (Proxy TransitionInfo -> String)
-> NoThunks TransitionInfo
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy TransitionInfo -> String
$cshowTypeOf :: Proxy TransitionInfo -> String
wNoThunks :: Context -> TransitionInfo -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TransitionInfo -> IO (Maybe ThunkInfo)
noThunks :: Context -> TransitionInfo -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> TransitionInfo -> IO (Maybe ThunkInfo)
NoThunks)