From a5655f8d5a096684536b17a8fc9f4b687b24648d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 18 Feb 2019 20:17:46 +0200 Subject: [PATCH] Rename ServantError to ClientError, ServantErr to ServerError --- .travis.yml | 12 +- cabal.project | 6 +- doc/cookbook/testing/Testing.lhs | 4 +- doc/tutorial/Server.lhs | 12 +- .../src/Servant/Client/Core.hs | 2 +- .../src/Servant/Client/Core/ClientError.hs | 10 +- .../src/Servant/Client/Core/HasClient.hs | 8 +- .../src/Servant/Client/Core/Reexport.hs | 2 +- .../src/Servant/Client/Core/RunClient.hs | 6 +- .../src/Servant/Client/Internal/XhrClient.hs | 14 +- .../src/Servant/Client/Internal/HttpClient.hs | 14 +- .../Client/Internal/HttpClient/Streaming.hs | 10 +- servant-client/test/Servant/ClientSpec.hs | 10 +- servant-client/test/Servant/StreamSpec.hs | 2 +- .../src/Servant/HttpStreams/Internal.hs | 14 +- .../test/Servant/ClientSpec.hs | 12 +- .../test/Servant/StreamSpec.hs | 2 +- servant-server/servant-server.cabal | 2 +- servant-server/src/Servant/Server.hs | 2 +- servant-server/src/Servant/Server/Internal.hs | 4 +- .../src/Servant/Server/Internal/BasicAuth.hs | 2 +- .../src/Servant/Server/Internal/Handler.hs | 12 +- .../src/Servant/Server/Internal/Router.hs | 2 +- .../Server/Internal/RoutingApplication.hs | 16 +- .../{ServantErr.hs => ServerError.hs} | 148 +++++++++--------- 25 files changed, 162 insertions(+), 166 deletions(-) rename servant-server/src/Servant/Server/Internal/{ServantErr.hs => ServerError.hs} (81%) diff --git a/.travis.yml b/.travis.yml index 7ebf9c5a..429ee087 100644 --- a/.travis.yml +++ b/.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' diff --git a/cabal.project b/cabal.project index 6209cf7f..76e4f523 100644 --- a/cabal.project +++ b/cabal.project @@ -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 diff --git a/doc/cookbook/testing/Testing.lhs b/doc/cookbook/testing/Testing.lhs index b59cbba0..e8759660 100644 --- a/doc/cookbook/testing/Testing.lhs +++ b/doc/cookbook/testing/Testing.lhs @@ -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" } diff --git a/doc/tutorial/Server.lhs b/doc/tutorial/Server.lhs index aa8023aa..bbf8ac2c 100644 --- a/doc/tutorial/Server.lhs +++ b/doc/tutorial/Server.lhs @@ -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." } ``` diff --git a/servant-client-core/src/Servant/Client/Core.hs b/servant-client-core/src/Servant/Client/Core.hs index cb872186..f18d327f 100644 --- a/servant-client-core/src/Servant/Client/Core.hs +++ b/servant-client-core/src/Servant/Client/Core.hs @@ -32,7 +32,7 @@ module Servant.Client.Core , AuthClientData -- * Generic Client - , ServantError(..) + , ClientError(..) , EmptyClient(..) -- * Response diff --git a/servant-client-core/src/Servant/Client/Core/ClientError.hs b/servant-client-core/src/Servant/Client/Core/ClientError.hs index 747c775d..a6982609 100644 --- a/servant-client-core/src/Servant/Client/Core/ClientError.hs +++ b/servant-client-core/src/Servant/Client/Core/ClientError.hs @@ -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 diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 5b3af280..4f7a0327 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs @@ -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 diff --git a/servant-client-core/src/Servant/Client/Core/Reexport.hs b/servant-client-core/src/Servant/Client/Core/Reexport.hs index fc3aa6f8..81e5d432 100644 --- a/servant-client-core/src/Servant/Client/Core/Reexport.hs +++ b/servant-client-core/src/Servant/Client/Core/Reexport.hs @@ -12,7 +12,7 @@ module Servant.Client.Core.Reexport , ResponseF(..) -- * Data types - , ServantError(..) + , ClientError(..) , EmptyClient(..) -- * BaseUrl diff --git a/servant-client-core/src/Servant/Client/Core/RunClient.hs b/servant-client-core/src/Servant/Client/Core/RunClient.hs index 5dccb02e..fb5eb957 100644 --- a/servant-client-core/src/Servant/Client/Core/RunClient.hs +++ b/servant-client-core/src/Servant/Client/Core/RunClient.hs @@ -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 diff --git a/servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs b/servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs index a40a3c47..2e941460 100644 --- a/servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs +++ b/servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs @@ -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 diff --git a/servant-client/src/Servant/Client/Internal/HttpClient.hs b/servant-client/src/Servant/Client/Internal/HttpClient.hs index fbc41e91..1feb56d6 100644 --- a/servant-client/src/Servant/Client/Internal/HttpClient.hs +++ b/servant-client/src/Servant/Client/Internal/HttpClient.hs @@ -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) diff --git a/servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs b/servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs index b810fa58..449c638d 100644 --- a/servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs +++ b/servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs @@ -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 diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 84a9fbad..f40fa3bc 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -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 "" diff --git a/servant-client/test/Servant/StreamSpec.hs b/servant-client/test/Servant/StreamSpec.hs index 0e9c557a..d0fc2a64 100644 --- a/servant-client/test/Servant/StreamSpec.hs +++ b/servant-client/test/Servant/StreamSpec.hs @@ -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 diff --git a/servant-http-streams/src/Servant/HttpStreams/Internal.hs b/servant-http-streams/src/Servant/HttpStreams/Internal.hs index 59490fe6..3c5fb7e4 100644 --- a/servant-http-streams/src/Servant/HttpStreams/Internal.hs +++ b/servant-http-streams/src/Servant/HttpStreams/Internal.hs @@ -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) diff --git a/servant-http-streams/test/Servant/ClientSpec.hs b/servant-http-streams/test/Servant/ClientSpec.hs index b93c6477..59197dec 100644 --- a/servant-http-streams/test/Servant/ClientSpec.hs +++ b/servant-http-streams/test/Servant/ClientSpec.hs @@ -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 "" diff --git a/servant-http-streams/test/Servant/StreamSpec.hs b/servant-http-streams/test/Servant/StreamSpec.hs index f13b6dd8..73a20cba 100644 --- a/servant-http-streams/test/Servant/StreamSpec.hs +++ b/servant-http-streams/test/Servant/StreamSpec.hs @@ -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 diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index efd237f4..e01208dc 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -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 diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index 5c8d40e6..731d9dd2 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -49,7 +49,7 @@ module Servant.Server -- , mkAuthHandler -- * Default error type - , ServantErr(..) + , ServerError(..) -- ** 3XX , err300 , err301 diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 03231508..27000054 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -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 diff --git a/servant-server/src/Servant/Server/Internal/BasicAuth.hs b/servant-server/src/Servant/Server/Internal/BasicAuth.hs index 4b4104d1..19e62c6d 100644 --- a/servant-server/src/Servant/Server/Internal/BasicAuth.hs +++ b/servant-server/src/Servant/Server/Internal/BasicAuth.hs @@ -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 diff --git a/servant-server/src/Servant/Server/Internal/Handler.hs b/servant-server/src/Servant/Server/Internal/Handler.hs index 82868629..67f4396a 100644 --- a/servant-server/src/Servant/Server/Internal/Handler.hs +++ b/servant-server/src/Servant/Server/Internal/Handler.hs @@ -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' diff --git a/servant-server/src/Servant/Server/Internal/Router.hs b/servant-server/src/Servant/Server/Internal/Router.hs index 36d7205c..ccfdb159 100644 --- a/servant-server/src/Servant/Server/Internal/Router.hs +++ b/servant-server/src/Servant/Server/Internal/Router.hs @@ -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 diff --git a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs index acd0db14..ef88fd37 100644 --- a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs +++ b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs @@ -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] diff --git a/servant-server/src/Servant/Server/Internal/ServantErr.hs b/servant-server/src/Servant/Server/Internal/ServerError.hs similarity index 81% rename from servant-server/src/Servant/Server/Internal/ServantErr.hs rename to servant-server/src/Servant/Server/Internal/ServerError.hs index 766d92a1..a22e953b 100644 --- a/servant-server/src/Servant/Server/Internal/ServantErr.hs +++ b/servant-server/src/Servant/Server/Internal/ServerError.hs @@ -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 = []