{-# LANGUAGE NamedFieldPuns #-}

module DMQ.Diffusion.NodeKernel where

import System.Random (StdGen)

import Control.Concurrent.Class.MonadSTM (MonadLabelledSTM)
import Control.DeepSeq (NFData)
import NoThunks.Class (NoThunks)
import Ouroboros.Network.BlockFetch (FetchClientRegistry,
           newFetchClientRegistry)
import Ouroboros.Network.NodeToNode (ConnectionId (..))
import Ouroboros.Network.PeerSelection.Governor.Types
           (makePublicPeerSelectionStateVar)
import Ouroboros.Network.PeerSharing (PeerSharingAPI, PeerSharingRegistry,
           newPeerSharingAPI, newPeerSharingRegistry,
           ps_POLICY_PEER_SHARE_MAX_PEERS, ps_POLICY_PEER_SHARE_STICKY_TIME)

data NodeKernel ntnAddr m =
  NodeKernel {
    -- | The fetch client registry, used for the keep alive clients.
    forall ntnAddr (m :: * -> *).
NodeKernel ntnAddr m
-> FetchClientRegistry (ConnectionId ntnAddr) () () m
fetchClientRegistry :: FetchClientRegistry (ConnectionId ntnAddr) () () m

    -- | Read the current peer sharing registry, used for interacting with
    -- the PeerSharing protocol
  , forall ntnAddr (m :: * -> *).
NodeKernel ntnAddr m -> PeerSharingRegistry ntnAddr m
peerSharingRegistry :: PeerSharingRegistry ntnAddr m
  , forall ntnAddr (m :: * -> *).
NodeKernel ntnAddr m -> PeerSharingAPI ntnAddr StdGen m
peerSharingAPI      :: PeerSharingAPI ntnAddr StdGen m
  }

newNodeKernel :: ( MonadLabelledSTM m
                 , Ord ntnAddr
                 , NFData ntnAddr
                 , NoThunks ntnAddr
                 )
              => StdGen
              -> m (NodeKernel ntnAddr m)
newNodeKernel :: forall (m :: * -> *) ntnAddr.
(MonadLabelledSTM m, Ord ntnAddr, NFData ntnAddr,
 NoThunks ntnAddr) =>
StdGen -> m (NodeKernel ntnAddr m)
newNodeKernel StdGen
peerSharingRng = do
  publicPeerSelectionStateVar <- m (StrictTVar m (PublicPeerSelectionState ntnAddr))
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
m (StrictTVar m (PublicPeerSelectionState peeraddr))
makePublicPeerSelectionStateVar

  fetchClientRegistry <- newFetchClientRegistry
  peerSharingRegistry <- newPeerSharingRegistry

  peerSharingAPI <- newPeerSharingAPI publicPeerSelectionStateVar
                                      peerSharingRng
                                      ps_POLICY_PEER_SHARE_STICKY_TIME
                                      ps_POLICY_PEER_SHARE_MAX_PEERS

  pure NodeKernel { fetchClientRegistry
                  , peerSharingRegistry
                  , peerSharingAPI
                  }