{-# LANGUAGE CPP #-}

#if !defined(mingw32_HOST_OS)
#define POSIX
#endif

module Ouroboros.Cardano.Network.Diffusion.Handlers where

import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers)
import Cardano.Network.Types (LedgerStateJudgement)
import Control.Concurrent.Class.MonadSTM.Strict
import Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Cardano
import Ouroboros.Network.ConnectionManager.Types
import Ouroboros.Network.Diffusion.Types (Tracers (..))
import Ouroboros.Network.PeerSelection.Governor
import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers)
import Ouroboros.Network.PeerSelection.PeerMetric
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
#ifdef POSIX
import Control.Monad.Class.MonadTime.SI
import Control.Tracer (traceWith)
import Ouroboros.Network.ConnectionManager.Core (Trace (..))
import Ouroboros.Network.PeerSelection.Governor.Types
           (makeDebugPeerSelectionState)
import System.Posix.Signals qualified as Signals
#endif

#ifdef POSIX
sigUSR1Handler
  :: Ord ntnAddr
  => Tracers ntnAddr ntnVersion ntnVersionData
             ntcAddr ntcVersion ntcVersionData
             resolverError extraState
             Cardano.DebugPeerSelectionState
             extraFlags extraPeers extraCounters
             IO
  -> STM IO UseLedgerPeers
  -> PeerSharing
  -> STM IO UseBootstrapPeers
  -> STM IO LedgerStateJudgement
  -> ConnectionManager muxMode socket ntnAddr
                       handle handleError IO
  -> StrictTVar IO (PeerSelectionState
                   Cardano.ExtraState
                   extraFlags extraPeers ntnAddr
                   peerconn)
  -> PeerMetrics IO ntnAddr
  -> IO ()
sigUSR1Handler :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData resolverError extraState extraFlags extraPeers
       extraCounters (muxMode :: Mode) socket handle handleError peerconn.
Ord ntnAddr =>
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
-> STM IO UseLedgerPeers
-> PeerSharing
-> STM IO UseBootstrapPeers
-> STM IO LedgerStateJudgement
-> ConnectionManager muxMode socket ntnAddr handle handleError IO
-> StrictTVar
     IO
     (PeerSelectionState
        ExtraState extraFlags extraPeers ntnAddr peerconn)
-> PeerMetrics IO ntnAddr
-> IO ()
sigUSR1Handler Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  resolverError
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
tracersExtra STM IO UseLedgerPeers
getUseLedgerPeers PeerSharing
ownPeerSharing STM IO UseBootstrapPeers
getBootstrapPeers
               STM IO LedgerStateJudgement
getLedgerStateJudgement ConnectionManager muxMode socket ntnAddr handle handleError IO
connectionManager StrictTVar
  IO
  (PeerSelectionState
     ExtraState extraFlags extraPeers ntnAddr peerconn)
dbgStateVar PeerMetrics IO ntnAddr
metrics = do
  _ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
Signals.installHandler
         Signal
Signals.sigUSR1
         (IO () -> Handler
Signals.Catch
           (do now <- IO Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
               (state, up, bp, lsj, am, ps) <- atomically $ do
                  useBootstrapPeers <- getBootstrapPeers
                  (,,,,,) <$> readState connectionManager
                          <*> upstreamyness metrics
                          <*> fetchynessBlocks metrics
                          <*> (Cardano.DebugPeerSelectionState <$> getLedgerStateJudgement)
                          <*> readAssociationMode
                                getUseLedgerPeers
                                ownPeerSharing
                                useBootstrapPeers
                          <*> readTVar dbgStateVar

               let dbgState = PeerSelectionState
  ExtraState extraFlags extraPeers ntnAddr peerconn
-> Map ntnAddr Int
-> Map ntnAddr Int
-> DebugPeerSelectionState
-> AssociationMode
-> DebugPeerSelectionState
     DebugPeerSelectionState extraFlags extraPeers ntnAddr
forall extraState extraFlags extraPeers peeraddr peerconn
       extraDebugState.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Map peeraddr Int
-> Map peeraddr Int
-> extraDebugState
-> AssociationMode
-> DebugPeerSelectionState
     extraDebugState extraFlags extraPeers peeraddr
makeDebugPeerSelectionState PeerSelectionState
  ExtraState extraFlags extraPeers ntnAddr peerconn
ps Map ntnAddr Int
up Map ntnAddr Int
bp DebugPeerSelectionState
lsj AssociationMode
am

               traceWith (dtConnectionManagerTracer tracersExtra)
                         (TrState state)
               traceWith (dtTracePeerSelectionTracer tracersExtra)
                         (TraceDebugState now dbgState)
           )
         )
         Maybe SignalSet
forall a. Maybe a
Nothing
  return ()
#else
sigUSR1Handler
  :: Tracers ntnAddr ntnVersion ntnVersionData
             ntcAddr ntcVersion ntcVersionData
             resolverError extraState
             Cardano.DebugPeerSelectionState
             extraFlags extraPeers extraCounters
             IO
  -> STM IO UseLedgerPeers
  -> PeerSharing
  -> UseBootstrapPeers
  -> STM IO LedgerStateJudgement
  -> ConnectionManager muxMode socket ntnAddr
                       handle handleError IO
  -> StrictTVar IO (PeerSelectionState
                   Cardano.ExtraState
                   extraFlags extraPeers ntnAddr
                   peerconn)
  -> PeerMetrics IO ntnAddr
  -> IO ()
sigUSR1Handler _ _ _ _ _ _ _ _ = pure ()
#endif