Allow more response codes without failing

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

View file

@ -120,7 +120,7 @@ instance HasClient Delete where
instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
type Client (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result
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,
-- 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
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
-- 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
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,
-- the corresponding querying function will automatically take

View file

@ -8,7 +8,7 @@ import Control.Monad
import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class
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.String
import Data.String.Conversions
@ -162,11 +162,11 @@ performRequest reqMethod req isWantedStatus reqHost = do
return (status_code, body, ct)
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
let acceptCT = contentType ct
(_status, respBody, respCT) <-
performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost
performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
unless (matches respCT (acceptCT)) $
left $ UnsupportedContentType respCT respBody
either