diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,12 @@ +# ChangeLog + +## 3.3.3 + +* Creating a bigger buffer when the current one is too small to fit the Builder + [#895](https://github.com/yesodweb/wai/pull/895) +* Expose TLS.supportedHashSignatures via TLSSettings + [#872](https://github.com/yesodweb/wai/pull/872) + ## 3.3.2 * Providing the Internal module. diff --git a/Network/Wai/Handler/WarpTLS.hs b/Network/Wai/Handler/WarpTLS.hs --- a/Network/Wai/Handler/WarpTLS.hs +++ b/Network/Wai/Handler/WarpTLS.hs @@ -63,10 +63,16 @@ import Data.Streaming.Network (bindPortTCP, safeRecv) import Data.Typeable (Typeable) import GHC.IO.Exception (IOErrorType(..)) -import Network.Socket (Socket, close, withSocketsDo, SockAddr, accept) +import Network.Socket ( + SockAddr, + Socket, + accept, + close, #if MIN_VERSION_network(3,1,1) -import Network.Socket (gracefulClose) + gracefulClose, #endif + withSocketsDo, + ) import Network.Socket.ByteString (sendAll) import qualified Network.TLS as TLS import qualified Crypto.PubKey.DH as DH @@ -102,6 +108,7 @@ , tlsSessionManagerConfig = Nothing , tlsCredentials = Nothing , tlsSessionManager = Nothing + , tlsSupportedHashSignatures = TLS.supportedHashSignatures def } -- taken from stunnel example in tls-extra @@ -139,7 +146,7 @@ :: S.ByteString -- ^ Certificate bytes -> S.ByteString -- ^ Key bytes -> TLSSettings -tlsSettingsMemory cert key = defaultTlsSettings { +tlsSettingsMemory cert key = defaultTlsSettings { certSettings = CertFromMemory cert [] key } @@ -152,7 +159,7 @@ -> [S.ByteString] -- ^ Chain certificate bytes -> S.ByteString -- ^ Key bytes -> TLSSettings -tlsSettingsChainMemory cert chainCerts key = defaultTlsSettings { +tlsSettingsChainMemory cert chainCerts key = defaultTlsSettings { certSettings = CertFromMemory cert chainCerts key } @@ -160,11 +167,11 @@ -- representations of the certificate and key based on 'defaultTlsSettings'. -- -- @since 3.3.0 -tlsSettingsRef +tlsSettingsRef :: I.IORef S.ByteString -- ^ Reference to certificate bytes - -> I.IORef (S.ByteString) -- ^ Reference to key bytes - -> TLSSettings -tlsSettingsRef cert key = defaultTlsSettings { + -> I.IORef S.ByteString -- ^ Reference to key bytes + -> TLSSettings +tlsSettingsRef cert key = defaultTlsSettings { certSettings = CertFromRef cert [] key } @@ -172,12 +179,12 @@ -- representations of the certificate and key based on 'defaultTlsSettings'. -- -- @since 3.3.0 -tlsSettingsChainRef +tlsSettingsChainRef :: I.IORef S.ByteString -- ^ Reference to certificate bytes -> [I.IORef S.ByteString] -- ^ Reference to chain certificate bytes - -> I.IORef (S.ByteString) -- ^ Reference to key bytes - -> TLSSettings -tlsSettingsChainRef cert chainCerts key = defaultTlsSettings { + -> I.IORef S.ByteString -- ^ Reference to key bytes + -> TLSSettings +tlsSettingsChainRef cert chainCerts key = defaultTlsSettings { certSettings = CertFromRef cert chainCerts key } @@ -195,11 +202,11 @@ loadCredentials :: TLSSettings -> IO TLS.Credentials loadCredentials TLSSettings{ tlsCredentials = Just creds } = return creds -loadCredentials TLSSettings{..} = case certSettings of +loadCredentials TLSSettings{..} = case certSettings of CertFromFile cert chainFiles key -> do cred <- either error id <$> TLS.credentialLoadX509Chain cert chainFiles key return $ TLS.Credentials [cred] - CertFromRef certRef chainCertsRef keyRef -> do + CertFromRef certRef chainCertsRef keyRef -> do cert <- I.readIORef certRef chainCerts <- mapM I.readIORef chainCertsRef key <- I.readIORef keyRef @@ -224,8 +231,8 @@ runTLSSocket' tlsset set credentials mgr sock app runTLSSocket' :: TLSSettings -> Settings -> TLS.Credentials -> TLS.SessionManager -> Socket -> Application -> IO () -runTLSSocket' tlsset@TLSSettings{..} set credentials mgr sock app = - runSettingsConnectionMakerSecure set get app +runTLSSocket' tlsset@TLSSettings{..} set credentials mgr sock = + runSettingsConnectionMakerSecure set get where get = getter tlsset set sock params params = def { -- TLS.ServerParams @@ -256,6 +263,7 @@ , TLS.supportedClientInitiatedRenegotiation = False , TLS.supportedSession = True , TLS.supportedFallbackScsv = True + , TLS.supportedHashSignatures = tlsSupportedHashSignatures #if MIN_VERSION_tls(1,5,0) , TLS.supportedGroups = [TLS.X25519,TLS.P256,TLS.P384] #endif @@ -296,11 +304,12 @@ TLS.handshake ctx h2 <- (== Just "h2") <$> TLS.getNegotiatedProtocol ctx isH2 <- I.newIORef h2 - writeBuf <- allocateBuffer bufferSize + writeBuffer <- createWriteBuffer bufferSize + writeBufferRef <- I.newIORef writeBuffer -- Creating a cache for leftover input data. ref <- I.newIORef "" tls <- getTLSinfo ctx - return (conn ctx writeBuf ref isH2, tls) + return (conn ctx writeBufferRef ref isH2, tls) where backend recvN = TLS.Backend { TLS.backendFlush = return () @@ -318,22 +327,21 @@ else Nothing) throwIO $ sendAll sock bs - conn ctx writeBuf ref isH2 = Connection { + conn ctx writeBufferRef ref isH2 = Connection { connSendMany = TLS.sendData ctx . L.fromChunks , connSendAll = sendall , connSendFile = sendfile , connClose = close' - , connFree = freeBuffer writeBuf , connRecv = recv ref , connRecvBuf = recvBuf ref - , connWriteBuffer = writeBuf - , connBufferSize = bufferSize + , connWriteBuffer = writeBufferRef , connHTTP2 = isH2 } where sendall = TLS.sendData ctx . L.fromChunks . return - sendfile fid offset len hook headers = - readSendFile writeBuf bufferSize sendall fid offset len hook headers + sendfile fid offset len hook headers = do + writeBuffer <- I.readIORef writeBufferRef + readSendFile (bufBuffer writeBuffer) (bufSize writeBuffer) sendall fid offset len hook headers close' = void (tryIO sendBye) `finally` TLS.contextClose ctx @@ -392,7 +400,7 @@ bs <- recv let len = S.length bs if len == 0 then return (False, "") - else if (len <= siz) then do + else if len <= siz then do buf' <- copy buf bs loop buf' (siz - len) else do diff --git a/Network/Wai/Handler/WarpTLS/Internal.hs b/Network/Wai/Handler/WarpTLS/Internal.hs --- a/Network/Wai/Handler/WarpTLS/Internal.hs +++ b/Network/Wai/Handler/WarpTLS/Internal.hs @@ -17,9 +17,9 @@ ---------------------------------------------------------------- --- | Determines where to load the certificate, chain +-- | Determines where to load the certificate, chain -- certificates, and key from. -data CertSettings +data CertSettings = CertFromFile !FilePath ![FilePath] !FilePath | CertFromMemory !S.ByteString ![S.ByteString] !S.ByteString | CertFromRef !(I.IORef S.ByteString) ![I.IORef S.ByteString] !(I.IORef S.ByteString) @@ -41,7 +41,7 @@ -- -- >>> certSettings defaultTlsSettings -- tlsSettings "certificate.pem" "key.pem" - -- + -- -- @since 3.3.0 , onInsecure :: OnInsecure -- ^ Do we allow insecure connections with this server as well? @@ -131,6 +131,11 @@ -- specified, 'tlsSessionManagerConfig' is ignored. -- -- Since 3.2.12 + , tlsSupportedHashSignatures :: [TLS.HashAndSignatureAlgorithm] + -- ^ Specifying supported hash/signature algorithms, ordered by decreasing + -- priority. See the "Network.TLS" module for details + -- + -- Since 3.3.3 } @@ -138,4 +143,3 @@ -- | Some programs need access to cert settings getCertSettings :: TLSSettings -> CertSettings getCertSettings tlsSetgs = certSettings tlsSetgs - diff --git a/warp-tls.cabal b/warp-tls.cabal --- a/warp-tls.cabal +++ b/warp-tls.cabal @@ -1,5 +1,5 @@ Name: warp-tls -Version: 3.3.2 +Version: 3.3.3 Synopsis: HTTP over TLS support for Warp via the TLS package License: MIT License-file: LICENSE @@ -21,7 +21,7 @@ Build-Depends: base >= 4.12 && < 5 , bytestring >= 0.9 , wai >= 3.2 && < 3.3 - , warp >= 3.3.6 && < 3.4 + , warp >= 3.3.22 && < 3.4 , data-default-class >= 0.0.1 , tls >= 1.5.3 , cryptonite >= 0.12