This commit is contained in:
Yann Esposito (Yogsototh) 2019-09-10 23:10:51 +02:00
parent 038a7dc56b
commit e5dae59d49
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
3 changed files with 53 additions and 58 deletions

View file

@ -28,7 +28,7 @@ import Servant
import qualified Text.Blaze.Html.Renderer.Utf8 as Utf8
import qualified Text.Blaze.Html5 as H
htmlErr :: H.ToMarkup j => ServantErr -> j -> ServantErr
htmlErr :: H.ToMarkup j => ServerError -> j -> ServerError
htmlErr err j = err { errBody = Utf8.renderHtml (H.toMarkup j)
, errHeaders = [ (hContentType
, "text/html;charset=utf-8") ]
@ -48,8 +48,8 @@ instance H.ToMarkup HTTPError where
H.p (H.text details)
throwHTMLErr :: (MonadError ServantErr m)
=> ServantErr -> Text -> Maybe User -> m a
throwHTMLErr :: (MonadError ServerError m)
=> ServerError -> Text -> Maybe User -> m a
throwHTMLErr err msg muser =
throwError (htmlErr err
(HTTPError
@ -67,70 +67,70 @@ throwHTMLErr err msg muser =
| 500 <= c && c < 600 = " (Server Error)"
| otherwise = " (Urepertoried HTTP Error Kind)"
badRequest :: MonadError ServantErr m => Text -> Maybe User -> m a
badRequest :: MonadError ServerError m => Text -> Maybe User -> m a
badRequest = throwHTMLErr err400
unauthorized :: MonadError ServantErr m => Text -> Maybe User -> m a
unauthorized :: MonadError ServerError m => Text -> Maybe User -> m a
unauthorized = throwHTMLErr err401
paymentRequired :: MonadError ServantErr m => Text -> Maybe User -> m a
paymentRequired :: MonadError ServerError m => Text -> Maybe User -> m a
paymentRequired = throwHTMLErr err402
forbidden :: MonadError ServantErr m => Text -> Maybe User -> m a
forbidden :: MonadError ServerError m => Text -> Maybe User -> m a
forbidden = throwHTMLErr err403
notFound :: MonadError ServantErr m => Text -> Maybe User -> m a
notFound :: MonadError ServerError m => Text -> Maybe User -> m a
notFound = throwHTMLErr err404
methodNotAllowed :: MonadError ServantErr m => Text -> Maybe User -> m a
methodNotAllowed :: MonadError ServerError m => Text -> Maybe User -> m a
methodNotAllowed = throwHTMLErr err405
notAcceptable :: MonadError ServantErr m => Text -> Maybe User -> m a
notAcceptable :: MonadError ServerError m => Text -> Maybe User -> m a
notAcceptable = throwHTMLErr err406
proxyAuthenticationRequired :: MonadError ServantErr m => Text -> Maybe User -> m a
proxyAuthenticationRequired :: MonadError ServerError m => Text -> Maybe User -> m a
proxyAuthenticationRequired = throwHTMLErr err407
err408 :: ServantErr
err408 = ServantErr { errHTTPCode = 408
err408 :: ServerError
err408 = ServerError { errHTTPCode = 408
, errReasonPhrase = "Request Timeout"
, errBody = ""
, errHeaders = []
}
requestTimeout :: MonadError ServantErr m => Text -> Maybe User -> m a
requestTimeout :: MonadError ServerError m => Text -> Maybe User -> m a
requestTimeout = throwHTMLErr err408
conflict :: MonadError ServantErr m => Text -> Maybe User -> m a
conflict :: MonadError ServerError m => Text -> Maybe User -> m a
conflict = throwHTMLErr err409
gone :: MonadError ServantErr m => Text -> Maybe User -> m a
gone :: MonadError ServerError m => Text -> Maybe User -> m a
gone = throwHTMLErr err410
lengthRequired :: MonadError ServantErr m => Text -> Maybe User -> m a
lengthRequired :: MonadError ServerError m => Text -> Maybe User -> m a
lengthRequired = throwHTMLErr err411
preconditionFailed :: MonadError ServantErr m => Text -> Maybe User -> m a
preconditionFailed :: MonadError ServerError m => Text -> Maybe User -> m a
preconditionFailed = throwHTMLErr err412
requestEntityTooLarge :: MonadError ServantErr m => Text -> Maybe User -> m a
requestEntityTooLarge :: MonadError ServerError m => Text -> Maybe User -> m a
requestEntityTooLarge = throwHTMLErr err413
requestURITooLong :: MonadError ServantErr m => Text -> Maybe User -> m a
requestURITooLong :: MonadError ServerError m => Text -> Maybe User -> m a
requestURITooLong = throwHTMLErr err414
internalServerError :: MonadError ServantErr m => Text -> Maybe User -> m a
internalServerError :: MonadError ServerError m => Text -> Maybe User -> m a
internalServerError = throwHTMLErr err500
notImplemented :: MonadError ServantErr m => Text -> Maybe User -> m a
notImplemented :: MonadError ServerError m => Text -> Maybe User -> m a
notImplemented = throwHTMLErr err501
badGateway :: MonadError ServantErr m => Text -> Maybe User -> m a
badGateway :: MonadError ServerError m => Text -> Maybe User -> m a
badGateway = throwHTMLErr err502
serviceUnavailable :: MonadError ServantErr m => Text -> Maybe User -> m a
serviceUnavailable :: MonadError ServerError m => Text -> Maybe User -> m a
serviceUnavailable = throwHTMLErr err503
gatewayTimeout :: MonadError ServantErr m => Text -> Maybe User -> m a
gatewayTimeout :: MonadError ServerError m => Text -> Maybe User -> m a
gatewayTimeout = throwHTMLErr err504

View file

@ -23,7 +23,7 @@ import Servant
import Network.HTTP.Types (hContentType)
import Data.Aeson (encode, ToJSON)
jsonErr :: ToJSON j => ServantErr -> j -> ServantErr
jsonErr :: ToJSON j => ServerError -> j -> ServerError
jsonErr err j = err { errBody = encode j
, errHeaders = [ (hContentType
, "application/json;charset=utf-8") ]
@ -38,8 +38,8 @@ data HTTPError =
throwJSONErr :: (MonadError ServantErr m)
=> ServantErr -> Text -> m a
throwJSONErr :: (MonadError ServerError m)
=> ServerError -> Text -> m a
throwJSONErr err msg =
throwError (jsonErr err
(HTTPError
@ -56,70 +56,70 @@ throwJSONErr err msg =
| 500 <= c && c < 600 = " (Server Error)"
| otherwise = " (Urepertoried HTTP Error Kind)"
badRequest :: MonadError ServantErr m => Text -> m a
badRequest :: MonadError ServerError m => Text -> m a
badRequest = throwJSONErr err400
unauthorized :: MonadError ServantErr m => Text -> m a
unauthorized :: MonadError ServerError m => Text -> m a
unauthorized = throwJSONErr err401
paymentRequired :: MonadError ServantErr m => Text -> m a
paymentRequired :: MonadError ServerError m => Text -> m a
paymentRequired = throwJSONErr err402
forbidden :: MonadError ServantErr m => Text -> m a
forbidden :: MonadError ServerError m => Text -> m a
forbidden = throwJSONErr err403
notFound :: MonadError ServantErr m => Text -> m a
notFound :: MonadError ServerError m => Text -> m a
notFound = throwJSONErr err404
methodNotAllowed :: MonadError ServantErr m => Text -> m a
methodNotAllowed :: MonadError ServerError m => Text -> m a
methodNotAllowed = throwJSONErr err405
notAcceptable :: MonadError ServantErr m => Text -> m a
notAcceptable :: MonadError ServerError m => Text -> m a
notAcceptable = throwJSONErr err406
proxyAuthenticationRequired :: MonadError ServantErr m => Text -> m a
proxyAuthenticationRequired :: MonadError ServerError m => Text -> m a
proxyAuthenticationRequired = throwJSONErr err407
err408 :: ServantErr
err408 = ServantErr { errHTTPCode = 408
err408 :: ServerError
err408 = ServerError { errHTTPCode = 408
, errReasonPhrase = "Request Timeout"
, errBody = ""
, errHeaders = []
}
requestTimeout :: MonadError ServantErr m => Text -> m a
requestTimeout :: MonadError ServerError m => Text -> m a
requestTimeout = throwJSONErr err408
conflict :: MonadError ServantErr m => Text -> m a
conflict :: MonadError ServerError m => Text -> m a
conflict = throwJSONErr err409
gone :: MonadError ServantErr m => Text -> m a
gone :: MonadError ServerError m => Text -> m a
gone = throwJSONErr err410
lengthRequired :: MonadError ServantErr m => Text -> m a
lengthRequired :: MonadError ServerError m => Text -> m a
lengthRequired = throwJSONErr err411
preconditionFailed :: MonadError ServantErr m => Text -> m a
preconditionFailed :: MonadError ServerError m => Text -> m a
preconditionFailed = throwJSONErr err412
requestEntityTooLarge :: MonadError ServantErr m => Text -> m a
requestEntityTooLarge :: MonadError ServerError m => Text -> m a
requestEntityTooLarge = throwJSONErr err413
requestURITooLong :: MonadError ServantErr m => Text -> m a
requestURITooLong :: MonadError ServerError m => Text -> m a
requestURITooLong = throwJSONErr err414
internalServerError :: MonadError ServantErr m => Text -> m a
internalServerError :: MonadError ServerError m => Text -> m a
internalServerError = throwJSONErr err500
notImplemented :: MonadError ServantErr m => Text -> m a
notImplemented :: MonadError ServerError m => Text -> m a
notImplemented = throwJSONErr err501
badGateway :: MonadError ServantErr m => Text -> m a
badGateway :: MonadError ServerError m => Text -> m a
badGateway = throwJSONErr err502
serviceUnavailable :: MonadError ServantErr m => Text -> m a
serviceUnavailable :: MonadError ServerError m => Text -> m a
serviceUnavailable = throwJSONErr err503
gatewayTimeout :: MonadError ServantErr m => Text -> m a
gatewayTimeout :: MonadError ServerError m => Text -> m a
gatewayTimeout = throwJSONErr err504

View file

@ -18,7 +18,7 @@
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-13.11
resolver: lts-14.3
# User packages to be built.
# Various formats can be used as shown in the example below.
@ -39,12 +39,7 @@ packages:
# Dependency packages to be pulled from upstream that are not in the resolver
# using the same syntax as the packages field.
# (e.g., acme-missiles-0.3)
extra-deps:
- ixset-1.1.1
- human-readable-duration-0.2.1.2
- beam-core-0.8.0.0
- beam-migrate-0.4.0.0
- beam-sqlite-0.4.0.0
extra-deps: []
# Override default flag values for local packages and extra-deps
@ -72,4 +67,4 @@ extra-deps:
# compiler-check: newer-minor
# for intero and 8.6.1
allow-newer: true
# allow-newer: true