Use directly socket for ws server stream

Former-commit-id: daa234438e35601f69c10115d502f3bb122900f6
Former-commit-id: b9c4a4820fed7c7fa9261fa3bc6097440e40b2e6 [formerly 0e80c23298933e37c2fc83f9690e2721de07dc1a] [formerly cc233a88979073852c3a3a09993f84038f632317 [formerly b78e81998262bdcf5ec2942e0c87e5f6e28e7865 [formerly b78e81998262bdcf5ec2942e0c87e5f6e28e7865 [formerly b78e81998262bdcf5ec2942e0c87e5f6e28e7865 [formerly d669991b6a4c285b1cfcd3966fd909d323eb0d2e]]]]]
Former-commit-id: eb6e0472a22f4c1eb9cf69e6533480b5fef5823a [formerly fb50ebbd510221c67dd18d4311eb995a3d392a07]
Former-commit-id: f6b4b9ff598de2a623d881018e949bf7e1f042fc
Former-commit-id: 0f42326884818628d0d79539c5559187d8d995e3
Former-commit-id: 3de35bb7f07cd76eab4e107034f08a963cfa9272
Former-commit-id: 532d3531daf0365ae6e59167b5997b4cd252737e [formerly c973fbc73d36e7a09fd3a4e37483ac4fa327b299]
Former-commit-id: ad6171066b614d131cbb450e35d75f1f630a5fbd
This commit is contained in:
Romain GERARD 2022-11-05 19:38:21 +01:00
parent fecd2e5fae
commit c305a77813

View file

@ -20,6 +20,7 @@ import Network.Socket (HostName, PortNumber)
import qualified Network.Socket as N hiding (recv, recvFrom,
send, sendTo)
import qualified Network.Socket.ByteString as N
import qualified Network.Socket.ByteString.Lazy as NL
import qualified Network.WebSockets as WS
import qualified Network.WebSockets.Connection as WS
@ -210,7 +211,8 @@ runTunnelingServer endPoint@(host, port) isAllowed = do
let srvSet = N.setReadBufferSize defaultRecvBufferSize $ N.serverSettingsTCP (fromIntegral port) (fromString host)
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)
let socket = fromJust $ N.appRawSocket sClient
stream <- WS.makeStream (N.recv socket defaultRecvBufferSize <&> \payload -> if payload == mempty then Nothing else Just payload) (NL.sendAll socket . fromJust)
runApp stream WS.defaultConnectionOptions (serverEventLoop (N.appSockAddr sClient) isAllowed)
info "CLOSE server"