warp-tls 3.4.3 → 3.4.4
raw patch · 4 files changed
+358/−274 lines, 4 filesdep ~warpPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: warp
API changes (from Hackage documentation)
+ Network.Wai.Handler.WarpTLS.Internal: defaultTlsSettings :: TLSSettings
+ Network.Wai.Handler.WarpTLS.Internal: instance GHC.Show.Show Network.Wai.Handler.WarpTLS.Internal.CertSettings
Files
- ChangeLog.md +4/−0
- Network/Wai/Handler/WarpTLS.hs +281/−219
- Network/Wai/Handler/WarpTLS/Internal.hs +71/−53
- warp-tls.cabal +2/−2
ChangeLog.md view
@@ -1,5 +1,9 @@ # ChangeLog +## 3.4.4++* Allow warp v3.4.+ ## 3.4.3 * Install shutdown handlers passed via `Settings` to `run...` functions
Network/Wai/Handler/WarpTLS.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PatternGuards #-} -- | HTTP over TLS support for Warp via the TLS package. --@@ -11,213 +11,226 @@ -- Otherwise HTTP\/1.1 over TLS is used. -- -- Support for SSL is now obsoleted.- module Network.Wai.Handler.WarpTLS ( -- * Runner- runTLS- , runTLSSocket+ runTLS,+ runTLSSocket,+ -- * Settings- , TLSSettings- , defaultTlsSettings+ TLSSettings,+ defaultTlsSettings,+ -- * Smart constructors+ -- ** From files- , tlsSettings- , tlsSettingsChain+ tlsSettings,+ tlsSettingsChain,+ -- ** From memory- , tlsSettingsMemory- , tlsSettingsChainMemory+ tlsSettingsMemory,+ tlsSettingsChainMemory,+ -- ** From references- , tlsSettingsRef- , tlsSettingsChainRef- , CertSettings+ tlsSettingsRef,+ tlsSettingsChainRef,+ CertSettings,+ -- * Accessors- , tlsCredentials- , tlsLogging- , tlsAllowedVersions- , tlsCiphers- , tlsWantClientCert- , tlsServerHooks- , tlsServerDHEParams- , tlsSessionManagerConfig- , tlsSessionManager- , onInsecure- , OnInsecure (..)+ tlsCredentials,+ tlsLogging,+ tlsAllowedVersions,+ tlsCiphers,+ tlsWantClientCert,+ tlsServerHooks,+ tlsServerDHEParams,+ tlsSessionManagerConfig,+ tlsSessionManager,+ onInsecure,+ OnInsecure (..),+ -- * Exception- , WarpTLSException (..)- ) where+ WarpTLSException (..),+) where import Control.Applicative ((<|>))-import UnliftIO.Exception (Exception, throwIO, bracket, finally, handleAny, try, IOException, onException, SomeException(..), handleJust)-import qualified UnliftIO.Exception as E-import Control.Monad (void, guard)+import Control.Monad (guard, void) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Default.Class (def) import qualified Data.IORef as I import Data.Streaming.Network (bindPortTCP, safeRecv) import Data.Typeable (Typeable)-import GHC.IO.Exception (IOErrorType(..))+import GHC.IO.Exception (IOErrorType (..)) import Network.Socket ( SockAddr, Socket, close,+ getSocketName, #if MIN_VERSION_network(3,1,1) gracefulClose, #endif withSocketsDo,- getSocketName, ) import Network.Socket.BufferPool import Network.Socket.ByteString (sendAll) import qualified Network.TLS as TLS-import qualified Network.TLS.Extra as TLSExtra import qualified Network.TLS.SessionManager as SM import Network.Wai (Application) import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp.Internal-import Network.Wai.Handler.WarpTLS.Internal(CertSettings(..), TLSSettings(..), OnInsecure(..))+import Network.Wai.Handler.WarpTLS.Internal import System.IO.Error (ioeGetErrorType, isEOFError)-import UnliftIO.Exception (handle, fromException)---- | The default 'CertSettings'.-defaultCertSettings :: CertSettings-defaultCertSettings = CertFromFile "certificate.pem" [] "key.pem"---------------------------------------------------------------------- | Default 'TLSSettings'. Use this to create 'TLSSettings' with the field record name (aka accessors).-defaultTlsSettings :: TLSSettings-defaultTlsSettings = TLSSettings {- certSettings = defaultCertSettings- , onInsecure = DenyInsecure "This server only accepts secure HTTPS connections."- , tlsLogging = def-#if MIN_VERSION_tls(1,5,0)- , tlsAllowedVersions = [TLS.TLS13,TLS.TLS12,TLS.TLS11,TLS.TLS10]-#else- , tlsAllowedVersions = [TLS.TLS12,TLS.TLS11,TLS.TLS10]-#endif- , tlsCiphers = ciphers- , tlsWantClientCert = False- , tlsServerHooks = def- , tlsServerDHEParams = Nothing- , tlsSessionManagerConfig = Nothing- , tlsCredentials = Nothing- , tlsSessionManager = Nothing- , tlsSupportedHashSignatures = TLS.supportedHashSignatures def- }---- taken from stunnel example in tls-extra-ciphers :: [TLS.Cipher]-ciphers = TLSExtra.ciphersuite_strong+import UnliftIO.Exception (+ Exception,+ IOException,+ SomeException (..),+ bracket,+ finally,+ fromException,+ handle,+ handleAny,+ handleJust,+ onException,+ throwIO,+ try,+ )+import qualified UnliftIO.Exception as E ---------------------------------------------------------------- -- | A smart constructor for 'TLSSettings' based on 'defaultTlsSettings'.-tlsSettings :: FilePath -- ^ Certificate file- -> FilePath -- ^ Key file- -> TLSSettings-tlsSettings cert key = defaultTlsSettings {- certSettings = CertFromFile cert [] key- }+tlsSettings+ :: FilePath+ -- ^ Certificate file+ -> FilePath+ -- ^ Key file+ -> TLSSettings+tlsSettings cert key =+ defaultTlsSettings+ { certSettings = CertFromFile cert [] key+ } -- | A smart constructor for 'TLSSettings' that allows specifying -- chain certificates based on 'defaultTlsSettings'. -- -- Since 3.0.3 tlsSettingsChain- :: FilePath -- ^ Certificate file- -> [FilePath] -- ^ Chain certificate files- -> FilePath -- ^ Key file- -> TLSSettings-tlsSettingsChain cert chainCerts key = defaultTlsSettings {- certSettings = CertFromFile cert chainCerts key- }+ :: FilePath+ -- ^ Certificate file+ -> [FilePath]+ -- ^ Chain certificate files+ -> FilePath+ -- ^ Key file+ -> TLSSettings+tlsSettingsChain cert chainCerts key =+ defaultTlsSettings+ { certSettings = CertFromFile cert chainCerts key+ } -- | A smart constructor for 'TLSSettings', but uses in-memory representations -- of the certificate and key based on 'defaultTlsSettings'. -- -- Since 3.0.1 tlsSettingsMemory- :: S.ByteString -- ^ Certificate bytes- -> S.ByteString -- ^ Key bytes+ :: S.ByteString+ -- ^ Certificate bytes+ -> S.ByteString+ -- ^ Key bytes -> TLSSettings-tlsSettingsMemory cert key = defaultTlsSettings {- certSettings = CertFromMemory cert [] key- }+tlsSettingsMemory cert key =+ defaultTlsSettings+ { certSettings = CertFromMemory cert [] key+ } -- | A smart constructor for 'TLSSettings', but uses in-memory representations -- of the certificate and key based on 'defaultTlsSettings'. -- -- Since 3.0.3 tlsSettingsChainMemory- :: S.ByteString -- ^ Certificate bytes- -> [S.ByteString] -- ^ Chain certificate bytes- -> S.ByteString -- ^ Key bytes+ :: S.ByteString+ -- ^ Certificate bytes+ -> [S.ByteString]+ -- ^ Chain certificate bytes+ -> S.ByteString+ -- ^ Key bytes -> TLSSettings-tlsSettingsChainMemory cert chainCerts key = defaultTlsSettings {- certSettings = CertFromMemory cert chainCerts key- }+tlsSettingsChainMemory cert chainCerts key =+ defaultTlsSettings+ { certSettings = CertFromMemory cert chainCerts key+ } -- | A smart constructor for 'TLSSettings', but uses references to in-memory -- representations of the certificate and key based on 'defaultTlsSettings'. -- -- @since 3.3.0 tlsSettingsRef- :: I.IORef S.ByteString -- ^ Reference to certificate bytes- -> I.IORef S.ByteString -- ^ Reference to key bytes+ :: I.IORef S.ByteString+ -- ^ Reference to certificate bytes+ -> I.IORef S.ByteString+ -- ^ Reference to key bytes -> TLSSettings-tlsSettingsRef cert key = defaultTlsSettings {- certSettings = CertFromRef cert [] key- }+tlsSettingsRef cert key =+ defaultTlsSettings+ { certSettings = CertFromRef cert [] key+ } -- | A smart constructor for 'TLSSettings', but uses references to in-memory -- representations of the certificate and key based on 'defaultTlsSettings'. -- -- @since 3.3.0 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+ :: 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 {- certSettings = CertFromRef cert chainCerts key- }+tlsSettingsChainRef cert chainCerts key =+ defaultTlsSettings+ { certSettings = CertFromRef cert chainCerts key+ } ---------------------------------------------------------------- -- | Running 'Application' with 'TLSSettings' and 'Settings'. runTLS :: TLSSettings -> Settings -> Application -> IO ()-runTLS tset set app = withSocketsDo $- bracket- (bindPortTCP (getPort set) (getHost set))- close- (\sock -> do- setSocketCloseOnExec sock- runTLSSocket tset set sock app)+runTLS tset set app =+ withSocketsDo $+ bracket+ (bindPortTCP (getPort set) (getHost set))+ close+ ( \sock -> do+ setSocketCloseOnExec sock+ runTLSSocket tset set sock app+ ) ---------------------------------------------------------------- loadCredentials :: TLSSettings -> IO TLS.Credentials-loadCredentials TLSSettings{ tlsCredentials = Just creds } = return creds+loadCredentials TLSSettings{tlsCredentials = Just creds} = return creds 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- cert <- I.readIORef certRef- chainCerts <- mapM I.readIORef chainCertsRef- key <- I.readIORef keyRef- cred <- either error return $ TLS.credentialLoadX509ChainFromMemory cert chainCerts key- return $ TLS.Credentials [cred]- CertFromMemory certMemory chainCertsMemory keyMemory -> do- cred <- either error return $ TLS.credentialLoadX509ChainFromMemory certMemory chainCertsMemory keyMemory- return $ TLS.Credentials [cred]+ CertFromFile cert chainFiles key -> do+ cred <- either error id <$> TLS.credentialLoadX509Chain cert chainFiles key+ return $ TLS.Credentials [cred]+ CertFromRef certRef chainCertsRef keyRef -> do+ cert <- I.readIORef certRef+ chainCerts <- mapM I.readIORef chainCertsRef+ key <- I.readIORef keyRef+ cred <-+ either error return $ TLS.credentialLoadX509ChainFromMemory cert chainCerts key+ return $ TLS.Credentials [cred]+ CertFromMemory certMemory chainCertsMemory keyMemory -> do+ cred <-+ either error return $+ TLS.credentialLoadX509ChainFromMemory certMemory chainCertsMemory keyMemory+ return $ TLS.Credentials [cred] getSessionManager :: TLSSettings -> IO TLS.SessionManager-getSessionManager TLSSettings{ tlsSessionManager = Just mgr } = return mgr+getSessionManager TLSSettings{tlsSessionManager = Just mgr} = return mgr getSessionManager TLSSettings{..} = case tlsSessionManagerConfig of- Nothing -> return TLS.noSessionManager- Just config -> SM.newSessionManager config+ Nothing -> return TLS.noSessionManager+ Just config -> SM.newSessionManager config -- | Running 'Application' with 'TLSSettings' and 'Settings' using -- specified 'Socket'.@@ -228,59 +241,83 @@ mgr <- getSessionManager tlsset runTLSSocket' tlsset set credentials mgr sock app -runTLSSocket' :: TLSSettings -> Settings -> TLS.Credentials -> TLS.SessionManager -> Socket -> Application -> IO ()+runTLSSocket'+ :: TLSSettings+ -> Settings+ -> TLS.Credentials+ -> TLS.SessionManager+ -> Socket+ -> Application+ -> IO () runTLSSocket' tlsset@TLSSettings{..} set credentials mgr sock = runSettingsConnectionMakerSecure set get where get = getter tlsset set sock params- params = def { -- TLS.ServerParams- TLS.serverWantClientCert = tlsWantClientCert- , TLS.serverCACertificates = []- , TLS.serverDHEParams = tlsServerDHEParams- , TLS.serverHooks = hooks- , TLS.serverShared = shared- , TLS.serverSupported = supported+ params =+ def -- TLS.ServerParams+ { TLS.serverWantClientCert = tlsWantClientCert+ , TLS.serverCACertificates = []+ , TLS.serverDHEParams = tlsServerDHEParams+ , TLS.serverHooks = hooks+ , TLS.serverShared = shared+ , TLS.serverSupported = supported #if MIN_VERSION_tls(1,5,0)- , TLS.serverEarlyDataSize = 2018+ , TLS.serverEarlyDataSize = 2018 #endif- }+ } -- Adding alpn to user's tlsServerHooks.- hooks = tlsServerHooks {- TLS.onALPNClientSuggest = TLS.onALPNClientSuggest tlsServerHooks <|>- (if settingsHTTP2Enabled set then Just alpn else Nothing)- }- shared = def {- TLS.sharedCredentials = credentials- , TLS.sharedSessionManager = mgr- }- supported = def { -- TLS.Supported- TLS.supportedVersions = tlsAllowedVersions- , TLS.supportedCiphers = tlsCiphers- , TLS.supportedCompressions = [TLS.nullCompression]- , TLS.supportedSecureRenegotiation = True- , TLS.supportedClientInitiatedRenegotiation = False- , TLS.supportedSession = True- , TLS.supportedFallbackScsv = True- , TLS.supportedHashSignatures = tlsSupportedHashSignatures+ hooks =+ tlsServerHooks+ { TLS.onALPNClientSuggest =+ TLS.onALPNClientSuggest tlsServerHooks+ <|> (if settingsHTTP2Enabled set then Just alpn else Nothing)+ }+ shared =+ def+ { TLS.sharedCredentials = credentials+ , TLS.sharedSessionManager = mgr+ }+ supported =+ def -- TLS.Supported+ { TLS.supportedVersions = tlsAllowedVersions+ , TLS.supportedCiphers = tlsCiphers+ , TLS.supportedCompressions = [TLS.nullCompression]+ , TLS.supportedSecureRenegotiation = True+ , 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]+ , TLS.supportedGroups = [TLS.X25519,TLS.P256,TLS.P384] #endif- }+ } alpn :: [S.ByteString] -> IO S.ByteString alpn xs- | "h2" `elem` xs = return "h2"- | otherwise = return "http/1.1"+ | "h2" `elem` xs = return "h2"+ | otherwise = return "http/1.1" ---------------------------------------------------------------- -getter :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> params -> IO (IO (Connection, Transport), SockAddr)+getter+ :: TLS.TLSParams params+ => TLSSettings+ -> Settings+ -> Socket+ -> params+ -> IO (IO (Connection, Transport), SockAddr) getter tlsset set@Settings{settingsAccept = accept'} sock params = do (s, sa) <- accept' sock setSocketCloseOnExec s return (mkConn tlsset set s params, sa) -mkConn :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> params -> IO (Connection, Transport)+mkConn+ :: TLS.TLSParams params+ => TLSSettings+ -> Settings+ -> Socket+ -> params+ -> IO (Connection, Transport) mkConn tlsset set s params = (safeRecv s 4096 >>= switch) `onException` close s where switch firstBS@@ -290,7 +327,14 @@ ---------------------------------------------------------------- -httpOverTls :: TLS.TLSParams params => TLSSettings -> Settings -> Socket -> S.ByteString -> params -> IO (Connection, Transport)+httpOverTls+ :: TLS.TLSParams params+ => TLSSettings+ -> Settings+ -> Socket+ -> S.ByteString+ -> params+ -> IO (Connection, Transport) httpOverTls TLSSettings{..} _set s bs0 params = do pool <- newBufferPool 2048 16384 rawRecvN <- makeRecvN bs0 $ receive s pool@@ -307,59 +351,74 @@ mysa <- getSocketName s return (conn ctx writeBufferRef isH2 mysa, tls) where- backend recvN = TLS.Backend {- TLS.backendFlush = return ()+ backend recvN =+ TLS.Backend+ { TLS.backendFlush = return () #if MIN_VERSION_network(3,1,1)- , TLS.backendClose = gracefulClose s 5000 `E.catch` \(SomeException _) -> return ()+ , TLS.backendClose =+ gracefulClose s 5000 `E.catch` \(SomeException _) -> return () #else- , TLS.backendClose = close s+ , TLS.backendClose = close s #endif- , TLS.backendSend = sendAll' s- , TLS.backendRecv = recvN- }- sendAll' sock bs = E.handleJust- (\ e -> if ioeGetErrorType e == ResourceVanished- then Just ConnectionClosedByPeer- else Nothing)- throwIO- $ sendAll sock bs- conn ctx writeBufferRef isH2 mysa = Connection {- connSendMany = TLS.sendData ctx . L.fromChunks- , connSendAll = sendall- , connSendFile = sendfile- , connClose = close'- , connRecv = recv- , connRecvBuf = \_ _ -> return True -- obsoleted- , connWriteBuffer = writeBufferRef- , connHTTP2 = isH2- , connMySockAddr = mysa- }+ , TLS.backendSend = sendAll' s+ , TLS.backendRecv = recvN+ }+ sendAll' sock bs =+ E.handleJust+ ( \e ->+ if ioeGetErrorType e == ResourceVanished+ then Just ConnectionClosedByPeer+ else Nothing+ )+ throwIO+ $ sendAll sock bs+ conn ctx writeBufferRef isH2 mysa =+ Connection+ { connSendMany = TLS.sendData ctx . L.fromChunks+ , connSendAll = sendall+ , connSendFile = sendfile+ , connClose = close'+ , connRecv = recv+ , connRecvBuf = \_ _ -> return True -- obsoleted+ , connWriteBuffer = writeBufferRef+ , connHTTP2 = isH2+ , connMySockAddr = mysa+ } where sendall = TLS.sendData ctx . L.fromChunks . return recv = handle onEOF $ TLS.recvData ctx where onEOF e #if MIN_VERSION_tls(1,8,0)- | Just (TLS.PostHandshake TLS.Error_EOF) <- E.fromException e = return S.empty+ | Just (TLS.PostHandshake TLS.Error_EOF) <- E.fromException e = return S.empty #else- | Just TLS.Error_EOF <- fromException e = return S.empty+ | Just TLS.Error_EOF <- fromException e = return S.empty #endif- | Just ioe <- fromException e, isEOFError ioe = return S.empty | otherwise = throwIO e+ | Just ioe <- fromException e, isEOFError ioe = return S.empty+ | otherwise = throwIO e sendfile fid offset len hook headers = do writeBuffer <- I.readIORef writeBufferRef- readSendFile (bufBuffer writeBuffer) (bufSize writeBuffer) sendall fid offset len hook headers+ readSendFile+ (bufBuffer writeBuffer)+ (bufSize writeBuffer)+ sendall+ fid+ offset+ len+ hook+ headers - close' = void (tryIO sendBye) `finally`- TLS.contextClose ctx+ close' =+ void (tryIO sendBye)+ `finally` TLS.contextClose ctx sendBye =- -- It's fine if the connection was closed by the other side before- -- receiving close_notify, see RFC 5246 section 7.2.1.- handleJust- (\e -> guard (e == ConnectionClosedByPeer) >> return e)- (const (return ()))- (TLS.bye ctx)-+ -- It's fine if the connection was closed by the other side before+ -- receiving close_notify, see RFC 5246 section 7.2.1.+ handleJust+ (\e -> guard (e == ConnectionClosedByPeer) >> return e)+ (const (return ()))+ (TLS.bye ctx) wrappedRecvN recvN n = handleAny handler $ recvN n handler :: SomeException -> IO S.ByteString@@ -370,39 +429,40 @@ proto <- TLS.getNegotiatedProtocol ctx minfo <- TLS.contextGetInformation ctx case minfo of- Nothing -> return TCP+ Nothing -> return TCP Just TLS.Information{..} -> do let (major, minor) = case infoVersion of- TLS.SSL2 -> (2,0)- TLS.SSL3 -> (3,0)- TLS.TLS10 -> (3,1)- TLS.TLS11 -> (3,2)- TLS.TLS12 -> (3,3)-#if MIN_VERSION_tls(1,5,0)- TLS.TLS13 -> (3,4)-#endif+ TLS.SSL2 -> (2, 0)+ TLS.SSL3 -> (3, 0)+ TLS.TLS10 -> (3, 1)+ TLS.TLS11 -> (3, 2)+ TLS.TLS12 -> (3, 3)+ _ -> (3,4) clientCert <- TLS.getClientCertificateChain ctx- return TLS {- tlsMajorVersion = major- , tlsMinorVersion = minor- , tlsNegotiatedProtocol = proto- , tlsChiperID = TLS.cipherID infoCipher- , tlsClientCertificate = clientCert- }+ return+ TLS+ { tlsMajorVersion = major+ , tlsMinorVersion = minor+ , tlsNegotiatedProtocol = proto+ , tlsChiperID = TLS.cipherID infoCipher+ , tlsClientCertificate = clientCert+ } tryIO :: IO a -> IO (Either IOException a) tryIO = try ---------------------------------------------------------------- -plainHTTP :: TLSSettings -> Settings -> Socket -> S.ByteString -> IO (Connection, Transport)+plainHTTP+ :: TLSSettings -> Settings -> Socket -> S.ByteString -> IO (Connection, Transport) plainHTTP TLSSettings{..} set s bs0 = case onInsecure of AllowInsecure -> do conn' <- socketConnection set s cachedRef <- I.newIORef bs0- let conn'' = conn'- { connRecv = recvPlain cachedRef (connRecv conn')- }+ let conn'' =+ conn'+ { connRecv = recvPlain cachedRef (connRecv conn')+ } return (conn'', TCP) DenyInsecure lbs -> do -- Listening port 443 but TLS records do not arrive.@@ -415,10 +475,12 @@ -- GOAWAY + INADEQUATE_SECURITY? -- FIXME: Content-Length: -- FIXME: TLS/<version>- sendAll s "HTTP/1.1 426 Upgrade Required\- \r\nUpgrade: TLS/1.0, HTTP/1.1\- \r\nConnection: Upgrade\- \r\nContent-Type: text/plain\r\n\r\n"+ sendAll+ s+ "HTTP/1.1 426 Upgrade Required\+ \\r\nUpgrade: TLS/1.0, HTTP/1.1\+ \\r\nConnection: Upgrade\+ \\r\nContent-Type: text/plain\r\n\r\n" mapM_ (sendAll s) $ L.toChunks lbs close s throwIO InsecureConnectionDenied
Network/Wai/Handler/WarpTLS/Internal.hs view
@@ -1,17 +1,21 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module Network.Wai.Handler.WarpTLS.Internal (- CertSettings(..)- , TLSSettings(..)- , OnInsecure(..)+ CertSettings (..),+ TLSSettings (..),+ defaultTlsSettings,+ OnInsecure (..),+ -- * Accessors- , getCertSettings- ) where+ getCertSettings,+) where import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L+import Data.Default.Class (def) import qualified Data.IORef as I import qualified Network.TLS as TLS+import qualified Network.TLS.Extra as TLSExtra import qualified Network.TLS.SessionManager as SM ----------------------------------------------------------------@@ -19,75 +23,61 @@ -- | Determines where to load the certificate, chain -- certificates, and key from. 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)+ = CertFromFile !FilePath ![FilePath] !FilePath+ | CertFromMemory !S.ByteString ![S.ByteString] !S.ByteString+ | CertFromRef+ !(I.IORef S.ByteString)+ ![I.IORef S.ByteString]+ !(I.IORef S.ByteString) +instance Show CertSettings where+ show (CertFromFile a b c) = "CertFromFile " ++ show a ++ " " ++ show b ++ " " ++ show c+ show (CertFromMemory a b c) = "CertFromMemory " ++ show a ++ " " ++ show b ++ " " ++ show c+ show (CertFromRef _ _ _) = "CertFromRef"+ ---------------------------------------------------------------- -- | An action when a plain HTTP comes to HTTP over TLS/SSL port.-data OnInsecure = DenyInsecure L.ByteString- | AllowInsecure- deriving (Show)+data OnInsecure+ = DenyInsecure L.ByteString+ | AllowInsecure+ deriving (Show) ---------------------------------------------------------------- -- | Settings for WarpTLS.-data TLSSettings = TLSSettings {- certSettings :: CertSettings+data TLSSettings = TLSSettings+ { certSettings :: CertSettings -- ^ Where are the certificate, chain certificates, and key -- loaded from? -- -- >>> certSettings defaultTlsSettings- -- tlsSettings "certificate.pem" "key.pem"+ -- CertFromFile "certificate.pem" [] "key.pem" -- -- @since 3.3.0- , onInsecure :: OnInsecure+ , onInsecure :: OnInsecure -- ^ Do we allow insecure connections with this server as well? -- -- >>> onInsecure defaultTlsSettings -- DenyInsecure "This server only accepts secure HTTPS connections." -- -- Since 1.4.0- , tlsLogging :: TLS.Logging+ , tlsLogging :: TLS.Logging -- ^ The level of logging to turn on. -- -- Default: 'TLS.defaultLogging'. -- -- Since 1.4.0- , tlsAllowedVersions :: [TLS.Version]-#if MIN_VERSION_tls(1,5,0)+ , tlsAllowedVersions :: [TLS.Version] -- ^ The TLS versions this server accepts. --- -- >>> tlsAllowedVersions defaultTlsSettings- -- [TLS13,TLS12,TLS11,TLS10]- -- -- Since 1.4.2-#else- -- ^ The TLS versions this server accepts.- --- -- >>> tlsAllowedVersions defaultTlsSettings- -- [TLS12,TLS11,TLS10]- --- -- Since 1.4.2-#endif- , tlsCiphers :: [TLS.Cipher]-#if MIN_VERSION_tls(1,5,0)+ , tlsCiphers+ :: [TLS.Cipher] -- ^ The TLS ciphers this server accepts. --- -- >>> tlsCiphers defaultTlsSettings- -- [ECDHE-ECDSA-AES256GCM-SHA384,ECDHE-ECDSA-AES128GCM-SHA256,ECDHE-RSA-AES256GCM-SHA384,ECDHE-RSA-AES128GCM-SHA256,DHE-RSA-AES256GCM-SHA384,DHE-RSA-AES128GCM-SHA256,ECDHE-ECDSA-AES256CBC-SHA384,ECDHE-RSA-AES256CBC-SHA384,DHE-RSA-AES256-SHA256,ECDHE-ECDSA-AES256CBC-SHA,ECDHE-RSA-AES256CBC-SHA,DHE-RSA-AES256-SHA1,RSA-AES256GCM-SHA384,RSA-AES256-SHA256,RSA-AES256-SHA1,AES128GCM-SHA256,AES256GCM-SHA384]- -- -- Since 1.4.2-#else- -- ^ The TLS ciphers this server accepts.- --- -- >>> tlsCiphers defaultTlsSettings- -- [ECDHE-ECDSA-AES256GCM-SHA384,ECDHE-ECDSA-AES128GCM-SHA256,ECDHE-RSA-AES256GCM-SHA384,ECDHE-RSA-AES128GCM-SHA256,DHE-RSA-AES256GCM-SHA384,DHE-RSA-AES128GCM-SHA256,ECDHE-ECDSA-AES256CBC-SHA384,ECDHE-RSA-AES256CBC-SHA384,DHE-RSA-AES256-SHA256,ECDHE-ECDSA-AES256CBC-SHA,ECDHE-RSA-AES256CBC-SHA,DHE-RSA-AES256-SHA1,RSA-AES256GCM-SHA384,RSA-AES256-SHA256,RSA-AES256-SHA1]- --- -- Since 1.4.2-#endif- , tlsWantClientCert :: Bool+ , tlsWantClientCert :: Bool -- ^ Whether or not to demand a certificate from the client. If this -- is set to True, you must handle received certificates in a server hook -- or all connections will fail.@@ -96,7 +86,7 @@ -- False -- -- Since 3.0.2- , tlsServerHooks :: TLS.ServerHooks+ , tlsServerHooks :: TLS.ServerHooks -- ^ The server-side hooks called by the tls package, including actions -- to take when a client certificate is received. See the "Network.TLS" -- module for details.@@ -104,14 +94,14 @@ -- Default: def -- -- Since 3.0.2- , tlsServerDHEParams :: Maybe TLS.DHParams+ , tlsServerDHEParams :: Maybe TLS.DHParams -- ^ Configuration for ServerDHEParams -- more function lives in `crypton` package -- -- Default: Nothing -- -- Since 3.2.2- , tlsSessionManagerConfig :: Maybe SM.Config+ , tlsSessionManagerConfig :: Maybe SM.Config -- ^ Configuration for in-memory TLS session manager. -- If Nothing, 'TLS.noSessionManager' is used. -- Otherwise, an in-memory TLS session manager is created@@ -120,25 +110,53 @@ -- Default: Nothing -- -- Since 3.2.4- , tlsCredentials :: Maybe TLS.Credentials+ , tlsCredentials :: Maybe TLS.Credentials -- ^ Specifying 'TLS.Credentials' directly. If this value is -- specified, other fields such as 'certFile' are ignored. -- -- Since 3.2.12- , tlsSessionManager :: Maybe TLS.SessionManager+ , tlsSessionManager :: Maybe TLS.SessionManager -- ^ Specifying 'TLS.SessionManager' directly. If this value is -- specified, 'tlsSessionManagerConfig' is ignored. -- -- Since 3.2.12- , tlsSupportedHashSignatures :: [TLS.HashAndSignatureAlgorithm]+ , tlsSupportedHashSignatures :: [TLS.HashAndSignatureAlgorithm] -- ^ Specifying supported hash/signature algorithms, ordered by decreasing -- priority. See the "Network.TLS" module for details -- -- Since 3.3.3- }-+ } -- Since 3.3.1+ -- | Some programs need access to cert settings getCertSettings :: TLSSettings -> CertSettings-getCertSettings tlsSetgs = certSettings tlsSetgs+getCertSettings = certSettings++-- | The default 'CertSettings'.+defaultCertSettings :: CertSettings+defaultCertSettings = CertFromFile "certificate.pem" [] "key.pem"++----------------------------------------------------------------++-- | Default 'TLSSettings'. Use this to create 'TLSSettings' with the field record name (aka accessors).+defaultTlsSettings :: TLSSettings+defaultTlsSettings =+ TLSSettings+ { certSettings = defaultCertSettings+ , onInsecure = DenyInsecure "This server only accepts secure HTTPS connections."+ , tlsLogging = def+ , tlsAllowedVersions = TLS.supportedVersions def+ , tlsCiphers = ciphers+ , tlsWantClientCert = False+ , tlsServerHooks = def+ , tlsServerDHEParams = Nothing+ , tlsSessionManagerConfig = Nothing+ , tlsCredentials = Nothing+ , tlsSessionManager = Nothing+ , tlsSupportedHashSignatures = TLS.supportedHashSignatures def+ }++-- taken from stunnel example in tls-extra+ciphers :: [TLS.Cipher]+ciphers = TLSExtra.ciphersuite_strong
warp-tls.cabal view
@@ -1,5 +1,5 @@ Name: warp-tls-Version: 3.4.3+Version: 3.4.4 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.29 && < 3.4+ , warp >= 3.3.29 && < 3.5 , data-default-class >= 0.0.1 , tls >= 1.7 , network >= 2.2.1