{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE PatternSynonyms    #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies       #-}

module Ouroboros.Consensus.Block.Abstract (
    -- * Protocol
    BlockProtocol
    -- * Configuration
  , BlockConfig
  , CodecConfig
  , StorageConfig
    -- * Previous hash
  , GetPrevHash (..)
  , blockPrevHash
    -- * Working with headers
  , GetHeader (..)
  , Header
  , blockIsEBB
  , blockToIsEBB
  , getBlockHeaderFields
  , headerHash
  , headerPoint
  , headerToIsEBB
    -- * Raw hash
  , ConvertRawHash (..)
  , decodeRawHash
  , encodeRawHash
    -- * Utilities for working with WithOrigin
  , succWithOrigin
    -- * Re-export basic definitions from @ouroboros-network@
  , ChainHash (..)
  , HasHeader (..)
  , HeaderFields (..)
  , HeaderHash
  , Point (GenesisPoint, BlockPoint)
  , StandardHash
  , blockHash
  , blockNo
  , blockPoint
  , blockSlot
  , castHash
  , castHeaderFields
  , castPoint
  , pointHash
  , pointSlot
    -- * Re-export basic definitions from @cardano-base@
  , BlockNo (..)
  , EpochNo (..)
  , EpochSize (..)
  , SlotNo (..)
  , WithOrigin (Origin, NotOrigin)
  , fromWithOrigin
  , withOrigin
  , withOriginFromMaybe
  , withOriginToMaybe
  ) where

import qualified Codec.Serialise as Serialise
import           Codec.Serialise.Decoding (Decoder)
import           Codec.Serialise.Encoding (Encoding)
import qualified Data.ByteString as Strict
import           Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as Short
import           Data.Kind (Type)
import           Data.Maybe (isJust)
import           Data.Word (Word32)

import           Cardano.Slotting.Block (BlockNo (..))
import           Cardano.Slotting.Slot (EpochNo (..), EpochSize (..),
                     SlotNo (..), WithOrigin (Origin), fromWithOrigin,
                     withOrigin, withOriginFromMaybe, withOriginToMaybe)
import qualified Cardano.Slotting.Slot as Cardano

import           Ouroboros.Network.Block (ChainHash (..), HasHeader (..),
                     HeaderFields (..), HeaderHash, Point, StandardHash,
                     blockHash, blockNo, blockPoint, blockSlot, castHash,
                     castHeaderFields, castPoint, pattern BlockPoint,
                     pattern GenesisPoint, pointHash, pointSlot)

import           Ouroboros.Consensus.Block.EBB

{-------------------------------------------------------------------------------
  Protocol
-------------------------------------------------------------------------------}

-- | Map block to consensus protocol
type family BlockProtocol blk :: Type

{-------------------------------------------------------------------------------
  Configuration
-------------------------------------------------------------------------------}

-- | Static configuration required to work with this type of blocks
data family BlockConfig blk :: Type

-- | Static configuration required for serialisation and deserialisation of
-- types pertaining to this type of block.
--
-- Data family instead of type family to get better type inference.
data family CodecConfig blk :: Type

-- | Config needed for the
-- 'Ouroboros.Consensus.Node.InitStorage.NodeInitStorage' class. Defined here to
-- avoid circular dependencies.
data family StorageConfig blk :: Type

{-------------------------------------------------------------------------------
  Get hash of previous block
-------------------------------------------------------------------------------}

class (HasHeader blk, GetHeader blk) => GetPrevHash blk where
  -- | Get the hash of the predecessor of this block
  headerPrevHash :: Header blk -> ChainHash blk

blockPrevHash :: GetPrevHash blk => blk -> ChainHash blk
blockPrevHash :: blk -> ChainHash blk
blockPrevHash = ChainHash blk -> ChainHash blk
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
ChainHash b -> ChainHash b'
castHash (ChainHash blk -> ChainHash blk)
-> (blk -> ChainHash blk) -> blk -> ChainHash blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header blk -> ChainHash blk
forall blk. GetPrevHash blk => Header blk -> ChainHash blk
headerPrevHash (Header blk -> ChainHash blk)
-> (blk -> Header blk) -> blk -> ChainHash blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader

{-------------------------------------------------------------------------------
  Link block to its header
-------------------------------------------------------------------------------}

data family Header blk :: Type

class HasHeader (Header blk) => GetHeader blk where
  getHeader          :: blk -> Header blk
  -- | Check whether the header is the header of the block.
  --
  -- For example, by checking whether the hash of the body stored in the
  -- header matches that of the block.
  blockMatchesHeader :: Header blk -> blk -> Bool

  -- | When the given header is the header of an Epoch Boundary Block, returns
  -- its epoch number.
  headerIsEBB        :: Header blk -> Maybe EpochNo

headerToIsEBB :: GetHeader blk => Header blk -> IsEBB
headerToIsEBB :: Header blk -> IsEBB
headerToIsEBB = Bool -> IsEBB
toIsEBB (Bool -> IsEBB) -> (Header blk -> Bool) -> Header blk -> IsEBB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe EpochNo -> Bool
forall a. Maybe a -> Bool
isJust (Maybe EpochNo -> Bool)
-> (Header blk -> Maybe EpochNo) -> Header blk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header blk -> Maybe EpochNo
forall blk. GetHeader blk => Header blk -> Maybe EpochNo
headerIsEBB

blockIsEBB :: GetHeader blk => blk -> Maybe EpochNo
blockIsEBB :: blk -> Maybe EpochNo
blockIsEBB = Header blk -> Maybe EpochNo
forall blk. GetHeader blk => Header blk -> Maybe EpochNo
headerIsEBB (Header blk -> Maybe EpochNo)
-> (blk -> Header blk) -> blk -> Maybe EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader

blockToIsEBB :: GetHeader blk => blk -> IsEBB
blockToIsEBB :: blk -> IsEBB
blockToIsEBB = Header blk -> IsEBB
forall blk. GetHeader blk => Header blk -> IsEBB
headerToIsEBB (Header blk -> IsEBB) -> (blk -> Header blk) -> blk -> IsEBB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader

type instance BlockProtocol (Header blk) = BlockProtocol blk

{-------------------------------------------------------------------------------
  Some automatic instances for 'Header'
-------------------------------------------------------------------------------}

type instance HeaderHash (Header blk) = HeaderHash blk

instance HasHeader blk => StandardHash (Header blk)

-- | Get the 'HeaderFields' of a block, without requiring 'HasHeader blk'
--
-- This is primarily useful as a a simple definition of 'HasHeader' for
-- block types:
--
-- > instance HasHeader SomeBlock where
-- >   getHeaderFields = getBlockHeaderFields
--
-- provided that there is a 'HasHeader' instance for the header.
--
-- Unfortunately we cannot give a 'HasHeader' instance once and for all; if we
-- mapped from a header to a block instead we could do
--
-- > instance HasHeader hdr => HasHeader (Block hdr) where
-- >  ..
--
-- but we can't do that when we do things this way around.
getBlockHeaderFields :: GetHeader blk => blk -> HeaderFields blk
getBlockHeaderFields :: blk -> HeaderFields blk
getBlockHeaderFields = HeaderFields (Header blk) -> HeaderFields blk
forall b b'.
(HeaderHash b ~ HeaderHash b') =>
HeaderFields b -> HeaderFields b'
castHeaderFields (HeaderFields (Header blk) -> HeaderFields blk)
-> (blk -> HeaderFields (Header blk)) -> blk -> HeaderFields blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header blk -> HeaderFields (Header blk)
forall b. HasHeader b => b -> HeaderFields b
getHeaderFields (Header blk -> HeaderFields (Header blk))
-> (blk -> Header blk) -> blk -> HeaderFields (Header blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader

{-------------------------------------------------------------------------------
  Convenience wrappers around 'HasHeader' that avoids unnecessary casts
-------------------------------------------------------------------------------}

headerHash :: HasHeader (Header blk) => Header blk -> HeaderHash blk
headerHash :: Header blk -> HeaderHash blk
headerHash = Header blk -> HeaderHash blk
forall b. HasHeader b => b -> HeaderHash b
blockHash

headerPoint :: HasHeader (Header blk) => Header blk -> Point blk
headerPoint :: Header blk -> Point blk
headerPoint = Point (Header blk) -> Point blk
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Header blk) -> Point blk)
-> (Header blk -> Point (Header blk)) -> Header blk -> Point blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header blk -> Point (Header blk)
forall block. HasHeader block => block -> Point block
blockPoint

{-------------------------------------------------------------------------------
  Raw hash
-------------------------------------------------------------------------------}

-- | Convert a hash from/to raw bytes
--
-- Variants of 'toRawHash' and 'fromRawHash' for 'ShortByteString' are
-- included. Override the default implementations to avoid an extra step in
-- case the 'HeaderHash' is a 'ShortByteString' under the hood.
class ConvertRawHash blk where
  -- | Get the raw bytes from a hash
  toRawHash :: proxy blk -> HeaderHash blk -> Strict.ByteString
  toRawHash proxy blk
p = ShortByteString -> ByteString
Short.fromShort (ShortByteString -> ByteString)
-> (HeaderHash blk -> ShortByteString)
-> HeaderHash blk
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy blk -> HeaderHash blk -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
toShortRawHash proxy blk
p

  -- | Construct the hash from a raw hash
  --
  -- PRECONDITION: the bytestring's size must match 'hashSize'
  fromRawHash :: proxy blk -> Strict.ByteString -> HeaderHash blk
  fromRawHash proxy blk
p = proxy blk -> ShortByteString -> HeaderHash blk
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
fromShortRawHash proxy blk
p (ShortByteString -> HeaderHash blk)
-> (ByteString -> ShortByteString) -> ByteString -> HeaderHash blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
Short.toShort

  -- | Variant of 'toRawHash' for 'ShortByteString'
  toShortRawHash :: proxy blk -> HeaderHash blk -> ShortByteString
  toShortRawHash proxy blk
p = ByteString -> ShortByteString
Short.toShort (ByteString -> ShortByteString)
-> (HeaderHash blk -> ByteString)
-> HeaderHash blk
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy blk -> HeaderHash blk -> ByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ByteString
toRawHash proxy blk
p

  -- | Variant of 'fromRawHash' for 'ShortByteString'
  fromShortRawHash :: proxy blk -> ShortByteString -> HeaderHash blk
  fromShortRawHash proxy blk
p = proxy blk -> ByteString -> HeaderHash blk
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ByteString -> HeaderHash blk
fromRawHash proxy blk
p (ByteString -> HeaderHash blk)
-> (ShortByteString -> ByteString)
-> ShortByteString
-> HeaderHash blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
Short.fromShort

  -- | The size of the hash in number of bytes
  hashSize :: proxy blk -> Word32

  {-# MINIMAL hashSize
            , (toRawHash | toShortRawHash)
            , (fromRawHash | fromShortRawHash) #-}

encodeRawHash :: ConvertRawHash blk
              => proxy blk -> HeaderHash blk -> Encoding
encodeRawHash :: proxy blk -> HeaderHash blk -> Encoding
encodeRawHash proxy blk
p = ShortByteString -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode (ShortByteString -> Encoding)
-> (HeaderHash blk -> ShortByteString)
-> HeaderHash blk
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy blk -> HeaderHash blk -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
toShortRawHash proxy blk
p

decodeRawHash :: ConvertRawHash blk
              => proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash :: proxy blk -> forall s. Decoder s (HeaderHash blk)
decodeRawHash proxy blk
p = proxy blk -> ShortByteString -> HeaderHash blk
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
fromShortRawHash proxy blk
p (ShortByteString -> HeaderHash blk)
-> Decoder s ShortByteString -> Decoder s (HeaderHash blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ShortByteString
forall a s. Serialise a => Decoder s a
Serialise.decode

{-------------------------------------------------------------------------------
  Utilities for working with WithOrigin
-------------------------------------------------------------------------------}

{-# COMPLETE Origin, NotOrigin #-}

-- | Custom pattern for 'WithOrigin'
--
-- This avoids clashing with our (extensive) use of 'At' for testing.
pattern NotOrigin :: t -> WithOrigin t
pattern $bNotOrigin :: t -> WithOrigin t
$mNotOrigin :: forall r t. WithOrigin t -> (t -> r) -> (Void# -> r) -> r
NotOrigin t = Cardano.At t

-- | Return the successor of a 'WithOrigin' value. Useful in combination with
-- 'SlotNo' and 'BlockNo'.
succWithOrigin :: (Bounded t, Enum t) => WithOrigin t -> t
succWithOrigin :: WithOrigin t -> t
succWithOrigin = t -> (t -> t) -> WithOrigin t -> t
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin t
forall a. Bounded a => a
minBound t -> t
forall a. Enum a => a -> a
succ