[websockets] fixes to task async end, also proto fix

src/Gargantext/Components/Notifications.purs

@@ -149,7 +149,7 @@ performAction (WSNotification ws') (Call notification) = do
 wsProtocol :: Effect String
 wsProtocol = do
   proto <- protocol
-  pure (if proto == "http" then "ws" else "wss")
+  pure (if proto == "http:" then "ws" else "wss")
 
 
 -- | Main WebSockets connect functionality. Handles incoming messages,
@@ -175,7 +175,7 @@ connect ws@(WSNotification ws') url session = do
                   Left err -> do
                     here.log2 "[connect] Can't parse message" err
                   Right n@(Notification topic _message) -> do
-                    here.log2 "[connect] notification" topic
+                    -- here.log2 "[connect] notification" topic
                     performAction ws (Call n)
                   -- Right parsed' -> do
                   --   here.log2 "[connect] onmessage, F.readString" parsed'

src/Gargantext/Context/Progress.purs

@@ -38,6 +38,14 @@ type AsyncProps =
 here :: R2.Here
 here = R2.here "Gargantext.Context.Progress"
 
+
+-- | Temporary constant, shouldn't be here. It's used together with
+-- | the 'resetInterval' function and when we fix the tasks so that
+-- | they can inform about their finish/error, this can be removed
+-- | along with 'resetInterval'.
+defaultJobPollInterval :: Int
+defaultJobPollInterval = 5000
+
 asyncProgress :: R2.Component AsyncProps
 asyncProgress = R2.component asyncProgressCpt
 asyncProgressCpt :: R.Component AsyncProps
@@ -55,12 +63,12 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
     let
       -- TODO Manage somehow to get the whole job status sent here via
       -- websockets, then we can remove the 'Maybe'
-      exec :: Maybe GT.AsyncProgress -> Effect Unit
-      exec Nothing = launchAff_ do
+      fetchJobProgress :: Effect Unit
+      fetchJobProgress = launchAff_ do
         let rdata = (RX.pick props :: Record QueryProgressData)
 
         eAsyncProgress <- queryProgress rdata
-        liftEffect $ here.log2 "[progress] received asyncProgress" eAsyncProgress
+        -- liftEffect $ here.log2 "[progress] received asyncProgress" eAsyncProgress
 
         -- exponential backoff in case of errors
         -- liftEffect $ do
@@ -75,11 +83,16 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
         -- Error logging will be done below, in handleRESTError
         case eAsyncProgress of
           Right _ -> pure unit
-          Left _err -> liftEffect $ GAT.finish props.nodeId props.asyncTask tasks
+          Left err -> do
+            liftEffect $ do
+              resetInterval intervalIdRef Nothing (pure unit)
+              GAT.finish props.nodeId props.asyncTask tasks
 
         handleRESTError hp errors eAsyncProgress onProgress
-      exec (Just jobProgress) = do
-        launchAff_ $ onProgress jobProgress
+
+      -- TODO Ideally we should use this function
+      -- onProgress jobProgress = do
+      --   launchAff_ $ onProgress jobProgress
         
 
       onProgress :: AsyncProgress -> Aff Unit
@@ -96,6 +109,7 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
           --   Nothing  -> R.nothing
           --   Just iid -> clearInterval iid
           handleErrorInAsyncProgress errors value
+          resetInterval intervalIdRef Nothing (pure unit)
           onFinish unit
         else
           R.nothing
@@ -103,47 +117,61 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
     useFirstEffect' $ do
       let (GT.AsyncTaskWithType { task: GT.AsyncTask { id: taskId } }) = props.asyncTask
       let cb msg = do
-            here.log2 "callback! for job update" taskId
+            -- here.log2 "callback! for job update" taskId
             case msg of
-              NotificationsT.MJobProgress jobProgress -> do
+              NotificationsT.MJobProgress _jobProgress -> do
                 -- TODO With jobProgress we could avoid polling here
-                -- exec (Just jobProgress)
-                exec Nothing
-              NotificationsT.MEmpty -> exec Nothing
+                -- onJobProgress jobProgress
+                fetchJobProgress
+              NotificationsT.MEmpty -> fetchJobProgress
+
+            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
       ws <- T.read wsNotification
       Notifications.performAction ws action
-      exec Nothing
-
+      fetchJobProgress
+ 
     -- Hooks
     -- useFirstEffect' do
     --   resetInterval intervalIdRef (Just 1000) exec
       -- intervalId <- setInterval interval' $ exec unit
       -- R.setRef intervalIdRef $ Just intervalId
 
+    -- TODO Current backend job implementation is that it cannot, by
+    -- itself, notify us when a job finished. Hence, we are forced to
+    -- poll for job still. However, we will keep canceling the timer
+    -- unless there is no progress report for some time.
+    useFirstEffect' $ do
+      resetInterval intervalIdRef (Just defaultJobPollInterval) fetchJobProgress
+
     -- Render
     pure $
 
       R.provideContext asyncContext (progress)
       children
 
-resetInterval :: R.Ref (Maybe IntervalId) -> Maybe Int -> (Unit -> Effect Unit) -> Effect Unit
+resetInterval :: R.Ref (Maybe IntervalId) -> Maybe Int -> Effect Unit -> Effect Unit
 resetInterval ref mInt exec = do
   case R.readRef ref /\ mInt of
     Nothing /\ Nothing  ->
       pure unit
     Nothing /\ Just interval' -> do
-      intervalId <- setInterval interval' $ exec unit
+      intervalId <- setInterval interval' exec'
       R.setRef ref $ Just intervalId
     Just iid /\ Nothing -> do
       clearInterval iid
       R.setRef ref Nothing
     Just iid /\ Just interval' -> do
       clearInterval iid
-      intervalId <- setInterval interval' $ exec unit
+      intervalId <- setInterval interval' exec'
       R.setRef ref $ Just intervalId
+  where
+    exec' = do
+      here.log "[resetInterval] calling"
+      exec
 
 asyncContext :: R.Context (Number)
 asyncContext = R.createContext 0.0