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

module DMQ.Diffusion.Arguments (diffusionArguments) where

import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadSTM (MonadSTM (..))
import Control.Exception (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
import DMQ.NodeToNode
import DMQ.NodeToNode qualified as DMQ
import Ouroboros.Network.Diffusion.Types qualified as Diffusion
import Ouroboros.Network.NodeToNode (HandshakeTr)
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.Types (nullPublicExtraPeersAPI)

diffusionArguments
  :: ( Alternative (STM m)
     , MonadCatch m
     , MonadDelay m
     , MonadST m
     , MonadSTM m
     , MonadTimer m
     , Exception exception
     )
  => Tracer m (HandshakeTr ntnAddr NodeToNodeVersion)
  -> Tracer m (HandshakeTr ntcAddr NodeToClientVersion)
  -> Diffusion.Arguments
       () () () () () () ()
       exception
       Resolver
       IOException
       m
       Socket
       ntnAddr
       NodeToNodeVersion
       NodeToNodeVersionData
       ntcAddr
       NodeToClientVersion
       NodeToClientVersionData
diffusionArguments :: forall (m :: * -> *) exception ntnAddr ntcAddr.
(Alternative (STM m), MonadCatch m, MonadDelay m, MonadST m,
 MonadSTM m, MonadTimer m, Exception exception) =>
Tracer m (HandshakeTr ntnAddr NodeToNodeVersion)
-> Tracer m (HandshakeTr ntcAddr NodeToClientVersion)
-> Arguments
     ()
     ()
     ()
     ()
     ()
     ()
     ()
     exception
     Resolver
     IOException
     m
     Socket
     ntnAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     ntcAddr
     NodeToClientVersion
     NodeToClientVersionData
diffusionArguments Tracer m (HandshakeTr ntnAddr NodeToNodeVersion)
handshakeNtNTracer
                   Tracer m (HandshakeTr ntcAddr NodeToClientVersion)
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 NodeToNodeVersion)
-> HandshakeArguments
     (ConnectionId ntnAddr) NodeToNodeVersion NodeToNodeVersionData m
forall (m :: * -> *) ntnAddr.
MonadST m =>
Tracer m (HandshakeTr ntnAddr NodeToNodeVersion)
-> HandshakeArguments
     (ConnectionId ntnAddr) NodeToNodeVersion NodeToNodeVersionData m
ntnHandshakeArguments Tracer m (HandshakeTr ntnAddr NodeToNodeVersion)
handshakeNtNTracer
  , daNtcHandshakeArguments :: HandshakeArguments
  (ConnectionId ntcAddr)
  NodeToClientVersion
  NodeToClientVersionData
  m
Diffusion.daNtcHandshakeArguments = Tracer m (HandshakeTr ntcAddr NodeToClientVersion)
-> HandshakeArguments
     (ConnectionId ntcAddr)
     NodeToClientVersion
     NodeToClientVersionData
     m
forall (m :: * -> *) ntcAddr.
MonadST m =>
Tracer m (HandshakeTr ntcAddr NodeToClientVersion)
-> HandshakeArguments
     (ConnectionId ntcAddr)
     NodeToClientVersion
     NodeToClientVersionData
     m
ntcHandshakeArguments Tracer m (HandshakeTr ntcAddr NodeToClientVersion)
handshakeNtCTracer
  , daLedgerPeersCtx :: LedgerPeersConsensusInterface () 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 RelayAccessPoint)]
lpGetLedgerPeers = [(PoolStake, NonEmpty RelayAccessPoint)]
-> STM m [(PoolStake, NonEmpty RelayAccessPoint)]
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      , lpExtraAPI :: ()
lpExtraAPI       = ()
      }
  , daEmptyExtraState :: ()
Diffusion.daEmptyExtraState           = ()
  , daEmptyExtraCounters :: ()
Diffusion.daEmptyExtraCounters        = ()
  , daExtraPeersAPI :: PublicExtraPeersAPI () ntnAddr
Diffusion.daExtraPeersAPI             = PublicExtraPeersAPI () ntnAddr
forall peeraddr. PublicExtraPeersAPI () peeraddr
nullPublicExtraPeersAPI
  , daInstallSigUSR1Handler :: forall (mode :: Mode) x y.
NodeToNodeConnectionManager
  mode Socket ntnAddr NodeToNodeVersionData NodeToNodeVersion m x y
-> StrictTVar
     m
     (PeerSelectionState
        ()
        ()
        ()
        ntnAddr
        (NodeToNodePeerConnectionHandle
           mode ntnAddr NodeToNodeVersionData m x y))
-> m ()
Diffusion.daInstallSigUSR1Handler     = \NodeToNodeConnectionManager
  mode Socket ntnAddr NodeToNodeVersionData NodeToNodeVersion m x y
_ StrictTVar
  m
  (PeerSelectionState
     ()
     ()
     ()
     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
  ()
  ()
  ()
  ()
  ()
  ()
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  exception
  m
Diffusion.daPeerSelectionGovernorArgs =
      PeerSelectionGovernorArgs {
        abortGovernor :: Time
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Maybe exception
abortGovernor   = \Time
_ PeerSelectionState
  ()
  ()
  ()
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
_ -> Maybe exception
forall a. Maybe a
Nothing
      , updateWithState :: PeerSelectionInterfaces
  ()
  ()
  ()
  ()
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  m
-> PeerSelectionActions
     ()
     ()
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionSetsWithSizes () ntnAddr
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> STM m ()
updateWithState = \PeerSelectionInterfaces
  ()
  ()
  ()
  ()
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  m
_ PeerSelectionActions
  ()
  ()
  ()
  ()
  ()
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  m
_ PeerSelectionSetsWithSizes () ntnAddr
_ PeerSelectionState
  ()
  ()
  ()
  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
  ()
  ()
  ()
  ()
  ()
  ()
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
  m
extraDecisions  =
          ExtraGuardedDecisions {
            preBlocking :: PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     ()
     ()
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
preBlocking     = PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     ()
     ()
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
forall a. Monoid a => a
mempty
          , postBlocking :: PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     ()
     ()
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
postBlocking    = PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     ()
     ()
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
forall a. Monoid a => a
mempty
          , postNonBlocking :: PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     ()
     ()
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
postNonBlocking = PeerSelectionPolicy ntnAddr m
-> PeerSelectionActions
     ()
     ()
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
     m
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> Guarded
     (STM m)
     (TimedDecision
        m
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b))
forall a. Monoid a => a
mempty
          , customTargetsAction :: Maybe
  (PeerSelectionPolicy ntnAddr m
   -> PeerSelectionActions
        ()
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
        m
   -> PeerSelectionState
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
   -> Guarded
        (STM m)
        (TimedDecision
           m
           ()
           ()
           ()
           ()
           ntnAddr
           (PeerConnectionHandle
              muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)))
customTargetsAction         = Maybe
  (PeerSelectionPolicy ntnAddr m
   -> PeerSelectionActions
        ()
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
        m
   -> PeerSelectionState
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
   -> Guarded
        (STM m)
        (TimedDecision
           m
           ()
           ()
           ()
           ()
           ntnAddr
           (PeerConnectionHandle
              muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)))
forall a. Maybe a
Nothing
          , customLocalRootsAction :: Maybe
  (PeerSelectionPolicy ntnAddr m
   -> PeerSelectionActions
        ()
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
        m
   -> PeerSelectionState
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
   -> Guarded
        (STM m)
        (TimedDecision
           m
           ()
           ()
           ()
           ()
           ntnAddr
           (PeerConnectionHandle
              muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)))
customLocalRootsAction      = Maybe
  (PeerSelectionPolicy ntnAddr m
   -> PeerSelectionActions
        ()
        ()
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
        m
   -> PeerSelectionState
        ()
        ()
        ()
        ntnAddr
        (PeerConnectionHandle
           muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
   -> Guarded
        (STM m)
        (TimedDecision
           m
           ()
           ()
           ()
           ()
           ntnAddr
           (PeerConnectionHandle
              muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)))
forall a. Maybe a
Nothing
          , enableProgressMakingActions :: () -> Bool
enableProgressMakingActions = Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True
          , ledgerPeerSnapshotExtraStateChange :: () -> ()
ledgerPeerSnapshotExtraStateChange = () -> ()
forall a. a -> a
id
          }
      }
  , daPeerSelectionStateToExtraCounters :: forall (muxMode :: Mode) responderCtx bytes a b.
PeerSelectionState
  ()
  ()
  ()
  ntnAddr
  (PeerConnectionHandle
     muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> ()
Diffusion.daPeerSelectionStateToExtraCounters = ()
-> PeerSelectionState
     ()
     ()
     ()
     ntnAddr
     (PeerConnectionHandle
        muxMode responderCtx ntnAddr NodeToNodeVersionData bytes m a b)
-> ()
forall a b. a -> b -> a
const ()
  , daToExtraPeers :: Map ntnAddr PeerAdvertise -> ()
Diffusion.daToExtraPeers                      = () -> Map ntnAddr PeerAdvertise -> ()
forall a b. a -> b -> a
const ()
  , daRequestPublicRootPeers :: Maybe
  (PeerActionsDNS ntnAddr Resolver IOException m
   -> DNSSemaphore m
   -> (Map ntnAddr PeerAdvertise -> ())
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
   -> LedgerPeersKind
   -> StdGen
   -> Int
   -> m (PublicRootPeers () ntnAddr, DiffTime))
Diffusion.daRequestPublicRootPeers            = Maybe
  (PeerActionsDNS ntnAddr Resolver IOException m
   -> DNSSemaphore m
   -> (Map ntnAddr PeerAdvertise -> ())
   -> (NumberOfPeers
       -> LedgerPeersKind -> m (Maybe (Set ntnAddr, DiffTime)))
   -> LedgerPeersKind
   -> StdGen
   -> Int
   -> m (PublicRootPeers () ntnAddr, DiffTime))
forall a. Maybe a
Nothing
  , daPeerChurnGovernor :: PeerChurnArgs m () () () () () () ntnAddr -> m Void
Diffusion.daPeerChurnGovernor                 = PeerChurnArgs m () () () () () () 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 :: ()
Diffusion.daExtraChurnArgs                    = ()
  }