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

module DMQ.Diffusion.Applications where

import DMQ.Configuration
import DMQ.Diffusion.NodeKernel (NodeKernel (..))
import DMQ.NodeToClient (NodeToClientVersion, NodeToClientVersionData,
           stdVersionDataNTC)
import DMQ.NodeToClient qualified as NTC
import DMQ.NodeToNode (NodeToNodeVersion, NodeToNodeVersionData,
           stdVersionDataNTN)
import DMQ.NodeToNode qualified as NTN

import Ouroboros.Network.Diffusion.Types qualified as Diffusion
import Ouroboros.Network.ExitPolicy (RepromoteDelay (..))
import Ouroboros.Network.PeerSelection.Governor.Types (PeerSelectionPolicy)
import Ouroboros.Network.Protocol.Handshake.Version (combineVersions,
           simpleSingletonVersions)
import Ouroboros.Network.RethrowPolicy (ioErrorRethrowPolicy,
           muxErrorRethrowPolicy)

diffusionApplications
  :: NodeKernel crypto ntnAddr m
  -> Configuration
  -> Diffusion.Configuration NoExtraFlags m ntnFd ntnAddr ntcFd ntcAddr
  -> NTN.LimitsAndTimeouts crypto ntnAddr
  -> NTN.Apps ntnAddr m a ()
  -> NTC.Apps ntcAddr m ()
  -> PeerSelectionPolicy ntnAddr m
  -> Diffusion.Applications ntnAddr NodeToNodeVersion   NodeToNodeVersionData
                            ntcAddr NodeToClientVersion NodeToClientVersionData
                            m a
diffusionApplications :: forall crypto ntnAddr (m :: * -> *) ntnFd ntcFd ntcAddr a.
NodeKernel crypto ntnAddr m
-> Configuration
-> Configuration NoExtraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> LimitsAndTimeouts crypto ntnAddr
-> Apps ntnAddr m a ()
-> Apps ntcAddr m ()
-> PeerSelectionPolicy ntnAddr m
-> Applications
     ntnAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     ntcAddr
     NodeToClientVersion
     NodeToClientVersionData
     m
     a
diffusionApplications
  NodeKernel {
    PeerSharingRegistry ntnAddr m
peerSharingRegistry :: PeerSharingRegistry ntnAddr m
peerSharingRegistry :: forall crypto ntnAddr (m :: * -> *).
NodeKernel crypto ntnAddr m -> PeerSharingRegistry ntnAddr m
peerSharingRegistry
  }
  Configuration {
    dmqcNetworkMagic :: forall (f :: * -> *). Configuration' f -> f NetworkMagic
dmqcNetworkMagic = I NetworkMagic
networkMagic
  }
  Diffusion.Configuration {
    DiffusionMode
dcMode :: DiffusionMode
dcMode :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> DiffusionMode
Diffusion.dcMode
  , PeerSharing
dcPeerSharing :: PeerSharing
dcPeerSharing :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> PeerSharing
Diffusion.dcPeerSharing
  }
  LimitsAndTimeouts crypto ntnAddr
ntnLimitsAndTimeouts
  Apps ntnAddr m a ()
ntnApps
  Apps ntcAddr m ()
ntcApps
  PeerSelectionPolicy ntnAddr m
peerSelectionPolicy =
  Diffusion.Applications {
    daApplicationInitiatorMode :: Versions
  NodeToNodeVersion
  NodeToNodeVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void)
Diffusion.daApplicationInitiatorMode =
      [Versions
   NodeToNodeVersion
   NodeToNodeVersionData
   (OuroborosBundleWithExpandedCtx
      'InitiatorMode ntnAddr ByteString m a Void)]
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorMode ntnAddr ByteString m a Void)
forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions
        [ NodeToNodeVersion
-> NodeToNodeVersionData
-> (NodeToNodeVersionData
    -> OuroborosBundleWithExpandedCtx
         'InitiatorMode ntnAddr ByteString m a Void)
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorMode ntnAddr ByteString m a Void)
forall vNum vData r.
vNum -> vData -> (vData -> r) -> Versions vNum vData r
simpleSingletonVersions
            NodeToNodeVersion
version
            (NetworkMagic
-> DiffusionMode -> PeerSharing -> NodeToNodeVersionData
stdVersionDataNTN NetworkMagic
networkMagic DiffusionMode
dcMode PeerSharing
dcPeerSharing)
            (LimitsAndTimeouts crypto ntnAddr
-> Apps ntnAddr m a ()
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void
forall crypto addr (m :: * -> *) a b.
LimitsAndTimeouts crypto addr
-> Apps addr m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode addr ByteString m a Void
NTN.initiatorProtocols LimitsAndTimeouts crypto ntnAddr
ntnLimitsAndTimeouts Apps ntnAddr m a ()
ntnApps NodeToNodeVersion
version)
        | NodeToNodeVersion
version <- [NodeToNodeVersion
forall a. Bounded a => a
minBound..NodeToNodeVersion
forall a. Bounded a => a
maxBound]
        ]
  , daApplicationInitiatorResponderMode :: Versions
  NodeToNodeVersion
  NodeToNodeVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode ntnAddr ByteString m a ())
Diffusion.daApplicationInitiatorResponderMode =
      [Versions
   NodeToNodeVersion
   NodeToNodeVersionData
   (OuroborosBundleWithExpandedCtx
      'InitiatorResponderMode ntnAddr ByteString m a ())]
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorResponderMode ntnAddr ByteString m a ())
forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions
        [ NodeToNodeVersion
-> NodeToNodeVersionData
-> (NodeToNodeVersionData
    -> OuroborosBundleWithExpandedCtx
         'InitiatorResponderMode ntnAddr ByteString m a ())
-> Versions
     NodeToNodeVersion
     NodeToNodeVersionData
     (OuroborosBundleWithExpandedCtx
        'InitiatorResponderMode ntnAddr ByteString m a ())
forall vNum vData r.
vNum -> vData -> (vData -> r) -> Versions vNum vData r
simpleSingletonVersions
            NodeToNodeVersion
version
            (NetworkMagic
-> DiffusionMode -> PeerSharing -> NodeToNodeVersionData
stdVersionDataNTN NetworkMagic
networkMagic DiffusionMode
dcMode PeerSharing
dcPeerSharing)
            (LimitsAndTimeouts crypto ntnAddr
-> Apps ntnAddr m a ()
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode ntnAddr ByteString m a ()
forall crypto addr (m :: * -> *) a b.
LimitsAndTimeouts crypto addr
-> Apps addr m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode addr ByteString m a b
NTN.initiatorAndResponderProtocols LimitsAndTimeouts crypto ntnAddr
ntnLimitsAndTimeouts Apps ntnAddr m a ()
ntnApps NodeToNodeVersion
version)
        | NodeToNodeVersion
version <- [NodeToNodeVersion
forall a. Bounded a => a
minBound..NodeToNodeVersion
forall a. Bounded a => a
maxBound]
        ]
  , daLocalResponderApplication :: Versions
  NodeToClientVersion
  NodeToClientVersionData
  (OuroborosApplicationWithMinimalCtx
     'ResponderMode ntcAddr ByteString m Void ())
Diffusion.daLocalResponderApplication =
      [Versions
   NodeToClientVersion
   NodeToClientVersionData
   (OuroborosApplicationWithMinimalCtx
      'ResponderMode ntcAddr ByteString m Void ())]
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplicationWithMinimalCtx
        'ResponderMode ntcAddr ByteString m Void ())
forall vNum (f :: * -> *) extra r.
(Ord vNum, Foldable f, HasCallStack) =>
f (Versions vNum extra r) -> Versions vNum extra r
combineVersions
        [ NodeToClientVersion
-> NodeToClientVersionData
-> (NodeToClientVersionData
    -> OuroborosApplicationWithMinimalCtx
         'ResponderMode ntcAddr ByteString m Void ())
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplicationWithMinimalCtx
        'ResponderMode ntcAddr ByteString m Void ())
forall vNum vData r.
vNum -> vData -> (vData -> r) -> Versions vNum vData r
simpleSingletonVersions
            NodeToClientVersion
version
            (NetworkMagic -> NodeToClientVersionData
stdVersionDataNTC NetworkMagic
networkMagic)
            (Apps ntcAddr m ()
-> NodeToClientVersion
-> NodeToClientVersionData
-> OuroborosApplicationWithMinimalCtx
     'ResponderMode ntcAddr ByteString m Void ()
forall ntcAddr (m :: * -> *) a.
Apps ntcAddr m a
-> NodeToClientVersion
-> NodeToClientVersionData
-> OuroborosApplicationWithMinimalCtx
     'ResponderMode ntcAddr ByteString m Void a
NTC.responders Apps ntcAddr m ()
ntcApps NodeToClientVersion
version)
        | NodeToClientVersion
version <- [NodeToClientVersion
forall a. Bounded a => a
minBound..NodeToClientVersion
forall a. Bounded a => a
maxBound]
        ]
  , daRethrowPolicy :: RethrowPolicy
Diffusion.daRethrowPolicy       =  RethrowPolicy
muxErrorRethrowPolicy
                                   RethrowPolicy -> RethrowPolicy -> RethrowPolicy
forall a. Semigroup a => a -> a -> a
<> RethrowPolicy
ioErrorRethrowPolicy
  , daReturnPolicy :: ReturnPolicy a
Diffusion.daReturnPolicy        = RepromoteDelay -> ReturnPolicy a
forall a b. a -> b -> a
const RepromoteDelay
dmqRepromoteDelay
  , daRepromoteErrorDelay :: RepromoteDelay
Diffusion.daRepromoteErrorDelay = RepromoteDelay
dmqRepromoteDelay
  , daLocalRethrowPolicy :: RethrowPolicy
Diffusion.daLocalRethrowPolicy  = RethrowPolicy
forall a. Monoid a => a
mempty
  , daPeerSelectionPolicy :: PeerSelectionPolicy ntnAddr m
Diffusion.daPeerSelectionPolicy = PeerSelectionPolicy ntnAddr m
peerSelectionPolicy
  , daPeerSharingRegistry :: PeerSharingRegistry ntnAddr m
Diffusion.daPeerSharingRegistry = PeerSharingRegistry ntnAddr m
peerSharingRegistry
  }


-- | PeerSelection RepromoteDelay used after
dmqRepromoteDelay :: RepromoteDelay
dmqRepromoteDelay :: RepromoteDelay
dmqRepromoteDelay = RepromoteDelay
10