Allow more response codes without failing
This commit is contained in:
parent
07d84d019c
commit
74b5bc400c
2 changed files with 6 additions and 6 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue