• Alfredo Di Napoli's avatar
    ws: remove calls to recvMalloc · 15b732f5
    Alfredo Di Napoli authored
    Remove the calls to `recvMalloc` in favour of using the (patched) `recv`
    from the original nanomsg library, which shouldn't segfault anymore. The
    reason for using `recv` are a few, but mostly the fact that `recv` can
    allocated arbitrary-long payloads data (up to the 1MB limit) without an
    hardcoded limit like `recvMalloc` was imposing. Furthermore, `recv` does
    resource cleanup for us via `c_nn_freemsg`, whereas `recvMalloc` is not
    thread/exception safe. Consider the implementation:
    
    ```
    recvMalloc :: Receiver a => Socket a -> Int -> IO ByteString
    recvMalloc (Socket t sid) numBytes = do
      ptr <- mallocBytes numBytes
      -- receive by blocking the thread
      len <- c_nn_recv sid ptr (#const NN_MSG) 0 -- (#const NN_DONTWAIT)
      str <- C.packCStringLen (castPtr ptr, fromIntegral len)
      free ptr
      return str
    ```
    
    If any exception (synchronous or asynchronous) strikes _before_ the call
    to `free`, we would be leaking C memory.
    15b732f5
Main.hs 1.97 KB
{-|
Module      : Main.hs
Description : Gargantext central exchange for async notifications
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

 -}

{-# LANGUAGE Strict            #-}

module Main where

import Control.Concurrent (threadDelay)
import Control.Monad (join, mapM_)
import Data.ByteString.Char8 qualified as C
import Data.Text qualified as T
import Gargantext.Core.AsyncUpdates.CentralExchange (gServer)
import Gargantext.Core.AsyncUpdates.Constants (ceBind, ceConnect)
import Gargantext.Prelude
import Nanomsg
import Options.Applicative


data Command =
    CEServer
  | SimpleServer
  | WSServer
  | Client


parser :: Parser (IO ())
parser = subparser
    ( command "ce-server" (info (pure gServer) idm)
   <> command "simple-server" (info (pure simpleServer) idm)
   <> command "ws-server" (info (pure wsServer) idm)
   <> command "client" (info (pure gClient) idm) )


main :: IO ()
main = join $ execParser (info parser idm)

simpleServer :: IO ()
simpleServer = do
  withSocket Pull $ \s -> do
    _ <- bind s ceBind
    putText "[simpleServer] receiving"
    forever $ do
      mr <- recv s
      C.putStrLn mr
      -- case mr of
      --   Nothing -> pure ()
      --   Just r -> C.putStrLn r
      -- threadDelay 10000

wsServer :: IO ()
wsServer = do
  withSocket Pull $ \ws -> do
    _ <- bind ws "ws://*:5560"
    forever $ do
      putText "[wsServer] receiving"
      r <- recv ws
      C.putStrLn r
    
gClient :: IO ()
gClient = do
    withSocket Push $ \s -> do
      _ <- connect s ceConnect
      -- let str = C.unwords (take 10 $ repeat "hello")
      let str = "{\"type\": \"update_tree_first_level\", \"node_id\": -1}"
      C.putStrLn $ C.pack "sending: " <> str
      send s str

    withSocket Push $ \s -> do
      _ <- connect s ceConnect
      let str2 = "{\"type\": \"update_tree_first_level\", \"node_id\": -2}"
      C.putStrLn $ C.pack "sending: " <> str2
      send s str2