refactor: Split up Types.hs and logically organize modules (#1793)
This commit is contained in:
+26
-21
@@ -5,15 +5,15 @@ Description : PostgREST error HTTP responses
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module PostgREST.Error (
|
||||
errorResponseFor
|
||||
, ApiRequestError(..)
|
||||
, PgError(..)
|
||||
, Error(..)
|
||||
, errorPayload
|
||||
, checkIsFatal
|
||||
, singularityError
|
||||
) where
|
||||
module PostgREST.Error
|
||||
( errorResponseFor
|
||||
, ApiRequestError(..)
|
||||
, PgError(..)
|
||||
, Error(..)
|
||||
, errorPayload
|
||||
, checkIsFatal
|
||||
, singularityError
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import qualified Data.Text as T
|
||||
@@ -24,11 +24,16 @@ import qualified Network.HTTP.Types.Status as HT
|
||||
import Data.Aeson ((.=))
|
||||
import Network.Wai (Response, responseLBS)
|
||||
|
||||
import Network.HTTP.Types.Header
|
||||
import Network.HTTP.Types.Header (Header)
|
||||
|
||||
import PostgREST.Types
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS, toSL)
|
||||
import PostgREST.ContentType (ContentType (..))
|
||||
import qualified PostgREST.ContentType as ContentType
|
||||
|
||||
import PostgREST.DbStructure.Relation (Link (..), Relation (..))
|
||||
import PostgREST.DbStructure.Table (Column (..), Table (..))
|
||||
|
||||
import Protolude hiding (toS)
|
||||
import Protolude.Conv (toS, toSL)
|
||||
|
||||
|
||||
class (JSON.ToJSON a) => PgrstError a where
|
||||
@@ -67,7 +72,7 @@ instance PgrstError ApiRequestError where
|
||||
status AmbiguousRelBetween{} = HT.status300
|
||||
status (UnacceptableSchema _) = HT.status406
|
||||
|
||||
headers _ = [toHeader CTApplicationJSON]
|
||||
headers _ = [ContentType.toHeader CTApplicationJSON]
|
||||
|
||||
instance JSON.ToJSON ApiRequestError where
|
||||
toJSON (ParseRequestError message details) = JSON.object [
|
||||
@@ -120,8 +125,8 @@ instance PgrstError PgError where
|
||||
|
||||
headers err =
|
||||
if status err == HT.status401
|
||||
then [toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
|
||||
else [toHeader CTApplicationJSON]
|
||||
then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header]
|
||||
else [ContentType.toHeader CTApplicationJSON]
|
||||
|
||||
instance JSON.ToJSON PgError where
|
||||
toJSON (PgError _ usageError) = JSON.toJSON usageError
|
||||
@@ -249,11 +254,11 @@ instance PgrstError Error where
|
||||
status (PgErr err) = status err
|
||||
status (ApiRequestError err) = status err
|
||||
|
||||
headers (SingularityError _) = [toHeader CTSingularJSON]
|
||||
headers (JwtTokenInvalid m) = [toHeader CTApplicationJSON, invalidTokenHeader m]
|
||||
headers (SingularityError _) = [ContentType.toHeader CTSingularJSON]
|
||||
headers (JwtTokenInvalid m) = [ContentType.toHeader CTApplicationJSON, invalidTokenHeader m]
|
||||
headers (PgErr err) = headers err
|
||||
headers (ApiRequestError err) = headers err
|
||||
headers _ = [toHeader CTApplicationJSON]
|
||||
headers _ = [ContentType.toHeader CTApplicationJSON]
|
||||
|
||||
instance JSON.ToJSON Error where
|
||||
toJSON GucHeadersError = JSON.object [
|
||||
@@ -261,7 +266,7 @@ instance JSON.ToJSON Error where
|
||||
toJSON GucStatusError = JSON.object [
|
||||
"message" .= ("response.status guc must be a valid status code" :: Text)]
|
||||
toJSON (BinaryFieldError ct) = JSON.object [
|
||||
"message" .= ((toS (toMime ct) <> " requested but more than one column was selected") :: Text)]
|
||||
"message" .= ((toS (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)]
|
||||
toJSON ConnectionLostError = JSON.object [
|
||||
"message" .= ("Database connection lost. Retrying the connection." :: Text)]
|
||||
|
||||
@@ -274,7 +279,7 @@ instance JSON.ToJSON Error where
|
||||
"message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)]
|
||||
toJSON (SingularityError n) = JSON.object [
|
||||
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
|
||||
"details" .= T.unwords ["Results contain", show n, "rows,", toS (toMime CTSingularJSON), "requires 1 row"]]
|
||||
"details" .= T.unwords ["Results contain", show n, "rows,", toS (ContentType.toMime CTSingularJSON), "requires 1 row"]]
|
||||
|
||||
toJSON JwtTokenMissing = JSON.object [
|
||||
"message" .= ("Server lacks JWT secret" :: Text)]
|
||||
|
||||
Reference in New Issue
Block a user