Add PostGIS GeoJSON support

Works for GET, POST, PATCH, PUT, DELETE, RPC.

src/PostgREST/App.hs

@@ -271,6 +271,7 @@ handleRead headersOnly identifier context@RequestContext{..} = do
         (shouldCount iPreferCount)
         (iAcceptContentType == CTTextCSV)
         (iAcceptContentType == CTTextXML)
+        (iAcceptContentType == CTGeoJSON)
         bField
         configDbPreparedStatements
 
@@ -464,6 +465,7 @@ handleInvoke invMethod proc context@RequestContext{..} = do
         (iAcceptContentType == CTSingularJSON)
         (iAcceptContentType == CTTextCSV)
         (iAcceptContentType == CTTextXML)
+        (iAcceptContentType == CTGeoJSON)
         (iPreferParameters == Just MultipleObjects)
         bField
         (configDbPreparedStatements ctxConfig)
@@ -551,6 +553,7 @@ writeQuery mutation identifier@QualifiedIdentifier{..} isInsert pkCols context@R
         (iAcceptContentType ctxApiRequest == CTSingularJSON)
         isInsert
         (iAcceptContentType ctxApiRequest == CTTextCSV)
+        (iAcceptContentType ctxApiRequest == CTGeoJSON)
         (iPreferRepresentation ctxApiRequest)
         pkCols
         (configDbPreparedStatements ctxConfig)

src/PostgREST/ContentType.hs

@@ -18,6 +18,7 @@ import Protolude
 data ContentType
   = CTApplicationJSON
   | CTSingularJSON
+  | CTGeoJSON
   | CTTextCSV
   | CTTextPlain
   | CTTextXML
@@ -40,6 +41,7 @@ toHeader ct = (hContentType, toMime ct <> charset)
 -- | Convert from ContentType to a ByteString representing the mime type
 toMime :: ContentType -> ByteString
 toMime CTApplicationJSON = "application/json"
+toMime CTGeoJSON         = "application/geo+json"
 toMime CTTextCSV         = "text/csv"
 toMime CTTextPlain       = "text/plain"
 toMime CTTextXML         = "text/xml"
@@ -55,6 +57,7 @@ decodeContentType :: BS.ByteString -> ContentType
 decodeContentType ct =
   case BS.takeWhile (/= BS.c2w ';') ct of
     "application/json"                  -> CTApplicationJSON
+    "application/geo+json"              -> CTGeoJSON
     "text/csv"                          -> CTTextCSV
     "text/plain"                        -> CTTextPlain
     "text/xml"                          -> CTTextXML

src/PostgREST/Query/SqlFragment.hs

@@ -11,6 +11,7 @@ module PostgREST.Query.SqlFragment
   , SqlFragment
   , asBinaryF
   , asCsvF
+  , asGeoJsonF
   , asJsonF
   , asJsonSingleF
   , asXmlF
@@ -182,6 +183,9 @@ asJsonSingleF returnsScalar
 asXmlF :: FieldName -> SqlFragment
 asXmlF fieldName = "coalesce(xmlagg(_postgrest_t." <> pgFmtIdent fieldName <> "), '')"
 
+asGeoJsonF ::  SqlFragment
+asGeoJsonF = "json_build_object('type', 'FeatureCollection', 'features', coalesce(json_agg(ST_AsGeoJSON(_postgrest_t)::json), '[]'))"
+
 asBinaryF :: FieldName -> SqlFragment
 asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"
 

src/PostgREST/Query/Statements.hs

@@ -43,10 +43,10 @@ import Protolude
 -}
 type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status))
 
-createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool ->
+createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> Bool ->
                         PreferRepresentation -> [Text] -> Bool ->
                         SQL.Statement () ResultsWithCount
-createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys =
+createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv asGeoJson rep pKeys =
   SQL.dynamicallyParameterized snippet decodeStandard
  where
   snippet =
@@ -74,6 +74,7 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
   bodyF
     | rep /= Full = "''"
     | asCsv = asCsvF
+    | asGeoJson = asGeoJsonF
     | wantSingle = asJsonSingleF False
     | otherwise = asJsonF False
 
@@ -86,9 +87,9 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys
   decodeStandard =
    fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow
 
-createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool ->  Bool -> Maybe FieldName -> Bool ->
+createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool ->  Bool -> Bool -> Maybe FieldName -> Bool ->
                        SQL.Statement () ResultsWithCount
-createReadStatement selectQuery countQuery isSingle countTotal asCsv asXml binaryField =
+createReadStatement selectQuery countQuery isSingle countTotal asCsv asXml asGeoJson binaryField =
   SQL.dynamicallyParameterized snippet decodeStandard
  where
   snippet =
@@ -109,6 +110,7 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv asXml binar
   bodyF
     | asCsv = asCsvF
     | isSingle = asJsonSingleF False
+    | asGeoJson = asGeoJsonF
     | isJust binaryField && asXml = asXmlF $ fromJust binaryField
     | isJust binaryField = asBinaryF $ fromJust binaryField
     | otherwise = asJsonF False
@@ -130,9 +132,9 @@ standardRow = (,,,,,) <$> nullableColumn HD.int8 <*> column HD.int8
 type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status))
 
 callProcStatement :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
-                     Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool ->
+                     Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool ->
                      SQL.Statement () ProcResults
-callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv asXml multObjects binaryField =
+callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv asXml asGeoJson multObjects binaryField =
   SQL.dynamicallyParameterized snippet decodeProc
   where
     snippet =
@@ -152,6 +154,7 @@ callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQue
     bodyF
      | asSingle           = asJsonSingleF returnsScalar
      | asCsv              = asCsvF
+     | asGeoJson = asGeoJsonF
      | isJust binaryField && asXml = asXmlF $ fromJust binaryField
      | isJust binaryField = asBinaryF $ fromJust binaryField
      | returnsSingle

src/PostgREST/Request/ApiRequest.hs

@@ -431,7 +431,7 @@ requestContentTypes conf action path =
         ++ rawContentTypes conf
         ++ [CTOpenAPI | pIsRootSpec path]
     defaultContentTypes =
-      [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+      [CTApplicationJSON, CTSingularJSON, CTGeoJSON, CTTextCSV]
 
 rawContentTypes :: AppConfig -> [ContentType]
 rawContentTypes AppConfig{..} =