[WIP] NewTask notification

src/Gargantext/API/Admin/EnvTypes.hs

@@ -114,6 +114,28 @@ data GargJob
   | AddAnnuaireFormJob
   | RecomputeGraphJob
   deriving (Show, Eq, Ord, Enum, Bounded)
+instance ToJSON GargJob where
+  toJSON = toJSON . show
+instance FromJSON GargJob where
+  parseJSON = withText $ \t ->
+    case t of
+      "TableNgramsJob" -> pure TableNgramsJob
+      "ForgotPasswordJob" -> pure ForgotPasswordJob
+      "UpdateNgramsListJobJSON" -> pure UpdateNgramsListJobJSON
+      "UpdateNgramsListJobTSV" -> pure UpdateNgramsListJobTSV
+      "AddContactJob" -> pure AddContactJob
+      "AddFileJob" -> pure AddFileJob
+      "DocumentFromWriteNodeJob" -> pure DocumentFromWriteNodeJob
+      "UpdateNodeJob" -> pure UpdateNodeJob
+      "UploadFrameCalcJob" -> pure UploadFrameCalcJob
+      "UploadDocumentJob" -> pure UploadDocumentJob
+      "NewNodeJob" -> pure NewNodeJob
+      "AddCorpusQueryJob" -> pure AddCorpusQueryJob
+      "AddCorpusFormJob" -> pure AddCorpusFormJob
+      "AddCorpusFileJob" -> pure AddCorpusFileJob
+      "AddAnnuaireFormJob" -> pure AddAnnuaireFormJob
+      "RecomputeGraphJob" -> pure RecomputeGraphJob
+      s -> prependFailure "parsing GargJob failed, " (typeMismatch "gargJob" s)
 
 -- Do /not/ treat the data types of this type as strict, because it's convenient
 -- to be able to partially initialise things like an 'Env' during tests, without

src/Gargantext/Core/AsyncUpdates/Dispatcher/Types.hs

@@ -29,6 +29,7 @@ import Data.ByteString.Lazy qualified as BSL
 import Data.List (nubBy)
 import DeferredFolds.UnfoldlM qualified as UnfoldlM
 import Data.UUID.V4 as UUID
+import Gargantext.API.Admin.EnvTypes (GargJob(..))
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Admin.Types (jwtSettings, Settings, jwtSettings)
@@ -55,23 +56,32 @@ import StmContainers.Set as SSet
 -- | A topic is sent, when a client wants to subscribe to specific
 -- | types of notifications
 data Topic =
+  -- | New task appeared on given node
+    NewTask NodeId (JobID 'Safe) GargJob
   -- | Update given Servant Job (we currently send a request every
   -- | second to get job status).
-   UpdateJobProgress (JobID 'Safe)
+  | UpdateJobProgress (JobID 'Safe)
   -- | 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, Ord)
 instance Prelude.Show Topic where
+  show (NewTask nodeId jId gargJob) = "NewTask " <> (show nodeId) <> ", " <> (CBUTF8.decode $ BSL.unpack $ Aeson.encode jId) <> ", " <> show gargJob
   show (UpdateJobProgress jId) = "UpdateJobProgress " <> (CBUTF8.decode $ BSL.unpack $ Aeson.encode jId)
   show (UpdateTree nodeId) = "UpdateTree " <> show nodeId
 instance Hashable Topic where
+  hashWithSalt salt (NewTask nodeId jId gargJob) = hashWithSalt salt ("new-task" :: Text, nodeId, Aeson.encode jId, show gargJob)
   hashWithSalt salt (UpdateJobProgress jId) = hashWithSalt salt ("update-job-progress" :: Text, Aeson.encode jId)
   hashWithSalt salt (UpdateTree nodeId) = hashWithSalt salt ("update-tree" :: Text, nodeId)
 instance FromJSON Topic where
   parseJSON = Aeson.withObject "Topic" $ \o -> do
     type_ <- o .: "type"
     case type_ of
+      "new_task" -> do
+        nodeId <= o .: "node_id"
+        jId <- o .: "j_id"
+        gargJob <- o .: "garg_job"
+        pure $ NewTask nodeId jId gargJob
       "update_job_progress" -> do
         jId <- o .: "j_id"
         pure $ UpdateJobProgress jId
@@ -80,13 +90,19 @@ instance FromJSON Topic where
         pure $ UpdateTree node_id
       s -> prependFailure "parsing type failed, " (typeMismatch "type" s)
 instance ToJSON Topic where
+  toJSON (NewTask nodeId jId gargJob) = Aeson.object [
+      "type" .= toJSON ("new_task" :: Text)
+    , "node_id" .= toJSON nodeId
+    , "j_id" .= toJSON jId
+    , "garg_job" .= toJSON gargJob
+    ]
   toJSON (UpdateJobProgress jId) = Aeson.object [
       "type" .= toJSON ("update_job_progress" :: Text)
     , "j_id" .= toJSON jId
     ]
-  toJSON (UpdateTree node_id) = Aeson.object [
+  toJSON (UpdateTree nodeId) = Aeson.object [
       "type" .= toJSON ("update_tree" :: Text)
-    , "node_id" .= toJSON node_id
+    , "node_id" .= toJSON nodeId
     ]
 
 -- | A message to  be sent inside a Notification
@@ -167,7 +183,7 @@ by default can handle 65k concurrent connections. With multiple users
 having multiple components open, we could exhaust that limit quickly.
 
 Hence, we architect this to have 1 websocket connection per web
-browser.
+-browser.
 -}
 data WSRequest =
     WSSubscribe Topic