Use a mime type to request singular JSON responses (#763)

2017-01-16 15:11:37 -08:00
parent e72e4491d1
commit 104a7ed4fa
16 changed files with 505 additions and 290 deletions
@@ -38,7 +38,7 @@ import           Data.Ranged.Boundaries
 import           PostgREST.Types           (QualifiedIdentifier (..),
                                            Schema,
                                            PayloadJSON(..))
-import           Data.Ranged.Ranges        (Range(..), singletonRange, rangeIntersection, emptyRange)
+import           Data.Ranged.Ranges        (Range(..), rangeIntersection, emptyRange)

 type RequestBody = BL.ByteString

@@ -59,6 +59,7 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq
                          --
 -- | Enumeration of currently supported response content types
 data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
+                 | CTSingularJSON
                 | CTAny | CTOther BS.ByteString deriving Eq

 data ApiRequestError = ErrorActionInappropriate
@@ -75,6 +76,7 @@ toMime :: ContentType -> ByteString
 toMime CTApplicationJSON = "application/json"
 toMime CTTextCSV         = "text/csv"
 toMime CTOpenAPI         = "application/openapi+json"
+toMime CTSingularJSON    = "application/vnd.pgrst.object+json"
 toMime CTAny             = "*/*"
 toMime (CTOther ct)      = ct

@@ -98,8 +100,6 @@ data ApiRequest = ApiRequest {
  , iPayload :: Maybe PayloadJSON
  -- | If client wants created items echoed back
  , iPreferRepresentation :: PreferRepresentation
-  -- | If client wants first row as raw object
-  , iPreferSingular :: Bool
  -- | Pass all parameters as a single json object to a stored procedure
  , iPreferSingleObjectParameter :: Bool
  -- | Whether the client wants a result count (slower)
@@ -130,9 +130,8 @@ userApiRequest schema req reqBody
        map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
      , iPayload = relevantPayload
      , iPreferRepresentation = representation
-      , iPreferSingular = singular
      , iPreferSingleObjectParameter = singleObject
-      , iPreferCount = not singular && hasPrefer "count=exact"
+      , iPreferCount = hasPrefer "count=exact"
      , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset"] k) ]
      , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
      , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
@@ -194,7 +193,6 @@ userApiRequest schema req reqBody
    where
        split :: BS.ByteString -> [Text]
        split = map T.strip . T.split (==',') . toS
-  singular        = hasPrefer "plurality=singular"
  singleObject    = hasPrefer "params=single-object"
  representation
    | hasPrefer "return=representation" = Full
@@ -208,7 +206,7 @@ userApiRequest schema req reqBody
  endingIn xx key = lastWord `elem` xx
    where lastWord = last $ T.split (=='.') key

-  headerRange = if singular && method == "GET" then singletonRange 0 else rangeRequested hdrs
+  headerRange = rangeRequested hdrs
  replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
  limitParams :: M.HashMap ByteString NonnegRange
  limitParams  = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
@@ -244,11 +242,13 @@ mutuallyAgreeable sProduces cAccepts =
 decodeContentType :: BS.ByteString -> ContentType
 decodeContentType ct =
  case BS.takeWhile (/= BS.c2w ';') ct of
-    "application/json"         -> CTApplicationJSON
-    "text/csv"                 -> CTTextCSV
-    "application/openapi+json" -> CTOpenAPI
-    "*/*"                      -> CTAny
-    ct'                        -> CTOther ct'
+    "application/json"                  -> CTApplicationJSON
+    "text/csv"                          -> CTTextCSV
+    "application/openapi+json"          -> CTOpenAPI
+    "application/vnd.pgrst.object+json" -> CTSingularJSON
+    "application/vnd.pgrst.object"      -> CTSingularJSON
+    "*/*"                               -> CTAny
+    ct'                                 -> CTOther ct'

 type CsvData = V.Vector (M.HashMap Text BL.ByteString)

@@ -11,19 +11,18 @@ import qualified Data.ByteString.Char8     as BS
 import           Data.IORef                (IORef, readIORef)
 import           Data.List                 (delete, lookup)
 import           Data.Maybe                (fromJust)
-import           Data.Text                 (replace, strip, isInfixOf, dropWhile, drop, intercalate)
+import           Data.Text                 (isInfixOf, dropWhile, drop, intercalate)
 import           Data.Time.Clock.POSIX     (POSIXTime)
 import           Data.Tree
 import           Data.Either.Combinators   (mapLeft)

-import qualified Hasql.Pool                as P
-import qualified Hasql.Transaction         as HT
+import qualified Hasql.Pool                 as P
+import qualified Hasql.Transaction          as HT
+import qualified Hasql.Transaction.Sessions as HT

 import           Text.Parsec.Error
 import           Text.ParserCombinators.Parsec (parse)

-import qualified Text.InterpolatedString.Perl6 as P6 (q)
-
 import           Network.HTTP.Types.Header
 import           Network.HTTP.Types.Status
 import           Network.HTTP.Types.URI    (renderSimpleQuery)
@@ -31,8 +30,6 @@ import           Network.Wai
 import           Network.Wai.Middleware.RequestLogger (logStdout)
 import           Web.JWT                   (binarySecret)

-import           Data.Aeson
-import           Data.Aeson.Types          (emptyArray)
 import qualified Data.Vector               as V
 import qualified Hasql.Transaction         as H

@@ -49,7 +46,7 @@ import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
 import           PostgREST.Auth            (jwtClaims, containsRole)
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
-import           PostgREST.Error           (errResponse, pgErrResponse, apiRequestErrResponse)
+import           PostgREST.Error           (errResponse, pgErrResponse, apiRequestErrResponse, singularityError, formatParserError)
 import           PostgREST.Parsers
 import           PostgREST.RangeQuery      (NonnegRange, allRange, rangeOffset, restrictRange)
 import           PostgREST.Middleware
@@ -89,7 +86,7 @@ postgrest conf refDbStructure pool getTime =
            authed = containsRole eClaims
            handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
            txMode = transactionMode $ iAction apiRequest
-        response <- P.use pool $ HT.run handleReq HT.ReadCommitted txMode
+        response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq
        return $ either (pgErrResponse authed) identity response
    respond response

@@ -109,96 +106,102 @@ app dbStructure conf apiRequest =
          case readSqlParts of
            Left errorResponse -> return errorResponse
            Right (q, cq) -> do
-              let singular = iPreferSingular apiRequest
-                  stm = createReadStatement q cq singular shouldCount (contentType == CTTextCSV)
+              let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount (contentType == CTTextCSV)
              row <- H.query () stm
              let (tableTotal, queryTotal, _ , body) = row
-              if singular
-              then return $ if queryTotal <= 0
-                then notFound
-                else responseLBS status200 [toHeader contentType] (toS body)
-              else do
-                let (status, contentRange) = rangeHeader queryTotal tableTotal
-                    canonical = iCanonicalQS apiRequest
-                    --TargetIdent qi = iTarget apiRequest
-                return $ responseLBS status
-                  [toHeader contentType, contentRange,
-                    ("Content-Location",
-                      "/" <> toS (qiName qi) <>
-                        if BS.null canonical then "" else "?" <> toS canonical
-                    )
-                  ] (toS body)
+                  (status, contentRange) = rangeHeader queryTotal tableTotal
+                  canonical = iCanonicalQS apiRequest
+              return $
+                if contentType == CTSingularJSON && queryTotal /= 1
+                  then singularityError (toInteger queryTotal)
+                  else responseLBS status
+                    [toHeader contentType, contentRange,
+                      ("Content-Location",
+                        "/" <> toS (qiName qi) <>
+                          if BS.null canonical then "" else "?" <> toS canonical
+                      )
+                    ] (toS body)

-        (ActionCreate, TargetIdent qi@(QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) ->
+        (ActionCreate, TargetIdent (QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) ->
          case mutateSqlParts of
            Left errorResponse -> return errorResponse
            Right (sq, mq) -> do
              let isSingle = (==1) $ V.length rows
-              when (not isSingle && iPreferSingular apiRequest) $
-                HT.sql [P6.q| DO $$
-                          BEGIN RAISE EXCEPTION cardinality_violation
-                          USING MESSAGE =
-                            'plurality=singular specified, but more than one object would be inserted';
-                          END $$;
-                        |]
-              let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
-              let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == CTTextCSV) payload
-              row <- H.query payload stm
-              let (_, _, fs, body) = extractQueryResult row
-                  headers = catMaybes [
-                      if null fs
-                        then Nothing
-                        else Just (hLocation, "/" <> toS table <> renderLocationFields fs)
-                    , if iPreferRepresentation apiRequest == Full
-                        then Just $ toHeader contentType
-                        else Nothing
-                    , Just . contentRangeH 1 0 $
-                        toInteger <$> if shouldCount then Just (V.length rows) else Nothing
-                    ]
+              if contentType == CTSingularJSON
+                 && not isSingle
+                 && iPreferRepresentation apiRequest == Full
+                then return $ singularityError (toInteger $ V.length rows)
+                else do
+                  let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
+                      stm = createWriteStatement sq mq
+                        (contentType == CTSingularJSON) isSingle
+                        (contentType == CTTextCSV) (iPreferRepresentation apiRequest)
+                        pKeys
+                  row <- H.query payload stm
+                  let (_, _, fs, body) = extractQueryResult row
+                      headers = catMaybes [
+                          if null fs
+                            then Nothing
+                            else Just (hLocation, "/" <> toS table <> renderLocationFields fs)
+                        , if iPreferRepresentation apiRequest == Full
+                            then Just $ toHeader contentType
+                            else Nothing
+                        , Just . contentRangeH 1 0 $
+                            toInteger <$> if shouldCount then Just (V.length rows) else Nothing
+                        ]

-              return . responseLBS status201 headers $
-                if iPreferRepresentation apiRequest == Full
-                  then toS body else ""
+                  return . responseLBS status201 headers $
+                    if iPreferRepresentation apiRequest == Full
+                      then toS body else ""

-        (ActionUpdate, TargetIdent qi, Just payload) ->
+        (ActionUpdate, TargetIdent _, Just payload) ->
          case mutateSqlParts of
            Left errorResponse -> return errorResponse
            Right (sq, mq) -> do
-              let singular = iPreferSingular apiRequest
-                  stm = createWriteStatement qi sq mq singular (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) payload
+              let stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) False (contentType == CTTextCSV)
+                    (iPreferRepresentation apiRequest) []
              row <- H.query payload stm
              let (_, queryTotal, _, body) = extractQueryResult row
-              when (singular && queryTotal > 1) $
-                HT.sql [P6.q| DO $$
-                          BEGIN RAISE EXCEPTION cardinality_violation
-                          USING MESSAGE =
-                            'plurality=singular specified, but more than one object would be updated';
-                          END $$;
-                        |]
-              let r = contentRangeH 0 (toInteger $ queryTotal-1)
-                        (toInteger <$> if shouldCount then Just queryTotal else Nothing)
-                  s = case () of _ | queryTotal == 0 -> status404
-                                  | iPreferRepresentation apiRequest == Full -> status200
-                                  | otherwise -> status204
-              return $ if iPreferRepresentation apiRequest == Full
-                then responseLBS s [toHeader contentType, r] (toS body)
-                else responseLBS s [r] ""
+              if contentType == CTSingularJSON
+                 && queryTotal /= 1
+                 && iPreferRepresentation apiRequest == Full
+                then do
+                  HT.condemn
+                  return $ singularityError (toInteger queryTotal)
+                else do
+                  let r = contentRangeH 0 (toInteger $ queryTotal-1)
+                            (toInteger <$> if shouldCount then Just queryTotal else Nothing)
+                      s = if iPreferRepresentation apiRequest == Full
+                            then status200
+                            else status204
+                  return $ if iPreferRepresentation apiRequest == Full
+                    then responseLBS s [toHeader contentType, r] (toS body)
+                    else responseLBS s [r] ""

-        (ActionDelete, TargetIdent qi, Nothing) ->
+        (ActionDelete, TargetIdent _, Nothing) ->
          case mutateSqlParts of
            Left errorResponse -> return errorResponse
            Right (sq, mq) -> do
              let emptyPayload = PayloadJSON V.empty
-                  stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) emptyPayload
+                  stm = createWriteStatement sq mq
+                    (contentType == CTSingularJSON) False
+                    (contentType == CTTextCSV)
+                    (iPreferRepresentation apiRequest) []
              row <- H.query emptyPayload stm
              let (_, queryTotal, _, body) = extractQueryResult row
                  r = contentRangeH 1 0 $
                        toInteger <$> if shouldCount then Just queryTotal else Nothing
-              return $ if queryTotal == 0
-                then notFound
-                else if iPreferRepresentation apiRequest == Full
-                  then responseLBS status200 [toHeader contentType, r] (toS body)
-                  else responseLBS status204 [r] ""
+              if contentType == CTSingularJSON
+                 && queryTotal /= 1
+                 && iPreferRepresentation apiRequest == Full
+                then do
+                  HT.condemn
+                  return $ singularityError (toInteger queryTotal)
+                else
+                  return $ if iPreferRepresentation apiRequest == Full
+                    then responseLBS status200 [toHeader contentType, r] (toS body)
+                    else responseLBS status204 [r] ""

        (ActionInfo, TargetIdent (QualifiedIdentifier tSchema tTable), Nothing) ->
          let mTable = find (\t -> tableName t == tTable && tableSchema t == tSchema) (dbTables dbStructure) in
@@ -213,13 +216,17 @@ app dbStructure conf apiRequest =
            Left errorResponse -> return errorResponse
            Right (q, cq) -> do
              let p = V.head payload
-                  singular = iPreferSingular apiRequest
+                  singular = contentType == CTSingularJSON
                  paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
              row <- H.query () (callProc qi p q cq topLevelRange shouldCount singular paramsAsSingleObject)
              let (tableTotal, queryTotal, body) =
-                    fromMaybe (Just 0, 0, emptyArray) row
+                    fromMaybe (Just 0, 0, "[]") row
                  (status, contentRange) = rangeHeader queryTotal tableTotal
-              return $ responseLBS status [jsonH, contentRange] (toS . encode $ body)
+              if singular && queryTotal /= 1
+                then do
+                  HT.condemn
+                  return $ singularityError (toInteger queryTotal)
+                else return $ responseLBS status [jsonH, contentRange] (toS body)

        (ActionInspect, TargetRoot, Nothing) -> do
          let host = configHost conf
@@ -275,13 +282,13 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
  where
    contentTypesForRequest =
      case action of
-        ActionRead -> [CTApplicationJSON, CTTextCSV]
-        ActionCreate -> [CTApplicationJSON, CTTextCSV]
-        ActionUpdate -> [CTApplicationJSON, CTTextCSV]
-        ActionDelete -> [CTApplicationJSON, CTTextCSV]
-        ActionInvoke -> [CTApplicationJSON]
+        ActionRead ->    [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionCreate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionUpdate ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionDelete ->  [CTApplicationJSON, CTSingularJSON, CTTextCSV]
+        ActionInvoke ->  [CTApplicationJSON, CTSingularJSON]
        ActionInspect -> [CTOpenAPI]
-        ActionInfo -> [CTTextCSV]
+        ActionInfo ->    [CTTextCSV]
    serves sProduces cAccepts =
      case mutuallyAgreeable sProduces cAccepts of
        Nothing -> do
@@ -318,23 +325,12 @@ contentRangeH lower upper total =
      totalNotZero  = fromMaybe True ((/=) 0 <$> total)
      fromInRange   = lower <= upper

-formatParserError :: ParseError -> Text
-formatParserError e = formatGeneralError message details
-  where
-     message = show $ errorPos e
-     details = strip $ replace "\n" " " $ toS
-       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
-
-formatGeneralError :: Text -> Text -> Text
-formatGeneralError message details = message <> ", " <> details
-
 augumentRequestWithJoin :: Schema ->  [Relation] ->  ReadRequest -> Either Text ReadRequest
 augumentRequestWithJoin schema allRels request =
  (first formatRelationError . addRelations schema allRels Nothing) request
  >>= addJoinConditions schema
  where
-    formatRelationError = formatGeneralError
-      "could not find foreign keys between these entities"
+    formatRelationError = ("could not find foreign keys between these entities, " <>)

 addFiltersOrdersRanges :: ApiRequest -> Either ParseError (ReadRequest -> ReadRequest)
 addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [
@@ -2,16 +2,18 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}

-module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError) where
+module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError, singularityError, formatGeneralError, formatParserError) where

 import           Protolude
 import           Data.Aeson                ((.=))
 import qualified Data.Aeson                as JSON
+import           Data.Text                 (replace, strip, unwords)
 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(..), ApiRequestError(..))
+import           PostgREST.ApiRequest      (toHeader, toMime, ContentType(..), ApiRequestError(..))
+import           Text.Parsec.Error

 apiRequestErrResponse :: ApiRequestError -> Response
 apiRequestErrResponse err =
@@ -41,6 +43,28 @@ prettyUsageError (P.ConnectionError e) =
  "Database connection error:\n" <> toS (fromMaybe "" e)
 prettyUsageError e = show $ JSON.encode e

+singularityError :: Integer -> Response
+singularityError numRows =
+  responseLBS HT.status406
+    [toHeader CTSingularJSON]
+    $ toS . formatGeneralError
+      "JSON object requested, multiple (or no) rows returned"
+      $ unwords
+        [ "Results contain", show numRows, "rows,"
+        , toS (toMime CTSingularJSON), "requires 1 row"
+        ]
+
+formatParserError :: ParseError -> Text
+formatParserError e = formatGeneralError message details
+  where
+     message = show $ errorPos e
+     details = strip $ replace "\n" " " $ toS
+       $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
+
+formatGeneralError :: Text -> Text -> Text
+formatGeneralError message details = toS . JSON.encode $
+  JSON.object ["message" .= message, "details" .= details]
+
 instance JSON.ToJSON P.UsageError where
  toJSON (P.ConnectionError e) = JSON.object [
    "code" .= ("" :: Text),
@@ -103,6 +127,7 @@ httpStatus authed (P.SessionError (H.ResultError (H.ServerError c _ _ _))) =
    "P0001"   -> HT.status400 -- default code for "raise"
    'P':'0':_ -> HT.status500 -- PL/pgSQL Error
    'X':'X':_ -> HT.status500 -- internal Error
+    "42883"   -> HT.status404 -- undefined function
    "42P01"   -> HT.status404 -- undefined table
    "42501"   -> if authed then HT.status403 else HT.status401 -- insufficient privilege
    _         -> HT.status400
@@ -155,7 +155,7 @@ makeGetParams :: [Column] -> [Param]
 makeGetParams [] =
  makeRangeParams ++
  [ makeSelectParam
-  , makePreferParam ["plurality=singular", "count=none"]
+  , makePreferParam ["count=none"]
  ]
 makeGetParams cs =
  makeRangeParams ++
@@ -168,12 +168,12 @@ makeGetParams cs =
      & in_ .~ ParamQuery
      & type_ .~ SwaggerString
      & enum_ .~ decode (encode $ makeOrderItems cs))
-  , makePreferParam ["plurality=singular", "count=none"]
+  , makePreferParam ["count=none"]
  ]

 makePostParams :: Text -> [Param]
 makePostParams tn =
-  [ makePreferParam ["return=representation", "return=representation,plurality=singular",
+  [ makePreferParam ["return=representation",
                     "return=minimal", "return=none"]
  , (mempty :: Param)
    & name        .~ "body"
@@ -200,17 +200,17 @@ makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t)
  where
    tOp = (mempty :: Operation)
      & tags .~ Set.fromList [tn]
-      & produces ?~ makeMimeList [CTApplicationJSON, CTTextCSV]
+      & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
      & at 200 ?~ "OK"
    getOp = tOp
      & parameters .~ map Inline (makeGetParams cs ++ rs)
      & at 206 ?~ "Partial Content"
    postOp = tOp
-      & consumes ?~ makeMimeList [CTApplicationJSON, CTTextCSV]
+      & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
      & parameters .~ map Inline (makePostParams tn)
      & at 201 ?~ "Created"
    patchOp = tOp
-      & consumes ?~ makeMimeList [CTApplicationJSON, CTTextCSV]
+      & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV]
      & parameters .~ map Inline (makePostParams tn ++ rs)
      & at 204 ?~ "No Content"
    deletOp = tOp
@@ -228,7 +228,7 @@ makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe)
    postOp = (mempty :: Operation)
      & parameters .~ map Inline (makeProcParam $ "(rpc) " <> pdName pd)
      & tags .~ Set.fromList ["(rpc) " <> pdName pd]
-      & produces ?~ makeMimeList [CTApplicationJSON]
+      & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON]
      & at 200 ?~ "OK"
    pe = (mempty :: PathItem) & post ?~ postOp

@@ -111,49 +111,40 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv =
    | isSingle = asJsonSingleF
    | otherwise = asJsonF

-createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool ->
-                        PreferRepresentation -> [Text] -> Bool -> PayloadJSON ->
+createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
+                        PreferRepresentation -> [Text] ->
                        H.Query PayloadJSON (Maybe ResultsWithCount)
-createWriteStatement _ _ mutateQuery _ None
-                     _ _ (PayloadJSON _) =
+createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
  unicodeStatement sql encodeUniformObjs decodeStandardMay True
+
 where
-  sql = [qc|
+  sql = case rep of
+    None -> [qc|
      WITH {sourceCTEName} AS ({mutateQuery})
      SELECT '', 0, {noLocationF}, '' |]
-
-createWriteStatement _ _ mutateQuery isSingle HeadersOnly
-                     pKeys _ (PayloadJSON _) =
-  unicodeStatement sql encodeUniformObjs decodeStandardMay True
- where
-  sql = [qc|
+    HeadersOnly -> [qc|
      WITH {sourceCTEName} AS ({mutateQuery})
      SELECT {cols}
      FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]
-  cols = intercalate ", " [
-      "'' AS total_result_set",
-      "pg_catalog.count(_postgrest_t) AS page_total",
-      if isSingle then locationF pKeys else noLocationF,
-      "''"
-    ]
-
-createWriteStatement _ selectQuery mutateQuery isSingle Full
-                     pKeys asCsv (PayloadJSON _) =
-  unicodeStatement sql encodeUniformObjs decodeStandardMay True
- where
-  sql = [qc|
+    Full -> [qc|
      WITH {sourceCTEName} AS ({mutateQuery})
      SELECT {cols}
      FROM ({selectQuery}) _postgrest_t |]
+
  cols = intercalate ", " [
      "'' AS total_result_set", -- when updateing it does not make sense
      "pg_catalog.count(_postgrest_t) AS page_total",
-      if isSingle then locationF pKeys else noLocationF <> " AS header",
-      bodyF <> " AS body"
+      if wantHdrs
+         then locationF pKeys
+         else noLocationF <> " AS header",
+      if rep == Full
+         then bodyF <> " AS body"
+         else "''"
    ]
+
  bodyF
    | asCsv = asCsvF
-    | isSingle = asJsonSingleF
+    | wantSingle = asJsonSingleF
    | otherwise = asJsonF

 addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
@@ -237,7 +228,7 @@ addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
    updatedForest = mapM (addJoinConditions schema) forest
    addCond query' con = query'{flt_=con ++ flt_ query'}

-type ProcResults = (Maybe Int64, Int64, JSON.Value)
+type ProcResults = (Maybe Int64, Int64, ByteString)
 callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults)
 callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson =
  unicodeStatement sql HE.unit decodeProc True
@@ -269,7 +260,7 @@ callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson =
                   else "null::bigint" :: Text
    decodeProc = HD.maybeRow procRow
    procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8
-                   <*> HD.value HD.json
+                   <*> HD.value HD.bytea
    bodyF
     | isSingle = asJsonSingleF
     | otherwise = asJsonF
@@ -389,9 +380,10 @@ requestToQuery schema _ returningSql (DbMutate (Insert mainTbl (PayloadJSON rows
        insInto = unwords [ "INSERT INTO" , fromQi qi,
            if T.null colsString then "" else "(" <> colsString <> ")"
          ]
-        vals = unwords $ if T.null colsString
-                  then ["DEFAULT VALUES"]
-                  else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]
+        vals = unwords $
+          if T.null colsString
+            then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"]
+            else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]
 requestToQuery schema _ returningSql (DbMutate (Update mainTbl (PayloadJSON rows) conditions)) =
  case rows V.!? 0 of
    Just obj ->