From c3109a64a94e3ee75d72c63fddb51b941536919c Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Tue, 17 Sep 2024 12:43:05 +0300 Subject: [PATCH 1/5] warp: Add Run.serveConnection to Internal re-exports --- warp/ChangeLog.md | 4 ++++ warp/Network/Wai/Handler/Warp/Internal.hs | 1 + warp/warp.cabal | 2 +- 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/warp/ChangeLog.md b/warp/ChangeLog.md index 89e9d41f4..c574d34d7 100644 --- a/warp/ChangeLog.md +++ b/warp/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for warp +## 3.4.2 + +* serveConnection is re-exported from the Internal module. + ## 3.4.1 * Using time-manager v0.1.0, and auto-update v0.2.0. diff --git a/warp/Network/Wai/Handler/Warp/Internal.hs b/warp/Network/Wai/Handler/Warp/Internal.hs index e686272f0..79be77248 100644 --- a/warp/Network/Wai/Handler/Warp/Internal.hs +++ b/warp/Network/Wai/Handler/Warp/Internal.hs @@ -86,6 +86,7 @@ module Network.Wai.Handler.Warp.Internal ( -- * Misc http2server, withII, + serveConnection, pReadMaker, ) where diff --git a/warp/warp.cabal b/warp/warp.cabal index 31205a72e..cadfe45fc 100644 --- a/warp/warp.cabal +++ b/warp/warp.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: warp -version: 3.4.1 +version: 3.4.2 license: MIT license-file: LICENSE maintainer: michael@snoyman.com From 838e769b8c8442c9f981b7c9a917eb24d34ae51f Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Tue, 17 Sep 2024 21:50:33 +0300 Subject: [PATCH 2/5] warp-tls: Extract and expose attachConn --- warp-tls/ChangeLog.md | 4 ++++ warp-tls/Network/Wai/Handler/WarpTLS.hs | 32 +++++++++++++++---------- warp-tls/warp-tls.cabal | 2 +- 3 files changed, 24 insertions(+), 14 deletions(-) diff --git a/warp-tls/ChangeLog.md b/warp-tls/ChangeLog.md index c979c0784..f6df04e08 100644 --- a/warp-tls/ChangeLog.md +++ b/warp-tls/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog +## 3.4.7 + +* Expose `attachConn` to use post-handshake TLS connection. + ## 3.4.6 * Preparing for tls v2.1 diff --git a/warp-tls/Network/Wai/Handler/WarpTLS.hs b/warp-tls/Network/Wai/Handler/WarpTLS.hs index 26aff6b97..c4dd3bfca 100644 --- a/warp-tls/Network/Wai/Handler/WarpTLS.hs +++ b/warp-tls/Network/Wai/Handler/WarpTLS.hs @@ -50,6 +50,9 @@ module Network.Wai.Handler.WarpTLS ( -- * Exception WarpTLSException (..), + + -- * Low-level + attachConn ) where import Control.Applicative ((<|>)) @@ -357,14 +360,8 @@ httpOverTls TLSSettings{..} _set s bs0 params = ctx <- TLS.contextNew (backend recvN) params TLS.contextHookSetLogging ctx tlsLogging TLS.handshake ctx - h2 <- (== Just "h2") <$> TLS.getNegotiatedProtocol ctx - isH2 <- I.newIORef h2 - writeBuffer <- createWriteBuffer 16384 - writeBufferRef <- I.newIORef writeBuffer - -- Creating a cache for leftover input data. - tls <- getTLSinfo ctx - mysa <- getSocketName s - return (conn ctx writeBufferRef isH2 mysa, tls) + attachConn s ctx + wrappedRecvN recvN n = handleAny (const mempty) $ recvN n backend recvN = TLS.Backend { TLS.backendFlush = return () @@ -386,7 +383,20 @@ httpOverTls TLSSettings{..} _set s bs0 params = ) throwIO $ sendAll sock bs - conn ctx writeBufferRef isH2 mysa = + +-- | Get "Connection" and "Transport" for a TLS connection that is already did the handshake. +attachConn :: Socket -> TLS.Context -> IO (Connection, Transport) +attachConn s ctx = do + h2 <- (== Just "h2") <$> TLS.getNegotiatedProtocol ctx + isH2 <- I.newIORef h2 + writeBuffer <- createWriteBuffer 16384 + writeBufferRef <- I.newIORef writeBuffer + -- Creating a cache for leftover input data. + tls <- getTLSinfo ctx + mysa <- getSocketName s + return (conn writeBufferRef isH2 mysa, tls) + where + conn writeBufferRef isH2 mysa = Connection { connSendMany = TLS.sendData ctx . L.fromChunks , connSendAll = sendall @@ -434,10 +444,6 @@ httpOverTls TLSSettings{..} _set s bs0 params = (const (return ())) (TLS.bye ctx) - wrappedRecvN recvN n = handleAny handler $ recvN n - handler :: SomeException -> IO S.ByteString - handler _ = return "" - getTLSinfo :: TLS.Context -> IO Transport getTLSinfo ctx = do proto <- TLS.getNegotiatedProtocol ctx diff --git a/warp-tls/warp-tls.cabal b/warp-tls/warp-tls.cabal index e3008929b..721964522 100644 --- a/warp-tls/warp-tls.cabal +++ b/warp-tls/warp-tls.cabal @@ -1,5 +1,5 @@ Name: warp-tls -Version: 3.4.6 +Version: 3.4.7 Synopsis: HTTP over TLS support for Warp via the TLS package License: MIT License-file: LICENSE From fb84321c132e4e6f0038b3401fb0c8b242b95919 Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Sun, 22 Sep 2024 21:15:48 +0300 Subject: [PATCH 3/5] Get SockAddr instead of full Socket in attachConn --- warp-tls/Network/Wai/Handler/WarpTLS.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/warp-tls/Network/Wai/Handler/WarpTLS.hs b/warp-tls/Network/Wai/Handler/WarpTLS.hs index c4dd3bfca..d15cf70c5 100644 --- a/warp-tls/Network/Wai/Handler/WarpTLS.hs +++ b/warp-tls/Network/Wai/Handler/WarpTLS.hs @@ -360,7 +360,8 @@ httpOverTls TLSSettings{..} _set s bs0 params = ctx <- TLS.contextNew (backend recvN) params TLS.contextHookSetLogging ctx tlsLogging TLS.handshake ctx - attachConn s ctx + mysa <- getSocketName s + attachConn mysa ctx wrappedRecvN recvN n = handleAny (const mempty) $ recvN n backend recvN = TLS.Backend @@ -385,18 +386,17 @@ httpOverTls TLSSettings{..} _set s bs0 params = $ sendAll sock bs -- | Get "Connection" and "Transport" for a TLS connection that is already did the handshake. -attachConn :: Socket -> TLS.Context -> IO (Connection, Transport) -attachConn s ctx = do +attachConn :: SockAddr -> TLS.Context -> IO (Connection, Transport) +attachConn mysa ctx = do h2 <- (== Just "h2") <$> TLS.getNegotiatedProtocol ctx isH2 <- I.newIORef h2 writeBuffer <- createWriteBuffer 16384 writeBufferRef <- I.newIORef writeBuffer -- Creating a cache for leftover input data. tls <- getTLSinfo ctx - mysa <- getSocketName s - return (conn writeBufferRef isH2 mysa, tls) + return (conn writeBufferRef isH2, tls) where - conn writeBufferRef isH2 mysa = + conn writeBufferRef isH2 = Connection { connSendMany = TLS.sendData ctx . L.fromChunks , connSendAll = sendall From 061d38dd0d18326cb6e29d7daf29923479b6c892 Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Sun, 22 Sep 2024 21:23:54 +0300 Subject: [PATCH 4/5] Add @since annotation --- warp-tls/Network/Wai/Handler/WarpTLS.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/warp-tls/Network/Wai/Handler/WarpTLS.hs b/warp-tls/Network/Wai/Handler/WarpTLS.hs index d15cf70c5..64387212e 100644 --- a/warp-tls/Network/Wai/Handler/WarpTLS.hs +++ b/warp-tls/Network/Wai/Handler/WarpTLS.hs @@ -386,6 +386,7 @@ httpOverTls TLSSettings{..} _set s bs0 params = $ sendAll sock bs -- | Get "Connection" and "Transport" for a TLS connection that is already did the handshake. +-- @since 3.4.7 attachConn :: SockAddr -> TLS.Context -> IO (Connection, Transport) attachConn mysa ctx = do h2 <- (== Just "h2") <$> TLS.getNegotiatedProtocol ctx From 12e40c9fc5cd36f0ab360d5562385ff95cdf9313 Mon Sep 17 00:00:00 2001 From: IC Rainbow Date: Sun, 22 Sep 2024 21:26:24 +0300 Subject: [PATCH 5/5] Add PR urls --- warp-tls/ChangeLog.md | 1 + warp/ChangeLog.md | 1 + 2 files changed, 2 insertions(+) diff --git a/warp-tls/ChangeLog.md b/warp-tls/ChangeLog.md index f6df04e08..e37297639 100644 --- a/warp-tls/ChangeLog.md +++ b/warp-tls/ChangeLog.md @@ -3,6 +3,7 @@ ## 3.4.7 * Expose `attachConn` to use post-handshake TLS connection. + [#1007](https://github.com/yesodweb/wai/pull/1007) ## 3.4.6 diff --git a/warp/ChangeLog.md b/warp/ChangeLog.md index c574d34d7..0984d4589 100644 --- a/warp/ChangeLog.md +++ b/warp/ChangeLog.md @@ -3,6 +3,7 @@ ## 3.4.2 * serveConnection is re-exported from the Internal module. + [#1007](https://github.com/yesodweb/wai/pull/1007) ## 3.4.1