warp-tls 3.4.4 → 3.4.5

raw patch · 3 files changed

+36/−17 lines, 3 filesdep ~tlsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: tls

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Network/Wai/Handler/WarpTLS.hs +30/−16
• warp-tls.cabal +1/−1

@@ -1,5 +1,10 @@ # ChangeLog +## 3.4.5++* Making mkConn of WarpTLS interruptible+  [#984](https://github.com/yesodweb/wai/pull/984)+ ## 3.4.4  * Allow warp v3.4.

@@ -95,6 +95,8 @@     try,  ) import qualified UnliftIO.Exception as E+import UnliftIO.Concurrent (newEmptyMVar, putMVar, takeMVar, forkIOWithUnmask)+import UnliftIO.Timeout (timeout)  ---------------------------------------------------------------- @@ -318,8 +320,18 @@     -> Socket     -> params     -> IO (Connection, Transport)-mkConn tlsset set s params = (safeRecv s 4096 >>= switch) `onException` close s+mkConn tlsset set s params = do+    var <- newEmptyMVar+    _ <- forkIOWithUnmask $ \umask -> do+        let tm = settingsTimeout set * 1000000+        mct <- umask (timeout tm recvFirstBS)+        putMVar var mct+    mbs <- takeMVar var+    case mbs of+      Nothing -> throwIO IncompleteHeaders+      Just bs -> switch bs   where+    recvFirstBS = safeRecv s 4096 `onException` close s     switch firstBS         | S.null firstBS = close s >> throwIO ClientClosedConnectionPrematurely         | S.head firstBS == 0x16 = httpOverTls tlsset set s firstBS params@@ -335,22 +347,24 @@     -> S.ByteString     -> params     -> IO (Connection, Transport)-httpOverTls TLSSettings{..} _set s bs0 params = do-    pool <- newBufferPool 2048 16384-    rawRecvN <- makeRecvN bs0 $ receive s pool-    let recvN = wrappedRecvN rawRecvN-    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)+httpOverTls TLSSettings{..} _set s bs0 params =+    makeConn `onException` close s   where+    makeConn = do+        pool <- newBufferPool 2048 16384+        rawRecvN <- makeRecvN bs0 $ receive s pool+        let recvN = wrappedRecvN rawRecvN+        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)     backend recvN =         TLS.Backend             { TLS.backendFlush = return ()

@@ -1,5 +1,5 @@ Name:                warp-tls-Version:             3.4.4+Version:             3.4.5 Synopsis:            HTTP over TLS support for Warp via the TLS package License:             MIT License-file:        LICENSE