Fix High CPU utilization #38

+ Properly notify that the stream is closed when there is no more data
  to read from the socket


Former-commit-id: 040b6f949d9f6751cdb626d080094ea359926d56
Former-commit-id: a13469bd6a307b44d8fb33085406a29755d98f61 [formerly adee22fb776a28d4746cd99fe5bd33699b2f46ce] [formerly a01daff330828687249cd040a74eb1bd66143c4d [formerly f79391c53820f0df1a4609ed01fdb5de68222f0b [formerly c358f0ababd30764b97017f12f4b508b04caf1de] [formerly be3e3e6f4b78ffd53b6a3ea67d3aa09bfab91f2b] [formerly be3e3e6f4b78ffd53b6a3ea67d3aa09bfab91f2b [formerly be3e3e6f4b78ffd53b6a3ea67d3aa09bfab91f2b [formerly b008128bf854a39bbc5c6abdc5fd87cc8e38fffe]]]]]
Former-commit-id: cf525aa4cde74e9d22826fc2fd46fc6f08ca478b [formerly 6751159b82b46bedef7fde04c0444c76d391bd99]
Former-commit-id: 9669125c02d8fdb2339cd927d28db7cdc0a60a58
Former-commit-id: e711b3a557f7b037794667c0b4249a21c44abc3f
Former-commit-id: eccc9eaf7007ec09119c4307389991d4d199f4b6
Former-commit-id: a6d5dd21c88508a5c8f2afd031852955cb45998d [formerly 3e1eca9a176bb75971f232a2dc0dc887e2dd1d31]
Former-commit-id: 053a1b7025f8cb4d6c67a648c15b66be18f1e9f0
This commit is contained in:
Romain GERARD 2020-02-24 18:37:38 +01:00
parent b47a05449e
commit 0a788ca3f7

View file

@ -195,8 +195,8 @@ runTlsTunnelingServer endPoint@(bindTo, portNumber) isAllowed = do
where
runApp :: N.AppData -> WS.ConnectionOptions -> WS.ServerApp -> IO ()
runApp appData opts app= do
stream <- WS.makeStream (Just <$> N.appRead appData) (N.appWrite appData . toStrict . fromJust)
runApp appData opts app = do
stream <- WS.makeStream (N.appRead appData <&> \payload -> if payload == mempty then Nothing else Just payload) (N.appWrite appData . toStrict . fromJust)
bracket (WS.makePendingConnectionFromStream stream opts)
(\conn -> catch (WS.close $ WS.pendingStream conn) (\(_ :: SomeException) -> return ()))
app
@ -206,8 +206,8 @@ runTunnelingServer endPoint@(host, port) isAllowed = do
info $ "WAIT for connection on " <> toStr endPoint
let srvSet = N.setReadBufferSize defaultRecvBufferSize $ N.serverSettingsTCP (fromIntegral port) (fromString host)
void $ N.runTCPServer (srvSet) $ \sClient -> do
stream <- WS.makeStream (Just <$> N.appRead sClient) (N.appWrite sClient . toStrict . fromJust)
void $ N.runTCPServer srvSet $ \sClient -> do
stream <- WS.makeStream (N.appRead sClient <&> \payload -> if payload == mempty then Nothing else Just payload) (N.appWrite sClient . toStrict . fromJust)
runApp stream WS.defaultConnectionOptions (serverEventLoop isAllowed)
info "CLOSE server"