Reduce memory usage by avoiding Aeson encode

It was detected that Aeson encoding had high memory usage when
the json payload was large, around x60 the payload size.
With this change we get around x10 payload size memory usage.

The encodeUtf8(when doing a Text -> ByteString with `toS`) function
on a large payload also contributed to the high memory usage.

Main idea to reduce the memory usage was to let the ByteString coming
from the request body go to the database unchanged.
This commit is contained in:
steve-chavez
2018-01-10 11:43:16 -05:00
committed by Steve Chávez
parent f159233de8
commit 38f3bcf4a6
7 changed files with 141 additions and 132 deletions
+57 -54
View File
@@ -31,14 +31,13 @@ import qualified Data.Aeson as JSON
import PostgREST.Config (pgVersion96)
import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset, allRange)
import Data.Functor.Contravariant (contramap)
import qualified Data.HashMap.Strict as HM
import Data.Maybe
import qualified Data.Set as S
import Data.Text (intercalate, unwords, replace, isInfixOf, toLower)
import qualified Data.Text as T (map, takeWhile, null)
import qualified Data.Text.Encoding as T
import Data.Tree (Tree(..))
import qualified Data.Vector as V
import PostgREST.Types
import Text.InterpolatedString.Perl6 (qc)
import qualified Data.ByteString.Char8 as BS
@@ -76,14 +75,6 @@ decodeStandardMay :: HD.Result (Maybe ResultsWithCount)
decodeStandardMay =
HD.maybeRow standardRow
{-| JSON and CSV payloads from the client are given to us as
PayloadJSON (objects who all have the same keys),
and we turn this into an old fasioned JSON array
-}
encodeUniformObjs :: HE.Params PayloadJSON
encodeUniformObjs =
contramap (JSON.Array . V.map JSON.Object . unPayloadJSON) (HE.value HE.json)
createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName ->
H.Query () ResultsWithCount
createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField =
@@ -105,11 +96,12 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField
| isJust binaryField = asBinaryF $ fromJust binaryField
| otherwise = asJsonF
createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
PreferRepresentation -> [Text] ->
H.Query PayloadJSON (Maybe ResultsWithCount)
H.Query ByteString (Maybe ResultsWithCount)
createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys =
unicodeStatement sql encodeUniformObjs decodeStandardMay True
unicodeStatement sql (HE.value HE.unknown) decodeStandardMay True
where
sql = case rep of
@@ -143,16 +135,14 @@ createWriteStatement selectQuery mutateQuery wantSingle wantHdrs asCsv rep pKeys
type ProcResults = (Maybe Int64, Int64, ByteString, ByteString)
callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> Bool ->
Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion ->
H.Query JSON.Value (Maybe ProcResults)
callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsJson asCsv asBinary isReadOnly binaryField pgVer =
unicodeStatement sql (HE.value HE.json) decodeProc True
Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> Bool -> PgVersion ->
H.Query ByteString (Maybe ProcResults)
callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle paramsAsSingleObject asCsv asBinary isReadOnly binaryField isObject pgVer =
unicodeStatement sql (HE.value HE.unknown) decodeProc True
where
sql =
if returnsScalar then [qc|
WITH _args_record AS (
{argsRecord}
),
WITH {argsRecord},
{sourceCTEName} AS (
SELECT {fromQi qi}({args})
)
@@ -163,9 +153,7 @@ callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle para
{responseHeaders} AS response_headers
FROM ({selectQuery}) _postgrest_t;|]
else [qc|
WITH _args_record AS (
{argsRecord}
),
WITH {argsRecord},
{sourceCTEName} AS (
SELECT * FROM {fromQi qi}({args})
)
@@ -176,11 +164,14 @@ callProc qi pgArgs returnsScalar selectQuery countQuery countTotal isSingle para
{responseHeaders} AS response_headers
FROM ({selectQuery}) _postgrest_t;|]
(argsRecord, args) | paramsAsJson && not isReadOnly = ("SELECT NULL", "$1")
| null pgArgs = ("SELECT NULL", "")
(argsRecord, args) | paramsAsSingleObject && not isReadOnly = ("_args_record AS (SELECT NULL)", "$1::json")
| null pgArgs = (ignoredBody, "")
| otherwise = (
"SELECT * FROM json_to_record($1) AS _(" <> intercalate ", " ((\a -> pgaName a <> " " <> pgaType a) <$> pgArgs) <> ")",
intercalate ", " ((\a -> pgaName a <> " := (SELECT " <> pgaName a <> " FROM _args_record)") <$> pgArgs)
"_args_record AS ( "<>
"SELECT * FROM " <> (if isObject then "json_to_record" else "json_to_recordset") <>
"($1) AS _(" <> intercalate ", " ((\a -> pgaName a <> " " <> pgaType a) <$> pgArgs) <> ")" <>
")"
, intercalate ", " ((\a -> pgaName a <> " := (SELECT " <> pgaName a <> " FROM _args_record)") <$> pgArgs)
)
countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text
_procName = qiName qi
@@ -284,43 +275,55 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest
--getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
--posible relations are Child Parent Many
getQueryParts _ _ = undefined
requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows) returnings)) =
insInto <> vals <> ret
where qi = QualifiedIdentifier schema mainTbl
cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
colsString = intercalate ", " cols
insInto = unwords [ "INSERT INTO" , fromQi qi,
if T.null colsString then "" else "(" <> colsString <> ")"
]
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)"]
ret = if null returnings
then ""
else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)]
requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) logicForest returnings)) =
case rows V.!? 0 of
Just obj ->
let cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> HM.keys obj) in
requestToQuery schema _ (DbMutate (Insert mainTbl p@(PayloadJSON _ pType keys) returnings)) =
unwords [
("WITH " <> ignoredBody) `emptyOnFalse` not payloadIsEmpty,
"INSERT INTO ", fromQi qi, if payloadIsEmpty then " " else "(" <> cols <> ") ",
case (pType, payloadIsEmpty) of
(PJArray _, True) -> "SELECT null WHERE false"
(PJObject, True) -> "DEFAULT VALUES"
_ -> unwords [
"SELECT " <> cols <> " FROM ",
case pType of
PJObject -> "json_populate_record"
PJArray _ -> "json_populate_recordset", "(null::", fromQi qi, ", $1) "],
("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
]
where
qi = QualifiedIdentifier schema mainTbl
cols = intercalate ", " $ pgFmtIdent <$> S.toList keys
payloadIsEmpty = pjIsEmpty p
requestToQuery schema _ (DbMutate (Update mainTbl p@(PayloadJSON _ pType keys) logicForest returnings)) =
if pjIsEmpty p
then "WITH " <> ignoredBody <> "SELECT ''"
else
unwords [
"UPDATE ", fromQi qi,
" SET " <> cols <> " FROM (SELECT * FROM json_populate_recordset(null::" <> fromQi qi <> ", $1)) _ ",
"UPDATE " <> fromQi qi <> " SET " <> cols,
"FROM (SELECT * FROM ",
case pType of
PJObject -> " json_populate_record"
PJArray _ -> " json_populate_recordset", "(null::", fromQi qi, ", $1)) _ ",
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
]
Nothing -> undefined
where
qi = QualifiedIdentifier schema mainTbl
cols = intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList keys)
requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) =
query
unwords [
"WITH " <> ignoredBody,
"DELETE FROM ", fromQi qi,
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
]
where
qi = QualifiedIdentifier schema mainTbl
query = unwords [
"DELETE FROM ", fromQi qi,
("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest,
("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings
]
-- Due to the use of the `unknown` encoder we need to cast '$1' when the value is not used in the main query
-- otherwise the query will err with a `could not determine data type of parameter $1`.
-- This happens because `unknown` relies on the context to determine the value type.
ignoredBody :: SqlFragment
ignoredBody = "ignored_body AS (SELECT $1::text) "
removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier
removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl