diff --git a/main/Main.hs b/main/Main.hs --- a/main/Main.hs +++ b/main/Main.hs @@ -7,12 +7,16 @@ import PostgREST.Config (AppConfig (..), minimumPgVersion, prettyVersion, readOptions) -import PostgREST.DbStructure (getDbStructure, getPgVersion) +import PostgREST.DbStructure (getDbStructure, getPgVersion, + fillSessionWithSettings) import PostgREST.Error (encodeError) import PostgREST.OpenAPI (isMalformedProxyUri) import PostgREST.Types (DbStructure, Schema, PgVersion(..)) import Protolude hiding (hPutStrLn, replace) + +import Control.AutoUpdate (defaultUpdateSettings, + mkAutoUpdate, updateAction) import Control.Retry (RetryStatus, capDelay, exponentialBackoff, retrying, rsPreviousDelay) @@ -24,6 +28,7 @@ import Data.Text (pack, replace, stripPrefix, strip) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.IO (hPutStrLn) +import Data.Time.Clock (getCurrentTime) import qualified Hasql.Pool as P import qualified Hasql.Session as H import Network.Wai.Handler.Warp (defaultSettings, @@ -32,6 +37,7 @@ setTimeout) import System.IO (BufferMode (..), hSetBuffering) + #ifndef mingw32_HOST_OS import System.Posix.Signals #endif @@ -58,10 +64,11 @@ :: ThreadId -- ^ This thread is killed if pg version is unsupported -> P.Pool -- ^ The PostgreSQL connection pool -> Schema -- ^ Schema PostgREST is serving up + -> [(Text, Text)] -- ^ Settings or Environment passed in through the config -> IORef (Maybe DbStructure) -- ^ mutable reference to 'DbStructure' -> IORef Bool -- ^ Used as a binary Semaphore -> IO () -connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do +connectionWorker mainTid pool schema settings refDbStructure refIsWorkerOn = do isWorkerOn <- readIORef refIsWorkerOn unless isWorkerOn $ do atomicWriteIORef refIsWorkerOn True @@ -79,6 +86,7 @@ ("Cannot run in this PostgreSQL version, PostgREST needs at least " <> pgvName minimumPgVersion) killThread mainTid + fillSessionWithSettings settings dbStructure <- getDbStructure schema actualPgVersion liftIO $ atomicWriteIORef refDbStructure $ Just dbStructure case result of @@ -140,18 +148,23 @@ port = configPort conf proxy = configProxyUri conf pgSettings = toS (configDatabase conf) -- is the db-uri + roleClaimKey = configRoleClaimKey conf appSettings = setHost ((fromString . toS) host) -- Warp settings . setPort port . setServerName (toS $ "postgrest/" <> prettyVersion) . setTimeout 3600 $ defaultSettings - -- - -- Checks that the provided proxy uri is formated correctly, - -- does not test if it works here. + + -- Checks that the provided proxy uri is formated correctly when (isMalformedProxyUri $ toS <$> proxy) $ panic "Malformed proxy uri, a correct example: https://example.com:8443/basePath" + + -- Checks that the provided jspath is valid + when (isLeft roleClaimKey) $ + panic $ show roleClaimKey + putStrLn $ ("Listening on port " :: Text) <> show (configPort conf) -- -- create connection pool with the provided settings, returns either @@ -173,6 +186,7 @@ mainTid pool (configSchema conf) + (configSettings conf) refDbStructure refIsWorkerOn -- @@ -195,22 +209,28 @@ mainTid pool (configSchema conf) + (configSettings conf) refDbStructure refIsWorkerOn ) Nothing #endif - -- + + -- ask for the OS time at most once per second + getTime <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime} + -- run the postgrest application runSettings appSettings $ postgrest conf refDbStructure pool + getTime (connectionWorker mainTid pool (configSchema conf) + (configSettings conf) refDbStructure refIsWorkerOn) diff --git a/postgrest.cabal b/postgrest.cabal --- a/postgrest.cabal +++ b/postgrest.cabal @@ -2,19 +2,19 @@ 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.4.4.0 +version: 0.5.0.0 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE author: Joe Nelson, Adam Baker -homepage: https://github.com/begriffs/postgrest +homepage: https://github.com/PostgREST/postgrest maintainer: cred+github@begriffs.com category: Web build-type: Simple cabal-version: >=1.10 source-repository head type: git - location: git://github.com/begriffs/postgrest.git + location: git://github.com/PostgREST/postgrest.git Flag CI Description: No warnings allowed in continuous integration @@ -29,12 +29,14 @@ -rtsopts "-with-rtsopts=-N -I2" default-language: Haskell2010 - build-depends: base + build-depends: auto-update + , base , hasql , hasql-pool , postgrest , protolude , text + , time , warp , bytestring , base64-bytestring @@ -57,17 +59,18 @@ , configurator-ng == 0.0.0.1 , containers , contravariant + , contravariant-extras , either , gitrev , hasql - , hasql-pool == 0.4.1 - , hasql-transaction == 0.5 + , hasql-pool + , hasql-transaction , heredoc , HTTP , http-types , insert-ordered-containers , interpolatedstring-perl6 - , jose >= 0.6 + , jose , lens , lens-aeson , network-uri @@ -80,6 +83,7 @@ , scientific , swagger2 , text + , time , unordered-containers , vector , wai @@ -131,11 +135,13 @@ , Feature.AndOrParamsSpec , Feature.RpcSpec , Feature.NonexistentSchemaSpec + , Feature.UpsertSpec , SpecHelper , TestTypes Build-Depends: aeson , aeson-qq , async + , auto-update , base , bytestring , base64-bytestring @@ -158,6 +164,7 @@ , process , protolude , regex-tdfa + , time , transformers-base , wai , wai-extra diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-| Module : PostgREST.ApiRequest Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest. @@ -13,7 +14,7 @@ import Protolude import qualified Data.Aeson as JSON -import Data.Aeson.Types (emptyObject) +import Data.Aeson.Types (emptyObject, emptyArray) import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS (c2w) import qualified Data.ByteString.Lazy as BL @@ -33,14 +34,7 @@ import Network.Wai.Parse (parseHttpAccept) import PostgREST.RangeQuery (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset) import Data.Ranged.Boundaries -import PostgREST.Types ( QualifiedIdentifier (..) - , Schema - , PayloadJSON(..) - , ContentType(..) - , ApiRequestError(..) - , toMime - , operators - , ftsOperators) +import PostgREST.Types import Data.Ranged.Ranges (Range(..), rangeIntersection, emptyRange) import qualified Data.CaseInsensitive as CI import Web.Cookie (parseCookiesText) @@ -48,10 +42,10 @@ type RequestBody = BL.ByteString -- | Types of things a user wants to do to tables/views/procs -data Action = ActionCreate | ActionRead - | ActionUpdate | ActionDelete - | ActionInfo | ActionInvoke{isReadOnly :: Bool} - | ActionInspect +data Action = ActionCreate | ActionRead + | ActionUpdate | ActionDelete + | ActionInfo | ActionInvoke{isReadOnly :: Bool} + | ActionInspect | ActionSingleUpsert deriving Eq -- | The target db object of a user action data Target = TargetIdent QualifiedIdentifier @@ -61,7 +55,7 @@ deriving Eq -- | How to return the inserted data data PreferRepresentation = Full | HeadersOnly | None deriving Eq - -- + {-| Describes what the user wants to do. This data type is a translation of the raw elements of an HTTP request into domain @@ -86,6 +80,8 @@ , iPreferSingleObjectParameter :: Bool -- | Whether the client wants a result count (slower) , iPreferCount :: Bool + -- | Whether the client wants to UPSERT or ignore records on PK conflict + , iPreferResolution :: Maybe PreferResolution -- | Filters on the result ("id", "eq.10") , iFilters :: [(Text, Text)] -- | &and and &or parameters used for complex boolean logic @@ -102,8 +98,6 @@ , iHeaders :: [(Text, Text)] -- | Request Cookies , iCookies :: [(Text, Text)] - -- | Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..) - , iRpcQParams :: [(Text, Text)] } -- | Examines HTTP request and translates it into user intent. @@ -122,8 +116,10 @@ , iPreferRepresentation = representation , iPreferSingleObjectParameter = singleObject , iPreferCount = hasPrefer "count=exact" + , iPreferResolution = if hasPrefer (show MergeDuplicates) then Just MergeDuplicates + else if hasPrefer (show IgnoreDuplicates) then Just IgnoreDuplicates + else Nothing , iFilters = filters - , iRpcQParams = rpcQParams , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ] , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ] @@ -137,6 +133,7 @@ , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie" } where + -- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..) (filters, rpcQParams) = case action of ActionInvoke{isReadOnly=True} -> partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts @@ -148,20 +145,22 @@ isEmbedPath = T.isInfixOf "." isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path payload = - case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of - CTApplicationJSON -> - note "All object keys must match" . ensureUniform . pluralize + case (decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type", action) of + (_, ActionInvoke{isReadOnly=True}) -> + Right $ PayloadJSON (JSON.encode $ M.fromList $ second JSON.toJSON <$> rpcQParams) PJObject (S.fromList $ fst <$> rpcQParams) + (CTApplicationJSON, _) -> + note "All object keys must match" . payloadAttributes reqBody =<< if BL.null reqBody && isTargetingProc then Right emptyObject else JSON.eitherDecode reqBody - CTTextCSV -> - note "All lines must have same number of fields" . ensureUniform . csvToJson - =<< CSV.decodeByName reqBody - CTOther "application/x-www-form-urlencoded" -> - Right . PayloadJSON . V.singleton . M.fromList - . map (toS *** JSON.String . toS) . parseSimpleQuery - $ toS reqBody - ct -> + (CTTextCSV, _) -> do + json <- csvToJson <$> CSV.decodeByName reqBody + note "All lines must have same number of fields" $ payloadAttributes (JSON.encode json) json + (CTOther "application/x-www-form-urlencoded", _) -> + let json = M.fromList . map (toS *** JSON.String . toS) . parseSimpleQuery $ toS reqBody + keys = S.fromList $ M.keys json in + Right $ PayloadJSON (JSON.encode json) PJObject keys + (ct, _) -> Left $ toS $ "Content-Type not acceptable: " <> toMime ct topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges action = @@ -174,6 +173,7 @@ then ActionInvoke{isReadOnly=False} else ActionCreate "PATCH" -> ActionUpdate + "PUT" -> ActionSingleUpsert "DELETE" -> ActionDelete "OPTIONS" -> ActionInfo _ -> ActionInspect @@ -184,9 +184,8 @@ ["rpc", proc] -> TargetProc $ QualifiedIdentifier schema proc other -> TargetUnknown other - shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke{isReadOnly=False}] - relevantPayload | action == ActionInvoke{isReadOnly=True} = Nothing - | shouldParsePayload = rightToMaybe payload + shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionSingleUpsert, ActionInvoke{isReadOnly=False}, ActionInvoke{isReadOnly=True}] + relevantPayload | shouldParsePayload = rightToMaybe payload | otherwise = Nothing path = pathInfo req method = requestMethod req @@ -270,9 +269,9 @@ The reason for its odd signature is so that it can compose directly with CSV.decodeByName -} -csvToJson :: (CSV.Header, CsvData) -> JSON.Array +csvToJson :: (CSV.Header, CsvData) -> JSON.Value csvToJson (_, vals) = - V.map rowToJsonObj vals + JSON.Array $ V.map rowToJsonObj vals where rowToJsonObj = JSON.Object . M.map (\str -> @@ -281,27 +280,26 @@ else JSON.String $ toS str ) --- | Convert {foo} to [{foo}], leave arrays unchanged --- and truncate everything else to an empty array. -pluralize :: JSON.Value -> JSON.Array -pluralize obj@(JSON.Object _) = V.singleton obj -pluralize (JSON.Array arr) = arr -pluralize _ = V.empty +payloadAttributes :: RequestBody -> JSON.Value -> Maybe PayloadJSON +payloadAttributes raw json = + -- Test that Array contains only Objects having the same keys + case json of + JSON.Array arr -> + case arr V.!? 0 of + Just (JSON.Object o) -> + let canonicalKeys = S.fromList $ M.keys o + areKeysUniform = all (\case + JSON.Object x -> S.fromList (M.keys x) == canonicalKeys + _ -> False) arr in + if areKeysUniform + then Just $ PayloadJSON raw (PJArray $ V.length arr) canonicalKeys + else Nothing + Just _ -> Nothing + Nothing -> Just emptyPJArray --- | Test that Array contains only Objects having the same keys --- and if so mark it as PayloadJSON -ensureUniform :: JSON.Array -> Maybe PayloadJSON -ensureUniform arr = - let objs :: V.Vector JSON.Object - objs = foldr -- filter non-objects, map to raw objects - (\val result -> case val of - JSON.Object o -> V.cons o result - _ -> result) - V.empty arr - keysPerObj = V.map (S.fromList . M.keys) objs - canonicalKeys = fromMaybe S.empty $ keysPerObj V.!? 0 - areKeysUniform = all (==canonicalKeys) keysPerObj in + JSON.Object o -> Just $ PayloadJSON raw PJObject (S.fromList $ M.keys o) - if (V.length objs == V.length arr) && areKeysUniform - then Just (PayloadJSON objs) - else Nothing + -- truncate everything else to an empty array. + _ -> Just emptyPJArray + where + emptyPJArray = PayloadJSON (JSON.encode emptyArray) (PJArray 0) S.empty diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -1,16 +1,19 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NamedFieldPuns #-} module PostgREST.App ( postgrest ) where import Control.Applicative -import Data.Aeson (toJSON, eitherDecode) +import Data.Aeson as JSON import qualified Data.ByteString.Char8 as BS import Data.Maybe import Data.IORef (IORef, readIORef) import Data.Text (intercalate) +import Data.Time.Clock (UTCTime) +import qualified Data.Set as S import qualified Hasql.Pool as P import qualified Hasql.Transaction as HT @@ -22,7 +25,6 @@ import Network.Wai import Network.Wai.Middleware.RequestLogger (logStdout) -import qualified Data.Vector as V import qualified Hasql.Transaction as H import qualified Data.HashMap.Strict as M @@ -38,7 +40,6 @@ import PostgREST.DbStructure import PostgREST.DbRequestBuilder( readRequest , mutateRequest - , readRpcRequest , fieldNames ) import PostgREST.Error ( simpleError, pgError @@ -62,12 +63,13 @@ import Protolude hiding (intercalate, Proxy) import Safe (headMay) -postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO () -> Application -postgrest conf refDbStructure pool worker = +postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO UTCTime -> IO () -> Application +postgrest conf refDbStructure pool getTime worker = let middle = (if configQuiet conf then id else logStdout) . defaultMiddle jwtSecret = parseJWK <$> configJwtSecret conf in middle $ \ req respond -> do + time <- getTime body <- strictRequestBody req maybeDbStructure <- readIORef refDbStructure case maybeDbStructure of @@ -76,38 +78,47 @@ response <- case userApiRequest (configSchema conf) req body of Left err -> return $ apiRequestError err Right apiRequest -> do - eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) + eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf) let authed = containsRole eClaims - handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest - txMode = transactionMode dbStructure - (iTarget apiRequest) (iAction apiRequest) + proc = case (iTarget apiRequest, iPayload apiRequest, iPreferSingleObjectParameter apiRequest) of + (TargetProc qi, Just PayloadJSON{pjKeys}, s) -> findProc qi pjKeys s $ dbProcs dbStructure + _ -> Nothing + handleReq = runWithClaims conf eClaims (app dbStructure proc conf) apiRequest + txMode = transactionMode proc (iAction apiRequest) response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq return $ either (pgError authed) identity response when (responseStatus response == status503) worker respond response -transactionMode :: DbStructure -> Target -> Action -> H.Mode -transactionMode structure target action = +findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> M.HashMap Text [ProcDescription] -> Maybe ProcDescription +findProc qi payloadKeys paramsAsSingleObject allProcs = + let procs = M.lookup (qiName qi) allProcs in + -- Handle overloaded functions case + join $ (case length <$> procs of + Just 1 -> headMay -- if it's not an overloaded function then immediatly get the ProcDescription + _ -> find (\x -> + if paramsAsSingleObject + then length (pdArgs x) == 1 -- if the arg is not of json type let the db give the err + else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs x)) + ) <$> procs + +transactionMode :: Maybe ProcDescription -> Action -> H.Mode +transactionMode proc action = case action of ActionRead -> HT.Read ActionInfo -> HT.Read ActionInspect -> HT.Read ActionInvoke{isReadOnly=False} -> - let proc = - case target of - (TargetProc qi) -> M.lookup (qiName qi) $ - dbProcs structure - _ -> Nothing - v = fromMaybe Volatile $ pdVolatility <$> proc in + let v = fromMaybe Volatile $ pdVolatility <$> proc in if v == Stable || v == Immutable then HT.Read else HT.Write ActionInvoke{isReadOnly=True} -> HT.Read _ -> HT.Write -app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response -app dbStructure conf apiRequest = +app :: DbStructure -> Maybe ProcDescription -> AppConfig -> ApiRequest -> H.Transaction Response +app dbStructure proc conf apiRequest = case responseContentTypeOrError (iAccepts apiRequest) (iAction apiRequest) of Left errorResponse -> return errorResponse Right contentType -> @@ -136,48 +147,52 @@ ) ] (toS body) - (ActionCreate, TargetIdent (QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) -> - case mutateSqlParts of + (ActionCreate, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType}) -> + case mutateSqlParts tSchema tName of Left errorResponse -> return errorResponse Right (sq, mq) -> do - let isSingle = (==1) $ V.length rows + let (isSingle, nRows) = case pjType of + PJArray len -> (len == 1, len) + PJObject -> (True, 1) if contentType == CTSingularJSON && not isSingle && iPreferRepresentation apiRequest == Full - then return $ singularityError (toInteger $ V.length rows) + then return $ singularityError (toInteger nRows) else do - let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself? + let pkCols = tablePKCols dbStructure tSchema tName stm = createWriteStatement sq mq (contentType == CTSingularJSON) isSingle - (contentType == CTTextCSV) (iPreferRepresentation apiRequest) - pKeys - row <- H.query payload stm + (contentType == CTTextCSV) (iPreferRepresentation apiRequest) pkCols + row <- H.query (toS pjRaw) stm let (_, _, fs, body) = extractQueryResult row headers = catMaybes [ if null fs then Nothing - else Just (hLocation, "/" <> toS table <> renderLocationFields fs) + else Just (hLocation, "/" <> toS tName <> renderLocationFields fs) , if iPreferRepresentation apiRequest == Full then Just $ toHeader contentType else Nothing , Just . contentRangeH 1 0 $ - toInteger <$> if shouldCount then Just (V.length rows) else Nothing + toInteger <$> if shouldCount then Just nRows else Nothing + , if null pkCols + then Nothing + else (\x -> ("Preference-Applied", show x)) <$> iPreferResolution apiRequest ] return . responseLBS status201 headers $ if iPreferRepresentation apiRequest == Full then toS body else "" - (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON rows)) -> - case (mutateSqlParts, null <$> rows V.!? 0, iPreferRepresentation apiRequest == Full) of + (ActionUpdate, TargetIdent (QualifiedIdentifier tSchema tName), Just p@PayloadJSON{pjRaw}) -> + case (mutateSqlParts tSchema tName, pjIsEmpty p, iPreferRepresentation apiRequest == Full) of (Left errorResponse, _, _) -> return errorResponse - (_, Just True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]" - (_, Just True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] "" + (_, True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]" + (_, True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] "" (Right (sq, mq), _, _) -> do let stm = createWriteStatement sq mq (contentType == CTSingularJSON) False (contentType == CTTextCSV) (iPreferRepresentation apiRequest) [] - row <- H.query payload stm + row <- H.query (toS pjRaw) stm let (_, queryTotal, _, body) = extractQueryResult row if contentType == CTSingularJSON && queryTotal /= 1 @@ -195,16 +210,46 @@ then responseLBS s [toHeader contentType, r] (toS body) else responseLBS s [r] "" - (ActionDelete, TargetIdent _, Nothing) -> - case mutateSqlParts of + (ActionSingleUpsert, TargetIdent (QualifiedIdentifier tSchema tName), Just PayloadJSON{pjRaw, pjType, pjKeys}) -> + case mutateSqlParts tSchema tName of Left errorResponse -> return errorResponse Right (sq, mq) -> do - let emptyPayload = PayloadJSON V.empty - stm = createWriteStatement sq mq + let isSingle = case pjType of + PJArray len -> len == 1 + PJObject -> True + colNames = colName <$> tableCols dbStructure tSchema tName + if topLevelRange /= allRange + then return $ simpleError status400 [] "Range header and limit/offset querystring parameters are not allowed for PUT" + else if not isSingle + then return $ simpleError status400 [] "PUT payload must contain a single row" + else if S.fromList colNames /= pjKeys + then return $ simpleError status400 [] "You must specify all columns in the payload when using PUT" + else do + row <- H.query (toS pjRaw) $ + createWriteStatement sq mq (contentType == CTSingularJSON) False + (contentType == CTTextCSV) (iPreferRepresentation apiRequest) [] + let (_, queryTotal, _, body) = extractQueryResult row + -- Makes sure the querystring pk matches the payload pk + -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, PUT /items?id=eq.14 { "id" : 2, .. } is rejected + -- If this condition is not satisfied then nothing is inserted, check the WHERE for INSERT in QueryBuilder.hs to see how it's done + if queryTotal /= 1 + then do + HT.condemn + return $ simpleError status400 [] "Payload values do not match URL in primary key column(s)" + else + return $ if iPreferRepresentation apiRequest == Full + then responseLBS status200 [toHeader contentType] (toS body) + else responseLBS status204 [] "" + + (ActionDelete, TargetIdent (QualifiedIdentifier tSchema tName), Nothing) -> + 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) [] - row <- H.query emptyPayload stm + row <- H.query mempty stm let (_, queryTotal, _, body) = extractQueryResult row r = contentRangeH 1 0 $ toInteger <$> if shouldCount then Just queryTotal else Nothing @@ -227,33 +272,32 @@ let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in return $ responseLBS status200 [allOrigins, acceptH] "" - (ActionInvoke _isReadOnly, TargetProc qi, payload) -> - let proc = M.lookup (qiName qi) allProcs - returnsScalar = case proc of + (ActionInvoke _, TargetProc qi, Just PayloadJSON{pjRaw, pjType, pjKeys}) -> + let returnsScalar = case proc of Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True _ -> False rpcBinaryField = if returnsScalar then Right Nothing else binaryField contentType =<< fldNames - parts = (,,) <$> readSqlParts <*> rpcBinaryField <*> rpcQParams in + parts = (,) <$> readSqlParts <*> rpcBinaryField in case parts of Left errorResponse -> return errorResponse - Right ((q, cq), bField, params) -> do - let prms = case payload of - Just (PayloadJSON pld) -> V.head pld - Nothing -> M.fromList $ second toJSON <$> params -- toJSON is just for reusing the callProc function + Right ((q, cq), bField) -> do + let isObject = case pjType of + PJObject -> True + PJArray _ -> False singular = contentType == CTSingularJSON - paramsAsSingleObject = iPreferSingleObjectParameter apiRequest - row <- H.query () $ - callProc qi prms returnsScalar q cq shouldCount - singular paramsAsSingleObject + specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ fromMaybe [] (pdArgs <$> proc) + row <- H.query (toS pjRaw) $ + callProc qi specifiedPgArgs returnsScalar q cq shouldCount + singular (iPreferSingleObjectParameter apiRequest) (contentType == CTTextCSV) - (contentType == CTOctetStream) _isReadOnly bField + (contentType == CTOctetStream) bField isObject (pgVersion dbStructure) let (tableTotal, queryTotal, body, jsonHeaders) = fromMaybe (Just 0, 0, "[]", "[]") row (status, contentRange) = rangeHeader queryTotal tableTotal - decodedHeaders = first toS $ eitherDecode $ toS jsonHeaders :: Either Text [GucHeader] + decodedHeaders = first toS $ JSON.eitherDecode $ toS jsonHeaders :: Either Text [GucHeader] case decodedHeaders of Left _ -> return gucHeadersError Right hs -> @@ -270,26 +314,16 @@ uri Nothing = ("http", host, port, "/") uri (Just Proxy { proxyScheme = s, proxyHost = h, proxyPort = p, proxyPath = b }) = (s, h, p, b) uri' = uri proxy - encodeApi ti sd procs = encodeOpenAPI (M.elems procs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure) + toTableInfo :: [Table] -> [(Table, [Column], [Text])] + toTableInfo = map (\t -> let (s, tn) = (tableSchema t, tableName t) in (t, tableCols dbStructure s tn, tablePKCols dbStructure s tn)) + encodeApi ti sd procs = encodeOpenAPI (concat $ M.elems procs) (toTableInfo ti) uri' sd $ dbPrimaryKeys dbStructure body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription <*> H.query schema accessibleProcs return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body _ -> return notFound where - toTableInfo :: [Table] -> [(Table, [Column], [Text])] - toTableInfo = map (\t -> - let tSchema = tableSchema t - tTable = tableName t - cols = filter (filterCol tSchema tTable) $ dbColumns dbStructure - pkeys = map pkName $ filter (filterPk tSchema tTable) allPrKeys - in (t, cols, pkeys)) notFound = responseLBS status404 [] "" - filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk - filterCol :: Schema -> TableName -> Column -> Bool - filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb - allPrKeys = dbPrimaryKeys dbStructure - allProcs = dbProcs dbStructure allOrigins = ("Access-Control-Allow-Origin", "*") :: Header shouldCount = iPreferCount apiRequest schema = toS $ configSchema conf @@ -301,16 +335,15 @@ status = rangeStatus lower upper (toInteger <$> tableTotal) in (status, contentRange) - readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) allProcs apiRequest + readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) proc apiRequest fldNames = fieldNames <$> readReq readDbRequest = DbRead <$> readReq - mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames) - rpcQParams = readRpcRequest apiRequest selectQuery = requestToQuery schema False <$> readDbRequest - mutateQuery = requestToQuery schema False <$> mutateDbRequest countQuery = requestToCountQuery schema <$> readDbRequest readSqlParts = (,) <$> selectQuery <*> countQuery - mutateSqlParts = (,) <$> selectQuery <*> mutateQuery + mutateSqlParts s t = + (,) <$> selectQuery + <*> (requestToQuery schema False . DbMutate <$> (mutateRequest apiRequest t (tablePKCols dbStructure s t) =<< fldNames)) responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType responseContentTypeOrError accepts action = serves contentTypesForRequest accepts @@ -324,6 +357,7 @@ ActionInvoke _ -> [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream] ActionInspect -> [CTOpenAPI, CTApplicationJSON] ActionInfo -> [CTTextCSV] + ActionSingleUpsert -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] serves sProduces cAccepts = case mutuallyAgreeable sProduces cAccepts of Nothing -> do diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-| Module : PostgREST.Auth Description : PostgREST authorization functions. @@ -19,8 +20,11 @@ ) where import Control.Lens.Operators -import Data.Aeson (Value (..), decode, toJSON) +import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as M +import Data.Time.Clock (UTCTime) +import Data.Vector as V +import PostgREST.Types import Protolude import qualified Crypto.JOSE.Types as JOSE.Types @@ -31,47 +35,56 @@ -} data JWTAttempt = JWTInvalid JWTError | JWTMissingSecret - | JWTClaims (M.HashMap Text Value) + | JWTClaims (M.HashMap Text JSON.Value) deriving (Eq, Show) {-| Receives the JWT secret and audience (from config) and a JWT and returns a map of JWT claims. -} -jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> IO JWTAttempt -jwtClaims _ _ "" = return $ JWTClaims M.empty -jwtClaims secret audience payload = +jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt +jwtClaims _ _ "" _ _ = return $ JWTClaims M.empty +jwtClaims secret audience payload time jspath = case secret of Nothing -> return JWTMissingSecret Just s -> do let validation = defaultJWTValidationSettings (maybe (const True) (==) audience) eJwt <- runExceptT $ do jwt <- decodeCompact payload - verifyClaims validation s jwt + verifyClaimsAt validation s time jwt return $ case eJwt of Left e -> JWTInvalid e - Right jwt -> JWTClaims . claims2map $ jwt + Right jwt -> JWTClaims $ claims2map jwt jspath {-| + Turn JWT ClaimSet into something easier to work with, + also here the jspath is applied to put the "role" in the map +-} +claims2map :: ClaimsSet -> Maybe JSPath -> M.HashMap Text JSON.Value +claims2map claims jspath = (\case + val@(JSON.Object o) -> + let role = maybe M.empty (M.singleton "role") $ + walkJSPath (Just val) =<< jspath in + M.delete "role" o `M.union` role -- mutating the map + _ -> M.empty + ) $ JSON.toJSON claims + +walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value +walkJSPath x [] = x +walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (M.lookup key o) rest +walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest +walkJSPath _ _ = Nothing + +{-| Whether a response from jwtClaims contains a role claim -} containsRole :: JWTAttempt -> Bool containsRole (JWTClaims claims) = M.member "role" claims containsRole _ = False -{-| - Internal helper used to turn JWT ClaimSet into something - easier to work with --} -claims2map :: ClaimsSet -> M.HashMap Text Value -claims2map = val2map . toJSON - where - val2map (Object o) = o - val2map _ = M.empty - parseJWK :: ByteString -> JWK parseJWK str = - fromMaybe (hs256jwk str) (decode (toS str) :: Maybe JWK) + fromMaybe (hs256jwk str) (JSON.decode (toS str) :: Maybe JWK) {-| Internal helper to generate HMAC-SHA256. When the jwt key in the diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -19,12 +19,12 @@ , readOptions , corsPolicy , minimumPgVersion + , pgVersion95 , pgVersion96 , AppConfig (..) ) where -import PostgREST.Types (PgVersion(..)) import Control.Applicative import Control.Monad (fail) import Control.Lens (preview) @@ -51,6 +51,9 @@ import Network.Wai.Middleware.Cors (CorsResourcePolicy (..)) import Options.Applicative hiding (str) import Paths_postgrest (version) +import PostgREST.Parsers (pRoleClaimKey) +import PostgREST.Types (PgVersion(..), ApiRequestError(..), + JSPath, JSPathExp(..)) import Protolude hiding (hPutStrLn, take, intercalate, (<>)) import System.IO (hPrint) @@ -76,6 +79,8 @@ , configMaxRows :: Maybe Integer , configReqCheck :: Maybe Text , configQuiet :: Bool + , configSettings :: [(Text, Text)] + , configRoleClaimKey :: Either ApiRequestError JSPath } defaultCorsPolicy :: CorsResourcePolicy @@ -136,6 +141,8 @@ <*> (join . fmap coerceInt <$> C.key "max-rows") <*> (mfilter (/= "") <$> C.key "pre-request") <*> pure False + <*> (fmap parsedPairToTextPair <$> C.subassocs "app.settings") + <*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key") case mAppConf of Nothing -> do @@ -145,6 +152,13 @@ return appConf where + parsedPairToTextPair :: (Name, Value) -> (Text, Text) + parsedPairToTextPair (k, v) = (k, newValue) + where + newValue = case v of + String textVal -> textVal + _ -> show v + parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI) parseJwtAudience k = C.key k >>= \case @@ -159,11 +173,15 @@ coerceInt (String x) = readMaybe $ toS x coerceInt _ = Nothing - coerceBool :: Value -> Maybe Bool + coerceBool :: Value -> Maybe Bool coerceBool (Bool b) = Just b - coerceBool (String x) = readMaybe $ toS x + coerceBool (String b) = readMaybe $ toS b coerceBool _ = Nothing + parseRoleClaimKey :: Value -> Either ApiRequestError JSPath + parseRoleClaimKey (String s) = pRoleClaimKey s + parseRoleClaimKey v = pRoleClaimKey $ show v + opts = info (helper <*> pathParser) $ fullDesc <> progDesc ( @@ -208,6 +226,9 @@ | |## stored proc to exec immediately after auth |# pre-request = "stored_proc_name" + | + |## jspath to the role claim key + |# role-claim-key = ".role" |] pathParser :: Parser FilePath @@ -218,7 +239,10 @@ -- | Tells the minimum PostgreSQL version required by this version of PostgREST minimumPgVersion :: PgVersion -minimumPgVersion = PgVersion 90300 "9.3" +minimumPgVersion = PgVersion 90400 "9.4" pgVersion96 :: PgVersion pgVersion96 = PgVersion 90600 "9.6" + +pgVersion95 :: PgVersion +pgVersion95 = PgVersion 90500 "9.5" diff --git a/src/PostgREST/DbRequestBuilder.hs b/src/PostgREST/DbRequestBuilder.hs --- a/src/PostgREST/DbRequestBuilder.hs +++ b/src/PostgREST/DbRequestBuilder.hs @@ -1,9 +1,11 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DuplicateRecordFields#-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} module PostgREST.DbRequestBuilder ( readRequest , mutateRequest -, readRpcRequest , fieldNames ) where @@ -14,6 +16,7 @@ import qualified Data.ByteString.Char8 as BS import Data.List (delete) import Data.Maybe (fromJust) +import qualified Data.Set as S import Data.Text (isInfixOf) import Data.Tree import Data.Either.Combinators (mapLeft) @@ -30,45 +33,50 @@ ) import PostgREST.Error (apiRequestError) import PostgREST.Parsers -import PostgREST.RangeQuery (NonnegRange, restrictRange) +import PostgREST.RangeQuery (NonnegRange, restrictRange, allRange) import PostgREST.Types import Protolude hiding (from, dropWhile, drop) import Text.Regex.TDFA ((=~)) import Unsafe (unsafeHead) -readRequest :: Maybe Integer -> [Relation] -> M.HashMap Text ProcDescription -> ApiRequest -> Either Response ReadRequest -readRequest maxRows allRels allProcs apiRequest = +readRequest :: Maybe Integer -> [Relation] -> Maybe ProcDescription -> ApiRequest -> Either Response ReadRequest +readRequest maxRows allRels proc apiRequest = mapLeft apiRequestError $ treeRestrictRange maxRows =<< augumentRequestWithJoin schema relations =<< - parseReadRequest + addFiltersOrdersRanges apiRequest <*> + (buildReadRequest <$> pRequestSelect (iSelect apiRequest)) where + action = iAction apiRequest (schema, rootTableName) = fromJust $ -- Make it safe let target = iTarget apiRequest in case target of (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t) - (TargetProc (QualifiedIdentifier s proc) ) -> Just (s, tName) + (TargetProc (QualifiedIdentifier s pName) ) -> Just (s, tName) where - retType = pdReturnType <$> M.lookup proc allProcs - tName = case retType of + tName = case pdReturnType <$> proc of Just (SetOf (Composite qi)) -> qiName qi Just (Single (Composite qi)) -> qiName qi - _ -> proc + _ -> pName _ -> Nothing - action :: Action - action = iAction apiRequest - - parseReadRequest :: Either ApiRequestError ReadRequest - parseReadRequest = addFiltersOrdersRanges apiRequest <*> - pRequestSelect rootName selStr + -- Build tree with a Depth attribute so when a self join occurs we can differentiate the parent and child tables by having + -- an alias like "table_depth", this is related to issue #987. + buildReadRequest :: [Tree SelectItem] -> ReadRequest + buildReadRequest fieldTree = + let rootDepth = 0 + rootNodeName = if action == ActionRead then rootTableName else sourceCTEName in + foldr (treeEntry rootDepth) (Node (Select [] [rootNodeName] [] [] [] allRange, (rootNodeName, Nothing, Nothing, Nothing, rootDepth)) []) fieldTree where - selStr = iSelect apiRequest - rootName = if action == ActionRead - then rootTableName - else sourceCTEName + treeEntry :: Depth -> Tree SelectItem -> ReadRequest -> ReadRequest + treeEntry depth (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) = + let nxtDepth = succ depth in + case fldForest of + [] -> Node (q {select=fld:select q}, i) rForest + _ -> Node (q, i) $ + foldr (treeEntry nxtDepth) (Node (Select [] [fn] [] [] [] allRange, (fn, Nothing, alias, relationDetail, nxtDepth)) []) fldForest:rForest relations :: [Relation] relations = case action of @@ -77,8 +85,20 @@ ActionDelete -> fakeSourceRelations ++ allRels ActionInvoke _ -> fakeSourceRelations ++ allRels _ -> allRels - where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation + where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels +-- in a relation where one of the tables matches "TableName" +-- replace the name to that table with pg_source +-- this "fake" relations is needed so that in a mutate query +-- we can look a the "returning *" part which is wrapped with a "with" +-- as just another table that has relations with other tables +toSourceRelation :: TableName -> Relation -> Maybe Relation +toSourceRelation mt r@(Relation t _ ft _ _ rt _ _) + | mt == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}} + | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceCTEName}} + | Just mt == (tableName <$> rt) = Just $ r {relLinkTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt} + | otherwise = Nothing + treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` request where @@ -88,136 +108,135 @@ augumentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either ApiRequestError ReadRequest augumentRequestWithJoin schema allRels request = addRelations schema allRels Nothing request - >>= addJoinFilters schema + >>= addJoinConditions schema addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest -addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias, relationDetail)) forest) = +addRelations schema allRelations parentNode (Node (query, (nodeName, _, alias, relationDetail, depth)) forest) = case parentNode of - (Just (Node (Select{from=[parentNodeTable]}, (_, _, _, _)) _)) -> - Node <$> readNode' <*> forest' - where - forest' = updateForest $ hush node' - node' = Node <$> readNode' <*> pure forest - readNode' = addRel readNode <$> rel - rel :: Either ApiRequestError Relation - rel = note (NoRelationBetween parentNodeTable name) - $ findRelation schema name parentNodeTable relationDetail - where - - findRelation s nodeTableName parentNodeTableName Nothing = - find (\r -> - s == tableSchema (relTable r) && -- match schema for relation table - s == tableSchema (relFTable r) && -- match schema for relation foriegn table - ( + Just (Node (Select{from=[parentNodeTable]}, _) _) -> + let newFrom r = (\tName -> if tName == nodeName then tableName (relTable r) else tName) <$> from query + newReadNode = (\r -> (query{from=newFrom r}, (nodeName, Just r, alias, Nothing, depth))) <$> rel + rel :: Either ApiRequestError Relation + rel = note (NoRelationBetween parentNodeTable nodeName) $ + findRelation schema allRelations nodeName parentNodeTable relationDetail in + Node <$> newReadNode <*> (updateForest . hush $ Node <$> newReadNode <*> pure forest) + _ -> + let rn = (query, (nodeName, Just r, alias, Nothing, depth)) + r = Relation t [] t [] Root Nothing Nothing Nothing + t = Table schema nodeName Nothing True in -- !!! TODO find another way to get the table from the query + Node rn <$> updateForest (Just $ Node rn forest) + where + updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest] + updateForest rq = mapM (addRelations schema allRelations rq) forest - -- (request) => projects { ..., clients{...} } - -- will match - -- (relation type) => parent - -- (entity) => clients {id} - -- (foriegn entity) => projects {client_id} - ( - nodeTableName == tableName (relTable r) && -- match relation table name - parentNodeTableName == tableName (relFTable r) -- match relation foreign table name - ) || +findRelation :: Schema -> [Relation] -> NodeName -> TableName -> Maybe RelationDetail -> Maybe Relation +findRelation schema allRelations nodeTableName parentNodeTableName relationDetail = + find (\Relation{relTable, relColumns, relFTable, relFColumns, relType, relLinkTable} -> + -- Both relation ends need to be on the exposed schema + schema == tableSchema relTable && schema == tableSchema relFTable && + case relationDetail of + Nothing -> + -- (request) => projects { ..., clients{...} } + -- will match + -- (relation type) => parent + -- (entity) => clients {id} + -- (foriegn entity) => projects {client_id} + ( + nodeTableName == tableName relTable && -- match relation table name + parentNodeTableName == tableName relFTable -- match relation foreign table name + ) || - -- (request) => projects { ..., client_id{...} } - -- will match - -- (relation type) => parent - -- (entity) => clients {id} - -- (foriegn entity) => projects {client_id} - ( - parentNodeTableName == tableName (relFTable r) && - length (relFColumns r) == 1 && - nodeTableName `colMatches` (colName . unsafeHead . relFColumns) r - ) + -- (request) => projects { ..., client_id{...} } + -- will match + -- (relation type) => parent + -- (entity) => clients {id} + -- (foriegn entity) => projects {client_id} + ( + parentNodeTableName == tableName relFTable && + length relFColumns == 1 && + -- match common foreign key names(table_name_id, table_name_fk) to table_name + (toS ("^" <> colName (unsafeHead relFColumns) <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS nodeTableName :: BS.ByteString) + ) - -- (request) => project_id { ..., client_id{...} } - -- will match - -- (relation type) => parent - -- (entity) => clients {id} - -- (foriegn entity) => projects {client_id} - -- this case works becasue before reaching this place - -- addRelation will turn project_id to project so the above condition will match - ) - ) allRelations - - findRelation s nodeTableName parentNodeTableName (Just rd) = - find (\r -> - s == tableSchema (relTable r) && -- match schema for relation table - s == tableSchema (relFTable r) && -- match schema for relation foriegn table - ( + -- (request) => project_id { ..., client_id{...} } + -- will match + -- (relation type) => parent + -- (entity) => clients {id} + -- (foriegn entity) => projects {client_id} + -- this case works becasue before reaching this place + -- addRelation will turn project_id to project so the above condition will match - -- (request) => clients { ..., project.client_id{...} } - -- will match - -- (relation type) => parent - -- (entity) => clients {id} - -- (foriegn entity) => projects {client_id} - ( - nodeTableName == tableName (relTable r) && -- match relation table name - parentNodeTableName == tableName (relFTable r) && -- && -- match relation foreign table name - length (relColumns r) == 1 && - rd == (colName . unsafeHead . relColumns) r - ) - || + Just rd -> + -- (request) => clients { ..., projects.client_id{...} } + -- will match + -- (relation type) => child + -- (entity) => clients {id} + -- (foriegn entity) => projects {client_id} + ( + relType == Child && + nodeTableName == tableName relTable && -- match relation table name + parentNodeTableName == tableName relFTable && -- match relation foreign table name + length relColumns == 1 && + rd == colName (unsafeHead relColumns) + ) || - -- (request) => tasks { ..., users.tasks_users{...} } - -- will match - -- (relation type) => many - -- (entity) => users - -- (foriegn entity) => tasks - ( - relType r == Many && - nodeTableName == tableName (relTable r) && -- match relation table name - parentNodeTableName == tableName (relFTable r) && -- match relation foreign table name - rd == tableName (fromJust (relLTable r)) - ) - ) - ) allRelations - n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString) - addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail)) - addRel (query', (n, _, a, _)) r = (query' {from=fromRelation}, (n, Just r, a, Nothing)) - where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query') + -- (request) => message { ..., person_detail.sender{...} } + -- will match + -- (relation type) => parent + -- (entity) => message {sender} + -- (foriegn entity) => person_detail {id} + ( + relType == Parent && + nodeTableName == tableName relTable && -- match relation table name + parentNodeTableName == tableName relFTable && -- match relation foreign table name + length relFColumns == 1 && + rd == colName (unsafeHead relFColumns) + ) || - _ -> n' <$> updateForest (Just (n' forest)) - where - n' = Node (query, (name, Just r, alias, Nothing)) - t = Table schema name Nothing True -- !!! TODO find another way to get the table from the query - r = Relation t [] t [] Root Nothing Nothing Nothing - where - updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest] - updateForest n = mapM (addRelations schema allRelations n) forest + -- (request) => tasks { ..., users.tasks_users{...} } + -- will match + -- (relation type) => many + -- (entity) => users + -- (foriegn entity) => tasks + ( + relType == Many && + nodeTableName == tableName relTable && -- match relation table name + parentNodeTableName == tableName relFTable && -- match relation foreign table name + rd == tableName (fromJust relLinkTable) + ) + ) allRelations -addJoinFilters :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest -addJoinFilters schema (Node node@(query, nodeProps@(_, relation, _, _)) forest) = +addJoinConditions :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest +addJoinConditions schema (Node node@(query, nodeProps@(_, relation, _, _, _)) forest) = case relation of Just Relation{relType=Root} -> Node node <$> updatedForest -- this is the root node Just rel@Relation{relType=Parent} -> Node (augmentQuery rel, nodeProps) <$> updatedForest Just rel@Relation{relType=Child} -> Node (augmentQuery rel, nodeProps) <$> updatedForest - Just rel@Relation{relType=Many, relLTable=(Just linkTable)} -> + Just rel@Relation{relType=Many, relLinkTable=(Just linkTable)} -> let rq = augmentQuery rel in Node (rq{from=tableName linkTable:from rq}, nodeProps) <$> updatedForest _ -> Left UnknownRelation where - updatedForest = mapM (addJoinFilters schema) forest - augmentQuery rel = foldr addFilterToReadQuery query (getJoinFilters rel) - addFilterToReadQuery flt rq@Select{where_=lf} = rq{where_=addFilterToLogicForest flt lf}::ReadQuery + updatedForest = mapM (addJoinConditions schema) forest + augmentQuery rel = foldr addJoinCond query (getJoinConditions rel) + addJoinCond :: JoinCondition -> ReadQuery -> ReadQuery + addJoinCond jc rq@Select{joinConditions=jcs} = rq{joinConditions=jc:jcs} -getJoinFilters :: Relation -> [Filter] -getJoinFilters (Relation t cols ft fcs typ lt lc1 lc2) = - case typ of - Child -> zipWith (toFilter tN ftN) cols fcs - Parent -> zipWith (toFilter tN ftN) cols fcs - Many -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2) - Root -> undefined --error "undefined getJoinFilters" +getJoinConditions :: Relation -> [JoinCondition] +getJoinConditions (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{tableName=ftN} fcs typ lt lc1 lc2) = + if | typ == Child || typ == Parent -> + zipWith (toJoinCondition tN ftN) cols fcs + | typ == Many -> + let ltN = fromMaybe "" (tableName <$> lt) in + zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fcs (fromMaybe [] lc2) + | typ == Root -> undefined where - s = if typ == Parent then "" else tableSchema t - tN = tableName t - ftN = tableName ft - ltN = fromMaybe "" (tableName <$> lt) - toFilter :: Text -> Text -> Column -> Column -> Filter - toFilter tb ftb c fc = Filter (colName c, Nothing) (OpExpr False (Join (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))) + toJoinCondition :: Text -> Text -> Column -> Column -> JoinCondition + toJoinCondition tb ftb c fc = + JoinCondition (QualifiedIdentifier tSchema tb, Nothing, colName c) + (QualifiedIdentifier tSchema ftb, Nothing, colName fc) addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest) addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [ @@ -254,7 +273,7 @@ addFilter = addProperty addFilterToNode addOrderToNode :: [OrderTerm] -> ReadRequest -> ReadRequest -addOrderToNode o (Node (q,i) f) = Node (q{order=Just o}, i) f +addOrderToNode o (Node (q,i) f) = Node (q{order=o}, i) f addOrder :: (EmbedPath, [OrderTerm]) -> ReadRequest -> ReadRequest addOrder = addProperty addOrderToNode @@ -272,53 +291,35 @@ addLogicTree = addProperty addLogicTreeToNode addProperty :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> ReadRequest -> ReadRequest -addProperty f ([], a) n = f a n -addProperty f (path, a) (Node rn forest) = - case targetNode of +addProperty f ([], a) rr = f a rr +addProperty f (targetNodeName:remainingPath, a) (Node rn forest) = + case pathNode of Nothing -> Node rn forest -- the property is silenty dropped in the Request does not contain the required path - Just tn -> Node rn (addProperty f (remainingPath, a) tn:restForest) + Just tn -> Node rn (addProperty f (remainingPath, a) tn:delete tn forest) where - targetNodeName:remainingPath = path - (targetNode,restForest) = splitForest targetNodeName forest - splitForest :: NodeName -> Forest ReadNode -> (Maybe ReadRequest, Forest ReadNode) - splitForest name forst = - case maybeNode of - Nothing -> (Nothing,forest) - Just node -> (Just node, delete node forest) - where - maybeNode :: Maybe ReadRequest - maybeNode = find fnd forst - where - fnd :: ReadRequest -> Bool - fnd (Node (_,(n,_,_,_)) _) = n == name - --- in a relation where one of the tables mathces "TableName" --- replace the name to that table with pg_source --- this "fake" relations is needed so that in a mutate query --- we can look a the "returning *" part which is wrapped with a "with" --- as just another table that has relations with other tables -toSourceRelation :: TableName -> Relation -> Maybe Relation -toSourceRelation mt r@(Relation t _ ft _ _ rt _ _) - | mt == tableName t = Just $ r {relTable=t {tableName=sourceCTEName}} - | mt == tableName ft = Just $ r {relFTable=t {tableName=sourceCTEName}} - | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt} - | otherwise = Nothing + pathNode = find (\(Node (_,(nodeName,_,alias,_,_)) _) -> nodeName == targetNodeName || alias == Just targetNodeName) forest -mutateRequest :: ApiRequest -> [FieldName] -> Either Response MutateRequest -mutateRequest apiRequest fldNames = mapLeft apiRequestError $ +mutateRequest :: ApiRequest -> TableName -> [Text] -> [FieldName] -> Either Response MutateRequest +mutateRequest apiRequest tName pkCols fldNames = mapLeft apiRequestError $ case action of - ActionCreate -> Right $ Insert rootTableName payload returnings - ActionUpdate -> Update rootTableName <$> pure payload <*> combinedLogic <*> pure returnings - ActionDelete -> Delete rootTableName <$> combinedLogic <*> pure returnings - _ -> Left UnsupportedVerb + ActionCreate -> Right $ Insert tName pkCols payload (iPreferResolution apiRequest) [] returnings + ActionUpdate -> Update tName payload <$> combinedLogic <*> pure returnings + ActionSingleUpsert -> + (\flts -> + if null (iLogic apiRequest) && + S.fromList (fst <$> iFilters apiRequest) == S.fromList pkCols && + not (null (S.fromList pkCols)) && + all (\case + Filter _ (OpExpr False (Op "eq" _)) -> True + _ -> False) flts + then Insert tName pkCols payload (Just MergeDuplicates) <$> combinedLogic <*> pure returnings + else + Left InvalidFilters) =<< filters + ActionDelete -> Delete tName <$> combinedLogic <*> pure returnings + _ -> Left UnsupportedVerb where action = iAction apiRequest payload = fromJust $ iPayload apiRequest - rootTableName = -- TODO: Make it safe - let target = iTarget apiRequest in - case target of - (TargetIdent (QualifiedIdentifier _ t) ) -> t - _ -> undefined returnings = if iPreferRepresentation apiRequest == None then [] else fldNames filters = map snd <$> mapM pRequestFilter mutateFilters logic = map snd <$> mapM pRequestLogicTree logicFilters @@ -327,17 +328,12 @@ (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest) onlyRoot = filter (not . ( "." `isInfixOf` ) . fst) -readRpcRequest :: ApiRequest -> Either Response [RpcQParam] -readRpcRequest apiRequest = mapLeft apiRequestError rpcQParams - where - rpcQParams = mapM pRequestRpcQParam $ iRpcQParams apiRequest - fieldNames :: ReadRequest -> [FieldName] fieldNames (Node (sel, _) forest) = map (fst . view _1) (select sel) ++ map colName fks where fks = concatMap (fromMaybe [] . f) forest - f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _, _)) _) = Just cols + f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _, _, _)) _) = Just cols f _ = Nothing -- Traditional filters(e.g. id=eq.1) are added as root nodes of the LogicTree diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -3,12 +3,14 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE NamedFieldPuns #-} module PostgREST.DbStructure ( getDbStructure , accessibleTables , accessibleProcs , schemaDescription , getPgVersion +, fillSessionWithSettings ) where import qualified Hasql.Decoders as HD @@ -17,10 +19,11 @@ import Control.Applicative import qualified Data.HashMap.Strict as M -import Data.List (elemIndex) -import Data.Maybe (fromJust) +import qualified Data.List as L +import Data.Set as S (fromList) import Data.Text (split, strip, - breakOn, dropAround, splitOn) + breakOn, dropAround, + splitOn) import qualified Data.Text as T import qualified Hasql.Session as H import PostgREST.Types @@ -30,23 +33,26 @@ import Protolude import Unsafe (unsafeHead) +import Data.Functor.Contravariant (contramap) +import Contravariant.Extras (contrazip2) + getDbStructure :: Schema -> PgVersion -> H.Session DbStructure getDbStructure schema pgVer = do - tabs <- H.query () allTables - cols <- H.query schema $ allColumns tabs - syns <- H.query () $ allSynonyms cols - rels <- H.query () $ allRelations tabs cols - keys <- H.query () $ allPrimaryKeys tabs - procs <- H.query schema allProcs + tabs <- H.query () allTables + cols <- H.query schema $ allColumns tabs + syns <- H.query () $ allSynonyms cols + childRels <- H.query () $ allChildRelations tabs cols + keys <- H.query () $ allPrimaryKeys tabs + procs <- H.query schema allProcs - let rels' = (addManyToManyRelations . raiseRelations schema syns . addParentRelations . addSynonymousRelations syns) rels - cols' = addForeignKeys rels' cols - keys' = synonymousPrimaryKeys syns keys + let rels = addManyToManyRelations . addParentRelations $ addViewRelations syns childRels + cols' = addForeignKeys rels cols + keys' = addViewPrimaryKeys syns keys return DbStructure { dbTables = tabs , dbColumns = cols' - , dbRelations = rels' + , dbRelations = rels , dbPrimaryKeys = keys' , dbProcs = procs , pgVersion = pgVer @@ -94,7 +100,7 @@ where pkRow = (,,) <$> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text -decodeSynonyms :: [Column] -> HD.Result [(Column,Column)] +decodeSynonyms :: [Column] -> HD.Result [Synonym] decodeSynonyms cols = mapMaybe (synonymFromRow cols) <$> HD.rowsList synRow where @@ -103,9 +109,10 @@ <*> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text -decodeProcs :: HD.Result (M.HashMap Text ProcDescription) +decodeProcs :: HD.Result (M.HashMap Text [ProcDescription]) decodeProcs = - M.fromList . map addName <$> HD.rowsList tblRow + -- Duplicate rows for a function means they're overloaded, order these by least args according to ProcDescription Ord instance + map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addName) <$> HD.rowsList tblRow where tblRow = ProcDescription <$> HD.value HD.text @@ -152,10 +159,10 @@ | v == 's' = Stable | otherwise = Volatile -- only 'v' can happen here -allProcs :: H.Query Schema (M.HashMap Text ProcDescription) +allProcs :: H.Query Schema (M.HashMap Text [ProcDescription]) allProcs = H.statement (toS procsSqlQuery) (HE.value HE.text) decodeProcs True -accessibleProcs :: H.Query Schema (M.HashMap Text ProcDescription) +accessibleProcs :: H.Query Schema (M.HashMap Text [ProcDescription]) accessibleProcs = H.statement (toS sql) (HE.value HE.text) decodeProcs True where sql = procsSqlQuery <> " AND has_function_privilege(p.oid, 'execute')" @@ -212,7 +219,7 @@ join pg_namespace n on n.oid = c.relnamespace left join pg_catalog.pg_description as d on d.objoid = c.oid and d.objsubid = 0 where - c.relkind in ('v', 'r', 'm') + c.relkind in ('v', 'r', 'm', 'f') and n.nspname = $1 and ( pg_has_role(c.relowner, 'USAGE'::text) @@ -221,18 +228,6 @@ ) order by relname |] -synonymousColumns :: [(Column,Column)] -> [Column] -> [[Column]] -synonymousColumns allSyns cols = synCols' - where - syns = case headMay cols of - Just firstCol -> sort $ filter ((== colTable firstCol) . colTable . fst) allSyns - Nothing -> [] - synCols  = transpose $ map (\c -> map snd $ filter ((== c) . fst) syns) cols - synCols' = (filter sameTable . filter matchLength) synCols - matchLength cs = length cols == length cs - sameTable (c:cs) = all (\cc -> colTable c == colTable cc) (c:cs) - sameTable [] = False - addForeignKeys :: [Relation] -> [Column] -> [Column] addForeignKeys rels = map addFk where @@ -241,35 +236,84 @@ lookupFn :: Column -> Relation -> Bool lookupFn c Relation{relColumns=cs, relType=rty} = c `elem` cs && rty==Child relToFk col Relation{relColumns=cols, relFColumns=colsF} = do - pos <- elemIndex col cols + pos <- L.elemIndex col cols colF <- atMay colsF pos return $ ForeignKey colF -addSynonymousRelations :: [(Column,Column)] -> [Relation] -> [Relation] -addSynonymousRelations _ [] = [] -addSynonymousRelations syns (rel:rels) = rel : synRelsP ++ synRelsF ++ addSynonymousRelations syns rels - where - synRelsP = synRels (relColumns rel) (\t cs -> rel{relTable=t,relColumns=cs}) - synRelsF = synRels (relFColumns rel) (\t cs -> rel{relFTable=t,relFColumns=cs}) - synRels cols mapFn = map (\cs -> mapFn (colTable $ unsafeHead cs) cs) $ synonymousColumns syns cols +{- +Adds Views Child Relations based on Synonyms found, the logic is as follows: +Having a Relation{relTable=t1, relColumns=[c1], relFTable=t2, relFColumns=[c2], relType=Child} represented by: + +t1.c1------t2.c2 + +When only having a t1_view.c1 synonym, we need to add a View to Table Relation + + t1.c1----t2.c2 t1.c1----------t2.c2 + -> --------/ + / + t1_view.c1 t1_view.c1 + + +When only having a t2_view.c2 synonym, we need to add a Table to View Relation + + t1.c1----t2.c2 t1.c1----------t2.c2 + -> \-------- + \ + t2_view.c2 t2_view.c1 + +When having t1_view.c1 and a t2_view.c2 synonyms, we need to add a View to View Relation in addition to the prior + + t1.c1----t2.c2 t1.c1----------t2.c2 + -> \--------/ + / \ + t1_view.c1 t2_view.c2 t1_view.c1-------t2_view.c1 + +The logic for composite pks is similar just need to make sure all the Relation columns have synonyms. +-} +addViewRelations :: [Synonym] -> [Relation] -> [Relation] +addViewRelations allSyns = concatMap (\rel -> + rel : case rel of + Relation{relType=Child, relTable, relColumns, relFTable, relFColumns} -> + + let colSynsGroupedByView :: [Column] -> [[Synonym]] + colSynsGroupedByView relCols = L.groupBy (\(_, viewCol1) (_, viewCol2) -> colTable viewCol1 == colTable viewCol2) $ + filter (\(c, _) -> c `elem` relCols) allSyns + colsSyns = colSynsGroupedByView relColumns + fColsSyns = colSynsGroupedByView relFColumns + getView :: [Synonym] -> Table + getView = colTable . snd . unsafeHead + syns `allSynsOf` cols = S.fromList (fst <$> syns) == S.fromList cols in + + -- View Table Relations + [Relation (getView syns) (snd <$> syns) relFTable relFColumns Child Nothing Nothing Nothing + | syns <- colsSyns, syns `allSynsOf` relColumns] ++ + + -- Table View Relations + [Relation relTable relColumns (getView fSyns) (snd <$> fSyns) Child Nothing Nothing Nothing + | fSyns <- fColsSyns, fSyns `allSynsOf` relFColumns] ++ + + -- View View Relations + [Relation (getView syns) (snd <$> syns) (getView fSyns) (snd <$> fSyns) Child Nothing Nothing Nothing + | syns <- colsSyns, fSyns <- fColsSyns, syns `allSynsOf` relColumns, fSyns `allSynsOf` relFColumns] + + _ -> []) + addParentRelations :: [Relation] -> [Relation] -addParentRelations [] = [] -addParentRelations (rel@(Relation t c ft fc _ _ _ _):rels) = Relation ft fc t c Parent Nothing Nothing Nothing : rel : addParentRelations rels +addParentRelations = concatMap (\rel@(Relation t c ft fc _ _ _ _) -> [rel, Relation ft fc t c Parent Nothing Nothing Nothing]) addManyToManyRelations :: [Relation] -> [Relation] addManyToManyRelations rels = rels ++ addMirrorRelation (mapMaybe link2Relation links) where links = join $ map (combinations 2) $ filter (not . null) $ groupWith groupFn $ filter ( (==Child). relType) rels groupFn :: Relation -> Text - groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s<>"_"<>t + groupFn Relation{relTable=Table{tableSchema=s, tableName=t}} = s <> "_" <> t -- Reference : https://wiki.haskell.org/99_questions/Solutions/26 combinations :: Int -> [a] -> [[a]] combinations 0 _ = [ [] ] combinations n xs = [ y:ys | y:xs' <- tails xs , ys <- combinations (n-1) xs'] - addMirrorRelation [] = [] - addMirrorRelation (rel@(Relation t c ft fc _ lt lc1 lc2):rels') = Relation ft fc t c Many lt lc2 lc1 : rel : addMirrorRelation rels' + addMirrorRelation = concatMap (\rel@(Relation t c ft fc _ lt lc1 lc2) -> [rel, Relation ft fc t c Many lt lc2 lc1]) link2Relation [ Relation{relTable=lt, relColumns=lc1, relFTable=t, relFColumns=c}, Relation{ relColumns=lc2, relFTable=ft, relFColumns=fc} @@ -278,25 +322,11 @@ | otherwise = Nothing link2Relation _ = Nothing -raiseRelations :: Schema -> [(Column,Column)] -> [Relation] -> [Relation] -raiseRelations schema syns = map raiseRel - where - raiseRel rel - | tableSchema table == schema = rel - | isJust newCols = rel{relFTable=fromJust newTable,relFColumns=fromJust newCols} - | otherwise = rel - where - cols = relFColumns rel - table = relFTable rel - newCols = listToMaybe $ filter ((== schema) . tableSchema . colTable . unsafeHead) (synonymousColumns syns cols) - newTable = (colTable . unsafeHead) <$> newCols - -synonymousPrimaryKeys :: [(Column,Column)] -> [PrimaryKey] -> [PrimaryKey] -synonymousPrimaryKeys _ [] = [] -synonymousPrimaryKeys syns (key:keys) = key : newKeys ++ synonymousPrimaryKeys syns keys - where - keySyns = filter ((\c -> colTable c == pkTable key && colName c == pkName key) . fst) syns - newKeys = map ((\c -> PrimaryKey{pkTable=colTable c,pkName=colName c}) . snd) keySyns +addViewPrimaryKeys :: [Synonym] -> [PrimaryKey] -> [PrimaryKey] +addViewPrimaryKeys syns = concatMap (\pk -> + let viewPks = (\(_, viewCol) -> PrimaryKey{pkTable=colTable viewCol, pkName=colName viewCol}) <$> + filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) syns in + pk : viewPks) allTables :: H.Query () [Table] allTables = @@ -316,7 +346,7 @@ AND (pg_trigger.tgtype::integer & 69) = 69) ) AS insertable FROM pg_class c JOIN pg_namespace n ON n.oid = c.relnamespace - WHERE c.relkind IN ('v','r','m') + WHERE c.relkind IN ('v','r','m','f') AND n.nspname NOT IN ('pg_catalog', 'information_schema') GROUP BY table_schema, table_name, insertable ORDER BY table_schema, table_name |] @@ -508,8 +538,8 @@ parseEnum :: Maybe Text -> [Text] parseEnum str = fromMaybe [] $ split (==',') <$> str -allRelations :: [Table] -> [Column] -> H.Query () [Relation] -allRelations tabs cols = +allChildRelations :: [Table] -> [Column] -> H.Query () [Relation] +allChildRelations tabs cols = H.statement sql HE.unit (decodeRelations tabs cols) True where sql = [q| @@ -659,7 +689,7 @@ pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs -allSynonyms :: [Column] -> H.Query () [(Column,Column)] +allSynonyms :: [Column] -> H.Query () [Synonym] allSynonyms cols = H.statement sql HE.unit (decodeSynonyms cols) True where @@ -734,7 +764,7 @@ order by c.view_schema, c.view_name, c.table_name, c.view_column_name |] -synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column) +synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe Synonym synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2 where col1 = findCol s1 t1 c1 @@ -746,3 +776,17 @@ where sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')" versionRow = HD.singleRow $ PgVersion <$> HD.value HD.int4 <*> HD.value HD.text + +fillSessionWithSettings :: [(Text, Text)] -> H.Session () +fillSessionWithSettings settings = + -- Send all of the config settings to the set_config function, using pgsql's `unnest` to transform arrays of values + H.query settings $ H.statement "SELECT set_config(k, v, false) FROM unnest($1, $2) AS f1(k, v)" encoder HD.unit False + + where + -- Take a list of (key, value) pairs and encode each as an array to later bind to the query + -- see Insert Many section at https://hackage.haskell.org/package/hasql-1.1.1/docs/Hasql-Encoders.html + encoder = contramap L.unzip $ contrazip2 (vector HE.text) (vector HE.text) + where + vector value = + HE.value $ HE.array $ HE.arrayDimension foldl' $ HE.arrayValue value + diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -39,6 +39,7 @@ NoRelationBetween _ _ -> HT.status400 InvalidRange -> HT.status416 UnknownRelation -> HT.status404 + InvalidFilters -> HT.status405 simpleError :: HT.Status -> [Header] -> Text -> Response simpleError status hdrs message = @@ -107,6 +108,8 @@ "message" .= ("Could not find foreign keys between these entities, No relation found between " <> parent <> " and " <> child :: Text)] toJSON UnsupportedVerb = JSON.object [ "message" .= ("Unsupported HTTP verb" :: Text)] + toJSON InvalidFilters = JSON.object [ + "message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text)] instance JSON.ToJSON P.UsageError where toJSON (P.ConnectionError e) = JSON.object [ diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -5,7 +5,7 @@ module PostgREST.Middleware where import Crypto.JWT -import Data.Aeson (Value (..)) +import qualified Data.Aeson as JSON import qualified Data.HashMap.Strict as M import qualified Hasql.Transaction as H @@ -32,7 +32,7 @@ JWTInvalid e -> return $ unauthed $ show e JWTMissingSecret -> return $ simpleError status500 [] "Server lacks JWT secret" JWTClaims claims -> do - H.sql $ toS.mconcat $ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql + H.sql $ toS.mconcat $ setSchemaSql ++ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql mapM_ H.sql customReqCheck app req where @@ -41,9 +41,10 @@ claimsSql = map (pgFmtEnvVar "request.jwt.claim.") [(c,unquoted v) | (c,v) <- M.toList claimsWithRole] setRoleSql = maybeToList $ (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole + setSchemaSql = ["set schema " <> pgFmtLit (configSchema conf) <> ";"] :: [Text] -- role claim defaults to anon if not specified in jwt claimsWithRole = M.union claims (M.singleton "role" anon) - anon = String . toS $ configAnonRole conf + anon = JSON.String . toS $ configAnonRole conf customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf where unauthed message = simpleError diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -260,7 +260,7 @@ & description ?~ d) & externalDocs ?~ ((mempty :: ExternalDocs) & description ?~ "PostgREST Documentation" - & url .~ URL ("https://postgrest.com/en/" <> docsVersion <> "/api.html")) + & url .~ URL ("https://postgrest.org/en/" <> docsVersion <> "/api.html")) & host .~ h' & definitions .~ fromList (map (makeTableDef pks) ti) & parameters .~ fromList (makeParamDefs ti) diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -8,20 +8,21 @@ import Data.List (init, last) import Data.Tree import Data.Either.Combinators (mapLeft) -import PostgREST.RangeQuery (NonnegRange,allRange) +import PostgREST.RangeQuery (NonnegRange) import PostgREST.Types import Text.ParserCombinators.Parsec hiding (many, (<|>)) import Text.Parsec.Error +import Text.Read (read) -pRequestSelect :: Text -> Text -> Either ApiRequestError ReadRequest -pRequestSelect rootName selStr = - mapError $ parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr) +pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem] +pRequestSelect selStr = + mapError $ parse pFieldForest ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr) pRequestFilter :: (Text, Text) -> Either ApiRequestError (EmbedPath, Filter) pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper) where treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k - oper = parse (pOpExpr pSingleVal pListVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v + oper = parse (pOpExpr pSingleVal) ("failed to parse filter (" ++ toS v ++ ")") $ toS v path = fst <$> treePath fld = snd <$> treePath @@ -47,33 +48,12 @@ -- Concat op and v to make pLogicTree argument regular, in the form of "?and=and(.. , ..)" instead of "?and=(.. , ..)" logicTree = join $ parse pLogicTree ("failed to parse logic tree (" ++ toS v ++ ")") . toS <$> ((<>) <$> op <*> pure v) -pRequestRpcQParam :: (Text, Text) -> Either ApiRequestError RpcQParam -pRequestRpcQParam (k, v) = mapError $ (,) <$> name <*> val - where - name = parse pFieldName ("failed to parse rpc arg name (" ++ toS k ++ ")") $ toS k - val = toS <$> parse (many anyChar) ("failed to parse rpc arg value (" ++ toS v ++ ")") v - ws :: Parser Text ws = toS <$> many (oneOf " \t") lexeme :: Parser a -> Parser a lexeme p = ws *> p <* ws -pReadRequest :: Text -> Parser ReadRequest -pReadRequest rootNodeName = do - fieldTree <- pFieldForest - return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing, Nothing)) []) fieldTree - where - readQuery = Select [] [rootNodeName] [] Nothing allRange - treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest - treeEntry (Node fld@((fn, _),_,alias,relationDetail) fldForest) (Node (q, i) rForest) = - case fldForest of - [] -> Node (q {select=fld:select q}, i) rForest - _ -> Node (q, i) newForest - where - newForest = - foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias, relationDetail)) []) fldForest:rForest - pTreePath :: Parser (EmbedPath, Field) pTreePath = do p <- pFieldName `sepBy1` pDelimiter @@ -82,16 +62,14 @@ pFieldForest :: Parser [Tree SelectItem] pFieldForest = pFieldTree `sepBy1` lexeme (char ',') - -pFieldTree :: Parser (Tree SelectItem) -pFieldTree = try (Node <$> pRelationSelect <*> between (char '{') (char '}') pFieldForest) -- TODO: "{}" deprecated - <|> try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) - <|> Node <$> pFieldSelect <*> pure [] + where + pFieldTree :: Parser (Tree SelectItem) + pFieldTree = try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) <|> + Node <$> pFieldSelect <*> pure [] pStar :: Parser Text pStar = toS <$> (string "*" *> pure ("*"::ByteString)) - pFieldName :: Parser Text pFieldName = do matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) "field name (* or [a..z0..9_])" @@ -136,13 +114,13 @@ s <- pStar return ((s, Nothing), Nothing, Nothing, Nothing) -pOpExpr :: Parser SingleVal -> Parser ListVal -> Parser OpExpr -pOpExpr pSVal pLVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation +pOpExpr :: Parser SingleVal -> Parser OpExpr +pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation where pOperation :: Parser Operation pOperation = Op . toS <$> foldl1 (<|>) (try . ((<* pDelimiter) . string) . toS <$> M.keys ops) <*> pSVal - <|> In <$> (string "in" *> pDelimiter *> pLVal) + <|> In <$> (try (string "in" *> pDelimiter) *> pListVal) <|> pFts "operator (eq, gt, ...)" @@ -158,8 +136,7 @@ pSingleVal = toS <$> many anyChar pListVal :: Parser ListVal -pListVal = try (lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')')) - <|> lexeme pListElement `sepBy1` char ',' -- TODO: "in.3,4,5" deprecated, parens e.g. "in.(3,4,5)" should be used +pListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')') pListElement :: Parser Text pListElement = try pQuotedValue <|> (toS <$> many (noneOf ",)")) @@ -171,30 +148,29 @@ pDelimiter = char '.' "delimiter (.)" pOrder :: Parser [OrderTerm] -pOrder = lexeme pOrderTerm `sepBy` char ',' +pOrder = lexeme pOrderTerm `sepBy1` char ',' pOrderTerm :: Parser OrderTerm -pOrderTerm = - try ( do - c <- pField - d <- optionMaybe (try $ pDelimiter *> ( - try(string "asc" *> pure OrderAsc) - <|> try(string "desc" *> pure OrderDesc) - )) - nls <- optionMaybe (pDelimiter *> ( - try(string "nullslast" *> pure OrderNullsLast) - <|> try(string "nullsfirst" *> pure OrderNullsFirst) - )) - return $ OrderTerm c d nls - ) - <|> OrderTerm <$> pField <*> pure Nothing <*> pure Nothing +pOrderTerm = do + fld <- pField + dir <- optionMaybe $ + try (pDelimiter *> string "asc" $> OrderAsc) <|> + try (pDelimiter *> string "desc" $> OrderDesc) + nls <- optionMaybe pNulls <* pEnd <|> + pEnd $> Nothing + return $ OrderTerm fld dir nls + where + pNulls = try (pDelimiter *> string "nullsfirst" $> OrderNullsFirst) <|> + try (pDelimiter *> string "nullslast" $> OrderNullsLast) + pEnd = try (void $ lookAhead (char ',')) <|> + try eof pLogicTree :: Parser LogicTree pLogicTree = Stmnt <$> try pLogicFilter <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')')) where pLogicFilter :: Parser Filter - pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal pLogicListVal + pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal pNot :: Parser Bool pNot = try (string "not" *> pDelimiter *> pure True) <|> pure False @@ -207,7 +183,6 @@ pLogicSingleVal :: Parser SingleVal pLogicSingleVal = try pQuotedValue <|> try pPgArray <|> (toS <$> many (noneOf ",)")) where - -- TODO: "{}" deprecated, after removal pPgArray can be removed pPgArray :: Parser Text pPgArray = do a <- string "{" @@ -215,9 +190,6 @@ c <- string "}" toS <$> pure (a ++ b ++ c) -pLogicListVal :: Parser ListVal -pLogicListVal = lexeme (char '(') *> pListElement `sepBy1` char ',' <* lexeme (char ')') - pLogicPath :: Parser (EmbedPath, Text) pLogicPath = do path <- pFieldName `sepBy1` pDelimiter @@ -234,3 +206,25 @@ message = show $ errorPos e details = strip $ replace "\n" " " $ toS $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e) + +-- Used for the config value "role-claim-key" +pRoleClaimKey :: Text -> Either ApiRequestError JSPath +pRoleClaimKey selStr = + mapError $ parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr) + +pJSPath :: Parser JSPath +pJSPath = toJSPath <$> (period *> pPath `sepBy` period <* eof) + where + toJSPath :: [(Text, Maybe Int)] -> JSPath + toJSPath = concatMap (\(key, idx) -> JSPKey key : maybeToList (JSPIdx <$> idx)) + period = char '.' "period (.)" + pPath :: Parser (Text, Maybe Int) + pPath = (,) <$> pJSPKey <*> optionMaybe pJSPIdx + +pJSPKey :: Parser Text +pJSPKey = toS <$> (many1 (alphaNum <|> oneOf "_$@") <|> pQuoted) "attribute name [a..z0..9_$@])" + where + pQuoted = char '"' *> many (noneOf "\"") <* char '"' + +pJSPIdx :: Parser Int +pJSPIdx = char '[' *> (read <$> many1 digit) <* char ']' "array index [0..n]" diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : PostgREST.QueryBuilder @@ -30,15 +32,14 @@ import qualified Data.Aeson as JSON import PostgREST.Config (pgVersion96) -import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset, allRange) -import Data.Functor.Contravariant (contramap) +import PostgREST.RangeQuery (rangeLimit, rangeOffset, allRange) 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 +77,6 @@ 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 +98,12 @@ | 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 @@ -129,7 +123,7 @@ "'' AS total_result_set", -- when updateing it does not make sense "pg_catalog.count(_postgrest_t) AS page_total", if wantHdrs - then locationF pKeys + then "coalesce(" <> locationF pKeys <> ", " <> noLocationF <> ")" else noLocationF <> " AS header", if rep == Full then bodyF <> " AS body" @@ -142,14 +136,18 @@ | otherwise = asJsonF type ProcResults = (Maybe Int64, Int64, ByteString, ByteString) -callProc :: QualifiedIdentifier -> JSON.Object -> Bool -> SqlQuery -> SqlQuery -> Bool -> - Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> H.Query () (Maybe ProcResults) -callProc qi params returnsScalar selectQuery countQuery countTotal isSingle paramsAsJson asCsv asBinary isReadOnly binaryField pgVer = - unicodeStatement sql HE.unit decodeProc True +callProc :: QualifiedIdentifier -> [PgArg] -> Bool -> SqlQuery -> SqlQuery -> 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 binaryField isObject pgVer = + unicodeStatement sql (HE.value HE.unknown) decodeProc True where sql = if returnsScalar then [qc| - WITH {sourceCTEName} AS (select {fromQi qi}({_args})) + WITH {argsRecord}, + {sourceCTEName} AS ( + SELECT {fromQi qi}({args}) + ) SELECT {countResultF} AS total_result_set, 1 AS page_total, @@ -157,7 +155,10 @@ {responseHeaders} AS response_headers FROM ({selectQuery}) _postgrest_t;|] else [qc| - WITH {sourceCTEName} AS (select * from {fromQi qi}({_args})) + WITH {argsRecord}, + {sourceCTEName} AS ( + SELECT * FROM {fromQi qi}({args}) + ) SELECT {countResultF} AS total_result_set, pg_catalog.count(_postgrest_t) AS page_total, @@ -165,12 +166,17 @@ {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 -> 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 - _args = if paramsAsJson && not isReadOnly - then insertableValueWithType "json" $ JSON.Object params - else intercalate "," $ map _assignment (HM.toList params) _procName = qiName qi - _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v responseHeaders = if pgVer >= pgVersion96 then "coalesce(nullif(current_setting('response.headers', true), ''), '[]')" :: Text -- nullif is used because of https://gist.github.com/steve-chavez/8d7033ea5655096903f3b52f8ed09a15 @@ -202,65 +208,61 @@ requestToCountQuery :: Schema -> DbRequest -> SqlQuery requestToCountQuery _ (DbMutate _) = undefined -requestToCountQuery schema (DbRead (Node (Select _ _ logicForest _ _, (mainTbl, _, _, _)) _)) = +requestToCountQuery schema (DbRead (Node (Select{where_=logicForest}, (mainTbl, _, _, _, _)) _)) = unwords [ "SELECT pg_catalog.count(*)", "FROM ", fromQi qi, - ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) filteredLogic)) `emptyOnFalse` null filteredLogic + ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest ] where qi = removeSourceCTESchema schema mainTbl - -- all foreing key filters are root nodes(see addFilterToLogicForest), only those are filtered - nonFKRoot :: LogicTree -> Bool - nonFKRoot (Stmnt (Filter _ (OpExpr _ (Join _ _)))) = False - nonFKRoot (Stmnt _) = True - nonFKRoot Expr{} = True - filteredLogic = filter nonFKRoot logicForest requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery -requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest ord range, (nodeName, maybeRelation, _, _)) forest)) = - query +requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest joinConditions_ ordts range, (nodeName, maybeRelation, _, _, depth)) forest)) = + unwords [ + "SELECT " <> intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), + "FROM " <> intercalate ", " tables, + unwords joins, + ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConds)) + `emptyOnFalse` (null logicForest && null joinConds), + ("ORDER BY " <> intercalate ", " (map (pgFmtOrderTerm qi) ordts)) `emptyOnFalse` null ordts, + ("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ] + where mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation) - qi = removeSourceCTESchema schema mainTbl - toQi = removeSourceCTESchema schema - query = unwords [ - "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), - "FROM ", intercalate ", " (map (fromQi . toQi) tbls), - unwords joins, - ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest, - orderF (fromMaybe [] ord), - if isParent then "" else limitF range - ] - orderF ts = - if null ts - then "" - else "ORDER BY " <> clause - where - clause = intercalate "," (map queryTerm ts) - queryTerm :: OrderTerm -> Text - queryTerm t = " " - <> toS (pgFmtField qi $ otTerm t) <> " " - <> maybe "" show (otDirection t) <> " " - <> maybe "" show (otNullOrder t) <> " " + isSelfJoin = maybe False (\r -> relType r /= Root && relTable r == relFTable r) maybeRelation + (qi, tables, joinConds) = + let depthAlias name dpth = if dpth /= 0 then name <> "_" <> show dpth else name in -- Root node doesn't get aliased + if isSelfJoin + then ( + QualifiedIdentifier "" (depthAlias mainTbl depth), + (\t -> fromQi (removeSourceCTESchema schema t) <> " AS " <> pgFmtIdent (depthAlias t depth)) <$> tbls, + (\(JoinCondition (qi1, _, c1) (qi2, _, c2)) -> + JoinCondition (qi1, Just $ depthAlias (qiName qi1) depth, c1) + (qi2, Just $ depthAlias (qiName qi2) (depth - 1), c2)) <$> joinConditions_) + else ( + removeSourceCTESchema schema mainTbl, + fromQi . removeSourceCTESchema schema <$> tbls, + joinConditions_) + (joins, selects) = foldr getQueryParts ([],[]) forest getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment]) - getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s) + getQueryParts (Node n@(_, (name, Just Relation{relType=Child,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (j,sel:s) where sel = "COALESCE((" <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) " <> "FROM (" <> subquery <> ") " <> pgFmtIdent table <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias) where subquery = requestToQuery schema False (DbRead (Node n forst)) - getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (joi:j,sel:s) + getQueryParts (Node n@(_, (name, Just Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (joi:j,sel:s) where aliasOrName = fromMaybe name alias localTableName = pgFmtIdent $ table <> "_" <> aliasOrName sel = "row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName joi = " LEFT JOIN LATERAL( " <> subquery <> " ) AS " <> localTableName <> " ON TRUE " where subquery = requestToQuery schema True (DbRead (Node n forst)) - getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (j,sel:s) + getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias, _, _)) forst) (j,s) = (j,sel:s) where sel = "COALESCE ((" <> "SELECT json_agg(" <> pgFmtIdent table <> ".*) " @@ -271,45 +273,65 @@ --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 assignments = map - (\(k,v) -> pgFmtIdent k <> "=" <> insertableValue v) $ HM.toList obj in +requestToQuery schema _ (DbMutate (Insert mainTbl pkCols p@(PayloadJSON _ pType pKeys) onConflct logicForest 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) _", + -- Only used for PUT + ("WHERE " <> intercalate " AND " (pgFmtLogicTree (QualifiedIdentifier "" "_") <$> logicForest)) `emptyOnFalse` null logicForest], + maybe "" (\x -> ( + "ON CONFLICT(" <> intercalate ", " pkCols <> ") " <> case x of + IgnoreDuplicates -> + "DO NOTHING" + MergeDuplicates -> + "DO UPDATE SET " <> intercalate ", " (pgFmtIdent <> const " = EXCLUDED." <> pgFmtIdent <$> S.toList pKeys) + ) `emptyOnFalse` null pkCols) onConflct, + ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings] + where + qi = QualifiedIdentifier schema mainTbl + cols = intercalate ", " $ pgFmtIdent <$> S.toList pKeys + 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 " <> intercalate "," assignments <> " ", + "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. +-- The error also happens on raw libpq used with C. +ignoredBody :: SqlFragment +ignoredBody = "ignored_body AS (SELECT $1::text) " + removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl @@ -345,24 +367,12 @@ asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')" locationF :: [Text] -> SqlFragment -locationF pKeys = - "(" <> - " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceCTEName <> " as ss limit 1)" <> - " SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null'))" <> - " FROM s, json_each_text(s.r) AS json_data" <> - ( - if null pKeys - then "" - else " WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')" - ) <> ")" - -limitF :: NonnegRange -> SqlFragment -limitF r = if r == allRange - then "" - else "LIMIT " <> limit <> " OFFSET " <> offset - where - limit = maybe "ALL" show $ rangeLimit r - offset = show $ rangeOffset r +locationF pKeys = [qc|( + WITH data AS (SELECT row_to_json(_) AS row FROM {sourceCTEName} AS _ LIMIT 1) + SELECT array_agg(json_data.key || '=' || coalesce('eq.' || json_data.value, 'is.null')) + FROM data CROSS JOIN json_each_text(data.row) AS json_data + {("WHERE json_data.key IN ('" <> intercalate "','" pKeys <> "')") `emptyOnFalse` null pKeys} +)|] fromQi :: QualifiedIdentifier -> SqlFragment fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n @@ -376,14 +386,6 @@ emptyOnFalse :: Text -> Bool -> Text emptyOnFalse val cond = if cond then "" else val -insertableValue :: JSON.Value -> SqlFragment -insertableValue JSON.Null = "null" -insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v - -insertableValueWithType :: Text -> JSON.Value -> SqlFragment -insertableValueWithType t v = - pgFmtLit (unquoted v) <> "::" <> t - pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment pgFmtColumn table "*" = fromQi table <> ".*" pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c @@ -395,6 +397,12 @@ pgFmtSelectItem table (f@(_, jp), Nothing, alias, _) = pgFmtField table f <> pgFmtAs jp alias pgFmtSelectItem table (f@(_, jp), Just cast, alias, _) = "CAST (" <> pgFmtField table f <> " AS " <> cast <> " )" <> pgFmtAs jp alias +pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SqlFragment +pgFmtOrderTerm qi ot = unwords [ + toS . pgFmtField qi $ otTerm ot, + maybe "" show $ otDirection ot, + maybe "" show $ otNullOrder ot] + pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of Op op val -> pgFmtFieldOp op <> " " <> case op of @@ -416,9 +424,6 @@ <> maybe "" ((<> ", ") . pgFmtLit) lang <> unknownLiteral val <> ") " - - Join fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName}) -> - pgFmtField fQi fld <> " = " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName where pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op sqlOperator o = HM.lookupDefault "=" o operators @@ -429,6 +434,13 @@ whiteList v = fromMaybe (toS (pgFmtLit v) <> "::unknown ") (find ((==) . toLower $ v) ["null","true","false"]) + +pgFmtJoinCondition :: JoinCondition -> SqlFragment +pgFmtJoinCondition (JoinCondition (qi, al1, col1) (QualifiedIdentifier schema fTable, al2, col2)) = + pgFmtColumn (fromMaybe qi $ aliasToQi al1) col1 <> " = " <> + pgFmtColumn (fromMaybe (removeSourceCTESchema schema fTable) $ aliasToQi al2) col2 + where + aliasToQi al = QualifiedIdentifier "" <$> al pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment pgFmtLogicTree qi (Expr hasNot op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")" diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -2,12 +2,12 @@ module PostgREST.Types where import Protolude import qualified GHC.Show -import Data.Aeson +import qualified Data.Aeson as JSON import qualified Data.ByteString.Lazy as BL import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as M +import qualified Data.Set as S import Data.Tree -import qualified Data.Vector as V import PostgREST.RangeQuery (NonnegRange) import Network.HTTP.Types.Header (hContentType, Header) @@ -23,29 +23,44 @@ | UnknownRelation | NoRelationBetween Text Text | UnsupportedVerb + | InvalidFilters deriving (Show, Eq) +data PreferResolution = MergeDuplicates | IgnoreDuplicates deriving Eq +instance Show PreferResolution where + show MergeDuplicates = "resolution=merge-duplicates" + show IgnoreDuplicates = "resolution=ignore-duplicates" + data DbStructure = DbStructure { dbTables :: [Table] , dbColumns :: [Column] , dbRelations :: [Relation] , dbPrimaryKeys :: [PrimaryKey] -, dbProcs :: M.HashMap Text ProcDescription +-- ProcDescription is a list because a function can be overloaded +, dbProcs :: M.HashMap Text [ProcDescription] , pgVersion :: PgVersion } deriving (Show, Eq) +-- TODO Table could hold references to all its Columns +tableCols :: DbStructure -> Schema -> TableName -> [Column] +tableCols dbs tSchema tName = filter (\Column{colTable=Table{tableSchema=s, tableName=t}} -> s==tSchema && t==tName) $ dbColumns dbs + +-- TODO Table could hold references to all its PrimaryKeys +tablePKCols :: DbStructure -> Schema -> TableName -> [Text] +tablePKCols dbs tSchema tName = pkName <$> filter (\pk -> tSchema == (tableSchema . pkTable) pk && tName == (tableName . pkTable) pk) (dbPrimaryKeys dbs) + data PgArg = PgArg { pgaName :: Text , pgaType :: Text , pgaReq :: Bool -} deriving (Show, Eq) +} deriving (Show, Eq, Ord) -data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show) +data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show, Ord) -data RetType = Single PgType | SetOf PgType deriving (Eq, Show) +data RetType = Single PgType | SetOf PgType deriving (Eq, Show, Ord) data ProcVolatility = Volatile | Stable | Immutable - deriving (Eq, Show) + deriving (Eq, Show, Ord) data ProcDescription = ProcDescription { pdName :: Text @@ -55,11 +70,17 @@ , pdVolatility :: ProcVolatility } deriving (Show, Eq) +-- Order by least number of args in the case of overloaded functions +instance Ord ProcDescription where + ProcDescription name1 des1 args1 rt1 vol1 `compare` ProcDescription name2 des2 args2 rt2 vol2 + | name1 == name2 && length args1 < length args2 = LT + | name1 == name2 && length args1 > length args2 = GT + | otherwise = (name1, des1, args1, rt1, vol1) `compare` (name2, des2, args2, rt2, vol2) + type Schema = Text type TableName = Text type SqlQuery = Text type SqlFragment = Text -type RequestBody = BL.ByteString data Table = Table { tableSchema :: Schema @@ -86,7 +107,9 @@ , colFK :: Maybe ForeignKey } deriving (Show, Ord) -type Synonym = (Column,Column) +-- | A view column that refers to a table column +type Synonym = (Column, ViewColumn) +type ViewColumn = Column data PrimaryKey = PrimaryKey { pkTable :: Table @@ -95,13 +118,13 @@ data OrderDirection = OrderAsc | OrderDesc deriving (Eq) instance Show OrderDirection where - show OrderAsc = "asc" - show OrderDesc = "desc" + show OrderAsc = "ASC" + show OrderDesc = "DESC" data OrderNulls = OrderNullsFirst | OrderNullsLast deriving (Eq) instance Show OrderNulls where - show OrderNullsFirst = "nulls first" - show OrderNullsLast = "nulls last" + show OrderNullsFirst = "NULLS FIRST" + show OrderNullsLast = "NULLS LAST" data OrderTerm = OrderTerm { otTerm :: Field @@ -112,7 +135,7 @@ data QualifiedIdentifier = QualifiedIdentifier { qiSchema :: Schema , qiName :: TableName -} deriving (Show, Eq) +} deriving (Show, Eq, Ord) data RelationType = Child | Parent | Many | Root deriving (Show, Eq) @@ -128,19 +151,30 @@ , relFTable :: Table , relFColumns :: [Column] , relType :: RelationType -, relLTable :: Maybe Table -, relLCols1 :: Maybe [Column] -, relLCols2 :: Maybe [Column] +-- The Link attrs are used when RelationType == Many +, relLinkTable :: Maybe Table +, relLinkCols1 :: Maybe [Column] +, relLinkCols2 :: Maybe [Column] } deriving (Show, Eq) --- | An array of JSON objects that has been verified to have --- the same keys in every object -newtype PayloadJSON = PayloadJSON (V.Vector Object) - deriving (Show, Eq) +-- | Cached attributes of a JSON payload +data PayloadJSON = PayloadJSON { +-- | This is the raw ByteString that comes from the request body. +-- We cache this instead of an Aeson Value because it was detected that for large payloads the encoding +-- had high memory usage, see #1005 for more details + pjRaw :: BL.ByteString +, pjType :: PJType +-- | Keys of the object or if it's an array these keys are guaranteed to be the same across all its objects +, pjKeys :: S.Set Text +} deriving (Show, Eq) -unPayloadJSON :: PayloadJSON -> V.Vector Object -unPayloadJSON (PayloadJSON objs) = objs +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 @@ -168,14 +202,10 @@ ("sr", ">>"), ("nxr", "&<"), ("nxl", "&>"), - ("adj", "-|-"), - -- TODO: these are deprecated and should be removed in v0.5.0.0 - ("@>", "@>"), - ("<@", "<@")]) ftsOperators + ("adj", "-|-")]) ftsOperators ftsOperators :: M.HashMap Operator SqlFragment ftsOperators = M.fromList [ - ("@@", "@@ to_tsquery"), -- TODO: '@@' deprecated ("fts", "@@ to_tsquery"), ("plfts", "@@ plainto_tsquery"), ("phfts", "@@ phraseto_tsquery") @@ -184,8 +214,7 @@ data OpExpr = OpExpr Bool Operation deriving (Eq, Show) data Operation = Op Operator SingleVal | In ListVal | - Fts Operator (Maybe Language) SingleVal | - Join QualifiedIdentifier ForeignKey deriving (Eq, Show) + Fts Operator (Maybe Language) SingleVal deriving (Eq, Show) type Language = Text -- | Represents a single value in a filter, e.g. id=eq.singleval @@ -224,10 +253,10 @@ -} newtype GucHeader = GucHeader (Text, Text) -instance FromJSON GucHeader where - parseJSON (Object o) = case headMay (M.toList o) of - Just (k, String s) | M.size o == 1 -> pure $ GucHeader (k, s) - | otherwise -> mzero +instance JSON.FromJSON GucHeader where + parseJSON (JSON.Object o) = case headMay (M.toList o) of + Just (k, JSON.String s) | M.size o == 1 -> pure $ GucHeader (k, s) + | otherwise -> mzero _ -> mzero parseJSON _ = mzero @@ -243,13 +272,17 @@ -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"] type EmbedPath = [Text] data Filter = Filter { field::Field, opExpr::OpExpr } deriving (Show, Eq) +data JoinCondition = JoinCondition (QualifiedIdentifier, Maybe Alias, FieldName) + (QualifiedIdentifier, Maybe Alias, FieldName) deriving (Show, Eq) -data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq) -data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] } +data ReadQuery = Select { select::[SelectItem], from::[TableName], where_::[LogicTree], joinConditions::[JoinCondition], order::[OrderTerm], range_::NonnegRange } deriving (Show, Eq) +data MutateQuery = Insert { in_::TableName, insPkCols::[Text], qPayload::PayloadJSON, onConflict:: Maybe PreferResolution, where_::[LogicTree], returning::[FieldName] } | Delete { in_::TableName, where_::[LogicTree], returning::[FieldName] } | Update { in_::TableName, qPayload::PayloadJSON, where_::[LogicTree], returning::[FieldName] } deriving (Show, Eq) -type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail)) +type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias, Maybe RelationDetail, Depth)) type ReadRequest = Tree ReadNode +-- Depth of the ReadRequest tree +type Depth = Integer type MutateRequest = MutateQuery data DbRequest = DbRead ReadRequest | DbMutate MutateRequest @@ -280,3 +313,8 @@ sourceCTEName :: SqlFragment sourceCTEName = "pg_source" + +-- | full jspath, e.g. .property[0].attr.detail +type JSPath = [JSPathExp] +-- | jspath expression, e.g. .property, .property[0] or ."property-dash" +data JSPathExp = JSPKey Text | JSPIdx Int deriving (Eq, Show) diff --git a/test/Feature/AndOrParamsSpec.hs b/test/Feature/AndOrParamsSpec.hs --- a/test/Feature/AndOrParamsSpec.hs +++ b/test/Feature/AndOrParamsSpec.hs @@ -27,13 +27,13 @@ context "embedded levels" $ do it "can do logic on the second level" $ - get "/entities?child_entities.or=(id.eq.1,name.eq.child entity 2)&select=id,child_entities{id}" `shouldRespondWith` + get "/entities?child_entities.or=(id.eq.1,name.eq.child entity 2)&select=id,child_entities(id)" `shouldRespondWith` [json|[ {"id": 1, "child_entities": [ { "id": 1 }, { "id": 2 } ] }, { "id": 2, "child_entities": []}, {"id": 3, "child_entities": []}, {"id": 4, "child_entities": []} ]|] { matchHeaders = [matchContentTypeJson] } it "can do logic on the third level" $ - get "/entities?child_entities.grandchild_entities.or=(id.eq.1,id.eq.2)&select=id,child_entities{id,grandchild_entities{id}}" `shouldRespondWith` + get "/entities?child_entities.grandchild_entities.or=(id.eq.1,id.eq.2)&select=id,child_entities(id,grandchild_entities(id))" `shouldRespondWith` [json|[ {"id": 1, "child_entities": [ { "id": 1, "grandchild_entities": [ { "id": 1 }, { "id": 2 } ]}, { "id": 2, "grandchild_entities": []}]}, {"id": 2, "child_entities": [ { "id": 3, "grandchild_entities": []} ]}, @@ -79,15 +79,9 @@ {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4" }, {"text_search_vector": "'art':4 'spass':5 'unmog':7"} ]|] { matchHeaders = [matchContentTypeJson] } - -- TODO: remove in 0.5.0 as deprecated - get "/entities?or=(text_search_vector.@@.bar,text_search_vector.@@.baz)&select=id" `shouldRespondWith` - [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] } - it "can handle cs and cd" $ do + it "can handle cs and cd" $ get "/entities?or=(arr.cs.{1,2,3},arr.cd.{1})&select=id" `shouldRespondWith` [json|[{ "id": 1 },{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] } - -- TODO: remove in 0.5.0 as deprecated - get "/entities?or=(arr.@>.{1,2,3},arr.<@.{1})&select=id" `shouldRespondWith` - [json|[{ "id": 1 },{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] } it "can handle range operators" $ do get "/ranges?range=eq.[1,3]&select=id" `shouldRespondWith` @@ -120,24 +114,15 @@ [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] } context "operators with not" $ do - it "eq, cs, like can be negated" $ do + it "eq, cs, like can be negated" $ get "/entities?and=(arr.not.cs.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith` [json|[{ "id": 1}]|] { matchHeaders = [matchContentTypeJson] } - -- TODO: remove in 0.5.0 as deprecated - get "/entities?and=(arr.not.@>.{1,2,3},and(id.not.eq.2,name.not.like.*3))&select=id" `shouldRespondWith` - [json|[{ "id": 1}]|] { matchHeaders = [matchContentTypeJson] } - it "in, is, fts can be negated" $ do + it "in, is, fts can be negated" $ get "/entities?and=(id.not.in.(1,3),and(name.not.is.null,text_search_vector.not.fts.foo))&select=id" `shouldRespondWith` [json|[{ "id": 2}]|] { matchHeaders = [matchContentTypeJson] } - -- TODO: remove in 0.5.0 as deprecated - get "/entities?and=(id.not.in.(1,3),and(name.not.is.null,text_search_vector.not.@@.foo))&select=id" `shouldRespondWith` - [json|[{ "id": 2}]|] { matchHeaders = [matchContentTypeJson] } - it "lt, gte, cd can be negated" $ do + it "lt, gte, cd can be negated" $ get "/entities?and=(arr.not.cd.{1},or(id.not.lt.1,id.not.gte.3))&select=id" `shouldRespondWith` [json|[{"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] } - -- TODO: remove in 0.5.0 as deprecated - get "/entities?and=(arr.not.<@.{1},or(id.not.lt.1,id.not.gte.3))&select=id" `shouldRespondWith` - [json|[{"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] } it "gt, lte, ilike can be negated" $ get "/entities?and=(name.not.ilike.*ITY2,or(id.not.gt.4,id.not.lte.1))&select=id" `shouldRespondWith` [json|[{"id": 1}, {"id": 2}, {"id": 3}]|] { matchHeaders = [matchContentTypeJson] } @@ -182,7 +167,7 @@ context "used with POST" $ it "includes related data with filters" $ - request methodPost "/child_entities?entities.or=(id.eq.2,id.eq.3)&select=id,entities{id}" + request methodPost "/child_entities?entities.or=(id.eq.2,id.eq.3)&select=id,entities(id)" [("Prefer", "return=representation")] [json|[{"id":4,"name":"entity 4","parent_id":1}, {"id":5,"name":"entity 5","parent_id":2}, diff --git a/test/Feature/DeleteSpec.hs b/test/Feature/DeleteSpec.hs --- a/test/Feature/DeleteSpec.hs +++ b/test/Feature/DeleteSpec.hs @@ -36,7 +36,7 @@ request methodDelete "/complex_items?id=eq.3&select=ciId:id::text,ciName:name" [("Prefer", "return=representation")] "" `shouldRespondWith` [str|[{"ciId":"3","ciName":"Three"}]|] it "can embed (parent) entities" $ - request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] "" + request methodDelete "/tasks?id=eq.8&select=id,name,project(id)" [("Prefer", "return=representation")] "" `shouldRespondWith` [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|] { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/*"] diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -49,9 +49,15 @@ , matchHeaders = [matchContentTypeJson] } + context "non uniform json array" $ do + it "rejects json array that isn't exclusivily composed of objects" $ + post "/articles" [json| [{"id": 100, "body": "xxxxx"}, 123, "xxxx", {"id": 111, "body": "xxxx"}] |] `shouldRespondWith` 400 + it "rejects json array that has objects with different keys" $ + post "/articles" [json| [{"id": 100, "body": "xxxxx"}, {"id": 111, "body": "xxxx", "owner": "me"}] |] `shouldRespondWith` 400 + context "requesting full representation" $ do it "includes related data after insert" $ - request methodPost "/projects?select=id,name,clients{id,name}" + request methodPost "/projects?select=id,name,clients(id,name)" [("Prefer", "return=representation"), ("Prefer", "count=exact")] [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|] { matchStatus = 201 @@ -416,13 +422,21 @@ -- put value back for other tests void $ request methodPatch "/items?id=eq.99" [] [json| { "id":1 } |] - it "makes no updates and returns 204, when patching with an empty json object" $ do + it "makes no updates and returns 204, when patching with an empty json object/array" $ do request methodPatch "/items" [] [json| {} |] `shouldRespondWith` "" { matchStatus = 204, matchHeaders = ["Content-Range" <:> "*/*"] } + + request methodPatch "/items" [] [json| [] |] + `shouldRespondWith` "" + { + matchStatus = 204, + matchHeaders = ["Content-Range" <:> "*/*"] + } + get "/items" `shouldRespondWith` [json|[{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}]|] { matchHeaders = [matchContentTypeJson] } diff --git a/test/Feature/QueryLimitedSpec.hs b/test/Feature/QueryLimitedSpec.hs --- a/test/Feature/QueryLimitedSpec.hs +++ b/test/Feature/QueryLimitedSpec.hs @@ -29,14 +29,14 @@ simpleStatus r `shouldBe` ok200 it "limit works on all levels" $ - get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc" + get "/users?select=id,tasks(id)&order=id.asc&tasks.order=id.asc" `shouldRespondWith` [json|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|] { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] } it "limit is not applied to parent embeds" $ - get "/tasks?select=id,project{id}&id=gt.5" + get "/tasks?select=id,project(id)&id=gt.5" `shouldRespondWith` [json|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|] { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -50,12 +50,12 @@ { matchHeaders = ["Content-Range" <:> "0-1/*"] } it "matches items IN" $ - get "/items?id=in.1,3,5" + get "/items?id=in.(1,3,5)" `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |] { matchHeaders = ["Content-Range" <:> "0-2/*"] } it "matches items NOT IN using not operator" $ - get "/items?id=not.in.2,4,6,7,8,9,10,11,12,13,14,15" + get "/items?id=not.in.(2,4,6,7,8,9,10,11,12,13,14,15)" `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |] { matchHeaders = ["Content-Range" <:> "0-2/*"] } @@ -145,22 +145,6 @@ {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|] { matchHeaders = [matchContentTypeJson] } - -- TODO: remove in 0.5.0 as deprecated - it "Deprecated @@ operator, pending to remove" $ do - get "/tsearch?text_search_vector=@@.impossible" `shouldRespondWith` - [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |] - { matchHeaders = [matchContentTypeJson] } - get "/tsearch?text_search_vector=not.@@.impossible%7Cfat%7Cfun" `shouldRespondWith` - [json| [ - {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"}, - {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|] - { matchHeaders = [matchContentTypeJson] } - get "/tsearch?text_search_vector=not.@@(english).impossible%7Cfat%7Cfun" `shouldRespondWith` - [json| [ - {"text_search_vector": "'amus':5 'fair':7 'impossibl':9 'peu':4"}, - {"text_search_vector": "'art':4 'spass':5 'unmog':7"}]|] - { matchHeaders = [matchContentTypeJson] } - it "matches with computed column" $ get "/items?always_true=eq.true&order=id.asc" `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |] @@ -171,37 +155,31 @@ [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |] { matchHeaders = [matchContentTypeJson] } + it "cannot access a computed column that is outside of the config schema" $ + get "/items?always_false=is.false" `shouldRespondWith` 400 + it "matches filtering nested items 2" $ - get "/clients?select=id,projects{id,tasks2{id,name}}&projects.tasks.name=like.Design*" + get "/clients?select=id,projects(id,tasks2(id,name))&projects.tasks.name=like.Design*" `shouldRespondWith` [json| {"message":"Could not find foreign keys between these entities, No relation found between projects and tasks2"}|] { matchStatus = 400 , matchHeaders = [matchContentTypeJson] } it "matches filtering nested items" $ - get "/clients?select=id,projects{id,tasks{id,name}}&projects.tasks.name=like.Design*" `shouldRespondWith` + get "/clients?select=id,projects(id,tasks(id,name))&projects.tasks.name=like.Design*" `shouldRespondWith` [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1,"name":"Design w7"}]},{"id":2,"tasks":[{"id":3,"name":"Design w10"}]}]},{"id":2,"projects":[{"id":3,"tasks":[{"id":5,"name":"Design IOS"}]},{"id":4,"tasks":[{"id":7,"name":"Design OSX"}]}]}]|] { matchHeaders = [matchContentTypeJson] } - it "matches with cs operator" $ do + it "matches with cs operator" $ get "/complex_items?select=id&arr_data=cs.{2}" `shouldRespondWith` [json|[{"id":2},{"id":3}]|] { matchHeaders = [matchContentTypeJson] } - -- TODO: remove in 0.5.0 as deprecated - get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith` - [json|[{"id":2},{"id":3}]|] - { matchHeaders = [matchContentTypeJson] } - it "matches with cd operator" $ do + it "matches with cd operator" $ get "/complex_items?select=id&arr_data=cd.{1,2,4}" `shouldRespondWith` [json|[{"id":1},{"id":2}]|] { matchHeaders = [matchContentTypeJson] } - -- TODO: remove in 0.5.0 as deprecated - get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith` - [json|[{"id":1},{"id":2}]|] - { matchHeaders = [matchContentTypeJson] } - describe "Shaping response with select parameter" $ do it "selectStar works in absense of parameter" $ @@ -285,12 +263,12 @@ { matchHeaders = [matchContentTypeJson] } it "requesting parents and children" $ - get "/projects?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith` + get "/projects?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|] { matchHeaders = [matchContentTypeJson] } it "requesting parent without specifying primary key" $ do - get "/projects?select=name,client{name}" `shouldRespondWith` + get "/projects?select=name,client(name)" `shouldRespondWith` [json|[ {"name":"Windows 7","client":{"name": "Microsoft"}}, {"name":"Windows 10","client":{"name": "Microsoft"}}, @@ -299,12 +277,12 @@ {"name":"Orphan","client":null} ]|] { matchHeaders = [matchContentTypeJson] } - get "/articleStars?select=createdAt,article{owner},user{name}&limit=1" `shouldRespondWith` + get "/articleStars?select=createdAt,article(owner),user(name)&limit=1" `shouldRespondWith` [json|[{"createdAt":"2015-12-08T04:22:57.472738","article":{"owner": "postgrest_test_authenticator"},"user":{"name": "Angela Martin"}}]|] { matchHeaders = [matchContentTypeJson] } it "requesting parent and renaming primary key" $ - get "/projects?select=name,client{clientId:id,name}" `shouldRespondWith` + get "/projects?select=name,client(clientId:id,name)" `shouldRespondWith` [json|[ {"name":"Windows 7","client":{"name": "Microsoft", "clientId": 1}}, {"name":"Windows 10","client":{"name": "Microsoft", "clientId": 1}}, @@ -315,116 +293,270 @@ { matchHeaders = [matchContentTypeJson] } it "requesting parent and specifying/renaming one key of the composite primary key" $ do - get "/comments?select=*,users_tasks{userId:user_id}" `shouldRespondWith` + get "/comments?select=*,users_tasks(userId:user_id)" `shouldRespondWith` [json|[{"id":1,"commenter_id":1,"user_id":2,"task_id":6,"content":"Needs to be delivered ASAP","users_tasks":{"userId": 2}}]|] { matchHeaders = [matchContentTypeJson] } - get "/comments?select=*,users_tasks{taskId:task_id}" `shouldRespondWith` + get "/comments?select=*,users_tasks(taskId:task_id)" `shouldRespondWith` [json|[{"id":1,"commenter_id":1,"user_id":2,"task_id":6,"content":"Needs to be delivered ASAP","users_tasks":{"taskId": 6}}]|] { matchHeaders = [matchContentTypeJson] } it "embed data with two fk pointing to the same table" $ - get "/orders?id=eq.1&select=id, name, billing_address_id{id}, shipping_address_id{id}" `shouldRespondWith` + get "/orders?id=eq.1&select=id, name, billing_address_id(id), shipping_address_id(id)" `shouldRespondWith` [str|[{"id":1,"name":"order 1","billing_address_id":{"id":1},"shipping_address_id":{"id":2}}]|] it "requesting parents and children while renaming them" $ - get "/projects?id=eq.1&select=myId:id, name, project_client:client_id{*}, project_tasks:tasks{id, name}" `shouldRespondWith` + get "/projects?id=eq.1&select=myId:id, name, project_client:client_id(*), project_tasks:tasks(id, name)" `shouldRespondWith` [json|[{"myId":1,"name":"Windows 7","project_client":{"id":1,"name":"Microsoft"},"project_tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|] { matchHeaders = [matchContentTypeJson] } it "requesting parents two levels up while using FK to specify the link" $ - get "/tasks?id=eq.1&select=id,name,project:project_id{id,name,client:client_id{id,name}}" `shouldRespondWith` + get "/tasks?id=eq.1&select=id,name,project:project_id(id,name,client:client_id(id,name))" `shouldRespondWith` [str|[{"id":1,"name":"Design w7","project":{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}}]|] it "requesting parents two levels up while using FK to specify the link (with rename)" $ - get "/tasks?id=eq.1&select=id,name,project:project_id{id,name,client:client_id{id,name}}" `shouldRespondWith` + get "/tasks?id=eq.1&select=id,name,project:project_id(id,name,client:client_id(id,name))" `shouldRespondWith` [str|[{"id":1,"name":"Design w7","project":{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}}]|] - it "requesting parents and filtering parent columns" $ - get "/projects?id=eq.1&select=id, name, clients{id}" `shouldRespondWith` + get "/projects?id=eq.1&select=id, name, clients(id)" `shouldRespondWith` [str|[{"id":1,"name":"Windows 7","clients":{"id":1}}]|] it "rows with missing parents are included" $ - get "/projects?id=in.1,5&select=id,clients{id}" `shouldRespondWith` + get "/projects?id=in.(1,5)&select=id,clients(id)" `shouldRespondWith` [json|[{"id":1,"clients":{"id":1}},{"id":5,"clients":null}]|] { matchHeaders = [matchContentTypeJson] } it "rows with no children return [] instead of null" $ - get "/projects?id=in.5&select=id,tasks{id}" `shouldRespondWith` + get "/projects?id=in.(5)&select=id,tasks(id)" `shouldRespondWith` [str|[{"id":5,"tasks":[]}]|] it "requesting children 2 levels" $ - get "/clients?id=eq.1&select=id,projects{id,tasks{id}}" `shouldRespondWith` - [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|] - { matchHeaders = [matchContentTypeJson] } - - it "requesting children 2 levels (with relation path fixed)" $ - get "/clients?id=eq.1&select=id,projects:projects.client_id{id,tasks{id}}" `shouldRespondWith` + get "/clients?id=eq.1&select=id,projects(id,tasks(id))" `shouldRespondWith` [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|] { matchHeaders = [matchContentTypeJson] } it "requesting many<->many relation" $ - get "/tasks?select=id,users{id}" `shouldRespondWith` - [json|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|] - { matchHeaders = [matchContentTypeJson] } - - it "requesting many<->many relation (with relation path fixed)" $ - get "/tasks?select=id,users:users.users_tasks{id}" `shouldRespondWith` + get "/tasks?select=id,users(id)" `shouldRespondWith` [json|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|] { matchHeaders = [matchContentTypeJson] } it "requesting many<->many relation with rename" $ - get "/tasks?id=eq.1&select=id,theUsers:users{id}" `shouldRespondWith` + get "/tasks?id=eq.1&select=id,theUsers:users(id)" `shouldRespondWith` [json|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|] { matchHeaders = [matchContentTypeJson] } - it "requesting many<->many relation reverse" $ - get "/users?select=id,tasks{id}" `shouldRespondWith` + get "/users?select=id,tasks(id)" `shouldRespondWith` [json|[{"id":1,"tasks":[{"id":1},{"id":2},{"id":3},{"id":4}]},{"id":2,"tasks":[{"id":5},{"id":6},{"id":7}]},{"id":3,"tasks":[{"id":1},{"id":5}]}]|] { matchHeaders = [matchContentTypeJson] } it "requesting parents and children on views" $ - get "/projects_view?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith` + get "/projects_view?id=eq.1&select=id, name, clients(*), tasks(id, name)" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|] { matchHeaders = [matchContentTypeJson] } it "requesting parents and children on views with renamed keys" $ - get "/projects_view_alt?t_id=eq.1&select=t_id, name, clients{*}, tasks{id, name}" `shouldRespondWith` + get "/projects_view_alt?t_id=eq.1&select=t_id, name, clients(*), tasks(id, name)" `shouldRespondWith` [json|[{"t_id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}]|] { matchHeaders = [matchContentTypeJson] } + it "detects parent relations when having many views of a private table" $ do + get "/books?select=title,author(name)&id=eq.5" `shouldRespondWith` + [json|[ { "title": "Farenheit 451", "author": { "name": "Ray Bradbury" } } ]|] + { matchHeaders = [matchContentTypeJson] } + get "/forties_books?select=title,author(name)&limit=1" `shouldRespondWith` + [json|[ { "title": "1984", "author": { "name": "George Orwell" } } ]|] + { matchHeaders = [matchContentTypeJson] } + get "/fifties_books?select=title,author(name)&limit=1" `shouldRespondWith` + [json|[ { "title": "The Catcher in the Rye", "author": { "name": "J.D. Salinger" } } ]|] + { matchHeaders = [matchContentTypeJson] } + get "/sixties_books?select=title,author(name)&limit=1" `shouldRespondWith` + [json|[ { "title": "To Kill a Mockingbird", "author": { "name": "Harper Lee" } } ]|] + { matchHeaders = [matchContentTypeJson] } it "requesting children with composite key" $ - get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments{content}" `shouldRespondWith` + get "/users_tasks?user_id=eq.2&task_id=eq.6&select=*, comments(content)" `shouldRespondWith` [json|[{"user_id":2,"task_id":6,"comments":[{"content":"Needs to be delivered ASAP"}]}]|] { matchHeaders = [matchContentTypeJson] } it "detect relations in views from exposed schema that are based on tables in private schema and have columns renames" $ - get "/articles?id=eq.1&select=id,articleStars{users{*}}" `shouldRespondWith` + get "/articles?id=eq.1&select=id,articleStars(users(*))" `shouldRespondWith` [json|[{"id":1,"articleStars":[{"users":{"id":1,"name":"Angela Martin"}},{"users":{"id":2,"name":"Michael Scott"}},{"users":{"id":3,"name":"Dwight Schrute"}}]}]|] { matchHeaders = [matchContentTypeJson] } it "can embed by FK column name" $ - get "/projects?id=in.1,3&select=id,name,client_id{id,name}" `shouldRespondWith` + get "/projects?id=in.(1,3)&select=id,name,client_id(id,name)" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":{"id":2,"name":"Apple"}}]|] { matchHeaders = [matchContentTypeJson] } - + it "can embed by FK column name and select the FK value at the same time, if aliased" $ - get "/projects?id=in.1,3&select=id,name,client_id,client:client_id{id,name}" `shouldRespondWith` + get "/projects?id=in.(1,3)&select=id,name,client_id,client:client_id(id,name)" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|] { matchHeaders = [matchContentTypeJson] } it "can select by column name sans id" $ - get "/projects?id=in.1,3&select=id,name,client_id,client{id,name}" `shouldRespondWith` + get "/projects?id=in.(1,3)&select=id,name,client_id,client(id,name)" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|] { matchHeaders = [matchContentTypeJson] } it "can detect fk relations through views to tables in the public schema" $ - get "/consumers_view?select=*,orders_view{*}" `shouldRespondWith` 200 + get "/consumers_view?select=*,orders_view(*)" `shouldRespondWith` 200 + describe "path fixed" $ do + it "works when requesting children 2 levels" $ + get "/clients?id=eq.1&select=id,projects:projects.client_id(id,tasks(id))" `shouldRespondWith` + [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|] + { matchHeaders = [matchContentTypeJson] } + it "works with parent relation" $ do + get "/message?select=id,body,sender:person_detail.sender(name,sent),recipient:person_detail.recipient(name,received)&id=lt.4" `shouldRespondWith` + [json| + [{"id":1,"body":"Hello Jane","sender":{"name":"John","sent":2},"recipient":{"name":"Jane","received":2}}, + {"id":2,"body":"Hi John","sender":{"name":"Jane","sent":1},"recipient":{"name":"John","received":1}}, + {"id":3,"body":"How are you doing?","sender":{"name":"John","sent":2},"recipient":{"name":"Jane","received":2}}] |] + { matchHeaders = [matchContentTypeJson] } + get "/message?select=id,body,sender:person.sender(name),recipient:person.recipient(name)&id=lt.4" `shouldRespondWith` + [json| + [{"id":1,"body":"Hello Jane","sender":{"name":"John"},"recipient":{"name":"Jane"}}, + {"id":2,"body":"Hi John","sender":{"name":"Jane"},"recipient":{"name":"John"}}, + {"id":3,"body":"How are you doing?","sender":{"name":"John"},"recipient":{"name":"Jane"}}] |] + { matchHeaders = [matchContentTypeJson] } + + it "works with many<->many relation" $ + get "/tasks?select=id,users:users.users_tasks(id)" `shouldRespondWith` + [json|[{"id":1,"users":[{"id":1},{"id":3}]},{"id":2,"users":[{"id":1}]},{"id":3,"users":[{"id":1}]},{"id":4,"users":[{"id":1}]},{"id":5,"users":[{"id":2},{"id":3}]},{"id":6,"users":[{"id":2}]},{"id":7,"users":[{"id":2}]},{"id":8,"users":[]}]|] + { matchHeaders = [matchContentTypeJson] } + + describe "aliased embeds" $ do + it "works with child relation" $ + get "/space?select=id,zones:zone(id,name),stores:zone(id,name)&zones.zone_type_id=eq.2&stores.zone_type_id=eq.3" `shouldRespondWith` + [json|[ + { "id":1, + "zones": [ {"id":1,"name":"zone 1"}, {"id":2,"name":"zone 2"}], + "stores": [ {"id":3,"name":"store 3"}, {"id":4,"name":"store 4"}]} + ]|] { matchHeaders = [matchContentTypeJson] } + + it "works with many to many relation" $ + get "/users?select=id,designTasks:tasks(id,name),codeTasks:tasks(id,name)&designTasks.name=like.*Design*&codeTasks.name=like.*Code*" `shouldRespondWith` + [json|[ + { "id":1, + "designTasks":[ { "id":1, "name":"Design w7" }, { "id":3, "name":"Design w10" } ], + "codeTasks":[ { "id":2, "name":"Code w7" }, { "id":4, "name":"Code w10" } ] }, + { "id":2, + "designTasks":[ { "id":5, "name":"Design IOS" }, { "id":7, "name":"Design OSX" } ], + "codeTasks":[ { "id":6, "name":"Code IOS" } ] }, + { "id":3, + "designTasks":[ { "id":1, "name":"Design w7" }, { "id":5, "name":"Design IOS" } ], + "codeTasks":[ ] } + ]|] { matchHeaders = [matchContentTypeJson] } + + it "works with an aliased child plus non aliased child" $ + get "/projects?select=id,name,designTasks:tasks(name,users(id,name))&designTasks.name=like.*Design*&designTasks.users.id=in.(1,2)" `shouldRespondWith` + [json|[ + { + "id":1, "name":"Windows 7", + "designTasks":[ { "name":"Design w7", "users":[ { "id":1, "name":"Angela Martin" } ] } ] }, + { + "id":2, "name":"Windows 10", + "designTasks":[ { "name":"Design w10", "users":[ { "id":1, "name":"Angela Martin" } ] } ] }, + { + "id":3, "name":"IOS", + "designTasks":[ { "name":"Design IOS", "users":[ { "id":2, "name":"Michael Scott" } ] } ] }, + { + "id":4, "name":"OSX", + "designTasks":[ { "name":"Design OSX", "users":[ { "id":2, "name":"Michael Scott" } ] } ] }, + { + "id":5, "name":"Orphan", + "designTasks":[ ] } + ]|] { matchHeaders = [matchContentTypeJson] } + + it "works with two aliased childs embeds plus and/or" $ + get "/entities?select=id,childs:child_entities(id,gChilds:grandchild_entities(id))&childs.and=(id.in.(1,2,3))&childs.gChilds.or=(id.eq.1,id.eq.2)" `shouldRespondWith` + [json|[ + { "id":1, + "childs":[ + {"id":1,"gChilds":[{"id":1}, {"id":2}]}, + {"id":2,"gChilds":[]}]}, + { "id":2, + "childs":[ + {"id":3,"gChilds":[]}]}, + { "id":3,"childs":[]}, + { "id":4,"childs":[]} + ]|] { matchHeaders = [matchContentTypeJson] } + + describe "tables with self reference foreign keys" $ do + context "one self reference foreign key" $ do + it "embeds parents recursively" $ + get "/family_tree?id=in.(3,4)&select=id,parent(id,name,parent(*))" `shouldRespondWith` + [json|[ + { "id": "3", "parent": { "id": "1", "name": "Parental Unit", "parent": null } }, + { "id": "4", "parent": { "id": "2", "name": "Kid One", "parent": { "id": "1", "name": "Parental Unit", "parent": null } } } + ]|] + { matchHeaders = [matchContentTypeJson] } + + it "embeds childs recursively" $ + get "/family_tree?id=eq.1&select=id,name, childs:family_tree.parent(id,name,childs:family_tree.parent(id,name))" `shouldRespondWith` + [json|[{ + "id": "1", "name": "Parental Unit", "childs": [ + { "id": "2", "name": "Kid One", "childs": [ { "id": "4", "name": "Grandkid One" } ] }, + { "id": "3", "name": "Kid Two", "childs": [ { "id": "5", "name": "Grandkid Two" } ] } + ] + }]|] { matchHeaders = [matchContentTypeJson] } + + it "embeds parent and then embeds childs" $ + get "/family_tree?id=eq.2&select=id,name,parent(id,name,childs:family_tree.parent(id,name))" `shouldRespondWith` + [json|[{ + "id": "2", "name": "Kid One", "parent": { + "id": "1", "name": "Parental Unit", "childs": [ { "id": "2", "name": "Kid One" }, { "id": "3", "name": "Kid Two"} ] + } + }]|] { matchHeaders = [matchContentTypeJson] } + + context "two self reference foreign keys" $ do + it "embeds parents" $ + get "/organizations?select=id,name,referee(id,name),auditor(id,name)&id=eq.3" `shouldRespondWith` + [json|[{ + "id": 3, "name": "Acme", + "referee": { + "id": 1, + "name": "Referee Org" + }, + "auditor": { + "id": 2, + "name": "Auditor Org" + } + }]|] { matchHeaders = [matchContentTypeJson] } + + it "embeds childs" $ do + get "/organizations?select=id,name,refereeds:organizations.referee(id,name)&id=eq.1" `shouldRespondWith` + [json|[{ + "id": 1, "name": "Referee Org", + "refereeds": [ + { + "id": 3, + "name": "Acme" + }, + { + "id": 4, + "name": "Umbrella" + } + ] + }]|] { matchHeaders = [matchContentTypeJson] } + get "/organizations?select=id,name,auditees:organizations.auditor(id,name)&id=eq.2" `shouldRespondWith` + [json|[{ + "id": 2, "name": "Auditor Org", + "auditees": [ + { + "id": 3, + "name": "Acme" + }, + { + "id": 4, + "name": "Umbrella" + } + ] + }]|] { matchHeaders = [matchContentTypeJson] } + describe "ordering response" $ do it "by a column asc" $ get "/items?id=lte.2&order=id.asc" @@ -432,6 +564,8 @@ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] } + + it "by a column desc" $ get "/items?id=lte.2&order=id.desc" `shouldRespondWith` [json| [{"id":2},{"id":1}] |] @@ -476,6 +610,26 @@ , matchHeaders = ["Content-Range" <:> "0-2/*"] } + it "by two columns with nulls and direction specified" $ + get "/projects?select=client_id,id,name&order=client_id.desc.nullslast,id.desc" + `shouldRespondWith` [json| + [{"client_id":2,"id":4,"name":"OSX"}, + {"client_id":2,"id":3,"name":"IOS"}, + {"client_id":1,"id":2,"name":"Windows 10"}, + {"client_id":1,"id":1,"name":"Windows 7"}, + {"client_id":null,"id":5,"name":"Orphan"}] + |] + { matchStatus = 200 + , matchHeaders = ["Content-Range" <:> "0-4/*"] + } + + it "by a column with no direction or nulls specified" $ + get "/items?id=lte.2&order=id" + `shouldRespondWith` [json| [{"id":1},{"id":2}] |] + { matchStatus = 200 + , matchHeaders = ["Content-Range" <:> "0-1/*"] + } + it "by a json column property asc" $ get "/json?order=data->>id.asc" `shouldRespondWith` [json| [{"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}, {"data": {"id": 3}}] |] @@ -490,29 +644,72 @@ get "/items?order=id.asc" `shouldRespondWith` 200 it "ordering embeded entities" $ - get "/projects?id=eq.1&select=id, name, tasks{id, name}&tasks.order=name.asc" `shouldRespondWith` + get "/projects?id=eq.1&select=id, name, tasks(id, name)&tasks.order=name.asc" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|] { matchHeaders = [matchContentTypeJson] } it "ordering embeded entities with alias" $ - get "/projects?id=eq.1&select=id, name, the_tasks:tasks{id, name}&tasks.order=name.asc" `shouldRespondWith` + get "/projects?id=eq.1&select=id, name, the_tasks:tasks(id, name)&tasks.order=name.asc" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","the_tasks":[{"id":2,"name":"Code w7"},{"id":1,"name":"Design w7"}]}]|] { matchHeaders = [matchContentTypeJson] } it "ordering embeded entities, two levels" $ - get "/projects?id=eq.1&select=id, name, tasks{id, name, users{id, name}}&tasks.order=name.asc&tasks.users.order=name.desc" `shouldRespondWith` + get "/projects?id=eq.1&select=id, name, tasks(id, name, users(id, name))&tasks.order=name.asc&tasks.users.order=name.desc" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","tasks":[{"id":2,"name":"Code w7","users":[{"id":1,"name":"Angela Martin"}]},{"id":1,"name":"Design w7","users":[{"id":3,"name":"Dwight Schrute"},{"id":1,"name":"Angela Martin"}]}]}]|] { matchHeaders = [matchContentTypeJson] } it "ordering embeded parents does not break things" $ - get "/projects?id=eq.1&select=id, name, clients{id, name}&clients.order=name.asc" `shouldRespondWith` + get "/projects?id=eq.1&select=id, name, clients(id, name)&clients.order=name.asc" `shouldRespondWith` [str|[{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"}}]|] it "ordering embeded parents does not break things when using ducktape names" $ - get "/projects?id=eq.1&select=id, name, client{id, name}&client.order=name.asc" `shouldRespondWith` + get "/projects?id=eq.1&select=id, name, client(id, name)&client.order=name.asc" `shouldRespondWith` [str|[{"id":1,"name":"Windows 7","client":{"id":1,"name":"Microsoft"}}]|] + context "order syntax errors" $ do + it "gives meaningful error messages when asc/desc/nulls{first,last} are misspelled" $ do + get "/items?order=id.ac" `shouldRespondWith` + [json|{"details":"unexpected \"c\" expecting \"asc\", \"desc\", \"nullsfirst\" or \"nullslast\"","message":"\"failed to parse order (id.ac)\" (line 1, column 4)"}|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + get "/items?order=id.descc" `shouldRespondWith` + [json|{"details":"unexpected 'c' expecting delimiter (.), \",\" or end of input","message":"\"failed to parse order (id.descc)\" (line 1, column 8)"}|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + get "/items?order=id.nulsfist" `shouldRespondWith` + [json|{"details":"unexpected \"n\" expecting \"asc\", \"desc\", \"nullsfirst\" or \"nullslast\"","message":"\"failed to parse order (id.nulsfist)\" (line 1, column 4)"}|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + get "/items?order=id.nullslasttt" `shouldRespondWith` + [json|{"details":"unexpected 't' expecting \",\" or end of input","message":"\"failed to parse order (id.nullslasttt)\" (line 1, column 13)"}|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + get "/items?order=id.smth34" `shouldRespondWith` + [json|{"details":"unexpected \"s\" expecting \"asc\", \"desc\", \"nullsfirst\" or \"nullslast\"","message":"\"failed to parse order (id.smth34)\" (line 1, column 4)"}|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + it "gives meaningful error messages when nulls{first,last} are misspelled after asc/desc" $ do + get "/items?order=id.asc.nlsfst" `shouldRespondWith` + [json|{"details":"unexpected \"l\" expecting \"nullsfirst\" or \"nullslast\"","message":"\"failed to parse order (id.asc.nlsfst)\" (line 1, column 8)"}|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + get "/items?order=id.asc.nullslasttt" `shouldRespondWith` + [json|{"details":"unexpected 't' expecting \",\" or end of input","message":"\"failed to parse order (id.asc.nullslasttt)\" (line 1, column 17)"}|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } + get "/items?order=id.asc.smth34" `shouldRespondWith` + [json|{"details":"unexpected \"s\" expecting \"nullsfirst\" or \"nullslast\"","message":"\"failed to parse order (id.asc.smth34)\" (line 1, column 8)"}|] + { matchStatus = 400 + , matchHeaders = [matchContentTypeJson] + } describe "Accept headers" $ do it "should respond an unknown accept type with 415" $ @@ -607,12 +804,12 @@ } it "will embed a collection" $ - get "/Escap3e;?select=ghostBusters{*}" `shouldRespondWith` + get "/Escap3e;?select=ghostBusters(*)" `shouldRespondWith` [json| [{"ghostBusters":[{"escapeId":1}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":3}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":5}]}] |] { matchHeaders = [matchContentTypeJson] } it "will embed using a column" $ - get "/ghostBusters?select=escapeId{*}" `shouldRespondWith` + get "/ghostBusters?select=escapeId(*)" `shouldRespondWith` [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |] { matchHeaders = [matchContentTypeJson] } @@ -634,7 +831,7 @@ `shouldRespondWith` 406 it "concatenates results if more than one row is returned" $ - request methodGet "/images_base64?select=img&name=in.A.png,B.png" (acceptHdrs "application/octet-stream") "" + request methodGet "/images_base64?select=img&name=in.(A.png,B.png)" (acceptHdrs "application/octet-stream") "" `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCCiVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII=" { matchStatus = 200 , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"] @@ -696,7 +893,6 @@ { matchStatus = 200 , matchHeaders = [] } - it "multiple cookies ends up as claims" $ request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue;secondcookie=anothervalue")] [json| {"name":"request.cookie.secondcookie"} |] @@ -705,99 +901,82 @@ { matchStatus = 200 , matchHeaders = [] } + it "app settings available" $ + request methodPost "/rpc/get_guc_value" [] + [json| { "name": "app.settings.app_host" } |] + `shouldRespondWith` + [str|"localhost"|] + { matchStatus = 200 + , matchHeaders = [ matchContentTypeJson ] + } describe "values with quotes in IN and NOT IN" $ do it "succeeds when only quoted values are present" $ do - get "/w_or_wo_comma_names?name=in.\"Hebdon, John\"" `shouldRespondWith` + get "/w_or_wo_comma_names?name=in.(\"Hebdon, John\")" `shouldRespondWith` [json| [{"name":"Hebdon, John"}] |] { matchHeaders = [matchContentTypeJson] } - get "/w_or_wo_comma_names?name=in.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith` + get "/w_or_wo_comma_names?name=in.(\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\")" `shouldRespondWith` [json| [{"name":"Hebdon, John"},{"name":"Williams, Mary"},{"name":"Smith, Joseph"}] |] { matchHeaders = [matchContentTypeJson] } - get "/w_or_wo_comma_names?name=not.in.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith` + get "/w_or_wo_comma_names?name=not.in.(\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\")" `shouldRespondWith` [json| [{"name":"David White"},{"name":"Larry Thompson"}] |] { matchHeaders = [matchContentTypeJson] } it "succeeds w/ and w/o quoted values" $ do - get "/w_or_wo_comma_names?name=in.David White,\"Hebdon, John\"" `shouldRespondWith` + get "/w_or_wo_comma_names?name=in.(David White,\"Hebdon, John\")" `shouldRespondWith` [json| [{"name":"Hebdon, John"},{"name":"David White"}] |] { matchHeaders = [matchContentTypeJson] } - get "/w_or_wo_comma_names?name=not.in.\"Hebdon, John\",Larry Thompson,\"Smith, Joseph\"" `shouldRespondWith` + get "/w_or_wo_comma_names?name=not.in.(\"Hebdon, John\",Larry Thompson,\"Smith, Joseph\")" `shouldRespondWith` [json| [{"name":"Williams, Mary"},{"name":"David White"}] |] { matchHeaders = [matchContentTypeJson] } it "checks well formed quoted values" $ do - get "/w_or_wo_comma_names?name=in.\"\"Hebdon, John\"" `shouldRespondWith` + get "/w_or_wo_comma_names?name=in.(\"\"Hebdon, John\")" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } - get "/w_or_wo_comma_names?name=in.\"\"Hebdon, John\"\"Mary" `shouldRespondWith` + get "/w_or_wo_comma_names?name=in.(\"\"Hebdon, John\"\"Mary)" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } - get "/w_or_wo_comma_names?name=in.Williams\"Hebdon, John\"" `shouldRespondWith` + get "/w_or_wo_comma_names?name=in.(Williams\"Hebdon, John\")" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } describe "IN and NOT IN empty set" $ do context "returns an empty result for IN when no value is present" $ do it "works for integer" $ - get "/items_with_different_col_types?int_data=in." `shouldRespondWith` + get "/items_with_different_col_types?int_data=in.()" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "works for text" $ - get "/items_with_different_col_types?text_data=in." `shouldRespondWith` + get "/items_with_different_col_types?text_data=in.()" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "works for bool" $ - get "/items_with_different_col_types?bool_data=in." `shouldRespondWith` + get "/items_with_different_col_types?bool_data=in.()" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "works for bytea" $ - get "/items_with_different_col_types?bin_data=in." `shouldRespondWith` + get "/items_with_different_col_types?bin_data=in.()" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "works for char" $ - get "/items_with_different_col_types?char_data=in." `shouldRespondWith` + get "/items_with_different_col_types?char_data=in.()" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "works for date" $ - get "/items_with_different_col_types?date_data=in." `shouldRespondWith` + get "/items_with_different_col_types?date_data=in.()" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "works for real" $ - get "/items_with_different_col_types?real_data=in." `shouldRespondWith` + get "/items_with_different_col_types?real_data=in.()" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "works for time" $ - get "/items_with_different_col_types?time_data=in." `shouldRespondWith` + get "/items_with_different_col_types?time_data=in.()" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "returns all results for not.in when no value is present" $ - get "/items_with_different_col_types?int_data=not.in.&select=int_data" `shouldRespondWith` + get "/items_with_different_col_types?int_data=not.in.()&select=int_data" `shouldRespondWith` [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] } it "returns an empty result ignoring spaces" $ - get "/items_with_different_col_types?int_data=in. " `shouldRespondWith` + get "/items_with_different_col_types?int_data=in.( )" `shouldRespondWith` [json| [] |] { matchHeaders = [matchContentTypeJson] } it "only returns an empty result set if the in value is empty" $ - get "/items_with_different_col_types?int_data=in. ,3,4" `shouldRespondWith` 400 - - it "returns empty result when the in value is empty between parentheses" $ - get "/items_with_different_col_types?int_data=in.()" `shouldRespondWith` - [json| [] |] { matchHeaders = [matchContentTypeJson] } - - it "returns all results when the not.in value is empty between parentheses" $ - get "/items_with_different_col_types?int_data=not.in.()&select=int_data" `shouldRespondWith` - [json| [{int_data: 1}] |] { matchHeaders = [matchContentTypeJson] } - - describe "Transition to url safe characters" $ do - context "top level in operator" $ do - it "works with parentheses" $ - get "/entities?id=in.(1,2,3)&select=id" `shouldRespondWith` - [json| [{"id": 1}, {"id": 2}, {"id": 3}] |] { matchHeaders = [matchContentTypeJson] } - it "works without parentheses" $ - get "/entities?id=in.1,2,3&select=id" `shouldRespondWith` - [json| [{"id": 1}, {"id": 2}, {"id": 3}] |] { matchHeaders = [matchContentTypeJson] } - - context "select query param" $ do - it "works with parentheses" $ - get "/entities?id=eq.2&select=id,child_entities(id)" `shouldRespondWith` - [json| [{"id": 2, "child_entities": [{"id": 3}]}] |] { matchHeaders = [matchContentTypeJson] } - it "works with brackets" $ - get "/entities?id=eq.2&select=id,child_entities{id}" `shouldRespondWith` - [json| [{"id": 2, "child_entities": [{"id": 3}]}] |] { matchHeaders = [matchContentTypeJson] } + get "/items_with_different_col_types?int_data=in.( ,3,4)" `shouldRespondWith` 400 - context "Embedding when column name = table name" $ do + describe "Embedding when column name = table name" $ do it "works with child embeds" $ get "/being?select=*,descendant(*)&limit=1" `shouldRespondWith` [json|[{"being":1,"descendant":[{"descendant":1,"being":1},{"descendant":2,"being":1},{"descendant":3,"being":1}]}]|] @@ -805,4 +984,14 @@ it "works with many to many embeds" $ get "/being?select=*,part(*)&limit=1" `shouldRespondWith` [json|[{"being":1,"part":[{"part":1}]}]|] + { matchHeaders = [matchContentTypeJson] } + + describe "Foreign table" $ do + it "can be queried by using regular filters" $ + get "/projects_dump?id=in.(1,2,3)" `shouldRespondWith` + [json| [{"id":1,"name":"Windows 7","client_id":1}, {"id":2,"name":"Windows 10","client_id":1}, {"id":3,"name":"IOS","client_id":2}]|] + { matchHeaders = [matchContentTypeJson] } + it "can be queried with select, order and limit" $ + get "/projects_dump?select=id,name&order=id.desc&limit=3" `shouldRespondWith` + [json| [{"id":5,"name":"Orphan"}, {"id":4,"name":"OSX"}, {"id":3,"name":"IOS"}] |] { matchHeaders = [matchContentTypeJson] } diff --git a/test/Feature/RangeSpec.hs b/test/Feature/RangeSpec.hs --- a/test/Feature/RangeSpec.hs +++ b/test/Feature/RangeSpec.hs @@ -149,7 +149,7 @@ } it "limit works on all levels" $ - get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1" + get "/clients?select=id,projects(id,tasks(id))&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1" `shouldRespondWith` [json|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|] { matchStatus = 200 diff --git a/test/Feature/RpcSpec.hs b/test/Feature/RpcSpec.hs --- a/test/Feature/RpcSpec.hs +++ b/test/Feature/RpcSpec.hs @@ -111,24 +111,24 @@ context "foreign entities embedding" $ do it "can embed if related tables are in the exposed schema" $ do - post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith` + post "/rpc/getproject?select=id,name,client(id),tasks(id)" [json| { "id": 1} |] `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|] { matchHeaders = [matchContentTypeJson] } - get "/rpc/getproject?id=1&select=id,name,client{id},tasks{id}" `shouldRespondWith` + get "/rpc/getproject?id=1&select=id,name,client(id),tasks(id)" `shouldRespondWith` [json|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|] { matchHeaders = [matchContentTypeJson] } it "cannot embed if the related table is not in the exposed schema" $ do - post "/rpc/single_article?select=*,article_stars{*}" [json|{ "id": 1}|] + post "/rpc/single_article?select=*,article_stars(*)" [json|{ "id": 1}|] `shouldRespondWith` 400 - get "/rpc/single_article?id=1&select=*,article_stars{*}" + get "/rpc/single_article?id=1&select=*,article_stars(*)" `shouldRespondWith` 400 it "can embed if the related tables are in a hidden schema but exposed as views" $ do - post "/rpc/single_article?select=id,articleStars{userId}" [json|{ "id": 2}|] + post "/rpc/single_article?select=id,articleStars(userId)" [json|{ "id": 2}|] `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|] { matchHeaders = [matchContentTypeJson] } - get "/rpc/single_article?id=2&select=id,articleStars{userId}" + get "/rpc/single_article?id=2&select=id,articleStars(userId)" `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|] { matchHeaders = [matchContentTypeJson] } @@ -275,9 +275,15 @@ [json|[{"my_json":{"a": 1, "b": "two"},"num":3,"str":"four"}]|] { matchHeaders = [matchContentTypeJson] } it "returns a row result when there are many INOUT params" $ - get "/rpc/many_inout_params?num=1&str=two" `shouldRespondWith` - [json| [{"num":1,"str":"two","b":true}]|] { matchHeaders = [matchContentTypeJson] } + get "/rpc/many_inout_params?num=1&str=two&b=false" `shouldRespondWith` + [json| [{"num":1,"str":"two","b":false}]|] { matchHeaders = [matchContentTypeJson] } + it "can handle procs with args that have a DEFAULT value" $ do + get "/rpc/many_inout_params?num=1&str=two" `shouldRespondWith` + [json| [{"num":1,"str":"two","b":true}]|] { matchHeaders = [matchContentTypeJson] } + get "/rpc/three_defaults?b=4" `shouldRespondWith` + [json|8|] { matchHeaders = [matchContentTypeJson] } + it "can map a RAISE error code and message to a http status" $ get "/rpc/raise_pt402" `shouldRespondWith` [json|{ "hint": "Upgrade your plan", "details": "Quota exceeded" }|] @@ -288,23 +294,42 @@ it "defaults to status 500 if RAISE code is PT not followed by a number" $ get "/rpc/raise_bad_pt" `shouldRespondWith` 500 - context "only for POST rpc" $ do - context "expects a single json object" $ do - it "does not expand posted json into parameters" $ - request methodPost "/rpc/singlejsonparam" - [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith` - [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] - { matchHeaders = [matchContentTypeJson] } + context "expects a single json object" $ do + it "does not expand posted json into parameters" $ + request methodPost "/rpc/singlejsonparam" + [("prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith` + [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] + { matchHeaders = [matchContentTypeJson] } - it "accepts parameters from an html form" $ - request methodPost "/rpc/singlejsonparam" - [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")] - ("integer=7&double=2.71828&varchar=forms+are+fun&" <> - "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith` - [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun" - , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |] - { matchHeaders = [matchContentTypeJson] } + it "accepts parameters from an html form" $ + request methodPost "/rpc/singlejsonparam" + [("Prefer","params=single-object"),("Content-Type", "application/x-www-form-urlencoded")] + ("integer=7&double=2.71828&varchar=forms+are+fun&" <> + "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith` + [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun" + , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |] + { matchHeaders = [matchContentTypeJson] } + it "works with GET" $ + request methodGet "/rpc/singlejsonparam?p1=1&p2=text" [("Prefer","params=single-object")] "" + `shouldRespondWith` [json|{ "p1": "1", "p2": "text"}|] + { matchHeaders = [matchContentTypeJson] } + + it "should work with an overloaded function" $ do + get "/rpc/overloaded" `shouldRespondWith` + [json|[{ "overloaded": 1 }, + { "overloaded": 2 }, + { "overloaded": 3 }]|] + { matchHeaders = [matchContentTypeJson] } + request methodPost "/rpc/overloaded" [("Prefer","params=single-object")] + [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|] + `shouldRespondWith` + [json|[{"x": 1, "y": "first"}, {"x": 2, "y": "second"}]|] + { matchHeaders = [matchContentTypeJson] } + get "/rpc/overloaded?a=1&b=2" `shouldRespondWith` [str|3|] + get "/rpc/overloaded?a=1&b=2&c=3" `shouldRespondWith` [str|"123"|] + + context "only for POST rpc" $ it "gives a parse filter error if GET style proc args are specified" $ post "/rpc/sayhello?name=John" [json|{}|] `shouldRespondWith` 400 @@ -334,12 +359,5 @@ [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|] { matchHeaders = [matchContentTypeJson] } get "/rpc/get_tsearch?text_search_vector=not.fts(english).fun%7Crat" `shouldRespondWith` - [json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|] - { matchHeaders = [matchContentTypeJson] } - -- TODO: '@@' deprecated - get "/rpc/get_tsearch?text_search_vector=@@(english).impossible" `shouldRespondWith` - [json|[{"text_search_vector":"'fun':5 'imposs':9 'kind':3"}]|] - { matchHeaders = [matchContentTypeJson] } - get "/rpc/get_tsearch?text_search_vector=not.@@(english).fun%7Crat" `shouldRespondWith` [json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|] { matchHeaders = [matchContentTypeJson] } diff --git a/test/Feature/SingularSpec.hs b/test/Feature/SingularSpec.hs --- a/test/Feature/SingularSpec.hs +++ b/test/Feature/SingularSpec.hs @@ -37,7 +37,7 @@ `shouldRespondWith` [str|{"id":5}|] it "can shape plurality singular object routes" $ - request methodGet "/projects_view?id=eq.1&select=id,name,clients{*},tasks{id,name}" [singular] "" + request methodGet "/projects_view?id=eq.1&select=id,name,clients(*),tasks(id,name)" [singular] "" `shouldRespondWith` [json|{"id":1,"name":"Windows 7","clients":{"id":1,"name":"Microsoft"},"tasks":[{"id":1,"name":"Design w7"},{"id":2,"name":"Code w7"}]}|] { matchHeaders = ["Content-Type" <:> "application/vnd.pgrst.object+json; charset=utf-8"] } diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -29,12 +29,12 @@ (acceptHdrs "application/openapi+json") "" `shouldRespondWith` 415 - it "includes postgrest.com current version api docs" $ do + it "includes postgrest.org current version api docs" $ do r <- simpleBody <$> get "/" let docsUrl = r ^? key "externalDocs" . key "url" - liftIO $ docsUrl `shouldBe` Just (String ("https://postgrest.com/en/" <> docsVersion <> "/api.html")) + liftIO $ docsUrl `shouldBe` Just (String ("https://postgrest.org/en/" <> docsVersion <> "/api.html")) describe "table" $ do @@ -131,6 +131,38 @@ . nth 0 liftIO $ tableTag `shouldBe` Just [aesonQQ|"authors_only"|] + describe "Foreign table" $ + + it "includes foreign table properties" $ do + r <- simpleBody <$> get "/" + + let method s = key "paths" . key "/projects_dump" . key s + getSummary = r ^? method "get" . key "summary" + getDescription = r ^? method "get" . key "description" + getParameters = r ^? method "get" . key "parameters" + + liftIO $ do + + getSummary `shouldBe` Just "A temporary projects dump" + + getDescription `shouldBe` Just "Just a test for foreign tables" + + getParameters `shouldBe` Just + [aesonQQ| + [ + { "$ref": "#/parameters/rowFilter.projects_dump.id" }, + { "$ref": "#/parameters/rowFilter.projects_dump.name" }, + { "$ref": "#/parameters/rowFilter.projects_dump.client_id" }, + { "$ref": "#/parameters/select" }, + { "$ref": "#/parameters/order" }, + { "$ref": "#/parameters/range" }, + { "$ref": "#/parameters/rangeUnit" }, + { "$ref": "#/parameters/offset" }, + { "$ref": "#/parameters/limit" }, + { "$ref": "#/parameters/preferCount" } + ] + |] + describe "RPC" $ do it "includes body schema for arguments" $ do @@ -173,7 +205,7 @@ "type": "string" }, "enum": { - "format": "test.enum_menagerie_type", + "format": "enum_menagerie_type", "type": "string" }, "integer": { diff --git a/test/Feature/UpsertSpec.hs b/test/Feature/UpsertSpec.hs new file mode 100644 --- /dev/null +++ b/test/Feature/UpsertSpec.hs @@ -0,0 +1,200 @@ +module Feature.UpsertSpec where + +import Test.Hspec +import Test.Hspec.Wai +import Test.Hspec.Wai.JSON +import Network.HTTP.Types + +import SpecHelper +import Network.Wai (Application) + +import Protolude hiding (get, put) +import Text.Heredoc + +spec :: SpecWith Application +spec = + describe "UPSERT" $ do + context "with POST" $ do + context "when Prefer: resolution=merge-duplicates is specified" $ do + it "INSERTs and UPDATEs rows on pk conflict" $ + request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")] + [json| [ + { "name": "Javascript", "rank": 6 }, + { "name": "Java", "rank": 2 }, + { "name": "C", "rank": 1 } + ]|] `shouldRespondWith` [json| [ + { "name": "Javascript", "rank": 6 }, + { "name": "Java", "rank": 2 }, + { "name": "C", "rank": 1 } + ]|] + { matchStatus = 201 + , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson] + } + + it "INSERTs and UPDATEs row on composite pk conflict" $ + request methodPost "/employees" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")] + [json| [ + { "first_name": "Frances M.", "last_name": "Roe", "salary": "30000" }, + { "first_name": "Peter S.", "last_name": "Yang", "salary": 42000 } + ]|] `shouldRespondWith` [json| [ + { "first_name": "Frances M.", "last_name": "Roe", "salary": "$30,000.00", "company": "One-Up Realty", "occupation": "Author" }, + { "first_name": "Peter S.", "last_name": "Yang", "salary": "$42,000.00", "company": null, "occupation": null } + ]|] + { matchStatus = 201 + , matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", matchContentTypeJson] + } + + context "when Prefer: resolution=ignore-duplicates is specified" $ do + it "INSERTs and ignores rows on pk conflict" $ + request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")] + [json|[ + { "name": "PHP", "rank": 9 }, + { "name": "Python", "rank": 10 } + ]|] `shouldRespondWith` [json|[ + { "name": "PHP", "rank": 9 } + ]|] + { matchStatus = 201 + , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson] + } + + it "INSERTs and ignores rows on composite pk conflict" $ + request methodPost "/employees" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")] + [json|[ + { "first_name": "Daniel B.", "last_name": "Lyon", "salary": "72000", "company": null, "occupation": null }, + { "first_name": "Sara M.", "last_name": "Torpey", "salary": 60000, "company": "Burstein-Applebee", "occupation": "Soil scientist" } + ]|] `shouldRespondWith` [json|[ + { "first_name": "Sara M.", "last_name": "Torpey", "salary": "$60,000.00", "company": "Burstein-Applebee", "occupation": "Soil scientist" } + ]|] + { matchStatus = 201 + , matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", matchContentTypeJson] + } + + it "succeeds if the table has only PK cols and no other cols" $ do + request methodPost "/only_pk" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")] + [json|[ { "id": 1 }, { "id": 2 }, { "id": 3} ]|] + `shouldRespondWith` + [json|[ { "id": 3} ]|] + { matchStatus = 201 , + matchHeaders = ["Preference-Applied" <:> "resolution=ignore-duplicates", + matchContentTypeJson] } + + request methodPost "/only_pk" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")] + [json|[ { "id": 1 }, { "id": 2 }, { "id": 4} ]|] + `shouldRespondWith` + [json|[ { "id": 1 }, { "id": 2 }, { "id": 4} ]|] + { matchStatus = 201 , + matchHeaders = ["Preference-Applied" <:> "resolution=merge-duplicates", + matchContentTypeJson] } + + it "succeeds and ignores the Prefer: resolution header(no Preference-Applied present) if the table has no PK" $ + request methodPost "/no_pk" [("Prefer", "return=representation"), ("Prefer", "resolution=merge-duplicates")] + [json|[ { "a": "1", "b": "0" } ]|] + `shouldRespondWith` + [json|[ { "a": "1", "b": "0" } ]|] { matchStatus = 201 , matchHeaders = [matchContentTypeJson] } + + it "succeeds if not a single resource is created" $ do + request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")] + [json|[ { "name": "Java", "rank": 1 } ]|] `shouldRespondWith` + [json|[]|] { matchStatus = 201 , matchHeaders = [matchContentTypeJson] } + request methodPost "/tiobe_pls" [("Prefer", "return=representation"), ("Prefer", "resolution=ignore-duplicates")] + [json|[ { "name": "Java", "rank": 1 }, { "name": "C", "rank": 2 } ]|] `shouldRespondWith` + [json|[]|] { matchStatus = 201 , matchHeaders = [matchContentTypeJson] } + + context "with PUT" $ do + context "Restrictions" $ do + it "fails if Range is specified" $ + request methodPut "/tiobe_pls?name=eq.Javascript" [("Range", "0-5")] + [str| [ { "name": "Javascript", "rank": 1 } ]|] `shouldRespondWith` 400 + + it "fails if limit is specified" $ + put "/tiobe_pls?name=eq.Javascript&limit=1" + [str| [ { "name": "Javascript", "rank": 1 } ]|] `shouldRespondWith` 400 + + it "fails if offset is specified" $ + put "/tiobe_pls?name=eq.Javascript&offset=1" + [str| [ { "name": "Javascript", "rank": 1 } ]|] `shouldRespondWith` 400 + + it "fails if the payload has more than one row" $ + put "/tiobe_pls?name=eq.Go" + [str| [ { "name": "Go", "rank": 19 }, { "name": "Swift", "rank": 12 } ]|] `shouldRespondWith` 400 + + it "fails if not all columns are specified" $ do + put "/tiobe_pls?name=eq.Go" + [str| [ { "name": "Go" } ]|] `shouldRespondWith` 400 + put "/employees?first_name=eq.Susan&last_name=eq.Heidt" + [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000" } ]|] `shouldRespondWith` 400 + + it "rejects every other filter than pk cols eq's" $ do + put "/tiobe_pls?rank=eq.19" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405 + put "/tiobe_pls?id=not.eq.Java" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405 + put "/tiobe_pls?id=in.(Go)" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405 + put "/tiobe_pls?and=(id.eq.Go)" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 405 + + it "fails if not all composite key cols are specified as eq filters" $ do + put "/employees?first_name=eq.Susan" + [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|] + `shouldRespondWith` 405 + put "/employees?last_name=eq.Heidt" + [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|] + `shouldRespondWith` 405 + + it "fails if the uri primary key doesn't match the payload primary key" $ do + put "/tiobe_pls?name=eq.MATLAB" + [str| [ { "name": "Perl", "rank": 17 } ]|] `shouldRespondWith` 400 + put "/employees?first_name=eq.Wendy&last_name=eq.Anderson" + [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|] `shouldRespondWith` 400 + + it "fails if the table has no PK" $ + put "/no_pk?a=eq.one&b=eq.two" [str| [ { "a": "one", "b": "two" } ]|] `shouldRespondWith` 405 + + context "Inserting row" $ do + it "succeeds on table with single pk col" $ do + get "/tiobe_pls?name=eq.Go" `shouldRespondWith` "[]" + put "/tiobe_pls?name=eq.Go" [str| [ { "name": "Go", "rank": 19 } ]|] `shouldRespondWith` 204 + get "/tiobe_pls?name=eq.Go" `shouldRespondWith` [json| [ { "name": "Go", "rank": 19 } ]|] { matchHeaders = [matchContentTypeJson] } + + it "succeeds on table with composite pk" $ do + get "/employees?first_name=eq.Susan&last_name=eq.Heidt" + `shouldRespondWith` "[]" + put "/employees?first_name=eq.Susan&last_name=eq.Heidt" + [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "48000", "company": "GEX", "occupation": "Railroad engineer" } ]|] + `shouldRespondWith` 204 + get "/employees?first_name=eq.Susan&last_name=eq.Heidt" + `shouldRespondWith` + [json| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "$48,000.00", "company": "GEX", "occupation": "Railroad engineer" } ]|] + { matchHeaders = [matchContentTypeJson] } + + it "succeeds if the table has only PK cols and no other cols" $ do + get "/only_pk?id=eq.10" `shouldRespondWith` "[]" + put "/only_pk?id=eq.10" [str|[ { "id": 10 } ]|] `shouldRespondWith` 204 + get "/only_pk?id=eq.10" `shouldRespondWith` [json|[ { "id": 10 } ]|] { matchHeaders = [matchContentTypeJson] } + + context "Updating row" $ do + it "succeeds on table with single pk col" $ do + get "/tiobe_pls?name=eq.Go" `shouldRespondWith` [json|[ { "name": "Go", "rank": 19 } ]|] { matchHeaders = [matchContentTypeJson] } + put "/tiobe_pls?name=eq.Go" [str| [ { "name": "Go", "rank": 13 } ]|] `shouldRespondWith` 204 + get "/tiobe_pls?name=eq.Go" `shouldRespondWith` [json| [ { "name": "Go", "rank": 13 } ]|] { matchHeaders = [matchContentTypeJson] } + + it "succeeds on table with composite pk" $ do + get "/employees?first_name=eq.Susan&last_name=eq.Heidt" + `shouldRespondWith` + [json| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "$48,000.00", "company": "GEX", "occupation": "Railroad engineer" } ]|] + { matchHeaders = [matchContentTypeJson] } + put "/employees?first_name=eq.Susan&last_name=eq.Heidt" + [str| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "60000", "company": "Gamma Gas", "occupation": "Railroad engineer" } ]|] + `shouldRespondWith` 204 + get "/employees?first_name=eq.Susan&last_name=eq.Heidt" + `shouldRespondWith` + [json| [ { "first_name": "Susan", "last_name": "Heidt", "salary": "$60,000.00", "company": "Gamma Gas", "occupation": "Railroad engineer" } ]|] + { matchHeaders = [matchContentTypeJson] } + + it "succeeds if the table has only PK cols and no other cols" $ do + get "/only_pk?id=eq.10" `shouldRespondWith` [json|[ { "id": 10 } ]|] { matchHeaders = [matchContentTypeJson] } + put "/only_pk?id=eq.10" [str|[ { "id": 10 } ]|] `shouldRespondWith` 204 + get "/only_pk?id=eq.10" `shouldRespondWith` [json|[ { "id": 10 } ]|] { matchHeaders = [matchContentTypeJson] } + + it "works with return=representation and vnd.pgrst.object+json" $ + request methodPut "/tiobe_pls?name=eq.Ruby" + [("Prefer", "return=representation"), ("Accept", "application/vnd.pgrst.object+json")] + [str| [ { "name": "Ruby", "rank": 11 } ]|] + `shouldRespondWith` [json|{ "name": "Ruby", "rank": 11 }|] { matchHeaders = [matchContentTypeSingular] } diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -6,11 +6,13 @@ import qualified Hasql.Pool as P import PostgREST.App (postgrest) -import PostgREST.Config (pgVersion96) -import PostgREST.DbStructure (getDbStructure, getPgVersion) +import PostgREST.Config (pgVersion95, pgVersion96, configSettings) +import PostgREST.DbStructure (getDbStructure, getPgVersion, fillSessionWithSettings) import PostgREST.Types (DbStructure(..)) +import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction) import Data.Function (id) import Data.IORef +import Data.Time.Clock (getCurrentTime) import qualified Feature.AuthSpec import qualified Feature.AsymmetricJwtSpec @@ -32,6 +34,7 @@ import qualified Feature.RpcSpec import qualified Feature.NonexistentSchemaSpec import qualified Feature.PgVersion96Spec +import qualified Feature.UpsertSpec import Protolude @@ -46,22 +49,27 @@ dbStructure <- pure $ either (panic.show) id result + getTime <- mkAutoUpdate defaultUpdateSettings { updateAction = getCurrentTime } + refDbStructure <- newIORef $ Just dbStructure - let withApp = return $ postgrest (testCfg testDbConn) refDbStructure pool $ pure () - ltdApp = return $ postgrest (testLtdRowsCfg testDbConn) refDbStructure pool $ pure () - unicodeApp = return $ postgrest (testUnicodeCfg testDbConn) refDbStructure pool $ pure () - proxyApp = return $ postgrest (testProxyCfg testDbConn) refDbStructure pool $ pure () - noJwtApp = return $ postgrest (testCfgNoJWT testDbConn) refDbStructure pool $ pure () - binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool $ pure () - audJwtApp = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool $ pure () - asymJwkApp = return $ postgrest (testCfgAsymJWK testDbConn) refDbStructure pool $ pure () - nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool $ pure () + let withApp = return $ postgrest (testCfg testDbConn) refDbStructure pool getTime $ pure () + ltdApp = return $ postgrest (testLtdRowsCfg testDbConn) refDbStructure pool getTime $ pure () + unicodeApp = return $ postgrest (testUnicodeCfg testDbConn) refDbStructure pool getTime $ pure () + proxyApp = return $ postgrest (testProxyCfg testDbConn) refDbStructure pool getTime $ pure () + noJwtApp = return $ postgrest (testCfgNoJWT testDbConn) refDbStructure pool getTime $ pure () + binaryJwtApp = return $ postgrest (testCfgBinaryJWT testDbConn) refDbStructure pool getTime $ pure () + audJwtApp = return $ postgrest (testCfgAudienceJWT testDbConn) refDbStructure pool getTime $ pure () + asymJwkApp = return $ postgrest (testCfgAsymJWK testDbConn) refDbStructure pool getTime $ pure () + nonexistentSchemaApp = return $ postgrest (testNonexistentSchemaCfg testDbConn) refDbStructure pool getTime $ pure () - let reset = resetDb testDbConn + let reset :: IO () + reset = P.use pool (fillSessionWithSettings (configSettings $ testCfg testDbConn)) >> resetDb testDbConn + actualPgVersion = pgVersion dbStructure - pg96spec | actualPgVersion >= pgVersion96 = [("Feature.PgVersion96Spec" , Feature.PgVersion96Spec.spec)] - | otherwise = [] + extraSpecs = + [("Feature.UpsertSpec", Feature.UpsertSpec.spec) | actualPgVersion >= pgVersion95] ++ + [("Feature.PgVersion96Spec", Feature.PgVersion96Spec.spec) | actualPgVersion >= pgVersion96] specs = uncurry describe <$> [ ("Feature.AuthSpec" , Feature.AuthSpec.spec) @@ -76,7 +84,7 @@ , ("Feature.StructureSpec" , Feature.StructureSpec.spec) , ("Feature.AndOrParamsSpec" , Feature.AndOrParamsSpec.spec) , ("Feature.NonexistentSchemaSpec" , Feature.NonexistentSchemaSpec.spec) - ] ++ pg96spec + ] ++ extraSpecs hspec $ do mapM_ (beforeAll_ reset . before withApp) specs diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -17,6 +17,7 @@ import Text.Heredoc import PostgREST.Config (AppConfig(..)) +import PostgREST.Types (JSPathExp(..)) import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai @@ -73,6 +74,11 @@ 10 Nothing (Just "test.switch_role") -- Debug Settings True + [ ("app.settings.app_host", "localhost") + , ("app.settings.external_api_secret", "0123456789abcdef") + ] + -- Default role claim key + (Right [JSPKey "role"]) testCfg :: Text -> AppConfig testCfg testDbConn = _baseCfg { configDatabase = testDbConn }