jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Build escaped queries in the app itself

Browse Source 
universally replace String with Text
This commit is contained in:
Joe Nelson
2014-11-03 23:30:04 -08:00
parent c27f178754
commit cc2c65a9ab
6 changed files with 92 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dbapi.cabal
+1 -1
View File
@@ -1,5 +1,5 @@
name: dbapi name: dbapi
version: 0.2.4.3 version: 0.2.4.4
synopsis: The database is your api synopsis: The database is your api
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
src/Dbapi.hs
+5 -5
View File
@@ -16,7 +16,7 @@ import Data.Map (intersection, fromList, toList, Map)
import Data.List (sort) import Data.List (sort)
import qualified Data.Set as S import qualified Data.Set as S
import Data.Convertible.Base (convert) import Data.Convertible.Base (convert)
import Data.Text (strip) import Data.Text (strip, Text)
import Network.HTTP.Types.Status import Network.HTTP.Types.Status
import Network.HTTP.Types.Header import Network.HTTP.Types.Header
@@ -125,7 +125,7 @@ app conn req respond =
([table], "POST") -> ([table], "POST") ->
jsonBodyAction req (\row -> do jsonBodyAction req (\row -> do
allvals <- insert ver table row conn allvals <- insert ver table row conn
keys <- primaryKeyColumns ver (cs table) conn keys <- map cs <$> primaryKeyColumns ver (cs table) conn
let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList $ filterByKeys allvals keys let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList $ filterByKeys allvals keys
return $ responseLBS status201 return $ responseLBS status201
[ jsonContentType [ jsonContentType
@@ -210,15 +210,15 @@ respondWithRangedResult rr =
| (1 + to - from) < total = status206 | (1 + to - from) < total = status206
| otherwise = status200 | otherwise = status200
requestedVersion :: RequestHeaders -> Maybe String requestedVersion :: RequestHeaders -> Maybe Text
requestedVersion hdrs = requestedVersion hdrs =
case verStr of case verStr of
Just [[_, ver]] -> Just ver Just [[_, ver]] -> Just ver
_ -> Nothing _ -> Nothing
where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String
accept = cs <$> lookup hAccept hdrs :: Maybe String accept = cs <$> lookup hAccept hdrs :: Maybe Text
verStr = (=~ verRegex) <$> accept :: Maybe [[String]] verStr = (=~ verRegex) <$> accept :: Maybe [[Text]]
addHeaders :: ResponseHeaders -> Response -> Response addHeaders :: ResponseHeaders -> Response -> Response
src/PgQuery.hs
+55 -69
View File
@@ -11,8 +11,8 @@ module PgQuery (
, setRole , setRole
, resetRole , resetRole
, checkPass , checkPass
, pgFormatIdentifier , pgFmtIdent
, pgFormatLiteral , pgFmtLit
, RangedResult(..) , RangedResult(..)
, LoginAttempt(..) , LoginAttempt(..)
, DbRole , DbRole
@@ -52,8 +52,7 @@ data RangedResult = RangedResult {
, rrBody :: BL.ByteString , rrBody :: BL.ByteString
} deriving (Show) } deriving (Show)
type QuotedSql = (Text, [SqlValue]) type Schema = Text
type Schema = String
type DbRole = BS.ByteString type DbRole = BS.ByteString
data LoginAttempt = data LoginAttempt =
@@ -63,15 +62,8 @@ data LoginAttempt =
| LoginSuccess DbRole | LoginSuccess DbRole
deriving (Eq, Show) deriving (Eq, Show)
getRows :: Schema -> String -> Net.Query -> Maybe R.NonnegRange -> Connection -> IO RangedResult getRows :: Schema -> Text -> Net.Query -> Maybe R.NonnegRange -> Connection -> IO RangedResult
getRows schema table qq range conn = do getRows schema table qq range conn = do
query <- populateSql conn
$ globalAndLimitedCounts schema table qq <>
jsonArrayRows
(selectStarClause schema table
<> whereClause qq
<> orderClause qq
<> limitClause range)
r <- quickQuery conn (cs query) [] r <- quickQuery conn (cs query) []
return $ case r of return $ case r of
@@ -83,26 +75,31 @@ getRows schema table qq range conn = do
where where
offset = fromMaybe 0 $ R.offset <$> range offset = fromMaybe 0 $ R.offset <$> range
query = globalAndLimitedCounts schema table qq <> jsonArrayRows (
selectStarClause schema table
<> whereClause qq
<> orderClause qq
<> limitClause range)
whereClause :: Net.Query -> QuotedSql whereClause :: Net.Query -> Text
whereClause qs = whereClause qs =
if null qs then ("", []) else (" where ", []) <> conjunction if null qs then "" else " where " <> conjunction
where where
cols = [ col | col <- qs, fst col `notElem` ["order"] ] cols = [ col | col <- qs, fst col `notElem` ["order"] ]
conjunction = mconcat $ L.intersperse (" and ", []) (map wherePred cols) conjunction = mconcat $ L.intersperse " and " (map wherePred cols)
orderClause :: Net.Query -> QuotedSql orderClause :: Net.Query -> Text
orderClause qs = do orderClause qs = do
let order = fromMaybe "" $ join $ lookup "order" qs let order = fromMaybe "" $ join $ lookup "order" qs
terms = mapMaybe parseOrderTerm $ splitOn "," $ cs order terms = mapMaybe parseOrderTerm $ splitOn "," $ cs order
termPred = mconcat $ L.intersperse (", ", []) (map orderTermSql terms) termPred = mconcat $ L.intersperse ", " (map orderTermSql terms)
if null terms if null terms
then ("", []) then ""
else (" order by ", []) <> termPred else " order by " <> termPred
where where
parseOrderTerm :: Text -> Maybe OrderTerm parseOrderTerm :: Text -> Maybe OrderTerm
@@ -114,9 +111,8 @@ orderClause qs = do
else Nothing else Nothing
_ -> Nothing _ -> Nothing
orderTermSql :: OrderTerm -> QuotedSql orderTermSql :: OrderTerm -> Text
orderTermSql t = orderTermSql t = pgFmtIdent (otColumn t) <> " " <> otDirection t
("%I " <> otDirection t, [toSql $ otColumn t])
data OrderTerm = OrderTerm { data OrderTerm = OrderTerm {
@@ -125,9 +121,9 @@ data OrderTerm = OrderTerm {
} }
wherePred :: Net.QueryItem -> QuotedSql wherePred :: Net.QueryItem -> Text
wherePred (column, predicate) = wherePred (column, predicate) =
("%I " <> op <> "%L", map toSql [column, value]) pgFmtIdent (cs column) <> " " <> op <> " " <> pgFmtLit (cs value)
where where
opCode:rest = BS.split '.' $ fromMaybe "." predicate opCode:rest = BS.split '.' $ fromMaybe "." predicate
@@ -141,37 +137,38 @@ wherePred (column, predicate) =
"neq" -> "<>" "neq" -> "<>"
_ -> "=" _ -> "="
limitClause :: Maybe R.NonnegRange -> QuotedSql limitClause :: Maybe R.NonnegRange -> Text
limitClause range = limitClause range =
(" LIMIT %s OFFSET %s ", [toSql limit, toSql offset]) cs $ " LIMIT " <> limit <> " OFFSET " <> show offset <> " "
where where
limit = fromMaybe "ALL" $ show <$> (R.limit =<< range) limit = fromMaybe "ALL" $ show <$> (R.limit =<< range)
offset = fromMaybe 0 $ R.offset <$> range offset = fromMaybe 0 $ R.offset <$> range
globalAndLimitedCounts :: Schema -> String -> Net.Query -> QuotedSql globalAndLimitedCounts :: Schema -> Text -> Net.Query -> Text
globalAndLimitedCounts schema table qq = globalAndLimitedCounts schema table qq =
(" select ", []) " select "
<> ("(select count(1) from %I.%I ", map toSql [schema, table]) <> "(select count(1) from " <> pgFmtIdent schema <> "." <> pgFmtIdent table <> " "
<> whereClause qq <> whereClause qq
<> ("), count(t), ", []) <> "), count(t), "
selectStarClause :: Schema -> String -> QuotedSql selectStarClause :: Schema -> Text -> Text
selectStarClause schema table = selectStarClause schema table =
(" select * from %I.%I ", map toSql [schema, table]) " select * from " <> pgFmtIdent schema <> "." <> pgFmtIdent table <> " "
jsonArrayRows :: QuotedSql -> QuotedSql jsonArrayRows :: Text -> Text
jsonArrayRows q = jsonArrayRows q =
("array_to_json(array_agg(row_to_json(t))) from (", []) <> q <> (") t", []) "array_to_json(array_agg(row_to_json(t))) from (" <> q <> ") t"
insert :: Schema -> Text -> SqlRow -> Connection -> IO (M.Map String SqlValue) insert :: Schema -> Text -> SqlRow -> Connection -> IO (M.Map String SqlValue)
insert schema table row conn = do insert schema table row conn = do
sql <- populateSql conn $ insertClause schema table row
stmt <- prepare conn $ cs sql stmt <- prepare conn $ cs sql
_ <- execute stmt $ sqlRowValues row _ <- execute stmt $ sqlRowValues row
Just m <- fetchRowMap stmt Just m <- fetchRowMap stmt
return m return m
where sql = insertClause schema table row
addUser :: BS.ByteString -> BS.ByteString -> BS.ByteString -> Connection -> IO () addUser :: BS.ByteString -> BS.ByteString -> BS.ByteString -> Connection -> IO ()
addUser identity pass role conn = do addUser identity pass role conn = do
Just hashed <- hashPasswordUsingPolicy fastBcryptHashingPolicy $ cs pass Just hashed <- hashPasswordUsingPolicy fastBcryptHashingPolicy $ cs pass
@@ -195,56 +192,45 @@ checkPass = validatePassword
upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue) upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue)
upsert schema table row qq conn = do upsert schema table row qq conn = do
sql <- populateSql conn $ upsertClause schema table row qq
stmt <- prepare conn $ cs sql stmt <- prepare conn $ cs sql
_ <- execute stmt $ join $ replicate 2 $ sqlRowValues row _ <- execute stmt $ join $ replicate 2 $ sqlRowValues row
Just m <- fetchRowMap stmt Just m <- fetchRowMap stmt
return m return m
where sql = upsertClause schema table row qq
placeholders :: Text -> SqlRow -> Text placeholders :: Text -> SqlRow -> Text
placeholders symbol = intercalate ", " . map (const symbol) . getRow placeholders symbol = intercalate ", " . map (const symbol) . getRow
insertClause :: Schema -> Text -> SqlRow -> QuotedSql insertClause :: Schema -> Text -> SqlRow -> Text
insertClause schema table (SqlRow []) = insertClause schema table (SqlRow []) =
("insert into %I.%I default values returning *", [toSql schema, toSql table]) "insert into " <> pgFmtIdent schema <> "." <> pgFmtIdent table <> " default values returning *"
insertClause schema table row = insertClause schema table row =
("insert into %I.%I (" <> placeholders "%I" row <> ")", "insert into " <> pgFmtIdent schema <> "." <> pgFmtIdent table <> " (" <>
map toSql $ cs schema : table : sqlRowColumns row) intercalate ", " (map pgFmtIdent (sqlRowColumns row))
<> (" values (" <> placeholders "?" row <> ") returning *", sqlRowValues row) <> ") values (" <> placeholders "?" row <> ") returning *"
insertClauseViaSelect :: Schema -> Text -> SqlRow -> Text
insertClauseViaSelect :: Schema -> Text -> SqlRow -> QuotedSql
insertClauseViaSelect schema table row = insertClauseViaSelect schema table row =
("insert into %I.%I (" <> placeholders "%I" row <> ")", "insert into " <> pgFmtIdent schema <> "." <> pgFmtIdent table <> " (" <>
map toSql $ cs schema : table : sqlRowColumns row) intercalate ", " (map pgFmtIdent (sqlRowColumns row))
<> (" select " <> placeholders "?" row, sqlRowValues row) <> ") select " <> placeholders "?" row
updateClause :: Schema -> Text -> SqlRow -> QuotedSql updateClause :: Schema -> Text -> SqlRow -> Text
updateClause schema table row = updateClause schema table row =
("update %I.%I set (" <> placeholders "%I" row <> ")", "update " <> pgFmtIdent schema <> "." <> pgFmtIdent table <> " set (" <>
map toSql $ cs schema : table : sqlRowColumns row) intercalate ", " (map pgFmtIdent (sqlRowColumns row))
<> (" = (" <> placeholders "?" row <> ")", []) <> ") = (" <> placeholders "?" row <> ")"
upsertClause :: Schema -> Text -> SqlRow -> Net.Query -> QuotedSql upsertClause :: Schema -> Text -> SqlRow -> Net.Query -> Text
upsertClause schema table row qq = upsertClause schema table row qq =
("with upsert as (", []) <> updateClause schema table row "with upsert as (" <> updateClause schema table row
<> whereClause qq <> whereClause qq
<> (" returning *) ", []) <> insertClauseViaSelect schema table row <> " returning *) " <> insertClauseViaSelect schema table row
<> (" where not exists (select * from upsert) returning *", []) <> " where not exists (select * from upsert) returning *"
populateSql :: Connection -> QuotedSql -> IO Text pgFmtIdent :: Text -> Text
populateSql conn sql = do pgFmtIdent x =
[[escaped]] <- quickQuery conn (cs q) (snd sql)
return $ fromSql escaped
where
q = mconcat [ "select format('", fst sql, "', ", ph (snd sql), ")" ]
ph :: [a] -> Text
ph = intercalate ", " . map (const "?::varchar")
pgFormatIdentifier :: Text -> Text
pgFormatIdentifier x =
let escaped = replace "\"" "\"\"" (trimNullChars x) in let escaped = replace "\"" "\"\"" (trimNullChars x) in
if escaped =~ danger if escaped =~ danger
then "\"" <> escaped <> "\"" then "\"" <> escaped <> "\""
@@ -252,8 +238,8 @@ pgFormatIdentifier x =
where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: Text where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: Text
pgFormatLiteral :: Text -> Text pgFmtLit :: Text -> Text
pgFormatLiteral x = pgFmtLit x =
let trimmed = trimNullChars x let trimmed = trimNullChars x
escaped = "'" <> replace "'" "''" trimmed <> "'" escaped = "'" <> replace "'" "''" trimmed <> "'"
slashed = replace "\\" "\\\\" escaped in slashed = replace "\\" "\\\\" escaped in
src/PgStructure.hs
+24 -22
View File
@@ -4,11 +4,13 @@ module PgStructure where
import Data.Functor ( (<$>) ) import Data.Functor ( (<$>) )
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
import Data.Text hiding (foldl, map, zipWith, concat)
import Data.Monoid ((<>))
import Data.String.Conversions (cs)
import Control.Applicative ( (<*>) ) import Control.Applicative ( (<*>) )
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.List.Split (splitOn)
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.Map as Map import qualified Data.Map as Map
@@ -19,8 +21,8 @@ import Database.HDBC.PostgreSQL
import Data.Aeson ((.=)) import Data.Aeson ((.=))
data Table = Table { data Table = Table {
tableSchema :: String tableSchema :: Text
, tableName :: String , tableName :: Text
, tableInsertable :: Bool , tableInsertable :: Bool
} deriving (Show) } deriving (Show)
@@ -30,17 +32,17 @@ instance JSON.ToJSON Table where
, "name" .= tableName v , "name" .= tableName v
, "insertable" .= tableInsertable v ] , "insertable" .= tableInsertable v ]
toBool :: String -> Bool toBool :: Text -> Bool
toBool = (== "YES") toBool = (== "YES")
data ForeignKey = ForeignKey { data ForeignKey = ForeignKey {
fkTable::String, fkCol::String fkTable::Text, fkCol::Text
} deriving (Eq, Show) } deriving (Eq, Show)
instance JSON.ToJSON ForeignKey where instance JSON.ToJSON ForeignKey where
toJSON fk = JSON.object ["table".=fkTable fk, "column".=fkCol fk] toJSON fk = JSON.object ["table".=fkTable fk, "column".=fkCol fk]
foreignKeys :: String -> String -> Connection -> IO (Map.Map String ForeignKey) foreignKeys :: Text -> Text -> Connection -> IO (Map.Map Text ForeignKey)
foreignKeys schema table conn = do foreignKeys schema table conn = do
r <- quickQuery conn r <- quickQuery conn
"select kcu.column_name, ccu.table_name AS foreign_table_name,\ "select kcu.column_name, ccu.table_name AS foreign_table_name,\
@@ -59,17 +61,17 @@ foreignKeys schema table conn = do
addKey m _ = m --should never happen addKey m _ = m --should never happen
data Column = Column { data Column = Column {
colSchema :: String colSchema :: Text
, colTable :: String , colTable :: Text
, colName :: String , colName :: Text
, colPosition :: Int , colPosition :: Int
, colNullable :: Bool , colNullable :: Bool
, colType :: String , colType :: Text
, colUpdatable :: Bool , colUpdatable :: Bool
, colMaxLen :: Maybe Int , colMaxLen :: Maybe Int
, colPrecision :: Maybe Int , colPrecision :: Maybe Int
, colDefault :: Maybe String , colDefault :: Maybe Text
, colEnum :: Maybe [String] , colEnum :: Maybe [Text]
, colFK :: Maybe ForeignKey , colFK :: Maybe ForeignKey
} deriving (Show) } deriving (Show)
@@ -89,7 +91,7 @@ instance JSON.ToJSON Column where
data TableOptions = TableOptions { data TableOptions = TableOptions {
tblOptcolumns :: [Column] tblOptcolumns :: [Column]
, tblOptpkey :: [String] , tblOptpkey :: [Text]
} }
instance JSON.ToJSON TableOptions where instance JSON.ToJSON TableOptions where
@@ -97,7 +99,7 @@ instance JSON.ToJSON TableOptions where
"columns" .= tblOptcolumns t "columns" .= tblOptcolumns t
, "pkey" .= tblOptpkey t ] , "pkey" .= tblOptpkey t ]
tables :: String -> Connection -> IO [Table] tables :: Text -> Connection -> IO [Table]
tables s conn = do tables s conn = do
r <- quickQuery conn r <- quickQuery conn
"select table_schema, table_name,\ "select table_schema, table_name,\
@@ -114,7 +116,7 @@ tables s conn = do
(toBool (fromSql insertable)) (toBool (fromSql insertable))
mkTable _ = Nothing mkTable _ = Nothing
columns :: String -> String -> Connection -> IO [Column] columns :: Text -> Text -> Connection -> IO [Column]
columns s t conn = do columns s t conn = do
r <- quickQuery conn r <- quickQuery conn
"select info.table_schema as schema, info.table_name as table_name, \ "select info.table_schema as schema, info.table_name as table_name, \
@@ -161,23 +163,23 @@ columns s t conn = do
(fromSql maxlen) (fromSql maxlen)
(fromSql precision) (fromSql precision)
(fromSql defVal) (fromSql defVal)
(splitOn "," <$> fromSql enum) (Data.Text.splitOn "," <$> fromSql enum)
mkColumn _ = error $ "Incomplete column data received for table " ++ mkColumn _ = error $ "Incomplete column data received for table " <>
t ++ " in schema " ++ s ++ "." cs t <> " in schema " <> cs s <> "."
printTables :: String -> Connection -> IO BL.ByteString printTables :: Text -> Connection -> IO BL.ByteString
printTables schema conn = JSON.encode <$> tables schema conn printTables schema conn = JSON.encode <$> tables schema conn
printColumns :: String -> String -> Connection -> IO BL.ByteString printColumns :: Text -> Text -> Connection -> IO BL.ByteString
printColumns schema table conn = printColumns schema table conn =
JSON.encode <$> (TableOptions <$> cols <*> pkey) JSON.encode <$> (TableOptions <$> cols <*> pkey)
where where
cols :: IO [Column] cols :: IO [Column]
cols = columns schema table conn cols = columns schema table conn
pkey :: IO [String] pkey :: IO [Text]
pkey = primaryKeyColumns schema table conn pkey = primaryKeyColumns schema table conn
primaryKeyColumns :: String -> String -> Connection -> IO [String] primaryKeyColumns :: Text -> Text -> Connection -> IO [Text]
primaryKeyColumns s t conn = do primaryKeyColumns s t conn = do
r <- quickQuery conn r <- quickQuery conn
"select kc.column_name \ "select kc.column_name \
test/Unit/PgQuerySpec.hs
+5 -5
View File
@@ -10,7 +10,7 @@ import Database.HDBC (IConnection, SqlValue, toSql, prepare,
quickQuery, fromSql, execute, seState, fetchAllRowsAL) quickQuery, fromSql, execute, seState, fetchAllRowsAL)
import PgQuery (LoginAttempt(..), insert, addUser, signInRole, checkPass import PgQuery (LoginAttempt(..), insert, addUser, signInRole, checkPass
, pgFormatIdentifier, pgFormatLiteral) , pgFmtIdent, pgFmtLit)
import Types (SqlRow(SqlRow)) import Types (SqlRow(SqlRow))
import TestTypes (fromList, incStr, incNullableStr, incInsert, incId) import TestTypes (fromList, incStr, incNullableStr, incInsert, incId)
import Data.Map (toList) import Data.Map (toList)
@@ -87,16 +87,16 @@ spec = around dbWithSchema $ do
signInRole "not-a-user" pass conn `shouldReturn` LoginFailed signInRole "not-a-user" pass conn `shouldReturn` LoginFailed
signInRole user (pass <> "crap") conn `shouldReturn` LoginFailed signInRole user (pass <> "crap") conn `shouldReturn` LoginFailed
describe "pgFormatIdentifier" $ describe "pgFmtIdent" $
it "Does what format %I would do" $ \conn -> it "Does what format %I would do" $ \conn ->
property $ monadicIO $ do property $ monadicIO $ do
fuzz <- pick arbitrary fuzz <- pick arbitrary
[[row]] <- run $ quickALQuery conn "select format('%I', ? :: varchar)" [toSql (fuzz :: String)] [[row]] <- run $ quickALQuery conn "select format('%I', ? :: varchar)" [toSql (fuzz :: String)]
assert $ fromSql (snd row) == pgFormatIdentifier (cs fuzz) assert $ fromSql (snd row) == pgFmtIdent (cs fuzz)
describe "pgFormatLiteral" $ describe "pgFmtLit" $
it "Does what format %L would do" $ \conn -> it "Does what format %L would do" $ \conn ->
property $ monadicIO $ do property $ monadicIO $ do
fuzz <- pick arbitrary fuzz <- pick arbitrary
[[row]] <- run $ quickALQuery conn "select format('%L', ? :: varchar)" [toSql (fuzz :: String)] [[row]] <- run $ quickALQuery conn "select format('%L', ? :: varchar)" [toSql (fuzz :: String)]
assert $ fromSql (snd row) == pgFormatLiteral (cs fuzz) assert $ fromSql (snd row) == pgFmtLit (cs fuzz)
test/Unit/PgStructureSpec.hs
+2
View File
@@ -1,3 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
module Unit.PgStructureSpec where module Unit.PgStructureSpec where
import Test.Hspec import Test.Hspec