git.iko.soy/typeable/servant
on master help sign in
Client Raw: returns `Right (status, body)` even for failure statuses
286b1dbSönke Hahn
src/Servant/API/Raw.hs+1−1
@@ -26,7 +26,7 @@ instance HasServer Raw where
26 rawApplication request (respond . succeedWith)
26 rawApplication request (respond . succeedWith)
27
27
28instance HasClient Raw where
28instance HasClient Raw where
29− type Client Raw = Method -> BaseUrl -> EitherT String IO ByteString
29+ type Client Raw = Method -> BaseUrl -> EitherT String IO (Int, ByteString)
30
30
31 clientWithRoute :: Proxy Raw -> Req -> Client Raw
31 clientWithRoute :: Proxy Raw -> Req -> Client Raw
32 clientWithRoute Proxy req method host =
32 clientWithRoute Proxy req method host =
src/Servant/Common/Req.hs+4−3
@@ -82,11 +82,12 @@ displayHttpRequest :: Method -> String
82displayHttpRequest method = "HTTP " ++ cs method ++ " request"
82displayHttpRequest method = "HTTP " ++ cs method ++ " request"
83
83
84
84
85−performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO ByteString
85+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString)
86performRequest method req isWantedStatus host = do
86performRequest method req isWantedStatus host = do
87 partialRequest <- liftIO $ reqToRequest req host
87 partialRequest <- liftIO $ reqToRequest req host
88
88
89 let request = partialRequest { Client.method = method
89 let request = partialRequest { Client.method = method
90+ , checkStatus = \ _status _headers _cookies -> Nothing
90 }
91 }
91
92
92 eResponse <- liftIO $ __withGlobalManager $ \ manager ->
93 eResponse <- liftIO $ __withGlobalManager $ \ manager ->
@@ -100,7 +101,7 @@ performRequest method req isWantedStatus host = do
100 let status = Client.responseStatus response
101 let status = Client.responseStatus response
101 unless (isWantedStatus (statusCode status)) $
102 unless (isWantedStatus (statusCode status)) $
102 left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)
103 left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)
103− return $ Client.responseBody response
104+ return $ (statusCode status, Client.responseBody response)
104 where
105 where
105 showStatus (Status code message) =
106 showStatus (Status code message) =
106 show code ++ " - " ++ cs message
107 show code ++ " - " ++ cs message
@@ -109,7 +110,7 @@ performRequest method req isWantedStatus host = do
109performRequestJSON :: FromJSON result =>
110performRequestJSON :: FromJSON result =>
110 Method -> Req -> Int -> BaseUrl -> EitherT String IO result
111 Method -> Req -> Int -> BaseUrl -> EitherT String IO result
111performRequestJSON method req wantedStatus host = do
112performRequestJSON method req wantedStatus host = do
112− responseBody <- performRequest method req (== wantedStatus) host
113+ (_status, responseBody) <- performRequest method req (== wantedStatus) host
113 either
114 either
114 (\ message -> left (displayHttpRequest method ++ " returned invalid json: " ++ message))
115 (\ message -> left (displayHttpRequest method ++ " returned invalid json: " ++ message))
115 return
116 return
test/Servant/ClientSpec.hs+8−2
@@ -72,8 +72,8 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person
72getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
72getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
73getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
73getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
74getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
74getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
75−getRawSuccess :: Method -> BaseUrl -> EitherT String IO ByteString
75+getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)
76−getRawFailure :: Method -> BaseUrl -> EitherT String IO ByteString
76+getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)
77getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
77getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
78 -> BaseUrl
78 -> BaseUrl
79 -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
79 -> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])])
@@ -115,6 +115,12 @@ spec = do
115 it (show flag) $ withServer $ \ host -> do
115 it (show flag) $ withServer $ \ host -> do
116 runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
116 runEitherT (getQueryFlag flag host) `shouldReturn` Right flag
117
117
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+
118 modifyMaxSuccess (const 20) $ do
124 modifyMaxSuccess (const 20) $ do
119 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
125 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
120 property $ forAllShrink pathGen shrink $ \ a -> \ b c d ->
126 property $ forAllShrink pathGen shrink $ \ a -> \ b c d ->