diff --git a/auto-update/Control/Debounce.hs b/auto-update/Control/Debounce.hs index 2f77d734f..33b123574 100644 --- a/auto-update/Control/Debounce.hs +++ b/auto-update/Control/Debounce.hs @@ -7,18 +7,17 @@ -- Example usage: -- -- @ --- printString <- 'mkDebounce' 'defaultDebounceSettings' +-- > printString <- 'mkDebounce' 'defaultDebounceSettings' -- { 'debounceAction' = putStrLn "Running action" -- , 'debounceFreq' = 5000000 -- 5 seconds -- , 'debounceEdge' = 'DI.trailingEdge' -- Trigger on the trailing edge -- } --- @ --- --- >>> printString +-- > printString -- Running action --- >>> printString --- +-- > printString +-- \ -- Running action +-- @ -- -- See the fast-logger package ("System.Log.FastLogger") for real-world usage. -- diff --git a/warp-tls/Network/Wai/Handler/WarpTLS.hs b/warp-tls/Network/Wai/Handler/WarpTLS.hs index 2a4605916..70cd3d034 100644 --- a/warp-tls/Network/Wai/Handler/WarpTLS.hs +++ b/warp-tls/Network/Wai/Handler/WarpTLS.hs @@ -74,16 +74,11 @@ import Network.Socket ( 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 (..), - OnInsecure (..), - TLSSettings (..), - ) +import Network.Wai.Handler.WarpTLS.Internal import System.IO.Error (ioeGetErrorType, isEOFError) import UnliftIO.Exception ( Exception, @@ -101,38 +96,6 @@ import UnliftIO.Exception ( ) import qualified UnliftIO.Exception as E --- | 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 - ---------------------------------------------------------------- -- | A smart constructor for 'TLSSettings' based on 'defaultTlsSettings'. @@ -474,9 +437,7 @@ getTLSinfo ctx = do TLS.TLS10 -> (3, 1) TLS.TLS11 -> (3, 2) TLS.TLS12 -> (3, 3) -#if MIN_VERSION_tls(1,5,0) - TLS.TLS13 -> (3,4) -#endif + _ -> (3,4) clientCert <- TLS.getClientCertificateChain ctx return TLS diff --git a/warp-tls/Network/Wai/Handler/WarpTLS/Internal.hs b/warp-tls/Network/Wai/Handler/WarpTLS/Internal.hs index 4549873ae..8559dee0a 100644 --- a/warp-tls/Network/Wai/Handler/WarpTLS/Internal.hs +++ b/warp-tls/Network/Wai/Handler/WarpTLS/Internal.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Network.Wai.Handler.WarpTLS.Internal ( CertSettings (..), TLSSettings (..), + defaultTlsSettings, OnInsecure (..), -- * Accessors @@ -11,8 +12,10 @@ module Network.Wai.Handler.WarpTLS.Internal ( 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 ---------------------------------------------------------------- @@ -61,37 +64,14 @@ data TLSSettings = TLSSettings -- -- Since 1.4.0 , tlsAllowedVersions :: [TLS.Version] -#if MIN_VERSION_tls(1,5,0) -- ^ 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 -- ^ 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 @@ -147,3 +127,31 @@ data TLSSettings = TLSSettings -- | Some programs need access to cert settings getCertSettings :: TLSSettings -> CertSettings 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 diff --git a/warp/Network/Wai/Handler/Warp/File.hs b/warp/Network/Wai/Handler/Warp/File.hs index 8da87dde1..807597fbf 100644 --- a/warp/Network/Wai/Handler/Warp/File.hs +++ b/warp/Network/Wai/Handler/Warp/File.hs @@ -21,9 +21,6 @@ import Network.Wai.Handler.Warp.Header import Network.Wai.Handler.Warp.Imports import Network.Wai.Handler.Warp.PackInt --- $setup --- >>> import Test.QuickCheck - ---------------------------------------------------------------- data RspFileInfo diff --git a/warp/Network/Wai/Handler/Warp/PackInt.hs b/warp/Network/Wai/Handler/Warp/PackInt.hs index db0e8e8ff..852aa4845 100644 --- a/warp/Network/Wai/Handler/Warp/PackInt.hs +++ b/warp/Network/Wai/Handler/Warp/PackInt.hs @@ -11,14 +11,6 @@ import qualified Network.HTTP.Types as H import Network.Wai.Handler.Warp.Imports --- $setup --- >>> import Data.ByteString.Char8 as C8 --- >>> import Test.QuickCheck (Large(..)) - --- | --- --- prop> packIntegral (abs n) == C8.pack (show (abs n)) --- prop> \(Large n) -> let n' = fromIntegral (abs n :: Int) in packIntegral n' == C8.pack (show n') packIntegral :: Integral a => a -> ByteString packIntegral 0 = "0" packIntegral n | n < 0 = error "packIntegral" diff --git a/warp/warp.cabal b/warp/warp.cabal index 63a738733..88a385830 100644 --- a/warp/warp.cabal +++ b/warp/warp.cabal @@ -139,6 +139,7 @@ Test-Suite spec ExceptionSpec FdCacheSpec FileSpec + PackIntSpec ReadIntSpec RequestSpec ResponseHeaderSpec