db2c5a4 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Expose content type in response.

db2c5a4Timo von Holtz12 years ago

servant-client.cabal+1

compare with master

unifiedsplit

@@ -71,6 +71,7 @@ test-suite spec

71 , deepseq

72 , either

73 , hspec == 2.*

74+ , http-media

74 , http-types

75 , http-types

75 , network >= 2.6

76 , network >= 2.6

76 , QuickCheck >= 2.7

77 , QuickCheck >= 2.7

src/Servant/Client.hs+1−1

@@ -412,7 +412,7 @@ instance (KnownSymbol sym, HasClient sublayout)

412-- | Pick a 'Method' and specify where the server you want to query is. You get

413-- back the status code and the response body as a 'ByteString'.

414instance HasClient Raw where

415− type Client Raw = H.Method -> BaseUrl -> EitherT String IO (Int, ByteString)

415+ type Client Raw = H.Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)

416

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

418 clientWithRoute Proxy req httpMethod host =

src/Servant/Common/Req.hs+9−5

@@ -14,7 +14,6 @@ import Data.Aeson.Parser

14import Data.Aeson.Types

15import Data.Attoparsec.ByteString

16import Data.ByteString.Lazy hiding (pack)

17−import qualified Data.ByteString.Char8 as BS

18import Data.String

17import Data.String

19import Data.String.Conversions

18import Data.String.Conversions

20import Data.Text

19import Data.Text

@@ -85,7 +84,7 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort) =

85 setrqb r = case (reqBody req) of

84 setrqb r = case (reqBody req) of

86 Nothing -> r

85 Nothing -> r

87 Just (b,t) -> r { requestBody = RequestBodyLBS b

86 Just (b,t) -> r { requestBody = RequestBodyLBS b

88− , requestHeaders = [(hContentType, BS.pack . show $ t)] }

87+ , requestHeaders = [(hContentType, cs . show $ t)] }

89 setQS = setQueryString $ queryTextToQuery (qs req)

88 setQS = setQueryString $ queryTextToQuery (qs req)

90 setheaders r = r { requestHeaders = requestHeaders r

89 setheaders r = r { requestHeaders = requestHeaders r

91 ++ Prelude.map toProperHeader (headers req) }

90 ++ Prelude.map toProperHeader (headers req) }

@@ -110,7 +109,7 @@ displayHttpRequest :: Method -> String

110displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

109displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

111

110

112

111

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

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

114performRequest reqMethod req isWantedStatus reqHost = do

113performRequest reqMethod req isWantedStatus reqHost = do

115 partialRequest <- liftIO $ reqToRequest req reqHost

114 partialRequest <- liftIO $ reqToRequest req reqHost

116

115

@@ -129,7 +128,12 @@ performRequest reqMethod req isWantedStatus reqHost = do

129 let status = Client.responseStatus response

128 let status = Client.responseStatus response

130 unless (isWantedStatus (statusCode status)) $

129 unless (isWantedStatus (statusCode status)) $

131 left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)

130 left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)

131+ ct <- case lookup "Content-Type" $ Client.responseHeaders response of

132+ Nothing -> pure $ "application"//"octet-stream"

133+ Just t -> case parseAccept t of

134+ Nothing -> left $ "invalid Content-Type header: " <> cs t

135+ Just t' -> pure t'

132− return $ (statusCode status, Client.responseBody response)

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

133 where

137 where

134 showStatus (Status code message) =

138 showStatus (Status code message) =

135 show code ++ " - " ++ cs message

139 show code ++ " - " ++ cs message

@@ -138,7 +142,7 @@ performRequest reqMethod req isWantedStatus reqHost = do

138performRequestJSON :: FromJSON result =>

142performRequestJSON :: FromJSON result =>

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

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

140performRequestJSON reqMethod req wantedStatus reqHost = do

144performRequestJSON reqMethod req wantedStatus reqHost = do

141− (_status, respBody) <- performRequest reqMethod req (== wantedStatus) reqHost

145+ (_status, respBody, _) <- performRequest reqMethod req (== wantedStatus) reqHost

142 either

146 either

143 (\ message -> left (displayHttpRequest reqMethod ++ " returned invalid json: " ++ message))

147 (\ message -> left (displayHttpRequest reqMethod ++ " returned invalid json: " ++ message))

144 return

148 return

test/Servant/ClientSpec.hs+5−4

@@ -17,6 +17,7 @@ import Data.Foldable (forM_)

17import Data.Proxy

18import Data.Typeable

19import GHC.Generics

20+import Network.HTTP.Media

20import Network.HTTP.Types

21import Network.HTTP.Types

21import Network.Socket

22import Network.Socket

22import Network.Wai

23import Network.Wai

@@ -101,8 +102,8 @@ getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool

101getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person

102getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person

102getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]

103getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]

103getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool

104getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool

104−getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)

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

105−getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString)

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

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

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

107 -> BaseUrl

108 -> BaseUrl

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

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

@@ -167,10 +168,10 @@ spec = do

167 runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag

168 runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag

168

169

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

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

170− runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess")

171+ runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")

171

172

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

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

173− runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure")

174+ runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")

174

175

175 modifyMaxSuccess (const 20) $ do

176 modifyMaxSuccess (const 20) $ do

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

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