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

-- | Generic infrastructure for working with EBBs
module Ouroboros.Consensus.Block.EBB (
    IsEBB (..)
  , fromIsEBB
  , toIsEBB
  ) where

import           Codec.Serialise (Serialise (..))
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)

import           Ouroboros.Consensus.Util.Condense

{-------------------------------------------------------------------------------
  EBBs
-------------------------------------------------------------------------------}

-- | Whether a block is an Epoch Boundary Block (EBB)
--
-- See "Ouroboros.Storage.ImmutableDB.API" for a discussion of EBBs. Key
-- idiosyncracies:
--
--  * An EBB carries no unique information.
--
--  * An EBB has the same 'BlockNo' as its predecessor.
--
--  * EBBs are vestigial. As of Shelley, nodes no longer forge EBBs: they are
--    only a legacy/backwards-compatibility concern.
data IsEBB
  = IsEBB
  | IsNotEBB
  deriving (IsEBB -> IsEBB -> Bool
(IsEBB -> IsEBB -> Bool) -> (IsEBB -> IsEBB -> Bool) -> Eq IsEBB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsEBB -> IsEBB -> Bool
$c/= :: IsEBB -> IsEBB -> Bool
== :: IsEBB -> IsEBB -> Bool
$c== :: IsEBB -> IsEBB -> Bool
Eq, Int -> IsEBB -> ShowS
[IsEBB] -> ShowS
IsEBB -> String
(Int -> IsEBB -> ShowS)
-> (IsEBB -> String) -> ([IsEBB] -> ShowS) -> Show IsEBB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsEBB] -> ShowS
$cshowList :: [IsEBB] -> ShowS
show :: IsEBB -> String
$cshow :: IsEBB -> String
showsPrec :: Int -> IsEBB -> ShowS
$cshowsPrec :: Int -> IsEBB -> ShowS
Show, (forall x. IsEBB -> Rep IsEBB x)
-> (forall x. Rep IsEBB x -> IsEBB) -> Generic IsEBB
forall x. Rep IsEBB x -> IsEBB
forall x. IsEBB -> Rep IsEBB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsEBB x -> IsEBB
$cfrom :: forall x. IsEBB -> Rep IsEBB x
Generic, Context -> IsEBB -> IO (Maybe ThunkInfo)
Proxy IsEBB -> String
(Context -> IsEBB -> IO (Maybe ThunkInfo))
-> (Context -> IsEBB -> IO (Maybe ThunkInfo))
-> (Proxy IsEBB -> String)
-> NoThunks IsEBB
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy IsEBB -> String
$cshowTypeOf :: Proxy IsEBB -> String
wNoThunks :: Context -> IsEBB -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> IsEBB -> IO (Maybe ThunkInfo)
noThunks :: Context -> IsEBB -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> IsEBB -> IO (Maybe ThunkInfo)
NoThunks)

instance Serialise IsEBB where
  encode :: IsEBB -> Encoding
encode = Bool -> Encoding
forall a. Serialise a => a -> Encoding
encode (Bool -> Encoding) -> (IsEBB -> Bool) -> IsEBB -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsEBB -> Bool
fromIsEBB
  decode :: Decoder s IsEBB
decode = Bool -> IsEBB
toIsEBB (Bool -> IsEBB) -> Decoder s Bool -> Decoder s IsEBB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Bool
forall a s. Serialise a => Decoder s a
decode

instance Condense IsEBB where
  condense :: IsEBB -> String
condense = IsEBB -> String
forall a. Show a => a -> String
show

toIsEBB :: Bool -> IsEBB
toIsEBB :: Bool -> IsEBB
toIsEBB Bool
b = if Bool
b then IsEBB
IsEBB else IsEBB
IsNotEBB

fromIsEBB :: IsEBB -> Bool
fromIsEBB :: IsEBB -> Bool
fromIsEBB IsEBB
IsEBB    = Bool
True
fromIsEBB IsEBB
IsNotEBB = Bool
False