{-# LANGUAGE CPP #-}

#if !defined(mingw32_HOST_OS)
#define POSIX
#else
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
#endif

module Cardano.Network.Diffusion.Handlers where

import Control.Monad.Class.MonadTime.SI

import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers)
import Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Cardano
import Cardano.Network.Types (LedgerStateJudgement)
import Control.Concurrent.Class.MonadSTM.Strict
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.Tracer (traceWith)
import Ouroboros.Network.ConnectionManager.Core (Trace (..))
import Ouroboros.Network.PeerSelection.Governor.Types
           (makeDebugPeerSelectionState)
import System.Posix.Signals qualified as Signals
#endif

sigUSR1Handler
  :: Ord ntnAddr
  => Tracers ntnAddr ntnVersion ntnVersionData
             ntcAddr ntcVersion ntcVersionData
             extraState
             Cardano.DebugPeerSelectionState
             extraFlags extraPeers extraCounters
             IO
  -> STM IO UseLedgerPeers
  -> PeerSharing
  -> STM IO UseBootstrapPeers
  -> STM IO LedgerStateJudgement
  -> PeerMetrics IO ntnAddr
  -> (peerconn -> STM IO (Maybe Time))
  -- ^ return time when an active peer was promoted to a hot peer.
  -> ConnectionManager muxMode socket ntnAddr
                       handle handleError IO
  -> StrictTVar IO (PeerSelectionState
                   Cardano.ExtraState
                   extraFlags extraPeers ntnAddr
                   peerconn)
  -> IO ()
#ifdef POSIX
sigUSR1Handler :: forall ntnAddr ntnVersion ntnVersionData ntcAddr ntcVersion
       ntcVersionData extraState extraFlags extraPeers extraCounters
       peerconn (muxMode :: Mode) socket handle handleError.
Ord ntnAddr =>
Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
-> STM IO UseLedgerPeers
-> PeerSharing
-> STM IO UseBootstrapPeers
-> STM IO LedgerStateJudgement
-> PeerMetrics IO ntnAddr
-> (peerconn -> STM IO (Maybe Time))
-> ConnectionManager muxMode socket ntnAddr handle handleError IO
-> StrictTVar
     IO
     (PeerSelectionState
        ExtraState extraFlags extraPeers ntnAddr peerconn)
-> IO ()
sigUSR1Handler Tracers
  ntnAddr
  ntnVersion
  ntnVersionData
  ntcAddr
  ntcVersion
  ntcVersionData
  extraState
  DebugPeerSelectionState
  extraFlags
  extraPeers
  extraCounters
  IO
tracersExtra STM IO UseLedgerPeers
getUseLedgerPeers PeerSharing
ownPeerSharing STM IO UseBootstrapPeers
getBootstrapPeers
               STM IO LedgerStateJudgement
getLedgerStateJudgement PeerMetrics IO ntnAddr
metrics peerconn -> STM IO (Maybe Time)
getPromotedHotTime ConnectionManager muxMode socket ntnAddr handle handleError IO
connectionManager StrictTVar
  IO
  (PeerSelectionState
     ExtraState extraFlags extraPeers ntnAddr peerconn)
dbgStateVar = 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

               dbgState <- makeDebugPeerSelectionState ps up bp lsj am getPromotedHotTime now

               traceWith (dtConnectionManagerTracer tracersExtra)
                         (TrState state)
               traceWith (dtTracePeerSelectionTracer tracersExtra)
                         (TraceDebugState now dbgState)
           )
         )
         Maybe SignalSet
forall a. Maybe a
Nothing
  return ()
#else
sigUSR1Handler _ _ _ _ _ _ _ _ _ = pure ()
#endif