{-# LANGUAGE LambdaCase #-}

module Cardano.Network.FetchMode
  ( mkReadFetchMode
  , ConsensusMode (..)
  , LedgerStateJudgement (..)
  , module Ouroboros.Network.BlockFetch.ConsensusInterface
  ) where

import Data.Functor ((<&>))

import Cardano.Network.ConsensusMode
import Cardano.Network.LedgerStateJudgement
import Ouroboros.Network.BlockFetch.ConsensusInterface


-- | Construct 'readFetchMode' for 'BlockFetchConsensusInterface' by branching
-- on the 'ConsensusMode'.
mkReadFetchMode
  :: Functor m
  => ConsensusMode
  -> m LedgerStateJudgement
     -- ^ Used for 'GenesisMode'.
  -> m PraosFetchMode
     -- ^ Used for 'PraosMode' for backwards compatibility.
  -> m FetchMode
mkReadFetchMode :: forall (m :: * -> *).
Functor m =>
ConsensusMode
-> m LedgerStateJudgement -> m PraosFetchMode -> m FetchMode
mkReadFetchMode ConsensusMode
consensusMode m LedgerStateJudgement
getLedgerStateJudgement m PraosFetchMode
getFetchMode =
    case ConsensusMode
consensusMode of
      ConsensusMode
GenesisMode -> m LedgerStateJudgement
getLedgerStateJudgement m LedgerStateJudgement
-> (LedgerStateJudgement -> FetchMode) -> m FetchMode
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        LedgerStateJudgement
YoungEnough -> PraosFetchMode -> FetchMode
PraosFetchMode PraosFetchMode
FetchModeDeadline
        LedgerStateJudgement
TooOld      -> FetchMode
FetchModeGenesis
      ConsensusMode
PraosMode   -> PraosFetchMode -> FetchMode
PraosFetchMode (PraosFetchMode -> FetchMode) -> m PraosFetchMode -> m FetchMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PraosFetchMode
getFetchMode