Add sendTimeout combinator

src/Gargantext/Core/Notifications/CentralExchange.hs

@@ -31,8 +31,8 @@ import Gargantext.Core.Config (GargConfig, gc_notifications_config, gc_logging)
 import Gargantext.Core.Config.Types (NotificationsConfig(..))
 import Gargantext.Core.Notifications.CentralExchange.Types
 import Gargantext.Prelude
-import Gargantext.System.Logging (LogLevel(..), withLogger, logLoc)
-import Nanomsg (Pull(..), Push(..), bind, connect, recv, send, withSocket, shutdown)
+import Gargantext.System.Logging (LogLevel(..), withLogger, logLoc, Logger)
+import Nanomsg (Pull(..), Push(..), bind, connect, recv, send, withSocket, shutdown, Socket, Sender)
 import System.Timeout (timeout)
 
 {-
@@ -99,15 +99,29 @@ gServer cfg = do
               -- process, independent of the server.
               -- send the same message that we received
               -- void $ sendNonblocking s_dispatcher r
-              void $ timeout 100_000 $ send s_dispatcher r
+              sendTimeout ioLogger s_dispatcher r
             Just (UpdateWorkerProgress _ji _jl) -> do
               -- $(logLoc) ioLogger DEBUG $ "[central_exchange] update worker progress: " <> show ji <> ", " <> show jl
-              void $ timeout 100_000 $ send s_dispatcher r
+              sendTimeout ioLogger s_dispatcher r
             Just Ping -> do
-              void $ timeout 100_000 $ send s_dispatcher r
+              sendTimeout ioLogger s_dispatcher r
             Nothing ->
               $(logLoc) ioLogger ERROR $ "[central_exchange] cannot decode message: " <> show r
 
+-- | A static send timeout in microseconds.
+send_timeout_ns :: Int
+send_timeout_ns = 100_00
+
+-- | Sends the given payload ensure the send doesn't take more than the static
+-- 'send_timeout_ns', logging a message if the timeouts kicks in.
+sendTimeout :: Sender a => Logger IO -> Socket a -> ByteString -> IO ()
+sendTimeout ioLogger sock payload = withFrozenCallStack $ do
+  timeoutKickedIn <- timeout send_timeout_ns $ send sock $ payload
+  case timeoutKickedIn of
+    Nothing ->
+      $(logLoc) ioLogger ERROR $ "[central_exchange] couldn't send msg in timely fashion."
+    Just () ->
+      $(logLoc) ioLogger DEBUG $ "[central_exchange] message sent."
 
 notify :: GargConfig -> CEMessage -> IO ()
 notify cfg ceMessage = withLogger log_cfg $ \ioLogger -> do
@@ -120,12 +134,7 @@ notify cfg ceMessage = withLogger log_cfg $ \ioLogger -> do
             $(logLoc) ioLogger DEBUG $ "[central_exchange] sending: " <> (TE.decodeUtf8 $ BSL.toStrict str)
             -- err <- sendNonblocking s $ BSL.toStrict str
             -- putText $ "[notify] err: " <> show err
-            timeoutKickedIn <- timeout 100_000 $ send s $ BSL.toStrict str
-            case timeoutKickedIn of
-              Nothing ->
-                $(logLoc) ioLogger ERROR $ "[central_exchange] couldn't send msg in timely fashion."
-              Just () ->
-                $(logLoc) ioLogger DEBUG $ "[central_exchange] message sent."
+            sendTimeout ioLogger s (BSL.toStrict str)
       do_work `finally` shutdown s connectEndpoint
   where
     NotificationsConfig { _nc_central_exchange_connect } = cfg ^. gc_notifications_config