{-# LANGUAGE DuplicateRecordFields #-}
{-# 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.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.Mux (OuroborosApplication (..))
import Ouroboros.Network.PeerSelection.Governor.Types (PeerSelectionPolicy)
import Ouroboros.Network.Protocol.Handshake.Version (combineVersions,
           simpleSingletonVersions)
import Ouroboros.Network.RethrowPolicy (ioErrorRethrowPolicy,
           muxErrorRethrowPolicy)

diffusionApplications
  :: NodeKernel ntnAddr m
  -> Configuration
  -> Diffusion.Configuration NoExtraFlags m ntnFd ntnAddr ntcFd ntcAddr
  -> NTN.LimitsAndTimeouts ntnAddr
  -> NTN.Apps ntnAddr m a ()
  -> PeerSelectionPolicy ntnAddr m
  -> Diffusion.Applications ntnAddr NodeToNodeVersion   NodeToNodeVersionData
                            ntcAddr NodeToClientVersion NodeToClientVersionData
                            m a
diffusionApplications :: forall ntnAddr (m :: * -> *) ntnFd ntcFd ntcAddr a.
NodeKernel ntnAddr m
-> Configuration
-> Configuration NoExtraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> LimitsAndTimeouts ntnAddr
-> Apps ntnAddr m a ()
-> PeerSelectionPolicy ntnAddr m
-> Applications
     ntnAddr
     NodeToNodeVersion
     NodeToNodeVersionData
     ntcAddr
     NodeToClientVersion
     NodeToClientVersionData
     m
     a
diffusionApplications
  NodeKernel {
    PeerSharingRegistry ntnAddr m
peerSharingRegistry :: PeerSharingRegistry ntnAddr m
peerSharingRegistry :: forall ntnAddr (m :: * -> *).
NodeKernel 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
dcMode
  , PeerSharing
dcPeerSharing :: PeerSharing
dcPeerSharing :: forall extraFlags (m :: * -> *) ntnFd ntnAddr ntcFd ntcAddr.
Configuration extraFlags m ntnFd ntnAddr ntcFd ntcAddr
-> PeerSharing
dcPeerSharing
  }
  LimitsAndTimeouts ntnAddr
ntnLimitsAndTimeouts
  Apps ntnAddr m a ()
ntnApps
  PeerSelectionPolicy ntnAddr m
peerSelectionPolicy =
  Diffusion.Applications {
    daApplicationInitiatorMode :: Versions
  NodeToNodeVersion
  NodeToNodeVersionData
  (OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void)
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 ntnAddr
-> Apps ntnAddr m a ()
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode ntnAddr ByteString m a Void
forall addr (m :: * -> *) a b.
LimitsAndTimeouts addr
-> Apps addr m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorMode addr ByteString m a Void
NTN.initiatorProtocols LimitsAndTimeouts 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 ())
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 ntnAddr
-> Apps ntnAddr m a ()
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode ntnAddr ByteString m a ()
forall addr (m :: * -> *) a b.
LimitsAndTimeouts addr
-> Apps addr m a b
-> NodeToNodeVersion
-> NodeToNodeVersionData
-> OuroborosBundleWithExpandedCtx
     'InitiatorResponderMode addr ByteString m a b
NTN.initiatorAndResponderProtocols LimitsAndTimeouts 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 ())
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)
            (\NodeToClientVersionData
_versionData ->
                [MiniProtocol
   'ResponderMode
   (MinimalInitiatorContext ntcAddr)
   (ResponderContext ntcAddr)
   ByteString
   m
   Void
   ()]
-> OuroborosApplicationWithMinimalCtx
     'ResponderMode ntcAddr ByteString m Void ()
forall (mode :: Mode) initiatorCtx responderCtx bytes (m :: * -> *)
       a b.
[MiniProtocol mode initiatorCtx responderCtx bytes m a b]
-> OuroborosApplication mode initiatorCtx responderCtx bytes m a b
OuroborosApplication
                  [
                  ]
            )
        | NodeToClientVersion
version <- [NodeToClientVersion
forall a. Bounded a => a
minBound..NodeToClientVersion
forall a. Bounded a => a
maxBound]
        ]
  , daRethrowPolicy :: RethrowPolicy
daRethrowPolicy                     =  RethrowPolicy
muxErrorRethrowPolicy
                                        RethrowPolicy -> RethrowPolicy -> RethrowPolicy
forall a. Semigroup a => a -> a -> a
<> RethrowPolicy
ioErrorRethrowPolicy
  , daReturnPolicy :: ReturnPolicy a
daReturnPolicy                      = RepromoteDelay -> ReturnPolicy a
forall a b. a -> b -> a
const RepromoteDelay
dmqRepromoteDelay
  , daRepromoteErrorDelay :: RepromoteDelay
daRepromoteErrorDelay               = RepromoteDelay
dmqRepromoteDelay
  , daLocalRethrowPolicy :: RethrowPolicy
daLocalRethrowPolicy                = RethrowPolicy
forall a. Monoid a => a
mempty
  , daPeerSelectionPolicy :: PeerSelectionPolicy ntnAddr m
daPeerSelectionPolicy               = PeerSelectionPolicy ntnAddr m
peerSelectionPolicy
  , daPeerSharingRegistry :: PeerSharingRegistry ntnAddr m
daPeerSharingRegistry               = PeerSharingRegistry ntnAddr m
peerSharingRegistry
  }


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