refactor: remove ToJSON instance definition on error types

Towards #4088.

- Some of these instances are not used. Reduces number of lines
  significantly.

- Removing this gives us more flexibility for cases like conditional
  encoding based on some outside parameter, without needing to
  add the conditional at type level.

Signed-off-by: Taimoor Zaeem <taimoorzaeem@gmail.com>

src/PostgREST/Error.hs

@@ -56,21 +56,31 @@ import PostgREST.Error.Types
 
 import Protolude
 
-class (ErrorBody a, JSON.ToJSON a) => PgrstError a where
+-- | Encode Error to ByteString
-  status   :: a -> HTTP.Status
+errorPayload :: (ErrorBody a, ErrorHeaders a) => a -> LByteString
-  headers  :: a -> [Header]
+errorPayload = JSON.encode . toJsonPgrstError
+  where
+    toJsonPgrstError :: (ErrorBody a, ErrorHeaders a) => a -> JSON.Value
+    toJsonPgrstError err = JSON.object [
+        "code"    .= code err
+      , "message" .= message err
+      , "details" .= details err
+      , "hint"    .= hint err
+      ]
 
-  errorPayload :: a -> LByteString
+-- | Create HTTP response from Error
-  errorPayload = JSON.encode
+errorResponseFor :: (ErrorBody a, ErrorHeaders a) => a -> Response
+errorResponseFor err =
+  let
+    baseHeader = MediaType.toContentType MTApplicationJSON
+    cLHeader body = (,) "Content-Length" (show $ LBS.length body) :: Header
+    pSHeader code' = ("Proxy-Status", "PostgREST; error=" <> T.encodeUtf8 code')
+  in
+  responseLBS (status err) (baseHeader : cLHeader (errorPayload err) : pSHeader (code err) : headers err) $ errorPayload err
 
-  errorResponseFor :: a -> Response
+class ErrorHeaders a where
-  errorResponseFor err =
+  status  :: a -> HTTP.Status
-    let
+  headers :: a -> [Header]
-      baseHeader = MediaType.toContentType MTApplicationJSON
-      cLHeader body = (,) "Content-Length" (show $ LBS.length body) :: Header
-      pSHeader code' = ("Proxy-Status", "PostgREST; error=" <> T.encodeUtf8 code')
-    in
-    responseLBS (status err) (baseHeader : cLHeader (errorPayload err) : pSHeader (code err) : headers err) $ errorPayload err
 
 class ErrorBody a where
   code    :: a -> Text
@@ -78,7 +88,7 @@ class ErrorBody a where
   details :: a -> Maybe JSON.Value
   hint    :: a -> Maybe JSON.Value
 
-instance PgrstError ApiRequestError where
+instance ErrorHeaders ApiRequestError where
   status AggregatesNotAllowed{}      = HTTP.status400
   status MediaTypeError{}            = HTTP.status406
   status InvalidBody{}               = HTTP.status400
@@ -202,11 +212,7 @@ instance ErrorBody ApiRequestError where
 
   hint _ = Nothing
 
-instance JSON.ToJSON ApiRequestError where
+instance ErrorHeaders SchemaCacheError where
-  toJSON err = toJsonPgrstError
-    (code err) (message err) (details err) (hint err)
-
-instance PgrstError SchemaCacheError where
   status AmbiguousRelBetween{} = HTTP.status300
   status AmbiguousRpc{}        = HTTP.status300
   status NoRelBetween{}        = HTTP.status400
@@ -270,18 +276,6 @@ instance ErrorBody SchemaCacheError where
 
   hint _ = Nothing
 
-instance JSON.ToJSON SchemaCacheError where
-  toJSON err = toJsonPgrstError
-    (code err) (message err) (details err) (hint err)
-
-toJsonPgrstError :: Text -> Text -> Maybe JSON.Value -> Maybe JSON.Value -> JSON.Value
-toJsonPgrstError code' message' details' hint' = JSON.object [
-    "code"     .= code'
-  , "message"  .= message'
-  , "details"  .= details'
-  , "hint"     .= hint'
-  ]
-
 -- |
 -- If no relationship is found then:
 --
@@ -438,7 +432,7 @@ pgrstParseErrorHint err = case err of
   MsgParseError _ -> "MESSAGE must be a JSON object with obligatory keys: 'code', 'message' and optional keys: 'details', 'hint'."
   _               -> "DETAIL must be a JSON object with obligatory keys: 'status', 'headers' and optional key: 'status_text'."
 
-instance PgrstError PgError where
+instance ErrorHeaders PgError where
   status (PgError authed usageError) = pgErrorStatus authed usageError
 
   headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (SQL.ServerError "PGRST" m d _ _p))))) =
@@ -453,20 +447,12 @@ instance PgrstError PgError where
        then [("WWW-Authenticate", "Bearer") :: Header]
        else mempty
 
-instance JSON.ToJSON PgError where
-  toJSON (PgError _ usageError) = toJsonPgrstError
-    (code usageError) (message usageError) (details usageError) (hint usageError)
-
 instance ErrorBody PgError where
   code    (PgError _ usageError) = code usageError
   message (PgError _ usageError) = message usageError
   details (PgError _ usageError) = details usageError
   hint    (PgError _ usageError) = hint usageError
 
-instance JSON.ToJSON SQL.UsageError where
-  toJSON err = toJsonPgrstError
-    (code err) (message err) (details err) (hint err)
-
 instance ErrorBody SQL.UsageError where
   code    (SQL.ConnectionUsageError _)                   = "PGRST000"
   code    (SQL.SessionUsageError (SQL.QueryError _ _ e)) = code e
@@ -484,10 +470,6 @@ instance ErrorBody SQL.UsageError where
   hint    (SQL.SessionUsageError (SQL.QueryError _ _ e)) = hint e
   hint    SQL.AcquisitionTimeoutUsageError               = Nothing
 
-instance JSON.ToJSON SQL.CommandError where
-  toJSON err = toJsonPgrstError
-    (code err) (message err) (details err) (hint err)
-
 instance ErrorBody SQL.CommandError where
   -- Special error raised with code PGRST, to allow full response control
   code (SQL.ResultError (SQL.ServerError "PGRST" m d _ _)) =
@@ -584,7 +566,7 @@ pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError
     _                       -> HTTP.status500
 
 
-instance PgrstError Error where
+instance ErrorHeaders Error where
   status (ApiRequestErr err)  = status err
   status (SchemaCacheErr err) = status err
   status (JwtErr err)         = status err
@@ -597,10 +579,6 @@ instance PgrstError Error where
   headers (PgErr err)          = headers err
   headers NoSchemaCacheError   = mempty
 
-instance JSON.ToJSON Error where
-  toJSON err = toJsonPgrstError
-    (code err) (message err) (details err) (hint err)
-
 instance ErrorBody Error where
   code (ApiRequestErr err)  = code err
   code (SchemaCacheErr err) = code err
@@ -626,7 +604,7 @@ instance ErrorBody Error where
   hint NoSchemaCacheError   = Nothing
   hint (PgErr err)          = hint err
 
-instance PgrstError JwtError where
+instance ErrorHeaders JwtError where
   status JwtDecodeErr{}   = HTTP.unauthorized401
   status JwtSecretMissing = HTTP.status500
   status JwtTokenRequired = HTTP.unauthorized401
@@ -637,10 +615,6 @@ instance PgrstError JwtError where
   headers e@(JwtClaimsErr _) = [invalidTokenHeader $ message e]
   headers _                  = mempty
 
-instance JSON.ToJSON JwtError where
-  toJSON err = toJsonPgrstError
-    (code err) (message err) (details err) (hint err)
-
 instance ErrorBody JwtError where
   code JwtSecretMissing = "PGRST300"
   code (JwtDecodeErr _) = "PGRST301"