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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.ClientSpec where
import Control.Concurrent (threadDelay)
import qualified Data.ByteString.Char8 as BS
import Network.HTTP.Client
import Network.HTTP.Client.Internal
import Network.HTTP.Types (status200, found302, status405)
import Network.HTTP.Types.Status
import qualified Network.Socket as NS
import Test.Hspec
import Control.Applicative ((<$>))
import Data.ByteString.Lazy.Char8 () -- orphan instance
import System.Mem (performGC)
main :: IO ()
main = hspec spec
spec :: Spec
spec = describe "Client" $ do
it "works" $ do
req <- parseUrlThrow "http://httpbin.org/"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status200
-- Test the failure condition described in https://github.com/snoyberg/http-client/issues/489
it "keeps connection alive long enough" $ do
req <- parseUrlThrow "http://httpbin.org/"
man <- newManager defaultManagerSettings
res <- responseOpen req man
responseStatus res `shouldBe` status200
let
getChunk = responseBody res
drainAll = do
chunk <- getChunk
if BS.null chunk then pure () else drainAll
-- The returned `BodyReader` used to not contain a reference to the `Managed Connection`,
-- only to the extracted connection and to the release action. Therefore, triggering a GC
-- would close the connection even though we were not done reading.
performGC
-- Not ideal, but weak finalizers run on a separate thread, so it's racing with our drain
-- call
threadDelay 500000
drainAll
-- Calling `responseClose res` here prevents the early collection from happening in this
-- test, but in a larger production application that did involve a `responseClose`, it still
-- occurred.
describe "method in URL" $ do
it "success" $ do
req <- parseUrlThrow "POST http://httpbin.org/post"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status200
it "failure" $ do
req <- parseRequest "PUT http://httpbin.org/post"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status405
describe "bearer auth" $ do
it "success" $ do
initialReq <- parseUrlThrow "http://httpbin.org/bearer"
let finalReq = applyBearerAuth "token" initialReq
man <- newManager defaultManagerSettings
res <- httpLbs finalReq man
responseStatus res `shouldBe` status200
it "failure" $ do
req <- parseRequest "http://httpbin.org/bearer"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status401
describe "redirects" $ do
xit "follows redirects" $ do
req <- parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status200
xit "allows to disable redirect following" $ do
req <- (\ r -> r{ redirectCount = 0 }) <$>
parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` found302
context "managerModifyResponse" $ do
it "allows to modify the response status code" $ do
let modify :: Response BodyReader -> IO (Response BodyReader)
modify res = do
return res {
responseStatus = (responseStatus res) {
statusCode = 201
}
}
settings = defaultManagerSettings { managerModifyResponse = modify }
man <- newManager settings
res <- httpLbs "http://httpbin.org" man
(statusCode.responseStatus) res `shouldBe` 201
it "modifies the response body" $ do
let modify :: Response BodyReader -> IO (Response BodyReader)
modify res = do
reader <- constBodyReader [BS.pack "modified response body"]
return res {
responseBody = reader
}
settings = defaultManagerSettings { managerModifyResponse = modify }
man <- newManager settings
res <- httpLbs "http://httpbin.org" man
responseBody res `shouldBe` "modified response body"
context "managerModifyRequest" $ do
it "port" $ do
let modify req = return req { port = 80 }
settings = defaultManagerSettings { managerModifyRequest = modify }
man <- newManager settings
res <- httpLbs "http://httpbin.org:1234" man
responseStatus res `shouldBe` status200
it "checkResponse" $ do
let modify req = return req { checkResponse = \_ _ -> error "some exception" }
settings = defaultManagerSettings { managerModifyRequest = modify }
man <- newManager settings
httpLbs "http://httpbin.org" man `shouldThrow` anyException
xit "redirectCount" $ do
let modify req = return req { redirectCount = 0 }
settings = defaultManagerSettings { managerModifyRequest = modify }
man <- newManager settings
response <- httpLbs "http://httpbin.org/redirect-to?url=foo" man
responseStatus response `shouldBe` found302
-- skipped because CI doesn't have working IPv6
xdescribe "raw IPV6 address as hostname" $ do
it "works" $ do
-- We rely on example.com serving a web page over IPv6.
-- The request (currently) actually ends up as 404 due to
-- virtual hosting, but we just care that the networking
-- side works.
(addr:_) <- NS.getAddrInfo
(Just NS.defaultHints { NS.addrFamily = NS.AF_INET6 })
(Just "example.com")
(Just "http")
-- ipv6Port will be of the form [::1]:80, which is good enough
-- for our purposes; ideally we'd easily get just the ::1.
let ipv6Port = show $ NS.addrAddress addr
ipv6Port `shouldStartWith` "["
req <- parseUrlThrow $ "http://" ++ ipv6Port
man <- newManager defaultManagerSettings
_ <- httpLbs (setRequestIgnoreStatus req) man
return ()
|
