diff --git a/warp-tls/ChangeLog.md b/warp-tls/ChangeLog.md index c979c0784..e37297639 100644 --- a/warp-tls/ChangeLog.md +++ b/warp-tls/ChangeLog.md @@ -1,5 +1,10 @@ # ChangeLog +## 3.4.7 + +* Expose `attachConn` to use post-handshake TLS connection. + [#1007](https://github.com/yesodweb/wai/pull/1007) + ## 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..64387212e 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,9 @@ 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 mysa ctx + wrappedRecvN recvN n = handleAny (const mempty) $ recvN n backend recvN = TLS.Backend { TLS.backendFlush = return () @@ -386,7 +384,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. +-- @since 3.4.7 +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 + return (conn writeBufferRef isH2, tls) + where + conn writeBufferRef isH2 = Connection { connSendMany = TLS.sendData ctx . L.fromChunks , connSendAll = sendall @@ -434,10 +445,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 diff --git a/warp/ChangeLog.md b/warp/ChangeLog.md index 89e9d41f4..0984d4589 100644 --- a/warp/ChangeLog.md +++ b/warp/ChangeLog.md @@ -1,5 +1,10 @@ # ChangeLog for warp +## 3.4.2 + +* serveConnection is re-exported from the Internal module. + [#1007](https://github.com/yesodweb/wai/pull/1007) + ## 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