git.iko.soy/typeable/servant
on master help sign in
Use parseRequest
197ed05Oleg Grenrus
servant-client/src/Servant/Common/Req.hs+13−11
compare with master
unifiedsplit
@@ -103,7 +103,7 @@ setRQBody b t req = req { reqBody = Just (b, t) }
103
103
104reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
104reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
105reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
105reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
106− setheaders . setAccept . setrqb . setQS <$> parseUrlThrow url
106+ setheaders . setAccept . setrqb . setQS <$> parseRequest url
107
107
108 where url = show $ nullURI { uriScheme = case reqScheme of
108 where url = show $ nullURI { uriScheme = case reqScheme of
109 Http -> "http:"
109 Http -> "http:"
@@ -129,8 +129,18 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
129 | not . null . reqAccept $ req] }
129 | not . null . reqAccept $ req] }
130 toProperHeader (name, val) =
130 toProperHeader (name, val) =
131 (fromString name, encodeUtf8 val)
131 (fromString name, encodeUtf8 val)
132+
132#if !MIN_VERSION_http_client(0,4,30)
133#if !MIN_VERSION_http_client(0,4,30)
133− parseUrlThrow = parseUrl
134+-- 'parseRequest' is introduced in http-client-0.4.30
135+-- it differs from 'parseUrl', by not throwing exceptions on non-2xx http statuses
136+--
137+-- See for implementations:
138+-- http://hackage.haskell.org/package/http-client-0.4.30/docs/src/Network-HTTP-Client-Request.html#parseRequest
139+-- http://hackage.haskell.org/package/http-client-0.5.0/docs/src/Network-HTTP-Client-Request.html#parseRequest
140+parseRequest :: MonadThrow m => String -> m Request
141+parseRequest url = disableStatusCheck <$> parseUrl url
142+ where
143+ disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing }
134#endif
144#endif
135
145
136
146
@@ -147,8 +157,7 @@ performRequest :: Method -> Req -> Manager -> BaseUrl
147performRequest reqMethod req manager reqHost = do
157performRequest reqMethod req manager reqHost = do
148 partialRequest <- liftIO $ reqToRequest req reqHost
158 partialRequest <- liftIO $ reqToRequest req reqHost
149
159
150− let request = disableStatusCheck $
151− partialRequest { Client.method = reqMethod }
160+ let request = partialRequest { Client.method = reqMethod }
152
161
153 eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager
162 eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager
154 case eResponse of
163 case eResponse of
@@ -169,13 +178,6 @@ performRequest reqMethod req manager reqHost = do
169 throwE $ FailureResponse status ct body
178 throwE $ FailureResponse status ct body
170 return (status_code, body, ct, hdrs, response)
179 return (status_code, body, ct, hdrs, response)
171
180
172−disableStatusCheck :: Request -> Request
173−#if MIN_VERSION_http_client(0,5,0)
174−disableStatusCheck req = req { checkResponse = \ _req _res -> return () }
175−#else
176−disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing }
177−#endif
178−
179performRequestCT :: MimeUnrender ct result =>
181performRequestCT :: MimeUnrender ct result =>
180 Proxy ct -> Method -> Req -> Manager -> BaseUrl
182 Proxy ct -> Method -> Req -> Manager -> BaseUrl
181 -> ClientM ([HTTP.Header], result)
183 -> ClientM ([HTTP.Header], result)