diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 6be81be51..f26949deb 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -39,7 +39,6 @@ import qualified Hasql.Transaction as H import qualified Data.HashMap.Strict as M import PostgREST.ApiRequest ( ApiRequest(..), ContentType(..) - , ApiRequestError(..) , Action(..), Target(..) , PreferRepresentation (..) , mutuallyAgreeable @@ -50,7 +49,7 @@ import PostgREST.ApiRequest ( ApiRequest(..), ContentType(..) import PostgREST.Auth (jwtClaims, containsRole) import PostgREST.Config (AppConfig (..)) import PostgREST.DbStructure -import PostgREST.Error (errResponse, pgErrResponse) +import PostgREST.Error (errResponse, pgErrResponse, apiRequestErrResponse) import PostgREST.Parsers import PostgREST.RangeQuery (NonnegRange, allRange, rangeOffset, restrictRange) import PostgREST.Middleware @@ -82,7 +81,7 @@ postgrest conf refDbStructure pool getTime = dbStructure <- readIORef refDbStructure case userApiRequest (configSchema conf) req body of - Left err -> respond $ respondToError err + Left err -> respond $ apiRequestErrResponse err Right apiRequest -> do let eClaims = jwtClaims (secret <$> configJwtSecret conf) (iJWT apiRequest) time @@ -93,12 +92,6 @@ postgrest conf refDbStructure pool getTime = resp <- either (pgErrResponse authed) id <$> P.use pool (HT.run handleReq HT.ReadCommitted txMode) respond resp - where - respondToError err = - case err of - ErrorActionInappropriate -> errResponse status405 "Bad Request" - ErrorInvalidBody errorMessage -> errResponse status400 $ toS errorMessage - ErrorInvalidRange -> errResponse status416 "HTTP Range error" transactionMode :: Action -> H.Mode transactionMode ActionRead = HT.Read diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index be4c2b1ac..75ae6d98d 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -2,7 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} -module PostgREST.Error (pgErrResponse, errResponse, prettyUsageError) where +module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError) where import Protolude import Data.Aeson ((.=)) @@ -12,7 +12,14 @@ import qualified Hasql.Pool as P import qualified Hasql.Session as H import qualified Network.HTTP.Types.Status as HT import Network.Wai (Response, responseLBS) -import PostgREST.ApiRequest (toHeader, ContentType(..)) +import PostgREST.ApiRequest (toHeader, ContentType(..), ApiRequestError(..)) + +apiRequestErrResponse :: ApiRequestError -> Response +apiRequestErrResponse err = + case err of + ErrorActionInappropriate -> errResponse HT.status405 "Bad Request" + ErrorInvalidBody errorMessage -> errResponse HT.status400 $ toS errorMessage + ErrorInvalidRange -> errResponse HT.status416 "HTTP Range error" errResponse :: HT.Status -> Text -> Response errResponse status message = responseLBS status