Merge branch 'fix-doctest'

yesodweb · Jan 16, 2024 · f5c445f · f5c445f
2 parents 64e42a2 + fdb875a
commit f5c445f
Show file tree

Hide file tree

Showing 6 changed files with 42 additions and 84 deletions.
diff --git 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
--- <Wait five seconds>
+-- > printString
+-- \<Wait five seconds>
 -- 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -139,6 +139,7 @@ Test-Suite spec
                      ExceptionSpec
                      FdCacheSpec
                      FileSpec
+                     PackIntSpec
                      ReadIntSpec
                      RequestSpec
                      ResponseHeaderSpec