1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
{-# LANGUAGE OverloadedStrings #-}
import Test.Hspec
import Network.Connection
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Types
import Control.Monad (join)
main :: IO ()
main = hspec $ do
it "make a TLS connection" $ do
manager <- newManager tlsManagerSettings
withResponse "https://httpbin.org/status/418" manager $ \res ->
responseStatus res `shouldBe` status418
it "digest authentication" $ do
man <- newManager defaultManagerSettings
req <- join $ applyDigestAuth
"user"
"passwd"
"http://httpbin.org/digest-auth/qop/user/passwd"
man
response <- httpNoBody req man
responseStatus response `shouldBe` status200
it "incorrect digest authentication" $ do
man <- newManager defaultManagerSettings
join (applyDigestAuth "user" "passwd" "http://httpbin.org/" man)
`shouldThrow` \(DigestAuthException _ _ det) ->
det == UnexpectedStatusCode
it "BadSSL: expired" $ do
manager <- newManager tlsManagerSettings
let action = withResponse "https://expired.badssl.com/" manager (const (return ()))
action `shouldThrow` anyException
it "BadSSL: self-signed" $ do
manager <- newManager tlsManagerSettings
let action = withResponse "https://self-signed.badssl.com/" manager (const (return ()))
action `shouldThrow` anyException
it "BadSSL: wrong.host" $ do
manager <- newManager tlsManagerSettings
let action = withResponse "https://wrong.host.badssl.com/" manager (const (return ()))
action `shouldThrow` anyException
it "BadSSL: we do have case-insensitivity though" $ do
manager <- newManager $ tlsManagerSettings
withResponse "https://BADSSL.COM" manager $ \res ->
responseStatus res `shouldBe` status200
-- https://github.com/snoyberg/http-client/issues/289
it "accepts TLS settings" $ do
let
tlsSettings = TLSSettingsSimple
{ settingDisableCertificateValidation = True
, settingDisableSession = False
, settingUseServerName = False
}
socketSettings = Nothing
managerSettings = mkManagerSettings tlsSettings socketSettings
manager <- newTlsManagerWith managerSettings
let url = "https://wrong.host.badssl.com"
request <- parseRequest url
response <- httpNoBody request manager
responseStatus response `shouldBe` status200
it "global supports TLS" $ do
manager <- getGlobalManager
request <- parseRequest "https://httpbin.org"
response <- httpNoBody request manager
responseStatus response `shouldBe` status200
|
