|
| 1 | +{-# LANGUAGE CPP #-} |
1 | 2 | {-# LANGUAGE OverloadedStrings #-} |
2 | 3 | import Test.Hspec |
3 | 4 | import Network.Connection |
4 | 5 | import Network.HTTP.Client |
5 | | -import Network.HTTP.Client.TLS |
| 6 | +import Network.HTTP.Client.TLS hiding (tlsManagerSettings) |
6 | 7 | import Network.HTTP.Types |
7 | 8 | import Control.Monad (join) |
| 9 | +import Data.Default |
| 10 | +import qualified Network.TLS as TLS |
8 | 11 |
|
9 | 12 | main :: IO () |
10 | 13 | main = hspec $ do |
| 14 | + let tlsSettings = def |
| 15 | + -- Since the release of v2.0.0 of the `tls` package , the default value of |
| 16 | + -- the `supportedExtendedMainSecret` parameter `is `RequireEMS`, this means |
| 17 | + -- that all the connections to a server not supporting TLS1.2+EMS will fail. |
| 18 | + -- The badssl.com service does not yet support TLS1.2+EMS connections, so |
| 19 | + -- let's switch to the value `AllowEMS`, ie: TLS1.2 conenctions without EMS. |
| 20 | +#if MIN_VERSION_crypton_connection(0,4,0) |
| 21 | + {settingClientSupported = def {TLS.supportedExtendedMainSecret = TLS.AllowEMS}} |
| 22 | +#endif |
| 23 | + |
| 24 | + let tlsManagerSettings = mkManagerSettings tlsSettings Nothing |
| 25 | + |
11 | 26 | it "make a TLS connection" $ do |
12 | 27 | manager <- newManager tlsManagerSettings |
13 | 28 | withResponse "https://httpbin.org/status/418" manager $ \res -> |
@@ -52,13 +67,13 @@ main = hspec $ do |
52 | 67 | -- https://github.com/snoyberg/http-client/issues/289 |
53 | 68 | it "accepts TLS settings" $ do |
54 | 69 | let |
55 | | - tlsSettings = TLSSettingsSimple |
| 70 | + tlsSettings' = tlsSettings |
56 | 71 | { settingDisableCertificateValidation = True |
57 | 72 | , settingDisableSession = False |
58 | 73 | , settingUseServerName = False |
59 | 74 | } |
60 | 75 | socketSettings = Nothing |
61 | | - managerSettings = mkManagerSettings tlsSettings socketSettings |
| 76 | + managerSettings = mkManagerSettings tlsSettings' socketSettings |
62 | 77 | manager <- newTlsManagerWith managerSettings |
63 | 78 | let url = "https://wrong.host.badssl.com" |
64 | 79 | request <- parseRequest url |
|
0 commit comments