db2c5a4 · servant · git.iko.soy

git.iko.soy/servant

Expose content type in response.

commitdb2c5a42b2852f0e627e7dea0e27e2b96bed3354 authorTimo von Holtz <tvh@anchor.com.au> dateTue 17 Feb 2015, 10:32 (12 years ago) parent7a1eac4

4 files changed+16−10

compare with master

unifiedsplit

servant-client.cabal+1 src/Servant/Client.hs+1−1 src/Servant/Common/Req.hs+9−5 test/Servant/ClientSpec.hs+5−4

servant-client.cabal+1

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

7171 , deepseq

7272 , either

7373 , hspec == 2.*

74+ , http-media

7475 , http-types

7576 , network >= 2.6

7677 , QuickCheck >= 2.7

src/Servant/Client.hs+1−1

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

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

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

414414instance 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)

416416

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

418418 clientWithRoute Proxy req httpMethod host =

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

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

1414import Data.Aeson.Types

1515import Data.Attoparsec.ByteString

1616import Data.ByteString.Lazy hiding (pack)

17−import qualified Data.ByteString.Char8 as BS

1817import Data.String

1918import Data.String.Conversions

2019import Data.Text

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

8584 setrqb r = case (reqBody req) of

8685 Nothing -> r

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

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

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

8988 setQS = setQueryString $ queryTextToQuery (qs req)

9089 setheaders r = r { requestHeaders = requestHeaders r

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

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

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

111110

112111

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)

114113performRequest reqMethod req isWantedStatus reqHost = do

115114 partialRequest <- liftIO $ reqToRequest req reqHost

116115

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

129128 let status = Client.responseStatus response

130129 unless (isWantedStatus (statusCode status)) $

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

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

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'

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

133137 where

134138 showStatus (Status code message) =

135139 show code ++ " - " ++ cs message

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

138142performRequestJSON :: FromJSON result =>

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

140144performRequestJSON reqMethod req wantedStatus reqHost = do

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

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

142146 either

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

144148 return

test/Servant/ClientSpec.hs+5−4

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

1717import Data.Proxy

1818import Data.Typeable

1919import GHC.Generics

20+import Network.HTTP.Media

2021import Network.HTTP.Types

2122import Network.Socket

2223import Network.Wai

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

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

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

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

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

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

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

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

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

107108 -> BaseUrl

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

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

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

168169

169170 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")

171172

172173 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")

174175

175176 modifyMaxSuccess (const 20) $ do

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