From f5dbfd7cfa7f14ac750ce2cb30a70bfa9d078822 Mon Sep 17 00:00:00 2001
From: Romain GERARD <erebe@erebe.eu>
Date: Sat, 5 Nov 2022 22:26:18 +0100
Subject: [PATCH] Use directly socket for server stream

Former-commit-id: 9f42c43688c66c30c4eaa488cf1ec3063b3ea9bb
Former-commit-id: 55dc272863336122c30304d8a974d41ef4b6d534 [formerly 5df12e9085b5aea55438fef7f978ee0dc541d7fe] [formerly e8fe8059bd0a909fcd2a939da122e3da3a23033e [formerly ec1b9baeb2a48ddac13711abf5916c6d514ed6ba [formerly ec1b9baeb2a48ddac13711abf5916c6d514ed6ba [formerly ec1b9baeb2a48ddac13711abf5916c6d514ed6ba [formerly c041b4158cb292d0b6906727131ca7b518cd2410]]]]]
Former-commit-id: 02d95624caa0c41a18f176f39c5dae08042f2185 [formerly 5ea32e9ce13de58f524e4353cc3f958e8625c55f]
Former-commit-id: 10cf6e796e862bddd3ad98dfd049540689272999
Former-commit-id: b1547ba96f437ab048d12ad7c1a90368c973fadc
Former-commit-id: c5a28603e3efad594d7cb3369a4ec3a7a3b721df
Former-commit-id: 28e143cd4e09423ad924e73555018df20280c9de [formerly be7d5b4c8c4d060dd2ba5a6329bf8875d53f48ea]
Former-commit-id: 65e1ae28fab86cc8d31b5373fef2becad7df9973
---
 src/Tunnel.hs | 3 ++-
 src/Types.hs  | 2 +-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Tunnel.hs b/src/Tunnel.hs
index 4faefb5..778b0ec 100644
--- a/src/Tunnel.hs
+++ b/src/Tunnel.hs
@@ -200,7 +200,8 @@ runTlsTunnelingServer endPoint@(bindTo, portNumber) isAllowed = do
   where
     runApp :: N.AppData -> WS.ConnectionOptions -> WS.ServerApp -> IO ()
     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)
+      let socket = fromJust $ N.appRawSocket appData
+      stream <- WS.makeStream (N.recv socket defaultRecvBufferSize <&> \payload -> if payload == mempty then Nothing else Just payload) (NL.sendAll socket . fromJust)
       bracket (WS.makePendingConnectionFromStream stream opts)
               (\conn -> catch (WS.close $ WS.pendingStream conn) (\(_ :: SomeException) -> return ()))
               app
diff --git a/src/Types.hs b/src/Types.hs
index cf9c8cb..a7f73d0 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -33,7 +33,7 @@ deriving instance Hashable N.SockAddr
 {-# NOINLINE defaultRecvBufferSize #-}   
 defaultRecvBufferSize ::  Int
 defaultRecvBufferSize = unsafeDupablePerformIO $
-  bracket (N.socket N.AF_INET N.Stream 0) N.close (\sock -> N.getSocketOption  sock N.RecvBuffer)
+  bracket (N.socket N.AF_INET N.Stream 0) N.close (\sock -> N.getSocketOption sock N.RecvBuffer)
 
 sO_MARK :: N.SocketOption
 sO_MARK = N.SockOpt 1 36 -- https://elixir.bootlin.com/linux/latest/source/arch/alpha/include/uapi/asm/socket.h#L64