{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes     #-}
module Ouroboros.Network.ConnectionManager.InformationChannel
  ( InformationChannel (..)
  , InboundGovernorInfoChannel
  , newInformationChannel
  ) where

import Control.Concurrent.Class.MonadSTM.Strict

import Data.Functor (($>))
import GHC.Natural (Natural)
import Network.Mux qualified as Mux
import Ouroboros.Network.ConnectionHandler (Handle)
import Ouroboros.Network.Context (ResponderContext)
import Ouroboros.Network.InboundGovernor.Event (NewConnectionInfo)

-- | Information channel.
--
data InformationChannel a m =
  InformationChannel {
    -- | Read a single value from the channel.
    --
    forall a (m :: * -> *). InformationChannel a m -> STM m a
readMessage  :: STM m a,

    -- | Write a value to the channel.
    --
    forall a (m :: * -> *). InformationChannel a m -> a -> STM m ()
writeMessage :: a -> STM m ()
  }

-- | A channel which instantiates to 'NewConnectionInfo' and
-- 'Handle'.
--
-- * /Producer:/ connection manger for duplex outbound connections.
-- * /Consumer:/ inbound governor.
--
type InboundGovernorInfoChannel (muxMode :: Mux.Mode) initiatorCtx peerAddr versionData bytes m a b =
    InformationChannel (NewConnectionInfo peerAddr (Handle muxMode initiatorCtx (ResponderContext peerAddr) versionData bytes m a b)) m


-- | Create a new 'InformationChannel' backed by a `TBQueue`.
--
newInformationChannel :: forall a m. MonadLabelledSTM m
                      => m (InformationChannel a m)
newInformationChannel :: forall a (m :: * -> *).
MonadLabelledSTM m =>
m (InformationChannel a m)
newInformationChannel = do
    channel <-
      STM m (StrictTBQueue m a) -> m (StrictTBQueue m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (StrictTBQueue m a) -> m (StrictTBQueue m a))
-> STM m (StrictTBQueue m a) -> m (StrictTBQueue m a)
forall a b. (a -> b) -> a -> b
$
        Natural -> STM m (StrictTBQueue m a)
forall (m :: * -> *) a.
MonadSTM m =>
Natural -> STM m (StrictTBQueue m a)
newTBQueue Natural
cc_QUEUE_BOUND
        STM m (StrictTBQueue m a)
-> (StrictTBQueue m a -> STM m (StrictTBQueue m a))
-> STM m (StrictTBQueue m a)
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \StrictTBQueue m a
q -> StrictTBQueue m a -> String -> STM m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
StrictTBQueue m a -> String -> STM m ()
labelTBQueue StrictTBQueue m a
q String
"server-cc" STM m () -> StrictTBQueue m a -> STM m (StrictTBQueue m a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StrictTBQueue m a
q
    pure $ InformationChannel {
        readMessage  = readTBQueue channel,
        writeMessage = writeTBQueue channel
      }


-- | The 'InformationChannel's 'TBQueue' depth.
--
cc_QUEUE_BOUND :: Natural
cc_QUEUE_BOUND :: Natural
cc_QUEUE_BOUND = Natural
10