[ws] remove textual ping/pong, replace with ping control frame

src/Gargantext/API/Routes.hs

@@ -12,9 +12,9 @@ Portability : POSIX
 {-# LANGUAGE ConstraintKinds      #-}
 {-# LANGUAGE KindSignatures       #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance HasSwagger (WithCustomErrorScheme GargAPI)
 
@@ -22,7 +22,6 @@ module Gargantext.API.Routes
       where
 
 import Control.Lens (view)
-import Data.List qualified as L
 import Data.Validity
 import Gargantext.API.Admin.Auth (ForgotPasswordAPI, ForgotPasswordAsyncAPI, withAccess, withPolicyT)
 import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))

src/Gargantext/Core/AsyncUpdates/Dispatcher.hs

@@ -124,8 +124,6 @@ data WSRequest =
   | WSUnsubscribe Topic
   | WSAuthorize Token
   | WSDeauthorize
-  | WSPing
-  | WSPong
   deriving (Eq, Show)
 instance FromJSON WSRequest where
   parseJSON = Aeson.withObject "WSRequest" $ \o -> do
@@ -141,8 +139,6 @@ instance FromJSON WSRequest where
          token <- o .: "token"
          pure $ WSAuthorize token
       "deauthorize" -> pure $ WSDeauthorize
-      "ping" -> pure WSPing
-      "pong" -> pure WSPong
       s -> prependFailure "parsing request type failed, " (typeMismatch "request" s)
     
 data Dispatcher =
@@ -216,9 +212,15 @@ wsServer authSettings subscriptions = streamData
     -- _ <- liftIO $ Async.withAsync (pure ()) (\_ -> wsLoop ws)
     pure ()
 
+  -- | Send a ping control frame periodically, otherwise the
+  -- | connection is dropped. NOTE that 'onPing' message is not
+  -- | supported in the JS API: either the browser supports this or
+  -- | not:
+  -- | https://stackoverflow.com/questions/10585355/sending-websocket-ping-pong-frame-from-browser
   pingLoop ws = do
     forever $ do
-      WS.sendDataMessage (wsConn ws) (WS.Text (Aeson.encode Ping) Nothing)
+      -- WS.sendDataMessage (wsConn ws) (WS.Text (Aeson.encode Ping) Nothing)
+      WS.sendPing (wsConn ws) ("" :: Text)
       threadDelay $ 10 * 1000000
     
   wsLoop ws = flip finally disconnect $ do
@@ -263,12 +265,6 @@ wsServer authSettings subscriptions = streamData
               Just WSDeauthorize -> do
                 -- TODO Update my subscriptions!
                 pure CUPublic
-              Just WSPing -> do
-                WS.sendDataMessage (wsConn ws) (WS.Text (Aeson.encode Pong) Nothing)
-                return user
-              Just WSPong -> do
-                putText $ "[wsLoop] pong received"
-                return user
           _ -> do
             putText "[wsLoop] binary ws messages not supported"
             return user
@@ -283,16 +279,12 @@ wsServer authSettings subscriptions = streamData
 
 data Notification =
    Notification Topic
- | Ping
- | Pong
   deriving (Eq, Show)
 
 instance ToJSON Notification where
   toJSON (Notification topic) = Aeson.object [
       "notification" .= toJSON topic
     ]
-  toJSON Ping = toJSON ("ping" :: Text)
-  toJSON Pong = toJSON ("pong" :: Text)
     
 
 ce_listener :: TVar [Subscription] -> IO ()