on master help sign in
Fix httpbin test failure (#13)

Apparently something has changed in that service.

commitb62d1c84b45017b6ff2063252cca1428a29cb0ec authorMark Karpov <markkarpov@opmbx.org> dateSat 18 Mar 2017, 21:05 (10 years ago) parent7a11e10
1 file changed+28−6
httpbin-tests/Network/HTTP/ReqSpec.hs+28−6
httpbin-tests/Network/HTTP/ReqSpec.hs+28−6
@@ -101,9 +101,10 @@ spec = do
101101 it "works" $ do
102102 r <- req GET (httpbin /: "headers")
103103 NoReqBody jsonResponse (header "Foo" "bar" <> header "Baz" "quux")
104− responseBody r `shouldBe` object
104+ stripFunnyHeaders (responseBody r) `shouldBe` object
105105 [ "headers" .= object
106106 [ "Accept-Encoding" .= ("gzip" :: Text)
107+ , "Connection" .= ("close" :: Text)
107108 , "Foo" .= ("bar" :: Text)
108109 , "Baz" .= ("quux" :: Text)
109110 , "Host" .= ("httpbin.org" :: Text) ] ]
@@ -113,11 +114,12 @@ spec = do
113114 describe "receiving GET data back" $
114115 it "works" $ do
115116 r <- req GET (httpbin /: "get") NoReqBody jsonResponse mempty
116− stripOrigin (responseBody r) `shouldBe` object
117+ (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
117118 [ "args" .= emptyObject
118119 , "url" .= ("https://httpbin.org/get" :: Text)
119120 , "headers" .= object
120121 [ "Accept-Encoding" .= ("gzip" :: Text)
122+ , "Connection" .= ("close" :: Text)
121123 , "Host" .= ("httpbin.org" :: Text) ] ]
122124 responseHeader r "Content-Type" `shouldBe` return "application/json"
123125 responseStatusCode r `shouldBe` 200
@@ -128,7 +130,7 @@ spec = do
128130 let text = "foo" :: Text
129131 reflected = reflectJSON text
130132 r <- req POST (httpbin /: "post") (ReqBodyJson text) jsonResponse mempty
131− stripOrigin (responseBody r) `shouldBe` object
133+ (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
132134 [ "args" .= emptyObject
133135 , "json" .= text
134136 , "data" .= reflected
@@ -136,6 +138,7 @@ spec = do
136138 , "headers" .= object
137139 [ "Content-Type" .= ("application/json; charset=utf-8" :: Text)
138140 , "Accept-Encoding" .= ("gzip" :: Text)
141+ , "Connection" .= ("close" :: Text)
139142 , "Host" .= ("httpbin.org" :: Text)
140143 , "Content-Length" .= show (T.length reflected) ]
141144 , "files" .= emptyObject
@@ -151,7 +154,7 @@ spec = do
151154 , LM.partBS "bar" "bar data!" ]
152155 r <- req POST (httpbin /: "post") body jsonResponse mempty
153156 let Just contentType = getRequestContentType body
154− stripOrigin (responseBody r) `shouldBe` object
157+ (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
155158 [ "args" .= emptyObject
156159 , "json" .= Null
157160 , "data" .= ("" :: Text)
@@ -159,6 +162,7 @@ spec = do
159162 , "headers" .= object
160163 [ "Content-Type" .= T.decodeUtf8 contentType
161164 , "Accept-Encoding" .= ("gzip" :: Text)
165+ , "Connection" .= ("close" :: Text)
162166 , "Host" .= ("httpbin.org" :: Text)
163167 , "Content-Length" .= ("242" :: Text)
164168 ]
@@ -177,13 +181,14 @@ spec = do
177181 file = "httpbin-data/robots.txt"
178182 contents <- TIO.readFile file
179183 r <- req PATCH (httpbin /: "patch") (ReqBodyFile file) jsonResponse mempty
180− stripOrigin (responseBody r) `shouldBe` object
184+ (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
181185 [ "args" .= emptyObject
182186 , "json" .= Null
183187 , "data" .= contents
184188 , "url" .= ("https://httpbin.org/patch" :: Text)
185189 , "headers" .= object
186190 [ "Accept-Encoding" .= ("gzip" :: Text)
191+ , "Connection" .= ("close" :: Text)
187192 , "Host" .= ("httpbin.org" :: Text)
188193 , "Content-Length" .= show (T.length contents) ]
189194 , "files" .= emptyObject
@@ -198,7 +203,7 @@ spec = do
198203 "baz" =: (5 :: Int) <>
199204 queryFlag "quux"
200205 r <- req PUT (httpbin /: "put") (ReqBodyUrlEnc params) jsonResponse mempty
201− stripOrigin (responseBody r) `shouldBe` object
206+ (stripFunnyHeaders . stripOrigin) (responseBody r) `shouldBe` object
202207 [ "args" .= emptyObject
203208 , "json" .= Null
204209 , "data" .= ("" :: Text)
@@ -206,6 +211,7 @@ spec = do
206211 , "headers" .= object
207212 [ "Content-Type" .= ("application/x-www-form-urlencoded" :: Text)
208213 , "Accept-Encoding" .= ("gzip" :: Text)
214+ , "Connection" .= ("close" :: Text)
209215 , "Host" .= ("httpbin.org" :: Text)
210216 , "Content-Length" .= ("18" :: Text) ]
211217 , "files" .= emptyObject
@@ -372,6 +378,22 @@ stripOrigin :: Value -> Value
372378stripOrigin (Object m) = Object (HM.delete "origin" m)
373379stripOrigin value = value
374380
381+-- | Remove funny headers that might break the tests.
382+
383+stripFunnyHeaders :: Value -> Value
384+stripFunnyHeaders (Object m) =
385+ let f (Object p) = Object $ HM.filterWithKey (\k _ -> k `elem` hs) p
386+ f value = value
387+ hs = [ "Content-Type"
388+ , "Accept-Encoding"
389+ , "Connection"
390+ , "Host"
391+ , "Content-Length"
392+ , "Foo"
393+ , "Baz" ]
394+ in Object (HM.adjust f "headers" m)
395+stripFunnyHeaders value = value
396+
375397-- | This is a complete test case that makes use of <https://httpbin.org> to
376398-- get various response status codes.
377399