[websockets] ws server test for nanomsg

Also, will use stm containers

bin/gargantext-central-exchange/Main.hs

@@ -25,18 +25,29 @@ import Options.Applicative
 
 data Command =
     Server
+  | WSServer
   | Client
 
 
 parser :: Parser (IO ())
 parser = subparser
     ( command "server" (info (pure gServer) idm)
+   <> command "ws-server" (info (pure wsServer) idm)
    <> command "client" (info (pure gClient) idm) )
 
 
 main :: IO ()
 main = join $ execParser (info parser idm)
 
+wsServer :: IO ()
+wsServer = do
+  withSocket Pull $ \ws -> do
+    _ <- connect ws "ws://localhost:5566"
+    forever $ do
+      putText "[wsServer] receiving"
+      r <- recv ws
+      C.putStrLn r
+    
 gClient :: IO ()
 gClient = do
     withSocket Push $ \s -> do
@@ -51,3 +62,4 @@ gClient = do
       let str2 = "{\"type\": \"update_tree_first_level\", \"node_id\": -2}"
       C.putStrLn $ C.pack "sending: " <> str2
       send s str2
+

gargantext.cabal

@@ -638,6 +638,7 @@ library
     , split ^>= 0.2.3.4
     , stemmer ^>= 0.5.2
     , stm ^>= 2.5.0.1
+    , stm-containers >= 1.2.1 && < 1.3
     , swagger2 ^>= 2.6
     , taggy-lens ^>= 0.1.2
     , tagsoup ^>= 0.14.8

src/Gargantext/Core/AsyncUpdates/Dispatcher.hs

@@ -224,8 +224,8 @@ wsServer authSettings subscriptions = streamData
       threadDelay $ 10 * 1000000
     
   wsLoop ws = flip finally disconnect $ do
-      putText "[wsLoop] connecting"
-      wsLoop' CUPublic
+    putText "[wsLoop] connecting"
+    wsLoop' CUPublic
 
     where
       wsLoop' user = do
@@ -299,9 +299,13 @@ ce_listener subscriptions = do
         Nothing -> putText "[ce_listener] unknown message from central exchange"
         Just ceMessage -> do
           subs <- atomically $ readTVar subscriptions
-          -- TODO This isn't safe: we atomically fetch subscriptions,
+          -- NOTE This isn't safe: we atomically fetch subscriptions,
           -- then send notifications one by one. In the meantime, a
-          -- subscription could end or new ones could appear
+          -- subscription could end or new ones could appear (but is
+          -- this really a problem? I new subscription comes up, then
+          -- probably they already fetch new tree anyways, and if old
+          -- one drops in the meantime, it won't listen to what we
+          -- send...)
           let filteredSubs = filterCEMessageSubs ceMessage subs
           mapM_ (sendNotification ceMessage) filteredSubs
   where