[websockets] some stub datatypes

gargantext.cabal

@@ -137,7 +137,9 @@ library
       Gargantext.API.Node.Update
       Gargantext.API.Prelude
       Gargantext.API.Routes
+      Gargantext.API.WebSockets
       Gargantext.Core
+      Gargantext.Core.AsyncUpdates
       Gargantext.Core.Mail.Types
       Gargantext.Core.Methods.Similarities
       Gargantext.Core.Methods.Similarities.Conditional
@@ -603,6 +605,7 @@ library
     , servant-server >= 0.18.3 && < 0.20
     , servant-swagger ^>= 1.1.10
     , servant-swagger-ui ^>= 0.3.5.3.5.0
+    , servant-websockets >= 2.0.0 && < 2.1
     , servant-xml-conduit >= 0.1.0.4
     , simple-reflect ^>= 0.3.3
     , singletons ^>= 2.7

src/Gargantext/API/WebSockets.hs

+{-|
+Module      : Gargantext.API.WebSockets
+Description : WebSockets API
+Copyright   : (c) CNRS, 2024-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE TypeOperators #-}
+
+module Gargantext.API.WebSockets
+where
+
+import Data.Text (pack)
+import Network.WebSockets (PendingConnection, acceptRequest, sendTextData, withPingThread)
+import Protolude
+import Servant
+import Servant.API.WebSocket qualified as WS
+
+
+type API = "ws" :> WS.WebSocketPending
+
+server :: Server API
+server = streamData
+ where
+  streamData :: MonadIO m => PendingConnection -> m ()
+  streamData pc = do
+    c <- liftIO $ acceptRequest pc
+    liftIO $ withPingThread c 10 (pure ()) $ do
+      forM_ [1..] $ \i -> do
+        sendTextData c (pack $ show (i :: Int)) >> threadDelay (1*ms)
+  ms = 1000000

src/Gargantext/Core/AsyncUpdates.hs

+{-|
+Module      : Gargantext.Core.AsyncUpdates
+Description : Asynchronous updates to the frontend
+Copyright   : (c) CNRS, 2024-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+module Gargantext.Core.AsyncUpdates
+where
+
+import Gargantext.Core.Types (NodeId, UserId)
+import Protolude
+
+
+{-
+I imagine the workflow as follows:
+- somewhere in the code (or in the async job worker) we decide to send
+  an update message to all interested users
+- such an action (UserAction) can be associated with the triggering
+  user (but doesn't have to be)
+- we compute interested users for given notification
+- we broadcast (using our broker) these notifications to all
+  interested users 
+- the broadcast message is either simple (meaning: hey, we have new
+  data, if you want you can send an update request) or we could send
+  the changed data already
+-}
+    
+
+-- | Various update actions
+data UpdateAction =
+  -- | Update given Servant Job (we currently send a request every second to get job status)
+  --  UpdateJob JobID
+  -- | Given parent node id, trigger update of the node and its
+  --   children (e.g. list is automatically created in a corpus)
+  UpdateTree NodeId
+  deriving (Eq, Show)
+
+data UserSource =
+    USUser UserId
+  | USSystem
+  deriving (Eq, Show)
+    
+-- | Action possibly associated with user who triggered it (there can
+--   be system actions as well)
+data UserAction =
+  UserAction UserSource UpdateAction
+  deriving (Eq, Show)
+    
+-- | Represents a notification that goes to a given user. This is
+--   directly sent via WebSockets.
+data UserNotification =
+  UserNotification UserId UserAction
+  deriving (Eq, Show)
+
+-- | What we want now is, given a UserAction action, generate all
+--   interested users to which the notification will be sent.
+--   This function lives in a monad because we have to fetch users
+--   from DB.
+notificationsForUserAction :: UserAction -> m [ UserNotification ]
+notificationsForUserAction = undefined
+
+
+-- | Stores connection type associated with given user.
+--   We probably should set conn = Servant.API.WebSocket.Connection
+data ConnectedUser conn =
+  ConnectedUser UserId conn
+
+
+-- | Given a UserNotification and all connected users, send it to
+--   interested ones.
+sendNotification :: UserNotification -> [ ConnectedUser conn ] -> m ()
+sendNotification = undefined

src/Gargantext/Core/Types.hs

@@ -14,8 +14,8 @@ commentary with @some markup@.
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 
 ------------------------------------------------------------------------
-{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE DerivingStrategies   #-}
+{-# LANGUAGE TemplateHaskell      #-}
 
 module Gargantext.Core.Types ( module Gargantext.Core.Types.Main
                              , module Gargantext.Database.Admin.Types.Node

src/Gargantext/Core/Types/Main.hs

@@ -19,6 +19,7 @@ module Gargantext.Core.Types.Main where
 ------------------------------------------------------------------------
 
 import Data.Bimap (Bimap)
+import Data.Bimap qualified as Bimap
 import Data.Swagger ( ToSchema(..), ToParamSchema, genericDeclareNamedSchema )
 import Data.Text (unpack, pack)
 import Data.TreeDiff
@@ -29,7 +30,6 @@ import Gargantext.Prelude
 import Servant.API (FromHttpApiData(..), ToHttpApiData(..))
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-import qualified Data.Bimap as Bimap
 
 type CorpusName = Text
 ------------------------------------------------------------------------

src/Gargantext/Database/Admin/Types/Node.hs

@@ -49,7 +49,7 @@ import Opaleye qualified as O
 import Prelude qualified
 import Servant hiding (Context)
 import Test.QuickCheck (elements, Positive (getPositive))
-import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary), arbitraryBoundedEnum)
+import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary), arbitraryBoundedEnum )
 import Test.QuickCheck.Instances.Text ()
 import Test.QuickCheck.Instances.Time ()
 import Text.Read (read)