Remove pjIsEmpty and rm pjType from ActionInvoke

* Remove PayloadJSON from Insert/Update
2019-02-26 11:38:21 -05:00
parent 50509b52b8
commit 3946dfbc64
4 changed files with 49 additions and 54 deletions
@@ -180,12 +180,10 @@ app dbStructure proc conf apiRequest =
                  if iPreferRepresentation apiRequest == Full
                    then toS body else ""

-        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just p@PayloadJSON{pjRaw}) ->
-          case (mutateSqlParts tSchema tName, pjIsEmpty p, iPreferRepresentation apiRequest == Full) of
-            (Left errorResponse, _, _) -> return errorResponse
-            (_, True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"
-            (_, True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] ""
-            (Right (sq, mq), _, _) -> do
+        (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw}) ->
+          case mutateSqlParts tSchema tName of
+            Left errorResponse -> return errorResponse
+            Right (sq, mq) -> do
              let stm = createWriteStatement sq mq
                    (contentType == CTSingularJSON) False (contentType == CTTextCSV)
                    (iPreferRepresentation apiRequest) []
@@ -197,15 +195,15 @@ app dbStructure proc conf apiRequest =
                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] ""
+              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] ""

        (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
          case mutateSqlParts tSchema tName of
@@ -269,7 +267,7 @@ app dbStructure proc conf apiRequest =
              let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
              return $ responseLBS status200 [allOrigins, acceptH] ""

-        (ActionInvoke _, TargetProc qi, Just PayloadJSON{pjRaw, pjType, pjKeys}) ->
+        (ActionInvoke _, TargetProc qi, Just PayloadJSON{pjRaw, pjKeys}) ->
          let returnsScalar = case proc of
                Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True
                _ -> False
@@ -280,16 +278,13 @@ app dbStructure proc conf apiRequest =
          case parts of
            Left errorResponse -> return errorResponse
            Right ((q, cq), bField) -> do
-              let isObject = case pjType of
-                                PJObject  -> True
-                                PJArray _ -> False
-                  singular = contentType == CTSingularJSON
+              let singular = contentType == CTSingularJSON
                  specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ maybe [] pdArgs proc
              row <- H.statement (toS pjRaw) $
                callProc qi specifiedPgArgs returnsScalar q cq shouldCount
                         singular (iPreferSingleObjectParameter apiRequest)
                         (contentType == CTTextCSV)
-                         (contentType == CTOctetStream) bField isObject
+                         (contentType == CTOctetStream) bField
                         (pgVersion dbStructure)
              let (tableTotal, queryTotal, body, jsonHeaders) =
                    fromMaybe (Just 0, 0, "[]", "[]") row
@@ -321,8 +321,8 @@ addProperty f (targetNodeName:remainingPath, a) (Node rn forest) =
 mutateRequest :: ApiRequest -> TableName -> [Text] -> [FieldName] -> Either Response MutateRequest
 mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
  case action of
-    ActionCreate -> Right $ Insert tName payload ((,) <$> iPreferResolution apiRequest <*> Just pkCols) [] returnings
-    ActionUpdate -> Update tName payload <$> combinedLogic <*> pure returnings
+    ActionCreate -> Right $ Insert tName (pjKeys payload) ((,) <$> iPreferResolution apiRequest <*> Just pkCols) [] returnings
+    ActionUpdate -> Update tName (pjKeys payload) <$> combinedLogic <*> pure returnings
    ActionSingleUpsert ->
      (\flts ->
        if null (iLogic apiRequest) &&
@@ -331,7 +331,7 @@ mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $
           all (\case
              Filter _ (OpExpr False (Op "eq" _)) -> True
              _ -> False) flts
-          then Insert tName payload (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
+          then Insert tName (pjKeys payload) (Just (MergeDuplicates, pkCols)) <$> combinedLogic <*> pure returnings
        else
          Left InvalidFilters) =<< filters
    ActionDelete -> Delete tName <$> combinedLogic <*> pure returnings
@@ -143,9 +143,9 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys

 type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
 callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
-            Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool -> PgVersion ->
+            Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
            H.Statement ByteString (Maybe ProcResults)
-callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField isObject pgVer =
+callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary binaryField pgVer =
  unicodeStatement sql (HE.param HE.unknown) decodeProc True
  where
    sql =
@@ -172,15 +172,21 @@ callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle para
         {responseHeaders} AS response_headers
       FROM ({selectQuery}) _postgrest_t;|]

-    (argsRecord, args) | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
-                       | null pgArgs = (ignoredBody, "")
-                       | otherwise = (
-                           unwords [
-                           "_args_record AS (",
-                             "SELECT * FROM " <> (if isObject then "json_to_record" else "json_to_recordset") <> "($1)",
-                             "AS _(" <> intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
-                           ")"]
-                         , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM _args_record)") <$> pgArgs))
+    (argsRecord, args)
+      | paramsAsSingleObject = ("_args_record AS (SELECT NULL)", "$1::json")
+      | null pgArgs = (ignoredBody, "")
+      | otherwise = (
+          unwords [
+            "payload AS (SELECT $1::json AS json_data),",
+            "vals AS (",
+              "SELECT json_data AS val FROM payload WHERE json_typeof(json_data) = 'array'",
+              "UNION ALL",
+              "SELECT json_build_array(json_data) AS val FROM payload WHERE json_typeof(json_data) = 'object'),",
+            "_args_record AS (",
+              "SELECT * FROM json_to_recordset((SELECT val FROM vals)) AS _(" <>
+                intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " " <> pgaType a) <$> pgArgs) <> ")",
+            ")"]
+         , intercalate ", " ((\a -> pgFmtIdent (pgaName a) <> " := (SELECT " <> pgFmtIdent (pgaName a) <> " FROM _args_record)") <$> pgArgs))
    countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
    _procName = qiName qi
    responseHeaders =
@@ -268,7 +274,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbl tblAlias imp
    --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
    --posible relations are Child Parent Many
    getQueryParts _ _ = witness
-requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON _ _ pKeys) onConflct putConditions returnings)) =
+requestToQuery schema _ (DbMutate (Insert mainTbl iCols onConflct putConditions returnings)) =
  unwords [
    "WITH payload AS (SELECT $1::json AS json_data),",
    "vals AS (",
@@ -276,10 +282,10 @@ requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON _ _ pKeys) onConf
     "SELECT json_data AS val FROM payload WHERE json_typeof(json_data) = 'array'",
     "UNION ALL",
     "SELECT json_build_array(json_data) AS val FROM payload WHERE json_typeof(json_data) = 'object')"],
-    "INSERT INTO ", fromQi qi, if S.null pKeys then " " else "(" <> cols <> ")",
+    "INSERT INTO ", fromQi qi, if S.null iCols then " " else "(" <> cols <> ")",
    unwords [
      "SELECT " <> cols <> " FROM",
-      "json_populate_recordset", "(null::", fromQi qi, ", (select val from vals)) _",
+      "json_populate_recordset", "(null::", fromQi qi, ", (SELECT val FROM vals)) _",
      -- Only used for PUT
      ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> putConditions)) `emptyOnFalse` null putConditions],
    maybe "" (\(oncDo, oncCols) -> (
@@ -287,14 +293,14 @@ requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON _ _ pKeys) onConf
      IgnoreDuplicates ->
        "DO NOTHING"
      MergeDuplicates  ->
-        "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList pKeys)
+        "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList iCols)
    ) `emptyOnFalse` null oncCols) onConflct,
    ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings]
  where
    qi = QualifiedIdentifier schema mainTbl
-    cols = intercalate ", " $ pgFmtIdent <$> S.toList pKeys
-requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON _ _ keys) logicForest returnings)) =
-  if S.null keys
+    cols = intercalate ", " $ pgFmtIdent <$> S.toList iCols
+requestToQuery schema _ (DbMutate (Update mainTbl uCols logicForest returnings)) =
+  if S.null uCols
    then "WITH " <> ignoredBody <> "SELECT null WHERE false" -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax
    else
      unwords [
@@ -304,13 +310,13 @@ requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON _ _ keys) logicFo
          "UNION ALL",
          "SELECT json_build_array(json_data) AS val FROM payload WHERE json_typeof(json_data) = 'object')",
        "UPDATE " <> fromQi qi <> " SET " <> cols,
-        "FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi qi, ", (select val from vals))) _ ",
+        "FROM (SELECT * FROM json_populate_recordset", "(null::", fromQi qi, ", (SELECT val FROM vals))) _ ",
        ("WHERE " <> intercalate " AND " (pgFmtLogicTree qi <$> logicForest)) `emptyOnFalse` null logicForest,
        ("RETURNING " <> intercalate ", " (pgFmtColumn qi <$> returnings)) `emptyOnFalse` null returnings
        ]
  where
    qi = QualifiedIdentifier schema mainTbl
-    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList keys)
+    cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols)
 requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
  unwords [
    "WITH " <> ignoredBody,
@@ -115,7 +115,7 @@ newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)
 data Column =
    Column {
      colTable       :: Table
-    , colName        :: ColumnName
+    , colName        :: FieldName
    , colDescription :: Maybe Text
    , colPosition    :: Int32
    , colNullable    :: Bool
@@ -134,7 +134,6 @@ instance Eq Column where
 -- | A view column that refers to a table column
 type Synonym = (Column, ViewColumn)
 type ViewColumn = Column
-type ColumnName = Text

 data PrimaryKey = PrimaryKey {
    pkTable :: Table
@@ -201,11 +200,6 @@ data PayloadJSON = PayloadJSON {

 data PJType = PJArray { pjaLength :: Int } | PJObject deriving (Show, Eq)

-- | e.g. whether it is []/{} or not
-pjIsEmpty :: PayloadJSON -> Bool
-pjIsEmpty (PayloadJSON _ PJObject keys) = S.size keys == 0
-pjIsEmpty (PayloadJSON _ (PJArray l) _) = l == 0
-
 data Proxy = Proxy {
  proxyScheme     :: Text
 , proxyHost       :: Text
@@ -330,14 +324,14 @@ data ReadQuery = Select {
 data MutateQuery =
  Insert {
    in_        :: TableName
-  , qPayload   :: PayloadJSON
-  , onConflict :: Maybe (PreferResolution, [ColumnName])
+  , insCols    :: S.Set FieldName
+  , onConflict :: Maybe (PreferResolution, [FieldName])
  , where_     :: [LogicTree]
  , returning  :: [FieldName]
  }|
  Update {
    in_        :: TableName
-  , qPayload   :: PayloadJSON
+  , updCols    :: S.Set FieldName
  , where_     :: [LogicTree]
  , returning  :: [FieldName]
  }|