[notifications] add possibility to notify user from the backend

src/Gargantext/Components/App/App.purs

@@ -2,6 +2,7 @@ module Gargantext.Components.App (app) where
 
 import Gargantext.Prelude
 
+import Data.Array as A
 import Data.Sequence as Seq
 import Data.Tuple.Nested ((/\))
 import Gargantext.AsyncTasks as GAT
@@ -14,7 +15,7 @@ import Gargantext.Hooks (useHashRouter)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
 import Gargantext.Router as Router
 import Gargantext.Sessions as Sessions
-import Gargantext.Types (CacheParams, defaultCacheParams)
+import Gargantext.Types (CacheParams, defaultCacheParams, FrontendError(FStringNotification))
 import Gargantext.Utils (getter, host)
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
@@ -122,6 +123,15 @@ mainAppCpt = here.component "main" cpt
       wsProto <- Notifications.wsProtocol
       h <- host
       Notifications.connect ws (wsProto <> "://" <> h <> "/ws") session
+
+      -- Subscribe to ping requests (e.g. NotifyUser)
+      let
+        callback n = case n of
+          NotificationsT.NNotifyUser _userId notification -> T.modify_ (A.cons $ FStringNotification { notification }) boxes.errors
+          _ -> here.log2 "ping received but not handled" n
+      let action = NotificationsT.InsertCallback NotificationsT.Ping "ping!" callback
+      Notifications.performAction ws action
+
     -- T.write_ ws boxes.wsNotification
     -- NOTE: Dummy subscription
     -- let action = NotificationsT.InsertCallback (NotificationsT.UpdateTree (-1)) "some-uuid" (\_ -> here.log "callback!")

src/Gargantext/Components/ErrorsView.purs

@@ -38,6 +38,7 @@ componentCpt = here.component "main" cpt
 
   showError errors i (FStringError { error }) = errorAlert errors i "danger" error
   showError errors i (FStringWarning { warning }) = errorAlert errors i "warning" warning
+  showError errors i (FStringNotification { notification }) = errorAlert errors i "info" notification
   showError errors i (FRESTError { error }) = errorAlert errors i "danger" (show error)
   showError errors i (FOtherError { error }) = errorAlert errors i "danger" (show error)
 

src/Gargantext/Components/Notifications.purs

@@ -142,7 +142,7 @@ performAction ws (RemoveCallback topic uuid) = do
 -- WSNotification $ ws' { state = removeCallback ws'.state topic uuid }
 performAction (WSNotification ws') (Call notification) = do
   state <- Ref.read ws'.state
-  -- here.log2 "[performAction Call] state" state
+  -- here.log2 "[performAction Call] notification" notification
   callNotification state notification
 
 -- | Correctly choose between "ws" and "wss" protocols based on what

src/Gargantext/Components/Notifications/Types.purs

@@ -18,6 +18,7 @@ import Effect.Timer (setTimeout)
 import Effect.Var (($=))
 import Effect.Var as Var
 import Foreign as F
+import Gargantext.Components.Login.Types (UserId)
 import Gargantext.Sessions.Types (Session(..))
 import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
@@ -37,6 +38,7 @@ type UUID = String
 data Topic
   = UpdateWorkerProgress GT.WorkerTask
   | UpdateTree NodeId
+  | Ping
 
 derive instance Generic Topic _
 instance Eq Topic where
@@ -58,6 +60,8 @@ instance JSON.ReadForeign Topic where
       "update_tree" -> do
         { node_id } <- JSON.readImpl f :: F.F { node_id :: NodeId }
         pure $ UpdateTree node_id
+      "ping" -> do
+        pure Ping
       s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unknown Topic type: " <> s
 
 instance JSON.WriteForeign Topic where
@@ -69,6 +73,9 @@ instance JSON.WriteForeign Topic where
     { "type": "update_tree"
     , node_id
     }
+  writeImpl Ping = JSON.writeImpl
+    { "type": "ping"
+    }
 
 data WSRequest
   = WSSubscribe Topic
@@ -98,6 +105,7 @@ instance JSON.WriteForeign WSRequest where
 data Notification
   = NUpdateWorkerProgress GT.WorkerTask GT.AsyncTaskLog
   | NUpdateTree NodeId
+  | NNotifyUser UserId String
 
 derive instance Generic Notification _
 instance JSON.ReadForeign Notification where
@@ -110,6 +118,9 @@ instance JSON.ReadForeign Notification where
       "update_tree" -> do
         { node_id } <- JSON.readImpl f :: F.F { node_id :: NodeId }
         pure $ NUpdateTree node_id
+      "notify_user" -> do
+        { user_id, message } <- JSON.readImpl f :: F.F { user_id :: UserId, message :: String }
+        pure $ NNotifyUser user_id message
       s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unkown type: " <> s
 
 notificationTopics :: Notification -> Array Topic
@@ -123,6 +134,7 @@ notificationTopics (NUpdateWorkerProgress workerTask@(GT.WorkerTask { node_id })
     Nothing -> []
     Just nId -> [ UpdateTree nId ]
 notificationTopics (NUpdateTree nodeId) = [ UpdateTree nodeId ]
+notificationTopics (NNotifyUser _ _) = [ Ping ]
 
 type Callback = Notification -> Effect Unit
 

src/Gargantext/Types.purs

@@ -922,6 +922,7 @@ toggleSidePanelState Opened = Closed
 data FrontendError
   = FStringError { error :: String }
   | FStringWarning { warning :: String }
+  | FStringNotification { notification :: String }
   | FRESTError { error :: RESTError }
   | FOtherError { error :: String }