diff --git a/postgrest.cabal b/postgrest.cabal index 1ea29e463..0b9de07cf 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -42,6 +42,7 @@ executable postgrest , blaze-builder , vector , mtl + , cassava Other-Modules: App , Auth , Config @@ -98,4 +99,5 @@ Test-Suite spec , blaze-builder , vector , mtl + , cassava , process diff --git a/src/App.hs b/src/App.hs index dd9dcd107..c90111a91 100644 --- a/src/App.hs +++ b/src/App.hs @@ -10,12 +10,14 @@ import Data.Maybe (fromMaybe) import Text.Regex.TDFA ((=~)) import Data.Ord (comparing) import Data.Ranged.Ranges (emptyRange) -import Data.HashMap.Strict (keys, elems, filterWithKey, toList) +import Data.HashMap.Strict (HashMap, keys, elems, filterWithKey, toList, fromList) import Data.String.Conversions (cs) import Data.List (sortBy) import Data.Functor.Identity import qualified Data.Set as S import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as BS +import qualified Data.Csv as CSV import Network.HTTP.Types.Status import Network.HTTP.Types.Header @@ -98,26 +100,38 @@ app v1schema reqBody req = , (hLocation, "/postgrest/users?id=eq." <> cs (userId u)) ] "" - ([table], "POST") -> - handleJsonObj reqBody $ \obj -> do - let qt = QualifiedTable schema (cs table) - query = insertInto qt (map cs $ keys obj) [(elems obj)] - echoRequested = lookup "Prefer" hdrs == Just "return=representation" - row <- H.maybeEx query - let (Identity insertedJson) = fromMaybe (Identity "{}" :: Identity Text) row - Just inserted = decode (cs insertedJson) :: Maybe Object + ([table], "POST") -> do + let qt = QualifiedTable schema (cs table) + echoRequested = lookup "Prefer" hdrs == Just "return=representation" + records :: Either String (CSV.Header, V.Vector (HashMap BS.ByteString BS.ByteString)) + records = if lookup "Content-Type" hdrs == Just "text/csv" + then CSV.decodeByName reqBody + else eitherDecode reqBody >>= \val -> + case val of + Object obj -> Right ( + V.fromList $ map cs $ keys obj + , V.singleton . fromList . map (\(k,v) -> (cs k, cs $ unquoted v)) $ toList obj + ) + _ -> Left "Expecting single JSON object or CSV rows" + rows = insertInto qt records + undefined + -- else do + -- query = insertInto qt (map cs $ keys obj) [(elems obj)] + -- row <- H.maybeEx query + -- let (Identity insertedJson) = fromMaybe (Identity "{}" :: Identity Text) row + -- Just inserted = decode (cs insertedJson) :: Maybe Object - primaryKeys <- map cs <$> primaryKeyColumns qt - let primaries = if Prelude.null primaryKeys - then inserted - else filterWithKey (const . (`elem` primaryKeys)) inserted - let params = urlEncodeVars - $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t))) - $ sortBy (comparing fst) $ toList primaries - return $ responseLBS status201 - [ jsonH - , (hLocation, "/" <> cs table <> "?" <> cs params) - ] $ if echoRequested then cs insertedJson else "" + -- primaryKeys <- map cs <$> primaryKeyColumns qt + -- let primaries = if Prelude.null primaryKeys + -- then inserted + -- else filterWithKey (const . (`elem` primaryKeys)) inserted + -- let params = urlEncodeVars + -- $ map (\t -> (cs $ fst t, cs (paramFilter $ snd t))) + -- $ sortBy (comparing fst) $ toList primaries + -- return $ responseLBS status201 + -- [ jsonH + -- , (hLocation, "/" <> cs table <> "?" <> cs params) + -- ] $ if echoRequested then cs insertedJson else "" ([table], "PUT") -> handleJsonObj reqBody $ \obj -> do diff --git a/src/PgQuery.hs b/src/PgQuery.hs index 1f7ef7b65..76009c98f 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -22,6 +22,7 @@ import Control.Monad (join) import Data.String.Conversions (cs) import qualified Data.Aeson as JSON import qualified Data.List as L +import qualified Data.Vector as V import Data.Scientific (isInteger, formatScientific, FPFormat(..)) type PStmt = H.Stmt P.Postgres @@ -108,21 +109,24 @@ returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" } deleteFrom :: QualifiedTable -> PStmt deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True -insertInto :: QualifiedTable -> [T.Text] -> [[JSON.Value]] -> PStmt -insertInto t [] _ = B.Stmt - ("insert into " <> fromQt t <> " default values returning *") empty True -insertInto t cols vals = B.Stmt - ("insert into " <> fromQt t <> " (" <> - T.intercalate ", " (map pgFmtIdent cols) <> - ") values " - <> T.intercalate ", " - (map (\v -> "(" - <> T.intercalate ", " (map insertableValue v) - <> ")" - ) vals - ) - <> " returning row_to_json(" <> fromQt t <> ".*)") - empty True +insertInto :: QualifiedTable + -> V.Vector T.Text + -> V.Vector (V.Vector T.Text) + -> PStmt +insertInto t cols vals + | V.null cols = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True + | otherwise = B.Stmt + ("insert into " <> fromQt t <> " (" <> + T.intercalate ", " (V.toList $ V.map pgFmtIdent cols) <> + ") values " + <> T.intercalate ", " + (V.toList $ V.map (\v -> "(" + <> T.intercalate ", " (V.toList $ V.map insertableText v) + <> ")" + ) vals + ) + <> " returning row_to_json(" <> fromQt t <> ".*)") + empty True insertSelect :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt insertSelect t [] _ = B.Stmt @@ -264,11 +268,14 @@ unquoted (JSON.String t) = t unquoted (JSON.Number n) = cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n unquoted (JSON.Bool b) = cs . show $ b +unquoted JSON.Null = "null" unquoted _ = "" +insertableText :: T.Text -> T.Text +insertableText = (<> "::unknown") . pgFmtLit + insertableValue :: JSON.Value -> T.Text -insertableValue JSON.Null = "null" -insertableValue v = ((<> "::unknown") . pgFmtLit . unquoted) v +insertableValue = insertableText . unquoted paramFilter :: JSON.Value -> T.Text paramFilter JSON.Null = "is.null"