postgrest 0.2.6.0 → 0.2.7.0
raw patch · 6 files changed
+30/−18 lines, 6 files
Files
- postgrest.cabal +1/−1
- src/App.hs +9/−8
- src/Config.hs +2/−0
- src/Main.hs +4/−3
- src/PgQuery.hs +12/−4
- test/SpecHelper.hs +2/−2
postgrest.cabal view
@@ -2,7 +2,7 @@ description: Reads the schema of a PostgreSQL database and creates RESTful routes for the tables and views, supporting all HTTP verbs that security permits.-version: 0.2.6.0+version: 0.2.7.0 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE
src/App.hs view
@@ -35,8 +35,8 @@ import RangeQuery import PgStructure -app :: BL.ByteString -> Request -> H.Tx P.Postgres s Response-app reqBody req =+app :: Text -> BL.ByteString -> Request -> H.Tx P.Postgres s Response+app v1schema reqBody req = case (path, verb) of ([], _) -> do body <- encode <$> tables (cs schema)@@ -102,6 +102,7 @@ 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@@ -116,7 +117,7 @@ return $ responseLBS status201 [ jsonH , (hLocation, "/" <> cs table <> "?" <> cs params)- ] ""+ ] $ if echoRequested then cs insertedJson else "" ([table], "PUT") -> handleJsonObj reqBody $ \obj -> do@@ -170,7 +171,7 @@ verb = requestMethod req qq = queryString req hdrs = requestHeaders req- schema = requestedSchema hdrs+ schema = requestedSchema v1schema hdrs range = rangeRequested hdrs allOrigins = ("Access-Control-Allow-Origin", "*") :: Header @@ -196,11 +197,11 @@ <> cs (show total) ) -requestedSchema :: RequestHeaders -> Text-requestedSchema hdrs =+requestedSchema :: Text -> RequestHeaders -> Text+requestedSchema v1schema hdrs = case verStr of- Just [[_, ver]] -> ver- _ -> "1"+ Just [[_, ver]] -> if ver == "1" then v1schema else ver+ _ -> v1schema where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String accept = cs <$> lookup hAccept hdrs :: Maybe Text
src/Config.hs view
@@ -20,6 +20,7 @@ , configAnonRole :: String , configSecure :: Bool , configPool :: Int+ , configV1Schema :: String } argParser :: Parser AppConfig@@ -34,6 +35,7 @@ <*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <> help "postgres role to use for non-authenticated requests") <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS") <*> option auto (long "db-pool" <> metavar "COUNT" <> value 10 <> help "Max connections in database pool" <> showDefault)+ <*> strOption (long "v1schema" <> metavar "NAME" <> value "1" <> help "Schema to use for nonspecified version (or explicit v1)" <> showDefault) defaultCorsPolicy :: CorsResourcePolicy defaultCorsPolicy = CorsResourcePolicy Nothing
src/Main.hs view
@@ -14,6 +14,7 @@ import Network.Wai.Handler.Warp hiding (Connection) import Network.Wai.Middleware.Gzip (gzip, def) import Network.Wai.Middleware.Static (staticPolicy, only)+import Network.Wai.Middleware.RequestLogger (logStdout) import Data.List (intercalate) import Data.Version (versionBranch) import qualified Hasql as H@@ -47,8 +48,8 @@ appSettings = setPort port . setServerName (cs $ "postgrest/" <> prettyVersion) $ defaultSettings- middle =- (if configSecure conf then redirectInsecure else id)+ middle = logStdout+ . (if configSecure conf then redirectInsecure else id) . gzip def . cors corsPolicy . staticPolicy (only [("favicon.ico", "static/favicon.ico")]) anonRole = cs $ configAnonRole conf@@ -62,7 +63,7 @@ runSettings appSettings $ middle $ \req respond -> do body <- strictRequestBody req resOrError <- liftIO $ H.session pool $ H.tx Nothing $- authenticated currRole anonRole (app body) req+ authenticated currRole anonRole (app (cs $ configV1Schema conf) body) req either (respond . errResponse) respond resOrError where
src/PgQuery.hs view
@@ -138,15 +138,22 @@ wherePred :: Net.QueryItem -> PStmt wherePred (col, predicate) = B.Stmt- (" " <> cs (pgFmtIdent $ cs col) <> " " <> op <> " " <> cs (pgFmtLit value) <> "::unknown ")+ (" " <> cs (pgFmtIdent $ cs col) <> " " <> op <> " " <> cs sqlValue) empty True where opCode:rest = T.split (=='.') $ cs $ fromMaybe "." predicate- unStarredVal = T.intercalate "." rest+ value = T.intercalate "." rest+ star c = if c == '*' then '%' else c- value = if opCode == "like" || opCode == "ilike"- then T.map star unStarredVal else unStarredVal+ unknownLiteral = (<> "::unknown ") . pgFmtLit++ sqlValue = case opCode of+ "like" -> unknownLiteral $ T.map star value+ "ilike" -> unknownLiteral $ T.map star value+ "in" -> "(" <> T.intercalate ", " (map unknownLiteral $ T.split (==',') value) <> ") "+ _ -> unknownLiteral value+ op = case opCode of "eq" -> "=" "gt" -> ">"@@ -156,6 +163,7 @@ "neq" -> "<>" "like"-> "like" "ilike"-> "ilike"+ "in" -> "in" _ -> "=" orderParse :: Net.Query -> [OrderTerm]
test/SpecHelper.hs view
@@ -35,7 +35,7 @@ isLeft _ = False cfg :: AppConfig-cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10+cfg = AppConfig "postgrest_test" 5432 "postgrest_test" "" "localhost" 3000 "postgrest_anonymous" False 10 "1" testPoolOpts :: PoolSettings testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30@@ -57,7 +57,7 @@ perform $ middle $ \req resp -> do body <- strictRequestBody req result <- liftIO $ H.session pool $ H.tx Nothing- $ authenticated currRole anonRole (app body) req+ $ authenticated currRole anonRole (app (cs $ configV1Schema cfg) body) req either (resp . errResponse) resp result where middle = cors corsPolicy