git.iko.soy/typeable/req
on master help sign in
Fix the test suite
f7c3b88Mark Karpov
httpbun-tests/Network/HTTP/ReqSpec.hs+35−20
compare with master
unifiedsplit
@@ -1,5 +1,6 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE RankNTypes #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -77,14 +78,11 @@ spec = do
77 NoReqBody
78 NoReqBody
78 jsonResponse
79 jsonResponse
79 (header "Foo" "bar" <> header "Baz" "quux")
80 (header "Foo" "bar" <> header "Baz" "quux")
80− stripFunnyHeaders (responseBody r)
81+ stripFunnyHeaders' (responseBody r)
81 `shouldBe` object
82 `shouldBe` object
82− [ "headers"
83− .= object
84− [ "Accept-Encoding" .= ("gzip" :: Text),
83+ [ "Accept-Encoding" .= ("gzip" :: Text),
85− "Foo" .= ("bar" :: Text),
84+ "Foo" .= ("bar" :: Text),
86− "Baz" .= ("quux" :: Text)
85+ "Baz" .= ("quux" :: Text)
87− ]
88 ]
86 ]
89 responseStatusCode r `shouldBe` 200
87 responseStatusCode r `shouldBe` 200
90 responseStatusMessage r `shouldBe` "OK"
88 responseStatusMessage r `shouldBe` "OK"
@@ -383,19 +381,36 @@ stripOrigin value = value
383
381
384-- | Remove funny headers that might break the tests.
382-- | Remove funny headers that might break the tests.
385stripFunnyHeaders :: Value -> Value
383stripFunnyHeaders :: Value -> Value
386−stripFunnyHeaders (Object m) =
384+stripFunnyHeaders = \case
385+ Object m ->
386+ Object
387+ ( runIdentity
388+ ( Aeson.KeyMap.alterF
389+ (pure . fmap stripFunnyHeaders')
390+ "headers"
391+ m
392+ )
393+ )
394+ value -> value
395+
396+-- | Similar to 'stripFunnyHeaders', but acts directly on the argument
397+-- without trying to access its "headers" field.
398+stripFunnyHeaders' :: Value -> Value
399+stripFunnyHeaders' = \case
400+ Object p ->
401+ Object $
387− let f (Object p) = Object $ Aeson.KeyMap.filterWithKey (\k _ -> k `elem` hs) p
402+ Aeson.KeyMap.filterWithKey
403+ (\k _ -> k `elem` whitelistedHeaders)
404+ p
388− f value = value
405+ value -> value
389− hs =
406+ where
407+ whitelistedHeaders =
390− [ "Content-Type",
408+ [ "Content-Type",
391− "Accept-Encoding",
409+ "Accept-Encoding",
392− "Host",
393− "Content-Length",
410+ "Content-Length",
394− "Foo",
411+ "Foo",
395− "Baz"
412+ "Baz"
396− ]
413+ ]
397− in Object (runIdentity (Aeson.KeyMap.alterF (pure . fmap f) "headers" m))
398−stripFunnyHeaders value = value
399
414
400-- | This is a complete test case that makes use of <https://httpbun.org> to
415-- | This is a complete test case that makes use of <https://httpbun.org> to
401-- get various response status codes.
416-- get various response status codes.