{-# LANGUAGE RankNTypes #-}

module Cardano.Network.LedgerPeerConsensusInterface
  ( LedgerPeersConsensusInterface (..)
  , GetImmutableBlockPointError (..)
    -- * Re-exports
  , FetchMode (..)
  , LedgerStateJudgement (..)
  , OutboundConnectionsState (..)
  ) where

import Control.Concurrent.Class.MonadSTM (MonadSTM (..))

import Cardano.Network.LedgerStateJudgement
import Cardano.Network.PeerSelection.LocalRootPeers
           (OutboundConnectionsState (..))
import Ouroboros.Network.Block (Point)
import Ouroboros.Network.BlockFetch.ConsensusInterface (FetchMode (..))
import Ouroboros.Network.PeerSelection.LedgerPeers.Type (RawBlockHash)


-- | Error returned by 'getImmutableBlockPoint'.
--
data GetImmutableBlockPointError
  = -- | Genesis point was provided as the target, which has no slot or hash
    -- to look up.
    ImmutableBlockPointGenesisPoint
  | -- | The block was not found in ImmutableDB because the target slot
    -- is not yet immutable.
    ImmutableBlockPointNotYetImmutable
  | -- | ImmutableDB is empty (tip is at origin).
    ImmutableBlockPointTipIsOrigin
  deriving (Int -> GetImmutableBlockPointError -> ShowS
[GetImmutableBlockPointError] -> ShowS
GetImmutableBlockPointError -> String
(Int -> GetImmutableBlockPointError -> ShowS)
-> (GetImmutableBlockPointError -> String)
-> ([GetImmutableBlockPointError] -> ShowS)
-> Show GetImmutableBlockPointError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetImmutableBlockPointError -> ShowS
showsPrec :: Int -> GetImmutableBlockPointError -> ShowS
$cshow :: GetImmutableBlockPointError -> String
show :: GetImmutableBlockPointError -> String
$cshowList :: [GetImmutableBlockPointError] -> ShowS
showList :: [GetImmutableBlockPointError] -> ShowS
Show, GetImmutableBlockPointError -> GetImmutableBlockPointError -> Bool
(GetImmutableBlockPointError
 -> GetImmutableBlockPointError -> Bool)
-> (GetImmutableBlockPointError
    -> GetImmutableBlockPointError -> Bool)
-> Eq GetImmutableBlockPointError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetImmutableBlockPointError -> GetImmutableBlockPointError -> Bool
== :: GetImmutableBlockPointError -> GetImmutableBlockPointError -> Bool
$c/= :: GetImmutableBlockPointError -> GetImmutableBlockPointError -> Bool
/= :: GetImmutableBlockPointError -> GetImmutableBlockPointError -> Bool
Eq)


-- | Cardano Node specific consensus interface actions.
--
data LedgerPeersConsensusInterface m =
  LedgerPeersConsensusInterface {
    -- | Required for BlockFetch protocol
    forall (m :: * -> *).
LedgerPeersConsensusInterface m -> STM m FetchMode
readFetchMode                  :: STM m FetchMode

  , forall (m :: * -> *).
LedgerPeersConsensusInterface m -> STM m LedgerStateJudgement
getLedgerStateJudgement        :: STM m LedgerStateJudgement

    -- | Callback provided by consensus to inform it if the node is
    -- connected to only local roots or also some external peers.
    --
    -- This is useful in order for the Bootstrap State Machine to
    -- simply refuse to transition from TooOld to YoungEnough while
    -- it only has local peers.
    --
  , forall (m :: * -> *).
LedgerPeersConsensusInterface m
-> OutboundConnectionsState -> STM m ()
updateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()

  -- | Ask the Consensus layer's immutable DB for a point. The callback will yield either:
  --   - the block at the target slot if there is a block in the immutable DB at that slot;
  --   - or the block from the next occupied slot.
  , forall (m :: * -> *).
LedgerPeersConsensusInterface m
-> forall r.
   Point RawBlockHash
   -> (m (Either GetImmutableBlockPointError (Point RawBlockHash))
       -> m r)
   -> m r
getImmutableBlockPoint
      :: forall r. Point RawBlockHash
      -> (m (Either GetImmutableBlockPointError (Point RawBlockHash)) -> m r)
      -> m r
  }