286b1db · typeable/servant

git.iko.soy/typeable/servant

Client Raw: returns `Right (status, body)` even for failure statuses

commit286b1db836d4ec85017e3a5bdd49a937f4028dc1 authorSönke Hahn <soenke.hahn@zalora.com> dateThu 13 Nov 2014, 20:36 (12 years ago) parenteff31f7

3 files changed+13−6

compare with master

unifiedsplit

src/Servant/API/Raw.hs+1−1 src/Servant/Common/Req.hs+4−3 test/Servant/ClientSpec.hs+8−2

src/Servant/API/Raw.hs+1−1

@@ -26,7 +26,7 @@ instance HasServer Raw where

2626 rawApplication request (respond . succeedWith)

2727

2828instance HasClient Raw where

29− type Client Raw = Method -> BaseUrl -> EitherT String IO ByteString

29+ type Client Raw = Method -> BaseUrl -> EitherT String IO (Int, ByteString)

3030

3131 clientWithRoute :: Proxy Raw -> Req -> Client Raw

3232 clientWithRoute Proxy req method host =

src/Servant/Common/Req.hs+4−3

@@ -82,11 +82,12 @@ displayHttpRequest :: Method -> String

8282displayHttpRequest method = "HTTP " ++ cs method ++ " request"

8383

8484

85−performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO ByteString

85+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString)

8686performRequest method req isWantedStatus host = do

8787 partialRequest <- liftIO $ reqToRequest req host

8888

8989 let request = partialRequest { Client.method = method

90+ , checkStatus = \ _status _headers _cookies -> Nothing

9091 }

9192

9293 eResponse <- liftIO $ __withGlobalManager $ \ manager ->

@@ -100,7 +101,7 @@ performRequest method req isWantedStatus host = do

100101 let status = Client.responseStatus response

101102 unless (isWantedStatus (statusCode status)) $

102103 left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)

103− return $ Client.responseBody response

104+ return $ (statusCode status, Client.responseBody response)

104105 where

105106 showStatus (Status code message) =

106107 show code ++ " - " ++ cs message

@@ -109,7 +110,7 @@ performRequest method req isWantedStatus host = do

109110performRequestJSON :: FromJSON result =>

110111 Method -> Req -> Int -> BaseUrl -> EitherT String IO result

111112performRequestJSON method req wantedStatus host = do

112− responseBody <- performRequest method req (== wantedStatus) host

113+ (_status, responseBody) <- performRequest method req (== wantedStatus) host

113114 either

114115 (\ message -> left (displayHttpRequest method ++ " returned invalid json: " ++ message))

115116 return

test/Servant/ClientSpec.hs+8−2

@@ -72,8 +72,8 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person

7272getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person

7373getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]

7474getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool

75−getRawSuccess :: Method -> BaseUrl -> EitherT String IO ByteString

76−getRawFailure :: Method -> BaseUrl -> EitherT String IO ByteString

75+getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)

76+getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)

7777getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

7878 -> BaseUrl

7979 -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])

@@ -115,6 +115,12 @@ spec = do

115115 it (show flag) $ withServer $ \ host -> do

116116 runEitherT (getQueryFlag flag host) `shouldReturn` Right flag

117117

118+ it "Servant.API.Raw on success" $ withServer $ \ host -> do

119+ runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess")

120+

121+ it "Servant.API.Raw on failure" $ withServer $ \ host -> do

122+ runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure")

123+

118124 modifyMaxSuccess (const 20) $ do

119125 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $

120126 property $ forAllShrink pathGen shrink $ \ a -> \ b c d ->