on master help sign in
Record accessors for ServantError
8015906Timo von Holtz
src/Servant/Common/Req.hs+22−6
@@ -28,11 +28,27 @@ import System.IO.Unsafe
28import qualified Network.HTTP.Client as Client
28import qualified Network.HTTP.Client as Client
29
29
30data ServantError
30data ServantError
31− = FailureResponse Status MediaType ByteString
31+ = FailureResponse
32+ { responseStatus :: Status
33+ , responseContentType :: MediaType
34+ , responseBody :: ByteString
35+ }
32− | DecodeFailure String MediaType ByteString
36+ | DecodeFailure
37+ { decodeError :: String
38+ , responseContentType :: MediaType
39+ , responseBody :: ByteString
40+ }
33− | UnsupportedContentType MediaType ByteString
41+ | UnsupportedContentType
42+ { responseContentType :: MediaType
43+ , responseBody :: ByteString
44+ }
34− | ConnectionError HttpException
45+ | ConnectionError
46+ { connectionError :: HttpException
47+ }
35− | InvalidContentTypeHeader String
48+ | InvalidContentTypeHeader
49+ { responseContentTypeHeader :: ByteString
50+ , responseBody :: ByteString
51+ }
36 deriving (Show)
52 deriving (Show)
37
53
38data Req = Req
54data Req = Req
@@ -139,7 +155,7 @@ performRequest reqMethod req isWantedStatus reqHost = do
139 ct <- case lookup "Content-Type" $ Client.responseHeaders response of
155 ct <- case lookup "Content-Type" $ Client.responseHeaders response of
140 Nothing -> pure $ "application"//"octet-stream"
156 Nothing -> pure $ "application"//"octet-stream"
141 Just t -> case parseAccept t of
157 Just t -> case parseAccept t of
142− Nothing -> left . InvalidContentTypeHeader . cs $ t
158+ Nothing -> left $ InvalidContentTypeHeader (cs t) body
143 Just t' -> pure t'
159 Just t' -> pure t'
144 unless (isWantedStatus status_code) $
160 unless (isWantedStatus status_code) $
145 left $ FailureResponse status ct body
161 left $ FailureResponse status ct body