Merge pull request #550 from marinelli/tls-2

Fix running tests with badssl.com
snoyberg · Dec 16, 2024 · e36f741 · e36f741
2 parents c982be2 + a8f05ac
commit e36f741
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 3 deletions.
diff --git a/http-client-tls/http-client-tls.cabal b/http-client-tls/http-client-tls.cabal
@@ -46,6 +46,8 @@ test-suite spec
                      , http-client-tls
                      , http-types
                      , crypton-connection
+                     , data-default
+                     , tls
 
 benchmark benchmark
   main-is:             Bench.hs

diff --git a/http-client-tls/test/Spec.hs b/http-client-tls/test/Spec.hs
@@ -1,13 +1,28 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 import Test.Hspec
 import Network.Connection
 import Network.HTTP.Client
-import Network.HTTP.Client.TLS
+import Network.HTTP.Client.TLS hiding (tlsManagerSettings)
 import Network.HTTP.Types
 import Control.Monad (join)
+import Data.Default
+import qualified Network.TLS as TLS
 
 main :: IO ()
 main = hspec $ do
+    let tlsSettings = def
+    -- Since the release of v2.0.0 of the `tls` package , the default value of
+    -- the `supportedExtendedMainSecret` parameter `is `RequireEMS`, this means
+    -- that all the connections to a server not supporting TLS1.2+EMS will fail.
+    -- The badssl.com service does not yet support TLS1.2+EMS connections, so
+    -- let's switch to the value `AllowEMS`, ie: TLS1.2 conenctions without EMS.
+#if MIN_VERSION_crypton_connection(0,4,0)
+            {settingClientSupported = def {TLS.supportedExtendedMainSecret = TLS.AllowEMS}}
+#endif
+
+    let tlsManagerSettings = mkManagerSettings tlsSettings Nothing
+
     it "make a TLS connection" $ do
         manager <- newManager tlsManagerSettings
         withResponse "https://httpbin.org/status/418" manager $ \res ->
@@ -52,13 +67,13 @@ main = hspec $ do
     -- https://github.com/snoyberg/http-client/issues/289
     it "accepts TLS settings" $ do
         let
-          tlsSettings = TLSSettingsSimple
+          tlsSettings' = tlsSettings
             { settingDisableCertificateValidation = True
             , settingDisableSession = False
             , settingUseServerName = False
             }
           socketSettings = Nothing
-          managerSettings = mkManagerSettings tlsSettings socketSettings
+          managerSettings = mkManagerSettings tlsSettings' socketSettings
         manager <- newTlsManagerWith managerSettings
         let url = "https://wrong.host.badssl.com"
         request <- parseRequest url