Rename ServantError to ClientError, ServantErr to ServerError
This commit is contained in:
Oleg Grenrus
parent
e922b9898c
commit
a5655f8d5a
25 changed files with 162 additions and 166 deletions
12
.travis.yml
12
.travis.yml
|
|
@ -87,9 +87,7 @@ install:
|
|||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/db-sqlite-simple\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/file-upload\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/generic\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/hoist-server-with-context\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/https\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/jwt-and-basic-auth\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/testing\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/structuring-apis\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"doc/cookbook/using-custom-monad\"\\n' >> cabal.project ; fi"
|
||||
|
|
@ -106,7 +104,7 @@ install:
|
|||
- "echo 'reorder-goals: True' >> cabal.project"
|
||||
- "echo 'optimization: False' >> cabal.project "
|
||||
- touch cabal.project.local
|
||||
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-db-sqlite-simple|cookbook-file-upload|cookbook-generic|cookbook-hoist-server-with-context|cookbook-https|cookbook-jwt-and-basic-auth|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
|
||||
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-db-sqlite-simple|cookbook-file-upload|cookbook-generic|cookbook-https|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
|
||||
- cat cabal.project || true
|
||||
- cat cabal.project.local || true
|
||||
- if [ -f "servant/configure.ac" ]; then (cd "servant" && autoreconf -i); fi
|
||||
|
|
@ -127,15 +125,13 @@ install:
|
|||
- if [ -f "doc/cookbook/db-sqlite-simple/configure.ac" ]; then (cd "doc/cookbook/db-sqlite-simple" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/file-upload/configure.ac" ]; then (cd "doc/cookbook/file-upload" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/generic/configure.ac" ]; then (cd "doc/cookbook/generic" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/hoist-server-with-context/configure.ac" ]; then (cd "doc/cookbook/hoist-server-with-context" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/https/configure.ac" ]; then (cd "doc/cookbook/https" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/jwt-and-basic-auth/configure.ac" ]; then (cd "doc/cookbook/jwt-and-basic-auth" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/testing/configure.ac" ]; then (cd "doc/cookbook/testing" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/structuring-apis/configure.ac" ]; then (cd "doc/cookbook/structuring-apis" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then (cd "doc/cookbook/using-custom-monad" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/using-free-client/configure.ac" ]; then (cd "doc/cookbook/using-free-client" && autoreconf -i); fi
|
||||
- rm -f cabal.project.freeze
|
||||
- rm -rf .ghc.environment.* "servant"/dist "servant-client"/dist "servant-client-core"/dist "servant-http-streams"/dist "servant-docs"/dist "servant-foreign"/dist "servant-server"/dist "doc/tutorial"/dist "servant-machines"/dist "servant-conduit"/dist "servant-pipes"/dist "doc/cookbook/basic-auth"/dist "doc/cookbook/curl-mock"/dist "doc/cookbook/basic-streaming"/dist "doc/cookbook/db-postgres-pool"/dist "doc/cookbook/db-sqlite-simple"/dist "doc/cookbook/file-upload"/dist "doc/cookbook/generic"/dist "doc/cookbook/hoist-server-with-context"/dist "doc/cookbook/https"/dist "doc/cookbook/jwt-and-basic-auth"/dist "doc/cookbook/testing"/dist "doc/cookbook/structuring-apis"/dist "doc/cookbook/using-custom-monad"/dist "doc/cookbook/using-free-client"/dist
|
||||
- rm -rf .ghc.environment.* "servant"/dist "servant-client"/dist "servant-client-core"/dist "servant-http-streams"/dist "servant-docs"/dist "servant-foreign"/dist "servant-server"/dist "doc/tutorial"/dist "servant-machines"/dist "servant-conduit"/dist "servant-pipes"/dist "doc/cookbook/basic-auth"/dist "doc/cookbook/curl-mock"/dist "doc/cookbook/basic-streaming"/dist "doc/cookbook/db-postgres-pool"/dist "doc/cookbook/db-sqlite-simple"/dist "doc/cookbook/file-upload"/dist "doc/cookbook/generic"/dist "doc/cookbook/https"/dist "doc/cookbook/testing"/dist "doc/cookbook/structuring-apis"/dist "doc/cookbook/using-custom-monad"/dist "doc/cookbook/using-free-client"/dist
|
||||
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
|
||||
|
||||
# Here starts the actual work to be performed for the package under test;
|
||||
|
|
@ -169,9 +165,7 @@ script:
|
|||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-db-sqlite-simple-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-file-upload-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-generic-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-hoist-server-with-context-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-https-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-jwt-and-basic-auth-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-testing-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-structuring-apis-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
- "if [ $HCNUMVER -eq 80404 ] || [ $HCNUMVER -eq 80603 ] ; then printf 'packages: \"cookbook-using-custom-monad-*/*.cabal\"\\n' >> cabal.project ; fi"
|
||||
|
|
@ -188,7 +182,7 @@ script:
|
|||
- "echo 'reorder-goals: True' >> cabal.project"
|
||||
- "echo 'optimization: False' >> cabal.project "
|
||||
- touch cabal.project.local
|
||||
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-db-sqlite-simple|cookbook-file-upload|cookbook-generic|cookbook-hoist-server-with-context|cookbook-https|cookbook-jwt-and-basic-auth|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
|
||||
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-db-sqlite-simple|cookbook-file-upload|cookbook-generic|cookbook-https|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
|
||||
- cat cabal.project || true
|
||||
- cat cabal.project.local || true
|
||||
- echo -en 'travis_fold:end:unpack\\r'
|
||||
|
|
|
|||
|
|
@ -21,11 +21,11 @@ packages:
|
|||
doc/cookbook/db-sqlite-simple
|
||||
doc/cookbook/file-upload
|
||||
doc/cookbook/generic
|
||||
doc/cookbook/hoist-server-with-context
|
||||
-- doc/cookbook/hoist-server-with-context
|
||||
doc/cookbook/https
|
||||
doc/cookbook/jwt-and-basic-auth/
|
||||
-- doc/cookbook/jwt-and-basic-auth/
|
||||
-- doc/cookbook/pagination
|
||||
-- doc/cookbook/sentry
|
||||
-- doc/cookbook/sentry
|
||||
doc/cookbook/testing
|
||||
doc/cookbook/structuring-apis
|
||||
doc/cookbook/using-custom-monad
|
||||
|
|
|
|||
|
|
@ -234,7 +234,7 @@ clientEnv esHost esPort = do
|
|||
manager <- newManager defaultManagerSettings
|
||||
pure $ mkClientEnv manager baseUrl
|
||||
|
||||
runSearchClient :: Text -> Text -> ClientM a -> IO (Either ServantError a)
|
||||
runSearchClient :: Text -> Text -> ClientM a -> IO (Either ClientError a)
|
||||
runSearchClient esHost esPort = (clientEnv esHost esPort >>=) . runClientM
|
||||
```
|
||||
|
||||
|
|
@ -267,7 +267,7 @@ docServer esHost esPort = getDocById esHost esPort
|
|||
-- actions
|
||||
getDocById :: Text -> Text -> Integer -> Handler Value
|
||||
getDocById esHost esPort docId = do
|
||||
-- Our Servant Client function returns Either ServantError Value here:
|
||||
-- Our Servant Client function returns Either ClientError Value here:
|
||||
docRes <- liftIO $ runSearchClient esHost esPort (getDocument docId)
|
||||
case docRes of
|
||||
Left err -> throwError $ err404 { errBody = "Failed looking up content" }
|
||||
|
|
|
|||
|
|
@ -599,7 +599,7 @@ $ curl -H 'Accept: text/html' http://localhost:8081/persons
|
|||
|
||||
## The `Handler` monad
|
||||
|
||||
At the heart of the handlers is the monad they run in, namely a newtype `Handler` around `ExceptT ServantErr IO`
|
||||
At the heart of the handlers is the monad they run in, namely a newtype `Handler` around `ExceptT ServerErroror IO`
|
||||
([haddock documentation for `ExceptT`](http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)).
|
||||
One might wonder: why this monad? The answer is that it is the
|
||||
simplest monad with the following properties:
|
||||
|
|
@ -617,7 +617,7 @@ newtype ExceptT e m a = ExceptT (m (Either e a))
|
|||
```
|
||||
|
||||
In short, this means that a handler of type `Handler a` is simply
|
||||
equivalent to a computation of type `IO (Either ServantErr a)`, that is, an IO
|
||||
equivalent to a computation of type `IO (Either ServerError a)`, that is, an IO
|
||||
action that either returns an error or a result.
|
||||
|
||||
The module [`Control.Monad.Except`](https://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)
|
||||
|
|
@ -660,16 +660,16 @@ server5 = do
|
|||
return (FileContent filecontent)
|
||||
```
|
||||
|
||||
### Failing, through `ServantErr`
|
||||
### Failing, through `ServerError`
|
||||
|
||||
If you want to explicitly fail at providing the result promised by an endpoint
|
||||
using the appropriate HTTP status code (not found, unauthorized, etc) and some
|
||||
error message, all you have to do is use the `throwError` function mentioned above
|
||||
and provide it with the appropriate value of type `ServantErr`, which is
|
||||
and provide it with the appropriate value of type `ServerError`, which is
|
||||
defined as:
|
||||
|
||||
``` haskell ignore
|
||||
data ServantErr = ServantErr
|
||||
data ServerError = ServerError
|
||||
{ errHTTPCode :: Int
|
||||
, errReasonPhrase :: String
|
||||
, errBody :: ByteString -- lazy bytestring
|
||||
|
|
@ -685,7 +685,7 @@ use record update syntax:
|
|||
failingHandler :: Handler ()
|
||||
failingHandler = throwError myerr
|
||||
|
||||
where myerr :: ServantErr
|
||||
where myerr :: ServerError
|
||||
myerr = err503 { errBody = "Sorry dear user." }
|
||||
```
|
||||
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ module Servant.Client.Core
|
|||
, AuthClientData
|
||||
|
||||
-- * Generic Client
|
||||
, ServantError(..)
|
||||
, ClientError(..)
|
||||
, EmptyClient(..)
|
||||
|
||||
-- * Response
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Servant.Client.Core.ClientError (
|
||||
ServantError (..),
|
||||
ClientError (..),
|
||||
) where
|
||||
|
||||
import Prelude ()
|
||||
|
|
@ -42,7 +42,7 @@ import Servant.Client.Core.Response
|
|||
-- | A type representing possible errors in a request
|
||||
--
|
||||
-- Note that this type substantially changed in 0.12.
|
||||
data ServantError =
|
||||
data ClientError =
|
||||
-- | The server returned an error response including the
|
||||
-- failing request. 'requestPath' includes the 'BaseUrl' and the
|
||||
-- path of the request.
|
||||
|
|
@ -57,7 +57,7 @@ data ServantError =
|
|||
| ConnectionError SomeException
|
||||
deriving (Show, Generic, Typeable)
|
||||
|
||||
instance Eq ServantError where
|
||||
instance Eq ClientError where
|
||||
FailureResponse req res == FailureResponse req' res' = req == req' && res == res'
|
||||
DecodeFailure t r == DecodeFailure t' r' = t == t' && r == r'
|
||||
UnsupportedContentType mt r == UnsupportedContentType mt' r' = mt == mt' && r == r'
|
||||
|
|
@ -74,11 +74,11 @@ instance Eq ServantError where
|
|||
InvalidContentTypeHeader {} == _ = False
|
||||
ConnectionError {} == _ = False
|
||||
|
||||
instance Exception ServantError
|
||||
instance Exception ClientError
|
||||
|
||||
-- | Note: an exception in 'ConnectionError' might not be evaluated fully,
|
||||
-- We only 'rnf' its 'show'ed value.
|
||||
instance NFData ServantError where
|
||||
instance NFData ClientError where
|
||||
rnf (FailureResponse req res) = rnf req `seq` rnf res
|
||||
rnf (DecodeFailure err res) = rnf err `seq` rnf res
|
||||
rnf (UnsupportedContentType mt' res) = mediaTypeRnf mt' `seq` rnf res
|
||||
|
|
|
|||
|
|
@ -254,7 +254,7 @@ instance {-# OVERLAPPING #-}
|
|||
, requestAccept = fromList $ toList accept
|
||||
}
|
||||
case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
|
||||
Left err -> throwServantError $ DecodeFailure (pack err) response
|
||||
Left err -> throwClientError $ DecodeFailure (pack err) response
|
||||
Right val -> return $ Headers
|
||||
{ getResponse = val
|
||||
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
|
||||
|
|
@ -662,7 +662,7 @@ checkContentTypeHeader response =
|
|||
case lookup "Content-Type" $ toList $ responseHeaders response of
|
||||
Nothing -> return $ "application"//"octet-stream"
|
||||
Just t -> case parseAccept t of
|
||||
Nothing -> throwServantError $ InvalidContentTypeHeader response
|
||||
Nothing -> throwClientError $ InvalidContentTypeHeader response
|
||||
Just t' -> return t'
|
||||
|
||||
decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
|
||||
|
|
@ -670,9 +670,9 @@ decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
|
|||
decodedAs response ct = do
|
||||
responseContentType <- checkContentTypeHeader response
|
||||
unless (any (matches responseContentType) accept) $
|
||||
throwServantError $ UnsupportedContentType responseContentType response
|
||||
throwClientError $ UnsupportedContentType responseContentType response
|
||||
case mimeUnrender ct $ responseBody response of
|
||||
Left err -> throwServantError $ DecodeFailure (T.pack err) response
|
||||
Left err -> throwClientError $ DecodeFailure (T.pack err) response
|
||||
Right val -> return val
|
||||
where
|
||||
accept = toList $ contentTypes ct
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ module Servant.Client.Core.Reexport
|
|||
, ResponseF(..)
|
||||
|
||||
-- * Data types
|
||||
, ServantError(..)
|
||||
, ClientError(..)
|
||||
, EmptyClient(..)
|
||||
|
||||
-- * BaseUrl
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ import Servant.Client.Core.Response
|
|||
class Monad m => RunClient m where
|
||||
-- | How to make a request.
|
||||
runRequest :: Request -> m Response
|
||||
throwServantError :: ServantError -> m a
|
||||
throwClientError :: ClientError -> m a
|
||||
|
||||
class RunClient m => RunStreamingClient m where
|
||||
withStreamingRequest :: Request -> (StreamingResponse -> IO a) -> m a
|
||||
|
|
@ -38,9 +38,9 @@ class RunClient m => RunStreamingClient m where
|
|||
-- Compare to 'RunClient'.
|
||||
data ClientF a
|
||||
= RunRequest Request (Response -> a)
|
||||
| Throw ServantError
|
||||
| Throw ClientError
|
||||
deriving (Functor)
|
||||
|
||||
instance ClientF ~ f => RunClient (Free f) where
|
||||
runRequest req = liftF (RunRequest req id)
|
||||
throwServantError = liftF . Throw
|
||||
throwClientError = liftF . Throw
|
||||
|
|
|
|||
|
|
@ -94,16 +94,16 @@ client api = api `clientIn` (Proxy :: Proxy ClientM)
|
|||
--
|
||||
-- NOTE: Does not support constant space streaming of the request body!
|
||||
newtype ClientM a = ClientM
|
||||
{ runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }
|
||||
{ runClientM' :: ReaderT ClientEnv (ExceptT ClientError IO) a }
|
||||
deriving ( Functor, Applicative, Monad, MonadIO, Generic
|
||||
, MonadReader ClientEnv, MonadError ServantError, MonadThrow
|
||||
, MonadReader ClientEnv, MonadError ClientError, MonadThrow
|
||||
, MonadCatch)
|
||||
|
||||
instance MonadBase IO ClientM where
|
||||
liftBase = ClientM . liftBase
|
||||
|
||||
instance MonadBaseControl IO ClientM where
|
||||
type StM ClientM a = Either ServantError a
|
||||
type StM ClientM a = Either ClientError a
|
||||
|
||||
liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))
|
||||
|
||||
|
|
@ -121,12 +121,12 @@ instance Exception StreamingNotSupportedException where
|
|||
|
||||
instance RunClient ClientM where
|
||||
runRequest = performRequest
|
||||
throwServantError = throwError
|
||||
throwClientError = throwError
|
||||
|
||||
runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ServantError a)
|
||||
runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)
|
||||
runClientMOrigin cm env = runExceptT $ flip runReaderT env $ runClientM' cm
|
||||
|
||||
runClientM :: ClientM a -> IO (Either ServantError a)
|
||||
runClientM :: ClientM a -> IO (Either ClientError a)
|
||||
runClientM m = do
|
||||
curLoc <- getWindowLocation
|
||||
|
||||
|
|
@ -298,7 +298,7 @@ foreign import javascript unsafe "$3.slice($1, $1 + $2)"
|
|||
-- * inspecting the xhr response
|
||||
|
||||
-- This function is only supposed to handle 'ConnectionError's. Other
|
||||
-- 'ServantError's are created in Servant.Client.Req.
|
||||
-- 'ClientError's are created in Servant.Client.Req.
|
||||
toResponse :: JSXMLHttpRequest -> ClientM Response
|
||||
toResponse xhr = do
|
||||
status <- liftIO $ getStatus xhr
|
||||
|
|
|
|||
|
|
@ -120,16 +120,16 @@ hoistClient = hoistClientMonad (Proxy :: Proxy ClientM)
|
|||
-- | @ClientM@ is the monad in which client functions run. Contains the
|
||||
-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
|
||||
newtype ClientM a = ClientM
|
||||
{ unClientM :: ReaderT ClientEnv (ExceptT ServantError IO) a }
|
||||
{ unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }
|
||||
deriving ( Functor, Applicative, Monad, MonadIO, Generic
|
||||
, MonadReader ClientEnv, MonadError ServantError, MonadThrow
|
||||
, MonadReader ClientEnv, MonadError ClientError, MonadThrow
|
||||
, MonadCatch)
|
||||
|
||||
instance MonadBase IO ClientM where
|
||||
liftBase = ClientM . liftBase
|
||||
|
||||
instance MonadBaseControl IO ClientM where
|
||||
type StM ClientM a = Either ServantError a
|
||||
type StM ClientM a = Either ClientError a
|
||||
|
||||
liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . unClientM)))
|
||||
|
||||
|
|
@ -141,9 +141,9 @@ instance Alt ClientM where
|
|||
|
||||
instance RunClient ClientM where
|
||||
runRequest = performRequest
|
||||
throwServantError = throwError
|
||||
throwClientError = throwError
|
||||
|
||||
runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
|
||||
runClientM :: ClientM a -> ClientEnv -> IO (Either ClientError a)
|
||||
runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm
|
||||
|
||||
performRequest :: Request -> ClientM Response
|
||||
|
|
@ -197,7 +197,7 @@ performRequest req = do
|
|||
fReq = Client.hrFinalRequest responses
|
||||
fRes = Client.hrFinalResponse responses
|
||||
|
||||
mkFailureResponse :: BaseUrl -> Request -> ResponseF BSL.ByteString -> ServantError
|
||||
mkFailureResponse :: BaseUrl -> Request -> ResponseF BSL.ByteString -> ClientError
|
||||
mkFailureResponse burl request =
|
||||
FailureResponse (bimap (const ()) f request)
|
||||
where
|
||||
|
|
@ -270,7 +270,7 @@ requestToClientRequest burl r = Client.defaultRequest
|
|||
Http -> False
|
||||
Https -> True
|
||||
|
||||
catchConnectionError :: IO a -> IO (Either ServantError a)
|
||||
catchConnectionError :: IO a -> IO (Either ClientError a)
|
||||
catchConnectionError action =
|
||||
catch (Right <$> action) $ \e ->
|
||||
pure . Left . ConnectionError $ SomeException (e :: Client.HttpException)
|
||||
|
|
|
|||
|
|
@ -100,9 +100,9 @@ hoistClient = hoistClientMonad (Proxy :: Proxy ClientM)
|
|||
-- | @ClientM@ is the monad in which client functions run. Contains the
|
||||
-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
|
||||
newtype ClientM a = ClientM
|
||||
{ unClientM :: ReaderT ClientEnv (ExceptT ServantError (Codensity IO)) a }
|
||||
{ unClientM :: ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a }
|
||||
deriving ( Functor, Applicative, Monad, MonadIO, Generic
|
||||
, MonadReader ClientEnv, MonadError ServantError)
|
||||
, MonadReader ClientEnv, MonadError ClientError)
|
||||
|
||||
instance MonadBase IO ClientM where
|
||||
liftBase = ClientM . liftIO
|
||||
|
|
@ -113,12 +113,12 @@ instance Alt ClientM where
|
|||
|
||||
instance RunClient ClientM where
|
||||
runRequest = performRequest
|
||||
throwServantError = throwError
|
||||
throwClientError = throwError
|
||||
|
||||
instance RunStreamingClient ClientM where
|
||||
withStreamingRequest = performWithStreamingRequest
|
||||
|
||||
withClientM :: ClientM a -> ClientEnv -> (Either ServantError a -> IO b) -> IO b
|
||||
withClientM :: ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
|
||||
withClientM cm env k =
|
||||
let Codensity f = runExceptT $ flip runReaderT env $ unClientM cm
|
||||
in f k
|
||||
|
|
@ -133,7 +133,7 @@ withClientM cm env k =
|
|||
-- /Note:/ we 'force' the result, so the likehood of accidentally leaking a
|
||||
-- connection is smaller. Use with care.
|
||||
--
|
||||
runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ServantError a)
|
||||
runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ClientError a)
|
||||
runClientM cm env = withClientM cm env (evaluate . force)
|
||||
|
||||
performRequest :: Request -> ClientM Response
|
||||
|
|
|
|||
|
|
@ -184,8 +184,8 @@ server = serve api (
|
|||
:<|> return
|
||||
:<|> (\ name -> case name of
|
||||
Just "alice" -> return alice
|
||||
Just n -> throwError $ ServantErr 400 (n ++ " not found") "" []
|
||||
Nothing -> throwError $ ServantErr 400 "missing parameter" "" [])
|
||||
Just n -> throwError $ ServerError 400 (n ++ " not found") "" []
|
||||
Nothing -> throwError $ ServerError 400 "missing parameter" "" [])
|
||||
:<|> (\ names -> return (zipWith Person names [0..]))
|
||||
:<|> return
|
||||
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
|
||||
|
|
@ -260,7 +260,7 @@ genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return
|
|||
manager' :: C.Manager
|
||||
manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
|
||||
|
||||
runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)
|
||||
runClient :: ClientM a -> BaseUrl -> IO (Either ClientError a)
|
||||
runClient x baseUrl' = runClientM x (mkClientEnv manager' baseUrl')
|
||||
|
||||
sucessSpec :: Spec
|
||||
|
|
@ -352,7 +352,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
|||
|
||||
wrappedApiSpec :: Spec
|
||||
wrappedApiSpec = describe "error status codes" $ do
|
||||
let serveW api = serve api $ throwError $ ServantErr 500 "error message" "" []
|
||||
let serveW api = serve api $ throwError $ ServerError 500 "error message" "" []
|
||||
context "are correctly handled by the client" $
|
||||
let test :: (WrappedApi, String) -> Spec
|
||||
test (WrappedApi api, desc) =
|
||||
|
|
@ -475,7 +475,7 @@ connectionErrorAPI :: Proxy ConnectionErrorAPI
|
|||
connectionErrorAPI = Proxy
|
||||
|
||||
connectionErrorSpec :: Spec
|
||||
connectionErrorSpec = describe "Servant.Client.ServantError" $
|
||||
connectionErrorSpec = describe "Servant.Client.ClientError" $
|
||||
it "correctly catches ConnectionErrors when the HTTP request can't go through" $ do
|
||||
let getInt = client connectionErrorAPI
|
||||
let baseUrl' = BaseUrl Http "example.invalid" 80 ""
|
||||
|
|
|
|||
|
|
@ -112,7 +112,7 @@ powerOfTwo = (2 ^)
|
|||
manager' :: C.Manager
|
||||
manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
|
||||
|
||||
withClient :: ClientM a -> BaseUrl -> (Either ServantError a -> IO r) -> IO r
|
||||
withClient :: ClientM a -> BaseUrl -> (Either ClientError a -> IO r) -> IO r
|
||||
withClient x baseUrl' = withClientM x (mkClientEnv manager' baseUrl')
|
||||
|
||||
testRunSourceIO :: SourceIO a
|
||||
|
|
|
|||
|
|
@ -123,9 +123,9 @@ hoistClient = hoistClientMonad (Proxy :: Proxy ClientM)
|
|||
-- | @ClientM@ is the monad in which client functions run. Contains the
|
||||
-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
|
||||
newtype ClientM a = ClientM
|
||||
{ unClientM :: ReaderT ClientEnv (ExceptT ServantError (Codensity IO)) a }
|
||||
{ unClientM :: ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a }
|
||||
deriving ( Functor, Applicative, Monad, MonadIO, Generic
|
||||
, MonadReader ClientEnv, MonadError ServantError)
|
||||
, MonadReader ClientEnv, MonadError ClientError)
|
||||
|
||||
instance MonadBase IO ClientM where
|
||||
liftBase = ClientM . liftIO
|
||||
|
|
@ -136,15 +136,15 @@ instance Alt ClientM where
|
|||
|
||||
instance RunClient ClientM where
|
||||
runRequest = performRequest
|
||||
throwServantError = throwError
|
||||
throwClientError = throwError
|
||||
|
||||
instance RunStreamingClient ClientM where
|
||||
withStreamingRequest = performWithStreamingRequest
|
||||
|
||||
runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ServantError a)
|
||||
runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ClientError a)
|
||||
runClientM cm env = withClientM cm env (evaluate . force)
|
||||
|
||||
withClientM :: ClientM a -> ClientEnv -> (Either ServantError a -> IO b) -> IO b
|
||||
withClientM :: ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
|
||||
withClientM cm env k =
|
||||
let Codensity f = runExceptT $ flip runReaderT env $ unClientM cm
|
||||
in f k
|
||||
|
|
@ -181,7 +181,7 @@ performWithStreamingRequest req k = do
|
|||
x <- k (clientResponseToResponse res' (fromInputStream body'))
|
||||
k1 x
|
||||
|
||||
mkFailureResponse :: BaseUrl -> Request -> ResponseF BSL.ByteString -> ServantError
|
||||
mkFailureResponse :: BaseUrl -> Request -> ResponseF BSL.ByteString -> ClientError
|
||||
mkFailureResponse burl request =
|
||||
FailureResponse (bimap (const ()) f request)
|
||||
where
|
||||
|
|
@ -233,7 +233,7 @@ requestToClientRequest burl r = (request, body)
|
|||
Nothing -> (Client.emptyBody, Nothing)
|
||||
Just (body', typ) -> (convertBody body', Just (hContentType, renderHeader typ))
|
||||
|
||||
catchConnectionError :: IO a -> IO (Either ServantError a)
|
||||
catchConnectionError :: IO a -> IO (Either ClientError a)
|
||||
catchConnectionError action =
|
||||
catch (Right <$> action) $ \e ->
|
||||
pure . Left . ConnectionError $ SomeException (e :: IOException)
|
||||
|
|
|
|||
|
|
@ -182,8 +182,8 @@ server = serve api (
|
|||
:<|> return
|
||||
:<|> (\ name -> case name of
|
||||
Just "alice" -> return alice
|
||||
Just n -> throwError $ ServantErr 400 (n ++ " not found") "" []
|
||||
Nothing -> throwError $ ServantErr 400 "missing parameter" "" [])
|
||||
Just n -> throwError $ ServerError 400 (n ++ " not found") "" []
|
||||
Nothing -> throwError $ ServerError 400 "missing parameter" "" [])
|
||||
:<|> (\ names -> return (zipWith Person names [0..]))
|
||||
:<|> return
|
||||
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
|
||||
|
|
@ -254,10 +254,10 @@ genAuthServerContext = genAuthHandler :. EmptyContext
|
|||
genAuthServer :: Application
|
||||
genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))
|
||||
|
||||
runClient :: NFData a => ClientM a -> BaseUrl -> IO (Either ServantError a)
|
||||
runClient :: NFData a => ClientM a -> BaseUrl -> IO (Either ClientError a)
|
||||
runClient x burl = withClientEnvIO burl (runClientM x)
|
||||
|
||||
runClientUnsafe :: ClientM a -> BaseUrl -> IO (Either ServantError a)
|
||||
runClientUnsafe :: ClientM a -> BaseUrl -> IO (Either ClientError a)
|
||||
runClientUnsafe x burl = withClientEnvIO burl (runClientMUnsafe x)
|
||||
where
|
||||
runClientMUnsafe x env = withClientM x env return
|
||||
|
|
@ -343,7 +343,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
|||
|
||||
wrappedApiSpec :: Spec
|
||||
wrappedApiSpec = describe "error status codes" $ do
|
||||
let serveW api = serve api $ throwError $ ServantErr 500 "error message" "" []
|
||||
let serveW api = serve api $ throwError $ ServerError 500 "error message" "" []
|
||||
context "are correctly handled by the client" $
|
||||
let test :: (WrappedApi, String) -> Spec
|
||||
test (WrappedApi api, desc) =
|
||||
|
|
@ -467,7 +467,7 @@ connectionErrorAPI :: Proxy ConnectionErrorAPI
|
|||
connectionErrorAPI = Proxy
|
||||
|
||||
connectionErrorSpec :: Spec
|
||||
connectionErrorSpec = describe "Servant.Client.ServantError" $
|
||||
connectionErrorSpec = describe "Servant.Client.ClientError" $
|
||||
xit "correctly catches ConnectionErrors when the HTTP request can't go through" $ do
|
||||
let getInt = client connectionErrorAPI
|
||||
let baseUrl' = BaseUrl Http "example.invalid" 80 ""
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ server = serve api
|
|||
powerOfTwo :: Int -> Int
|
||||
powerOfTwo = (2 ^)
|
||||
|
||||
withClient :: ClientM a -> BaseUrl -> (Either ServantError a -> IO r) -> IO r
|
||||
withClient :: ClientM a -> BaseUrl -> (Either ClientError a -> IO r) -> IO r
|
||||
withClient x burl k = do
|
||||
withClientEnvIO burl $ \env -> withClientM x env k
|
||||
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ library
|
|||
Servant.Server.Internal.Handler
|
||||
Servant.Server.Internal.Router
|
||||
Servant.Server.Internal.RoutingApplication
|
||||
Servant.Server.Internal.ServantErr
|
||||
Servant.Server.Internal.ServerError
|
||||
Servant.Server.StaticFiles
|
||||
|
||||
-- deprecated
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ module Servant.Server
|
|||
-- , mkAuthHandler
|
||||
|
||||
-- * Default error type
|
||||
, ServantErr(..)
|
||||
, ServerError(..)
|
||||
-- ** 3XX
|
||||
, err300
|
||||
, err301
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ module Servant.Server.Internal
|
|||
, module Servant.Server.Internal.Handler
|
||||
, module Servant.Server.Internal.Router
|
||||
, module Servant.Server.Internal.RoutingApplication
|
||||
, module Servant.Server.Internal.ServantErr
|
||||
, module Servant.Server.Internal.ServerError
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
|
|
@ -91,7 +91,7 @@ import Servant.Server.Internal.Context
|
|||
import Servant.Server.Internal.Handler
|
||||
import Servant.Server.Internal.Router
|
||||
import Servant.Server.Internal.RoutingApplication
|
||||
import Servant.Server.Internal.ServantErr
|
||||
import Servant.Server.Internal.ServerError
|
||||
|
||||
#ifdef HAS_TYPE_ERROR
|
||||
import GHC.TypeLits
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ import Network.Wai
|
|||
import Servant.API.BasicAuth
|
||||
(BasicAuthData (BasicAuthData))
|
||||
import Servant.Server.Internal.RoutingApplication
|
||||
import Servant.Server.Internal.ServantErr
|
||||
import Servant.Server.Internal.ServerError
|
||||
|
||||
-- * Basic Auth
|
||||
|
||||
|
|
|
|||
|
|
@ -22,13 +22,13 @@ import Control.Monad.Trans.Except
|
|||
(ExceptT, runExceptT)
|
||||
import GHC.Generics
|
||||
(Generic)
|
||||
import Servant.Server.Internal.ServantErr
|
||||
(ServantErr)
|
||||
import Servant.Server.Internal.ServerError
|
||||
(ServerError)
|
||||
|
||||
newtype Handler a = Handler { runHandler' :: ExceptT ServantErr IO a }
|
||||
newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
|
||||
deriving
|
||||
( Functor, Applicative, Monad, MonadIO, Generic
|
||||
, MonadError ServantErr
|
||||
, MonadError ServerError
|
||||
, MonadThrow, MonadCatch, MonadMask
|
||||
)
|
||||
|
||||
|
|
@ -36,7 +36,7 @@ instance MonadBase IO Handler where
|
|||
liftBase = Handler . liftBase
|
||||
|
||||
instance MonadBaseControl IO Handler where
|
||||
type StM Handler a = Either ServantErr a
|
||||
type StM Handler a = Either ServerError a
|
||||
|
||||
-- liftBaseWith :: (RunInBase Handler IO -> IO a) -> Handler a
|
||||
liftBaseWith f = Handler (liftBaseWith (\g -> f (g . runHandler')))
|
||||
|
|
@ -44,5 +44,5 @@ instance MonadBaseControl IO Handler where
|
|||
-- restoreM :: StM Handler a -> Handler a
|
||||
restoreM st = Handler (restoreM st)
|
||||
|
||||
runHandler :: Handler a -> IO (Either ServantErr a)
|
||||
runHandler :: Handler a -> IO (Either ServerError a)
|
||||
runHandler = runExceptT . runHandler'
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ import qualified Data.Text as T
|
|||
import Network.Wai
|
||||
(Response, pathInfo)
|
||||
import Servant.Server.Internal.RoutingApplication
|
||||
import Servant.Server.Internal.ServantErr
|
||||
import Servant.Server.Internal.ServerError
|
||||
|
||||
type Router env = Router' env RoutingApplication
|
||||
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ import Network.Wai
|
|||
import Prelude ()
|
||||
import Prelude.Compat
|
||||
import Servant.Server.Internal.Handler
|
||||
import Servant.Server.Internal.ServantErr
|
||||
import Servant.Server.Internal.ServerError
|
||||
|
||||
type RoutingApplication =
|
||||
Request -- ^ the request, the field 'pathInfo' may be modified by url routing
|
||||
|
|
@ -39,9 +39,9 @@ type RoutingApplication =
|
|||
|
||||
-- | The result of matching against a path in the route tree.
|
||||
data RouteResult a =
|
||||
Fail ServantErr -- ^ Keep trying other paths. The @ServantErr@
|
||||
Fail ServerError -- ^ Keep trying other paths. The @ServantErr@
|
||||
-- should only be 404, 405 or 406.
|
||||
| FailFatal !ServantErr -- ^ Don't try other paths.
|
||||
| FailFatal !ServerError -- ^ Don't try other paths.
|
||||
| Route !a
|
||||
deriving (Eq, Show, Read, Functor)
|
||||
|
||||
|
|
@ -97,8 +97,8 @@ toApplication :: RoutingApplication -> Application
|
|||
toApplication ra request respond = ra request routingRespond
|
||||
where
|
||||
routingRespond :: RouteResult Response -> IO ResponseReceived
|
||||
routingRespond (Fail err) = respond $ responseServantErr err
|
||||
routingRespond (FailFatal err) = respond $ responseServantErr err
|
||||
routingRespond (Fail err) = respond $ responseServerError err
|
||||
routingRespond (FailFatal err) = respond $ responseServerError err
|
||||
routingRespond (Route v) = respond v
|
||||
|
||||
-- | A 'Delayed' is a representation of a handler with scheduled
|
||||
|
|
@ -235,11 +235,11 @@ emptyDelayed result =
|
|||
r = return ()
|
||||
|
||||
-- | Fail with the option to recover.
|
||||
delayedFail :: ServantErr -> DelayedIO a
|
||||
delayedFail :: ServerError -> DelayedIO a
|
||||
delayedFail err = liftRouteResult $ Fail err
|
||||
|
||||
-- | Fail fatally, i.e., without any option to recover.
|
||||
delayedFailFatal :: ServantErr -> DelayedIO a
|
||||
delayedFailFatal :: ServerError -> DelayedIO a
|
||||
delayedFailFatal err = liftRouteResult $ FailFatal err
|
||||
|
||||
-- | Gain access to the incoming request.
|
||||
|
|
@ -388,7 +388,7 @@ runAction action env req respond k = runResourceT $
|
|||
go (Route a) = liftIO $ do
|
||||
e <- runHandler a
|
||||
case e of
|
||||
Left err -> return . Route $ responseServantErr err
|
||||
Left err -> return . Route $ responseServerError err
|
||||
Right x -> return $! k x
|
||||
|
||||
{- Note [Existential Record Update]
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Servant.Server.Internal.ServantErr where
|
||||
module Servant.Server.Internal.ServerError where
|
||||
|
||||
import Control.Exception
|
||||
(Exception)
|
||||
|
|
@ -13,16 +13,18 @@ import qualified Network.HTTP.Types as HTTP
|
|||
import Network.Wai
|
||||
(Response, responseLBS)
|
||||
|
||||
data ServantErr = ServantErr { errHTTPCode :: Int
|
||||
, errReasonPhrase :: String
|
||||
, errBody :: LBS.ByteString
|
||||
, errHeaders :: [HTTP.Header]
|
||||
} deriving (Show, Eq, Read, Typeable)
|
||||
data ServerError = ServerError
|
||||
{ errHTTPCode :: Int
|
||||
, errReasonPhrase :: String
|
||||
, errBody :: LBS.ByteString
|
||||
, errHeaders :: [HTTP.Header]
|
||||
}
|
||||
deriving (Show, Eq, Read, Typeable)
|
||||
|
||||
instance Exception ServantErr
|
||||
instance Exception ServerError
|
||||
|
||||
responseServantErr :: ServantErr -> Response
|
||||
responseServantErr ServantErr{..} = responseLBS status errHeaders errBody
|
||||
responseServerError :: ServerError -> Response
|
||||
responseServerError ServerError{..} = responseLBS status errHeaders errBody
|
||||
where
|
||||
status = HTTP.mkStatus errHTTPCode (BS.pack errReasonPhrase)
|
||||
|
||||
|
|
@ -33,8 +35,8 @@ responseServantErr ServantErr{..} = responseLBS status errHeaders errBody
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err300 { errBody = "I can't choose." }
|
||||
--
|
||||
err300 :: ServantErr
|
||||
err300 = ServantErr { errHTTPCode = 300
|
||||
err300 :: ServerError
|
||||
err300 = ServerError { errHTTPCode = 300
|
||||
, errReasonPhrase = "Multiple Choices"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -47,8 +49,8 @@ err300 = ServantErr { errHTTPCode = 300
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err301
|
||||
--
|
||||
err301 :: ServantErr
|
||||
err301 = ServantErr { errHTTPCode = 301
|
||||
err301 :: ServerError
|
||||
err301 = ServerError { errHTTPCode = 301
|
||||
, errReasonPhrase = "Moved Permanently"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -61,8 +63,8 @@ err301 = ServantErr { errHTTPCode = 301
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err302
|
||||
--
|
||||
err302 :: ServantErr
|
||||
err302 = ServantErr { errHTTPCode = 302
|
||||
err302 :: ServerError
|
||||
err302 = ServerError { errHTTPCode = 302
|
||||
, errReasonPhrase = "Found"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -75,8 +77,8 @@ err302 = ServantErr { errHTTPCode = 302
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err303
|
||||
--
|
||||
err303 :: ServantErr
|
||||
err303 = ServantErr { errHTTPCode = 303
|
||||
err303 :: ServerError
|
||||
err303 = ServerError { errHTTPCode = 303
|
||||
, errReasonPhrase = "See Other"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -89,8 +91,8 @@ err303 = ServantErr { errHTTPCode = 303
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err304
|
||||
--
|
||||
err304 :: ServantErr
|
||||
err304 = ServantErr { errHTTPCode = 304
|
||||
err304 :: ServerError
|
||||
err304 = ServerError { errHTTPCode = 304
|
||||
, errReasonPhrase = "Not Modified"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -103,8 +105,8 @@ err304 = ServantErr { errHTTPCode = 304
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err305
|
||||
--
|
||||
err305 :: ServantErr
|
||||
err305 = ServantErr { errHTTPCode = 305
|
||||
err305 :: ServerError
|
||||
err305 = ServerError { errHTTPCode = 305
|
||||
, errReasonPhrase = "Use Proxy"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -117,8 +119,8 @@ err305 = ServantErr { errHTTPCode = 305
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err307
|
||||
--
|
||||
err307 :: ServantErr
|
||||
err307 = ServantErr { errHTTPCode = 307
|
||||
err307 :: ServerError
|
||||
err307 = ServerError { errHTTPCode = 307
|
||||
, errReasonPhrase = "Temporary Redirect"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -131,8 +133,8 @@ err307 = ServantErr { errHTTPCode = 307
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err400 { errBody = "Your request makes no sense to me." }
|
||||
--
|
||||
err400 :: ServantErr
|
||||
err400 = ServantErr { errHTTPCode = 400
|
||||
err400 :: ServerError
|
||||
err400 = ServerError { errHTTPCode = 400
|
||||
, errReasonPhrase = "Bad Request"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -145,8 +147,8 @@ err400 = ServantErr { errHTTPCode = 400
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err401 { errBody = "Your credentials are invalid." }
|
||||
--
|
||||
err401 :: ServantErr
|
||||
err401 = ServantErr { errHTTPCode = 401
|
||||
err401 :: ServerError
|
||||
err401 = ServerError { errHTTPCode = 401
|
||||
, errReasonPhrase = "Unauthorized"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -159,8 +161,8 @@ err401 = ServantErr { errHTTPCode = 401
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err402 { errBody = "You have 0 credits. Please give me $$$." }
|
||||
--
|
||||
err402 :: ServantErr
|
||||
err402 = ServantErr { errHTTPCode = 402
|
||||
err402 :: ServerError
|
||||
err402 = ServerError { errHTTPCode = 402
|
||||
, errReasonPhrase = "Payment Required"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -173,8 +175,8 @@ err402 = ServantErr { errHTTPCode = 402
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err403 { errBody = "Please login first." }
|
||||
--
|
||||
err403 :: ServantErr
|
||||
err403 = ServantErr { errHTTPCode = 403
|
||||
err403 :: ServerError
|
||||
err403 = ServerError { errHTTPCode = 403
|
||||
, errReasonPhrase = "Forbidden"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -187,8 +189,8 @@ err403 = ServantErr { errHTTPCode = 403
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err404 { errBody = "(╯°□°）╯︵ ┻━┻)." }
|
||||
--
|
||||
err404 :: ServantErr
|
||||
err404 = ServantErr { errHTTPCode = 404
|
||||
err404 :: ServerError
|
||||
err404 = ServerError { errHTTPCode = 404
|
||||
, errReasonPhrase = "Not Found"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -201,8 +203,8 @@ err404 = ServantErr { errHTTPCode = 404
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err405 { errBody = "Your account privileges does not allow for this. Please pay $$$." }
|
||||
--
|
||||
err405 :: ServantErr
|
||||
err405 = ServantErr { errHTTPCode = 405
|
||||
err405 :: ServerError
|
||||
err405 = ServerError { errHTTPCode = 405
|
||||
, errReasonPhrase = "Method Not Allowed"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -215,8 +217,8 @@ err405 = ServantErr { errHTTPCode = 405
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err406
|
||||
--
|
||||
err406 :: ServantErr
|
||||
err406 = ServantErr { errHTTPCode = 406
|
||||
err406 :: ServerError
|
||||
err406 = ServerError { errHTTPCode = 406
|
||||
, errReasonPhrase = "Not Acceptable"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -229,8 +231,8 @@ err406 = ServantErr { errHTTPCode = 406
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err407
|
||||
--
|
||||
err407 :: ServantErr
|
||||
err407 = ServantErr { errHTTPCode = 407
|
||||
err407 :: ServerError
|
||||
err407 = ServerError { errHTTPCode = 407
|
||||
, errReasonPhrase = "Proxy Authentication Required"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -243,8 +245,8 @@ err407 = ServantErr { errHTTPCode = 407
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err409 { errBody = "Transaction conflicts with 59879cb56c7c159231eeacdd503d755f7e835f74" }
|
||||
--
|
||||
err409 :: ServantErr
|
||||
err409 = ServantErr { errHTTPCode = 409
|
||||
err409 :: ServerError
|
||||
err409 = ServerError { errHTTPCode = 409
|
||||
, errReasonPhrase = "Conflict"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -257,8 +259,8 @@ err409 = ServantErr { errHTTPCode = 409
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err410 { errBody = "I know it was here at some point, but.. I blame bad luck." }
|
||||
--
|
||||
err410 :: ServantErr
|
||||
err410 = ServantErr { errHTTPCode = 410
|
||||
err410 :: ServerError
|
||||
err410 = ServerError { errHTTPCode = 410
|
||||
, errReasonPhrase = "Gone"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -271,8 +273,8 @@ err410 = ServantErr { errHTTPCode = 410
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError err411
|
||||
--
|
||||
err411 :: ServantErr
|
||||
err411 = ServantErr { errHTTPCode = 411
|
||||
err411 :: ServerError
|
||||
err411 = ServerError { errHTTPCode = 411
|
||||
, errReasonPhrase = "Length Required"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -285,8 +287,8 @@ err411 = ServantErr { errHTTPCode = 411
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err412 { errBody = "Precondition fail: x < 42 && y > 57" }
|
||||
--
|
||||
err412 :: ServantErr
|
||||
err412 = ServantErr { errHTTPCode = 412
|
||||
err412 :: ServerError
|
||||
err412 = ServerError { errHTTPCode = 412
|
||||
, errReasonPhrase = "Precondition Failed"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -299,8 +301,8 @@ err412 = ServantErr { errHTTPCode = 412
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err413 { errBody = "Request exceeded 64k." }
|
||||
--
|
||||
err413 :: ServantErr
|
||||
err413 = ServantErr { errHTTPCode = 413
|
||||
err413 :: ServerError
|
||||
err413 = ServerError { errHTTPCode = 413
|
||||
, errReasonPhrase = "Request Entity Too Large"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -313,8 +315,8 @@ err413 = ServantErr { errHTTPCode = 413
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err414 { errBody = "Maximum length is 64." }
|
||||
--
|
||||
err414 :: ServantErr
|
||||
err414 = ServantErr { errHTTPCode = 414
|
||||
err414 :: ServerError
|
||||
err414 = ServerError { errHTTPCode = 414
|
||||
, errReasonPhrase = "Request-URI Too Large"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -327,8 +329,8 @@ err414 = ServantErr { errHTTPCode = 414
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err415 { errBody = "Supported media types: gif, png" }
|
||||
--
|
||||
err415 :: ServantErr
|
||||
err415 = ServantErr { errHTTPCode = 415
|
||||
err415 :: ServerError
|
||||
err415 = ServerError { errHTTPCode = 415
|
||||
, errReasonPhrase = "Unsupported Media Type"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -341,8 +343,8 @@ err415 = ServantErr { errHTTPCode = 415
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err416 { errBody = "Valid range is [0, 424242]." }
|
||||
--
|
||||
err416 :: ServantErr
|
||||
err416 = ServantErr { errHTTPCode = 416
|
||||
err416 :: ServerError
|
||||
err416 = ServerError { errHTTPCode = 416
|
||||
, errReasonPhrase = "Request range not satisfiable"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -355,8 +357,8 @@ err416 = ServantErr { errHTTPCode = 416
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err417 { errBody = "I found a quux in the request. This isn't going to work." }
|
||||
--
|
||||
err417 :: ServantErr
|
||||
err417 = ServantErr { errHTTPCode = 417
|
||||
err417 :: ServerError
|
||||
err417 = ServerError { errHTTPCode = 417
|
||||
, errReasonPhrase = "Expectation Failed"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -369,8 +371,8 @@ err417 = ServantErr { errHTTPCode = 417
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err418 { errBody = "Apologies, this is not a webserver but a teapot." }
|
||||
--
|
||||
err418 :: ServantErr
|
||||
err418 = ServantErr { errHTTPCode = 418
|
||||
err418 :: ServerError
|
||||
err418 = ServerError { errHTTPCode = 418
|
||||
, errReasonPhrase = "I'm a teapot"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -383,8 +385,8 @@ err418 = ServantErr { errHTTPCode = 418
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err422 { errBody = "I understood your request, but can't process it." }
|
||||
--
|
||||
err422 :: ServantErr
|
||||
err422 = ServantErr { errHTTPCode = 422
|
||||
err422 :: ServerError
|
||||
err422 = ServerError { errHTTPCode = 422
|
||||
, errReasonPhrase = "Unprocessable Entity"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -397,8 +399,8 @@ err422 = ServantErr { errHTTPCode = 422
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err500 { errBody = "Exception in module A.B.C:55. Have a great day!" }
|
||||
--
|
||||
err500 :: ServantErr
|
||||
err500 = ServantErr { errHTTPCode = 500
|
||||
err500 :: ServerError
|
||||
err500 = ServerError { errHTTPCode = 500
|
||||
, errReasonPhrase = "Internal Server Error"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -411,8 +413,8 @@ err500 = ServantErr { errHTTPCode = 500
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err501 { errBody = "/v1/foo is not supported with quux in the request." }
|
||||
--
|
||||
err501 :: ServantErr
|
||||
err501 = ServantErr { errHTTPCode = 501
|
||||
err501 :: ServerError
|
||||
err501 = ServerError { errHTTPCode = 501
|
||||
, errReasonPhrase = "Not Implemented"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -425,8 +427,8 @@ err501 = ServantErr { errHTTPCode = 501
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err502 { errBody = "Tried gateway foo, bar, and baz. None responded." }
|
||||
--
|
||||
err502 :: ServantErr
|
||||
err502 = ServantErr { errHTTPCode = 502
|
||||
err502 :: ServerError
|
||||
err502 = ServerError { errHTTPCode = 502
|
||||
, errReasonPhrase = "Bad Gateway"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -439,8 +441,8 @@ err502 = ServantErr { errHTTPCode = 502
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err503 { errBody = "We're rewriting in PHP." }
|
||||
--
|
||||
err503 :: ServantErr
|
||||
err503 = ServantErr { errHTTPCode = 503
|
||||
err503 :: ServerError
|
||||
err503 = ServerError { errHTTPCode = 503
|
||||
, errReasonPhrase = "Service Unavailable"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -453,8 +455,8 @@ err503 = ServantErr { errHTTPCode = 503
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err504 { errBody = "Backend foobar did not respond in 5 seconds." }
|
||||
--
|
||||
err504 :: ServantErr
|
||||
err504 = ServantErr { errHTTPCode = 504
|
||||
err504 :: ServerError
|
||||
err504 = ServerError { errHTTPCode = 504
|
||||
, errReasonPhrase = "Gateway Time-out"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
|
|
@ -467,8 +469,8 @@ err504 = ServantErr { errHTTPCode = 504
|
|||
-- > failingHandler :: Handler ()
|
||||
-- > failingHandler = throwError $ err505 { errBody = "I support HTTP/4.0 only." }
|
||||
--
|
||||
err505 :: ServantErr
|
||||
err505 = ServantErr { errHTTPCode = 505
|
||||
err505 :: ServerError
|
||||
err505 = ServerError { errHTTPCode = 505
|
||||
, errReasonPhrase = "HTTP Version not supported"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
Loading…
Reference in a new issue