eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Allow more response codes without failing

Browse source
This commit is contained in:
Timo von Holtz 2015-03-09 17:04:31 +11:00
parent 07d84d019c
commit 74b5bc400c
2 changed files with 6 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/Servant/Client.hs
View file

@ -120,7 +120,7 @@ instance HasClient Delete where
instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
type Client (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result type Client (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
performRequestCT (Proxy :: Proxy ct) H.methodGet req 200 host performRequestCT (Proxy :: Proxy ct) H.methodGet req [200] host
-- | If you use a 'Header' in one of your endpoints in your API, -- | If you use a 'Header' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -167,7 +167,7 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
type Client (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req uri = clientWithRoute Proxy req uri =
performRequestCT (Proxy :: Proxy ct) H.methodPost req 201 uri performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] uri
-- | If you have a 'Put' endpoint in your API, the client -- | If you have a 'Put' endpoint in your API, the client
-- side querying function that is created when calling 'client' -- side querying function that is created when calling 'client'
@ -177,7 +177,7 @@ instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
type Client (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
performRequestCT (Proxy :: Proxy ct) H.methodPut req 200 host performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] host
-- | If you use a 'QueryParam' in one of your endpoints in your API, -- | If you use a 'QueryParam' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take

6
src/Servant/Common/Req.hs
View file

@ -8,7 +8,7 @@ import Control.Monad
import Control.Monad.Catch (MonadThrow) import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Data.ByteString.Lazy hiding (pack, filter, map, null) import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
import Data.IORef import Data.IORef
import Data.String import Data.String
import Data.String.Conversions import Data.String.Conversions
@ -162,11 +162,11 @@ performRequest reqMethod req isWantedStatus reqHost = do
return (status_code, body, ct) return (status_code, body, ct)
performRequestCT :: MimeUnrender ct result => performRequestCT :: MimeUnrender ct result =>
Proxy ct -> Method -> Req -> Int -> BaseUrl -> EitherT ServantError IO result Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO result
performRequestCT ct reqMethod req wantedStatus reqHost = do performRequestCT ct reqMethod req wantedStatus reqHost = do
let acceptCT = contentType ct let acceptCT = contentType ct
(_status, respBody, respCT) <- (_status, respBody, respCT) <-
performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
unless (matches respCT (acceptCT)) $ unless (matches respCT (acceptCT)) $
left $ UnsupportedContentType respCT respBody left $ UnsupportedContentType respCT respBody
either either