{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Ouroboros.Consensus.Block.SupportsProtocol (BlockSupportsProtocol (..)) where

import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block.Abstract
import Ouroboros.Consensus.Protocol.Abstract

{-------------------------------------------------------------------------------
  Supported blocks
-------------------------------------------------------------------------------}

-- | Evidence that a block supports its protocol
class
  ( GetHeader blk
  , GetPrevHash blk
  , ConsensusProtocol (BlockProtocol blk)
  , NoThunks (Header blk)
  , NoThunks (BlockConfig blk)
  , NoThunks (CodecConfig blk)
  , NoThunks (StorageConfig blk)
  ) =>
  BlockSupportsProtocol blk
  where
  validateView ::
    BlockConfig blk ->
    Header blk ->
    ValidateView (BlockProtocol blk)

  selectView ::
    BlockConfig blk ->
    Header blk ->
    SelectView (BlockProtocol blk)
  -- Default chain selection just looks at longest chains
  default selectView ::
    SelectView (BlockProtocol blk) ~ BlockNo =>
    BlockConfig blk ->
    Header blk ->
    SelectView (BlockProtocol blk)
  selectView BlockConfig blk
_ = Header blk -> BlockNo
Header blk -> SelectView (BlockProtocol blk)
forall b. HasHeader b => b -> BlockNo
blockNo

  projectChainOrderConfig ::
    BlockConfig blk ->
    ChainOrderConfig (SelectView (BlockProtocol blk))
  default projectChainOrderConfig ::
    ChainOrderConfig (SelectView (BlockProtocol blk)) ~ () =>
    BlockConfig blk ->
    ChainOrderConfig (SelectView (BlockProtocol blk))
  projectChainOrderConfig BlockConfig blk
_ = ()