[notifications] more granular notifications

src/Gargantext/Components/Login/PasswordForm.purs

@@ -19,6 +19,7 @@ import Gargantext.Hooks.FormValidation (VForm, useFormValidation)
 import Gargantext.Hooks.FormValidation.Unboxed as FV
 import Gargantext.Hooks.StateRecord (useStateRecord)
 import Gargantext.Sessions (postForgotPasswordRequest)
+import Gargantext.Types as GT
 import Gargantext.Utils ((?))
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
@@ -195,5 +196,5 @@ formValidation r = foldl append mempty rules
 sendEmail ::
       Backend
   ->  FormData
-  ->  Aff (Either String { status :: String })
+  ->  Aff (Either String GT.WorkerTask)
 sendEmail backend { email } = postForgotPasswordRequest backend email

src/Gargantext/Components/Notifications.purs

@@ -51,16 +51,19 @@ removeCallback (State state@{ callbacks }) topic uuid =
 
 -- | Execute all callbacks for a given Notification
 callNotification :: State -> Notification -> Effect Unit
-callNotification (State { callbacks }) (Notification topic message) = do
+callNotification (State { callbacks }) n = do
   -- here.log2 "[callTopic] topic" topic
   -- here.log2 "[callTopic] callbacks" (HM.values callbacks)
   -- here.log2 "[callTopic] topicCallbacks" (HM.values topicCallbacks)
-  _ <- for (HM.values topicCallbacks) $ \cb -> do
-    cb message
+
+  let topic = notificationTopic n
+  
+  _ <- for (HM.values $ topicCallbacks topic) $ \cb -> do
+    cb n
   pure unit
   where
-    topicCallbacks :: CallbacksHM
-    topicCallbacks = fromMaybe HM.empty $ HM.lookup topic callbacks
+    topicCallbacks :: Topic -> CallbacksHM
+    topicCallbacks topic = fromMaybe HM.empty $ HM.lookup topic callbacks
 
 
 
@@ -174,7 +177,7 @@ connect ws@(WSNotification ws') url session = do
                 case parsed of
                   Left err -> do
                     here.log2 "[connect] Can't parse message" err
-                  Right n@(Notification topic _message) -> do
+                  Right n -> do
                     -- here.log2 "[connect] notification" topic
                     performAction ws (Call n)
                   -- Right parsed' -> do

src/Gargantext/Components/Notifications/Types.purs

@@ -38,6 +38,7 @@ type UUID = String
 
 data Topic =
     UpdateJobProgress GT.AsyncTaskID
+  | UpdateWorkerProgress GT.WorkerTask
   | UpdateTree NodeId
 derive instance Generic Topic _
 instance Eq Topic where eq = genericEq
@@ -51,6 +52,9 @@ instance JSON.ReadForeign Topic where
       "update_job_progress" -> do
         { j_id } <- JSON.readImpl f :: F.F { j_id :: GT.AsyncTaskID }
         pure $ UpdateJobProgress j_id
+      "update_worker_progress" -> do
+        { ji } <- JSON.readImpl f :: F.F { ji :: GT.WorkerTask }
+        pure $ UpdateWorkerProgress ji
       "update_tree" -> do
         { node_id } <- JSON.readImpl f :: F.F { node_id :: NodeId }
         pure $ UpdateTree node_id
@@ -58,6 +62,8 @@ instance JSON.ReadForeign Topic where
 instance JSON.WriteForeign Topic where
   writeImpl (UpdateJobProgress j_id) = JSON.writeImpl { "type": "update_job_progress"
                                                       , j_id }
+  writeImpl (UpdateWorkerProgress ji) = JSON.writeImpl { "type": "update_worker_progress"
+                                                       , ji }
   writeImpl (UpdateTree node_id) = JSON.writeImpl { "type": "update_tree"
                                                   , node_id }
 
@@ -78,42 +84,28 @@ instance JSON.WriteForeign WSRequest where
   writeImpl WSDeauthorize = JSON.writeImpl { request: "deauthorize" }
 
 
-
-data Message =
-    -- TODO
-    -- MJobProgress GT.AsyncProgress
-    -- MJobProgress GT.AsyncTaskLog
-    MJobProgress GT.AsyncProgress
-  | MEmpty
-derive instance Generic Message _
-instance JSON.ReadForeign Message where
-  readImpl f = do
-    { type: type_ } <- JSON.readImpl f :: F.F { type :: String }
-    case type_ of
-      "MJobProgress" -> do
-        -- TODO
-        -- { job_progress } <- JSON.readImpl f :: F.F { job_progress :: GT.AsyncProgress }
-        -- { job_progress } <- JSON.readImpl f :: F.F { job_progress :: GT.AsyncTaskLog }
-        { job_status } <- JSON.readImpl f :: F.F { job_status :: GT.AsyncProgress }
-        pure $ MJobProgress job_status
-      "MEmpty" -> do
-        pure MEmpty
-      s -> do F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unknown Message type: " <> s
-
 data Notification =
-    Notification Topic Message
+    NUpdateJobProgress GT.AsyncTaskID GT.AsyncProgress
+  | NUpdateTree NodeId
 derive instance Generic Notification _
 instance JSON.ReadForeign Notification where
   readImpl f = do
-    let str = JSON.read_ f :: Maybe String
-    case str of
-      Nothing -> do
-        { notification } <- JSON.readImpl f :: F.F { notification :: { topic :: Topic, message :: Message } }
-        pure $ Notification notification.topic notification.message
-      Just s -> F.fail $ F.ErrorAtProperty "_" $ F.ForeignError $ "unkown string: " <> s
+    { type: type_ } <- JSON.readImpl f :: F.F { type :: String }
+    case type_ of
+      "update_job_progress" -> do
+        { j_id, job_status } <- JSON.readImpl f :: F.F { j_id :: GT.AsyncTaskID, job_status :: GT.AsyncProgress }
+        pure $ NUpdateJobProgress j_id job_status
+      "update_tree" -> do
+        { node_id } <- JSON.readImpl f :: F.F { node_id :: NodeId }
+        pure $ NUpdateTree node_id
+      s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unkown type: " <> s
+
+notificationTopic :: Notification -> Topic
+notificationTopic (NUpdateJobProgress taskId _) = UpdateJobProgress taskId
+notificationTopic (NUpdateTree nodeId) = UpdateTree nodeId
 
 
-type Callback = Message -> Effect Unit
+type Callback = Notification -> Effect Unit
 
 type CallbacksHM = HM.HashMap UUID Callback
 

src/Gargantext/Context/Progress.purs

@@ -15,7 +15,7 @@ import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.App.Store as AppStore
 import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (QueryProgressData, queryProgress)
 import Gargantext.Components.Notifications as Notifications
-import Gargantext.Components.Notifications.Types as NotificationsT
+import Gargantext.Components.Notifications.Types as NT
 import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
 import Gargantext.Prelude
@@ -116,17 +116,21 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
 
     useFirstEffect' $ do
       let (GT.AsyncTaskWithType { task: GT.AsyncTask { id: taskId } }) = props.asyncTask
-      let cb msg = do
+      let cb n = do
             -- here.log2 "callback! for job update" taskId
-            case msg of
-              NotificationsT.MJobProgress jobProgress -> launchAff_ $ onProgress jobProgress
-              NotificationsT.MEmpty -> fetchJobProgress
+            case n of
+              NT.NUpdateJobProgress _jId jobProgress -> launchAff_ $ onProgress jobProgress
+              _ -> pure unit
 
             resetInterval intervalIdRef (Just defaultJobPollInterval) fetchJobProgress
 
             -- The modal window has some problems closing when we refresh too early. This is a HACK
             -- void $ setTimeout 400 $ T2.reload reload
-      let action = NotificationsT.InsertCallback (NotificationsT.UpdateJobProgress taskId) ("task-" <> show taskId) cb
+      let action = NT.InsertCallback (NT.UpdateJobProgress taskId) ("task-" <> show taskId) cb
+      ws <- T.read wsNotification
+      Notifications.performAction ws action
+      -- let action = NT.InsertCallback (NT.UpdateWorkerProgress $ GT.WorkerTask { message_id: taskId }) ("worker-job-" <> show taskId) cb
+      let action = NT.InsertCallback (NT.UpdateJobProgress taskId) ("job-" <> taskId) cb
       ws <- T.read wsNotification
       Notifications.performAction ws action
       fetchJobProgress

src/Gargantext/Sessions.purs

@@ -21,6 +21,7 @@ import Gargantext.Config.REST as REST
 import Gargantext.Ends (class ToUrl, Backend, toUrl)
 import Gargantext.Prelude
 import Gargantext.Sessions.Types (Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId, sessionUrl, sessionId, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove)
+import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Simple.JSON as JSON
@@ -118,7 +119,7 @@ postAuthRequest backend ar@(AuthRequest {username}) =
     decode (Right (AuthData { token, tree_id, user_id })) =
       Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username, userId: user_id }
 
-postForgotPasswordRequest :: Backend -> String -> Aff (Either String { status :: String })
+postForgotPasswordRequest :: Backend -> String -> Aff (Either String GT.WorkerTask)
 postForgotPasswordRequest backend email =
   decode <$> REST.post Nothing (toUrl backend "async/forgot-password") { email }
   where

src/Gargantext/Types.purs

@@ -835,6 +835,18 @@ progressPercent (AsyncProgress { log }) = perc
           nom = toNumber $ failed + succeeded
           denom = toNumber $ failed + succeeded + remaining
 
+
+-- New type tasks (async workers)
+newtype WorkerTask = WorkerTask { message_id :: Number }
+derive instance Generic WorkerTask _
+derive instance Newtype WorkerTask _
+instance Eq WorkerTask where
+  eq = genericEq
+instance Show WorkerTask where
+  show = genericShow
+derive newtype instance JSON.ReadForeign WorkerTask
+derive newtype instance JSON.WriteForeign WorkerTask
+
 ---------------------------------------------------------------------------
 -- | GarganText Internal Sugar