refactor: Split up Types.hs and logically organize modules (#1793)

This commit is contained in:
Remo Rechkemmer
2021-04-11 18:28:01 +02:00
committed by GitHub
parent 8c44410ce0
commit f99fd6cbad
37 changed files with 1496 additions and 1008 deletions
+26 -21
View File
@@ -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)]