{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE KindSignatures    #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

module DMQ.Diffusion.Arguments
  ( diffusionArguments
  , NoExtraPeers (..)
  , NoExtraState (..)
  , NoExtraDebugState (..)
  , NoExtraCounters (..)
  , NoExtraFlags (..)
  , NoExtraConfig (..)
  , NoExtraAPI (..)
  , NoExtraChurnArgs (..)
  ) where

import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadSTM (MonadSTM (..))
import Control.Exception (IOException)
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadCatch)
import Control.Monad.Class.MonadTimer.SI (MonadDelay, MonadTimer)
import Control.Tracer (Tracer)
import Network.DNS (Resolver)
import Network.Socket (Socket)

import DMQ.NodeToClient as NtC
import DMQ.NodeToNode as NtN
import DMQ.NodeToNode qualified as DMQ
import DMQ.Tracer

import Ouroboros.Network.Diffusion.Types qualified as Diffusion
import Ouroboros.Network.PeerSelection.Churn (peerChurnGovernor)
import Ouroboros.Network.PeerSelection.Governor.Types
           (ExtraGuardedDecisions (..), PeerSelectionGovernorArgs (..))
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
           (LedgerPeersConsensusInterface (..))
import Ouroboros.Network.PeerSelection.RelayAccessPoint (SRVPrefix)
import Ouroboros.Network.PeerSelection.Types (nullPublicExtraPeersAPI)


diffusionArguments
  :: ( Alternative (STM m)
     , MonadCatch m
     , MonadDelay m
     , MonadST m
     , MonadTimer m
     )
  => Tracer m (NtN.HandshakeTr ntnAddr)
  -> Tracer m (NtC.HandshakeTr ntcAddr)
  -> Diffusion.Arguments
       NoExtraState NoExtraDebugState NoExtraFlags NoExtraPeers NoExtraAPI NoExtraChurnArgs NoExtraCounters
       IOException
       Resolver
       m
       Socket
       ntnAddr
       NodeToNodeVersion
       NodeToNodeVersionData
       ntcAddr
       NodeToClientVersion
       NodeToClientVersionData
diffusionArguments :: forall (m :: * -> *) ntnAddr ntcAddr.
(Alternative (STM m), MonadCatch m, MonadDelay m, MonadST m,
 MonadTimer m) =>
Tracer m (HandshakeTr ntnAddr)
-> Tracer m (HandshakeTr ntcAddr)
-> Arguments
     NoExtraState
     NoExtraDebugState
     NoExtraFlags
     NoExtraPeers
     NoExtraAPI
     NoExtraChurnArgs
     NoExtraCounters
     IOException
     Resolver
     m
     Socket
     ntnAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     ntcAddr
     NodeToClientVersion
     NodeToClientVersionData
diffusionArguments Tracer m (HandshakeTr ntnAddr)
handshakeNtNTracer
                   Tracer m (HandshakeTr ntcAddr)
handshakeNtCTracer =
  Diffusion.Arguments {
    daNtnDataFlow :: NodeToNodeVersionData -> DataFlow
Diffusion.daNtnDataFlow    = NodeToNodeVersionData -> DataFlow
DMQ.ntnDataFlow
  , daNtnPeerSharing :: NodeToNodeVersionData -> PeerSharing
Diffusion.daNtnPeerSharing = NodeToNodeVersionData -> PeerSharing
peerSharing
  , daUpdateVersionData :: NodeToNodeVersionData -> DiffusionMode -> NodeToNodeVersionData
Diffusion.daUpdateVersionData =
      \NodeToNodeVersionData
versionData DiffusionMode
diffusionMode -> NodeToNodeVersionData
versionData { diffusionMode }
  , daNtnHandshakeArguments :: HandshakeArguments
  (ConnectionId ntnAddr) NodeToNodeVersion NodeToNodeVersionData m
Diffusion.daNtnHandshakeArguments = Tracer m (HandshakeTr ntnAddr)
-> HandshakeArguments
     (ConnectionId ntnAddr) NodeToNodeVersion NodeToNodeVersionData m
forall (m :: * -> *) ntnAddr.
MonadST m =>
Tracer m (HandshakeTr ntnAddr)
-> HandshakeArguments
     (ConnectionId ntnAddr) NodeToNodeVersion NodeToNodeVersionData m
ntnHandshakeArguments Tracer m (HandshakeTr ntnAddr)
handshakeNtNTracer
  , daNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId ntcAddr)
  NodeToClientVersion
  NodeToClientVersionData
  m
Diffusion.daNtcHandshakeArguments = Tracer m (HandshakeTr ntcAddr)
-> HandshakeArguments
     (ConnectionId ntcAddr)
     NodeToClientVersion
     NodeToClientVersionData
     m
forall (m :: * -> *) ntcAddr.
MonadST m =>
Tracer m (HandshakeTr ntcAddr)
-> HandshakeArguments
     (ConnectionId ntcAddr)
     NodeToClientVersion
     NodeToClientVersionData
     m
ntcHandshakeArguments Tracer m (HandshakeTr ntcAddr)
handshakeNtCTracer
  , daLedgerPeersCtx :: LedgerPeersConsensusInterface NoExtraAPI m
Diffusion.daLedgerPeersCtx        =
      LedgerPeersConsensusInterface {
        lpGetLatestSlot :: STM m (WithOrigin SlotNo)
lpGetLatestSlot  = WithOrigin SlotNo -> STM m (WithOrigin SlotNo)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return WithOrigin SlotNo
forall a. Bounded a => a
minBound
      , lpGetLedgerPeers :: STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
lpGetLedgerPeers = [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
-> STM m [(PoolStake, NonEmpty LedgerRelayAccessPoint)]
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      , lpExtraAPI :: NoExtraAPI
lpExtraAPI       = NoExtraAPI
NoExtraAPI
      }
  , daEmptyExtraState :: NoExtraState
Diffusion.daEmptyExtraState           = NoExtraState
NoExtraState
  , daEmptyExtraCounters :: NoExtraCounters
Diffusion.daEmptyExtraCounters        = NoExtraCounters
NoExtraCounters
  , daExtraPeersAPI :: PublicExtraPeersAPI NoExtraPeers ntnAddr
Diffusion.daExtraPeersAPI             = PublicExtraPeersAPI NoExtraPeers ntnAddr
forall extraPeers peeraddr.
Monoid extraPeers =>
PublicExtraPeersAPI extraPeers peeraddr
nullPublicExtraPeersAPI
  , daInstallSigUSR1Handler :: forall (mode :: Mode) x y.
NodeToNodeConnectionManager
  mode Socket ntnAddr NodeToNodeVersionData NodeToNodeVersion m x y
-> StrictTVar
     m
     (PeerSelectionState
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (NodeToNodePeerConnectionHandle
           mode ntnAddr NodeToNodeVersionData m x y))
-> m ()
Diffusion.daInstallSigUSR1Handler     = \NodeToNodeConnectionManager
  mode Socket ntnAddr NodeToNodeVersionData NodeToNodeVersion m x y
_ StrictTVar
  m
  (PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (NodeToNodePeerConnectionHandle
        mode ntnAddr NodeToNodeVersionData m x y))
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , daPeerSelectionGovernorArgs :: forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionGovernorArgs
  NoExtraState
  NoExtraDebugState
  NoExtraFlags
  NoExtraPeers
  NoExtraAPI
  NoExtraCounters
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  IOException
  m
Diffusion.daPeerSelectionGovernorArgs =
      PeerSelectionGovernorArgs {
        abortGovernor :: Time
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Maybe IOException
abortGovernor   = \Time
_ PeerSelectionState
  NoExtraState
  NoExtraFlags
  NoExtraPeers
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
_ -> Maybe IOException
forall a. Maybe a
Nothing
      , updateWithState :: PeerSelectionInterfaces
  NoExtraState
  NoExtraFlags
  NoExtraPeers
  NoExtraCounters
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  m
-> PeerSelectionActions
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     NoExtraAPI
     NoExtraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionSetsWithSizes NoExtraCounters ntnAddr
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> STM m ()
updateWithState = \PeerSelectionInterfaces
  NoExtraState
  NoExtraFlags
  NoExtraPeers
  NoExtraCounters
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  m
_ PeerSelectionActions
  NoExtraState
  NoExtraFlags
  NoExtraPeers
  NoExtraAPI
  NoExtraCounters
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  m
_ PeerSelectionSetsWithSizes NoExtraCounters ntnAddr
_ PeerSelectionState
  NoExtraState
  NoExtraFlags
  NoExtraPeers
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
_ -> () -> STM m ()
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      , extraDecisions :: ExtraGuardedDecisions
  NoExtraState
  NoExtraDebugState
  NoExtraFlags
  NoExtraPeers
  NoExtraAPI
  NoExtraCounters
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  m
extraDecisions  =
          ExtraGuardedDecisions {
            preBlocking :: PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     NoExtraAPI
     NoExtraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        NoExtraState
        NoExtraDebugState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
preBlocking     = PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     NoExtraAPI
     NoExtraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        NoExtraState
        NoExtraDebugState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
forall a. Monoid a => a
mempty
          , postBlocking :: PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     NoExtraAPI
     NoExtraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        NoExtraState
        NoExtraDebugState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
postBlocking    = PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     NoExtraAPI
     NoExtraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        NoExtraState
        NoExtraDebugState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
forall a. Monoid a => a
mempty
          , postNonBlocking :: PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     NoExtraAPI
     NoExtraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        NoExtraState
        NoExtraDebugState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
postNonBlocking = PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     NoExtraAPI
     NoExtraCounters
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        NoExtraState
        NoExtraDebugState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
forall a. Monoid a => a
mempty
          , customTargetsAction :: Maybe
  (PeerSelectionPolicy ntnAddr m
   -> PeerSelectionActions
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        NoExtraAPI
        NoExtraCounters
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
        m
   -> PeerSelectionState
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
   -> Guarded
        (STM m)
        (TimedDecision
           m
           NoExtraState
           NoExtraDebugState
           NoExtraFlags
           NoExtraPeers
           ntnAddr
           (PeerConnectionHandle
              muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)))
customTargetsAction         = Maybe
  (PeerSelectionPolicy ntnAddr m
   -> PeerSelectionActions
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        NoExtraAPI
        NoExtraCounters
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
        m
   -> PeerSelectionState
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
   -> Guarded
        (STM m)
        (TimedDecision
           m
           NoExtraState
           NoExtraDebugState
           NoExtraFlags
           NoExtraPeers
           ntnAddr
           (PeerConnectionHandle
              muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)))
forall a. Maybe a
Nothing
          , customLocalRootsAction :: Maybe
  (PeerSelectionPolicy ntnAddr m
   -> PeerSelectionActions
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        NoExtraAPI
        NoExtraCounters
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
        m
   -> PeerSelectionState
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
   -> Guarded
        (STM m)
        (TimedDecision
           m
           NoExtraState
           NoExtraDebugState
           NoExtraFlags
           NoExtraPeers
           ntnAddr
           (PeerConnectionHandle
              muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)))
customLocalRootsAction      = Maybe
  (PeerSelectionPolicy ntnAddr m
   -> PeerSelectionActions
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        NoExtraAPI
        NoExtraCounters
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
        m
   -> PeerSelectionState
        NoExtraState
        NoExtraFlags
        NoExtraPeers
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
   -> Guarded
        (STM m)
        (TimedDecision
           m
           NoExtraState
           NoExtraDebugState
           NoExtraFlags
           NoExtraPeers
           ntnAddr
           (PeerConnectionHandle
              muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)))
forall a. Maybe a
Nothing
          , enableProgressMakingActions :: NoExtraState -> Bool
enableProgressMakingActions = Bool -> NoExtraState -> Bool
forall a b. a -> b -> a
const Bool
True
          , ledgerPeerSnapshotExtraStateChange :: NoExtraState -> NoExtraState
ledgerPeerSnapshotExtraStateChange = NoExtraState -> NoExtraState
forall a. a -> a
id
          }
      }
  , daPeerSelectionStateToExtraCounters :: forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionState
  NoExtraState
  NoExtraFlags
  NoExtraPeers
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> NoExtraCounters
Diffusion.daPeerSelectionStateToExtraCounters = NoExtraCounters
-> PeerSelectionState
     NoExtraState
     NoExtraFlags
     NoExtraPeers
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> NoExtraCounters
forall a b. a -> b -> a
const NoExtraCounters
NoExtraCounters
  , daToExtraPeers :: Map ntnAddr PeerAdvertise -> NoExtraPeers
Diffusion.daToExtraPeers                      = NoExtraPeers -> Map ntnAddr PeerAdvertise -> NoExtraPeers
forall a b. a -> b -> a
const NoExtraPeers
NoExtraPeers
  , daRequestPublicRootPeers :: Maybe
  (PeerActionsDNS ntnAddr Resolver m
   -> DNSSemaphore m
   -> (Map ntnAddr PeerAdvertise -> NoExtraPeers)
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
   -> LedgerPeersKind
   -> StdGen
   -> Int
   -> m (PublicRootPeers NoExtraPeers ntnAddr, DiffTime))
Diffusion.daRequestPublicRootPeers            = Maybe
  (PeerActionsDNS ntnAddr Resolver m
   -> DNSSemaphore m
   -> (Map ntnAddr PeerAdvertise -> NoExtraPeers)
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
   -> LedgerPeersKind
   -> StdGen
   -> Int
   -> m (PublicRootPeers NoExtraPeers ntnAddr, DiffTime))
forall a. Maybe a
Nothing
  , daPeerChurnGovernor :: PeerChurnArgs
  m
  NoExtraChurnArgs
  NoExtraDebugState
  NoExtraFlags
  NoExtraPeers
  NoExtraAPI
  NoExtraCounters
  ntnAddr
-> m Void
Diffusion.daPeerChurnGovernor                 = PeerChurnArgs
  m
  NoExtraChurnArgs
  NoExtraDebugState
  NoExtraFlags
  NoExtraPeers
  NoExtraAPI
  NoExtraCounters
  ntnAddr
-> m Void
forall (m :: * -> *) extraArgs extraDebugState extraFlags
       extraPeers extraAPI extraCounters peeraddr.
(MonadDelay m, Alternative (STM m), MonadTimer m, MonadCatch m) =>
PeerChurnArgs
  m
  extraArgs
  extraDebugState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
-> m Void
peerChurnGovernor
  , daExtraChurnArgs :: NoExtraChurnArgs
Diffusion.daExtraChurnArgs                    = NoExtraChurnArgs
NoExtraChurnArgs
  , daSRVPrefix :: SRVPrefix
Diffusion.daSRVPrefix                         = SRVPrefix
dmqSRVPrefix
  }


-- | SRVPrefix as registered in `CIP#0155`.
--
dmqSRVPrefix :: SRVPrefix
dmqSRVPrefix :: SRVPrefix
dmqSRVPrefix = SRVPrefix
"_dmq._mithril._cardano._tcp"