diff --git a/main/Main.hs b/main/Main.hs --- a/main/Main.hs +++ b/main/Main.hs @@ -2,39 +2,46 @@ module Main where -import Protolude -import PostgREST.App -import PostgREST.Config (AppConfig (..), - PgVersion (..), - minimumPgVersion, - prettyVersion, - readOptions) -import PostgREST.Error (encodeError) -import PostgREST.OpenAPI (isMalformedProxyUri) -import PostgREST.DbStructure -import PostgREST.Types (DbStructure, Schema) +import PostgREST.App (postgrest) +import PostgREST.Config (AppConfig (..), + PgVersion (..), + minimumPgVersion, + prettyVersion, readOptions) +import PostgREST.DbStructure (getDbStructure) +import PostgREST.Error (encodeError) +import PostgREST.OpenAPI (isMalformedProxyUri) +import PostgREST.Types (DbStructure, Schema) +import Protolude hiding (replace, hPutStrLn) -import Control.AutoUpdate -import Control.Retry -import Data.ByteString.Base64 (decode) -import Data.String (IsString (..)) -import Data.Text (stripPrefix, pack, replace) -import Data.Text.Encoding (encodeUtf8, decodeUtf8) -import Data.Text.IO (hPutStrLn, readFile) -import Data.Time.Clock.POSIX (getPOSIXTime) -import qualified Hasql.Query as H -import qualified Hasql.Session as H -import qualified Hasql.Decoders as HD -import qualified Hasql.Encoders as HE -import qualified Hasql.Pool as P -import Network.Wai.Handler.Warp -import System.IO (BufferMode (..), - hSetBuffering) -import Data.IORef +import Control.Retry (RetryStatus, capDelay, + exponentialBackoff, + retrying, rsPreviousDelay) +import Data.ByteString.Base64 (decode) +import Data.IORef (IORef, atomicWriteIORef, + newIORef, readIORef) +import Data.String (IsString (..)) +import Data.Text (pack, replace, stripPrefix, strip) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Text.IO (hPutStrLn, readFile) +import qualified Hasql.Decoders as HD +import qualified Hasql.Encoders as HE +import qualified Hasql.Pool as P +import qualified Hasql.Query as H +import qualified Hasql.Session as H +import Network.Wai.Handler.Warp (defaultSettings, + runSettings, setHost, + setPort, setServerName, + setTimeout) +import System.IO (BufferMode (..), + hSetBuffering) #ifndef mingw32_HOST_OS import System.Posix.Signals #endif +{-| + Used by connectionWorker to know if it should throw an error and kill the + main thread. +-} isServerVersionSupported :: H.Session Bool isServerVersionSupported = do ver <- H.query () pgVersion @@ -45,14 +52,30 @@ HE.unit (HD.singleRow $ HD.value HD.int4) False {-| + The purpose of this worker is to fill the refDbStructure created in 'main' + with the 'DbStructure' returned from calling 'getDbStructure'. This method + is meant to be called by multiple times by the same thread, but does nothing if + the previous invocation has not terminated. In all cases this method does not + halt the calling thread, the work is preformed in a separate thread. + + Note: 'atomicWriteIORef' is essentially a lazy semaphore that prevents two + threads from running 'connectionWorker' at the same time. + Background thread that does the following : 1. Tries to connect to pg server and will keep trying until success. - 2. Checks if the pg version is supported and if it's not it kills the main program. + 2. Checks if the pg version is supported and if it's not it kills the main + program. 3. Obtains the dbStructure. - 4. If 2 or 3 fail to give their result it means the connection is down so it goes back to 1, - otherwise it finishes his work successfully. + 4. If 2 or 3 fail to give their result it means the connection is down so it + goes back to 1, otherwise it finishes his work successfully. -} -connectionWorker :: ThreadId -> P.Pool -> Schema -> IORef (Maybe DbStructure) -> IORef Bool -> IO () +connectionWorker + :: ThreadId -- ^ This thread is killed if 'isServerVersionSupported' returns false + -> P.Pool -- ^ The PostgreSQL connection pool + -> Schema -- ^ Schema PostgREST is serving up + -> IORef (Maybe DbStructure) -- ^ mutable reference to 'DbStructure' + -> IORef Bool -- ^ Used as a binary Semaphore + -> IO () connectionWorker mainTid pool schema refDbStructure refIsWorkerOn = do isWorkerOn <- readIORef refIsWorkerOn unless isWorkerOn $ do @@ -82,7 +105,16 @@ atomicWriteIORef refIsWorkerOn False putStrLn ("Connection successful" :: Text) --- | Connect to pg server if it fails retry with capped exponential backoff until success + +{-| + Used by 'connectionWorker' to check if the provided db-uri lets + the application access the PostgreSQL database. This method is used + the first time the connection is tested, but only to test before + calling 'getDbStructure' inside the 'connectionWorker' method. + + The connection tries are capped, but if the connection times out no error is + thrown, just 'False' is returned. +-} connectingSucceeded :: P.Pool -> IO Bool connectingSucceeded pool = retrying (capDelay 32000000 $ exponentialBackoff 1000000) @@ -103,39 +135,70 @@ putStrLn $ "Attempting to reconnect to the database in " <> (show delay::Text) <> " seconds..." return itShould +{-| + This is where everything starts. +-} main :: IO () main = do + -- + -- LineBuffering: the entire output buffer is flushed whenever a newline is + -- output, the buffer overflows, a hFlush is issued or the handle is closed + -- + -- NoBuffering: output is written immediately and never stored in the buffer hSetBuffering stdout LineBuffering - hSetBuffering stdin LineBuffering + hSetBuffering stdin LineBuffering hSetBuffering stderr NoBuffering - + -- + -- readOptions builds the 'AppConfig' from the config file specified on the + -- command line conf <- loadSecretFile =<< readOptions let host = configHost conf port = configPort conf proxy = configProxyUri conf - pgSettings = toS (configDatabase conf) - appSettings = setHost ((fromString . toS) host) - . setPort port - . setServerName (toS $ "postgrest/" <> prettyVersion) - . setTimeout 3600 - $ defaultSettings - - when (isMalformedProxyUri $ toS <$> proxy) $ panic - "Malformed proxy uri, a correct example: https://example.com:8443/basePath" - + pgSettings = toS (configDatabase conf) -- is the db-uri + 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. + when (isMalformedProxyUri $ toS <$> proxy) $ + panic + "Malformed proxy uri, a correct example: https://example.com:8443/basePath" putStrLn $ ("Listening on port " :: Text) <> show (configPort conf) - + -- + -- create connection pool with the provided settings, returns either + -- a 'Connection' or a 'ConnectionError'. Does not throw. pool <- P.acquire (configPool conf, 10, pgSettings) - + -- + -- To be filled in by connectionWorker refDbStructure <- newIORef Nothing - + -- -- Helper ref to make sure just one connectionWorker can run at a time refIsWorkerOn <- newIORef False - + -- + -- This is passed to the connectionWorker method so it can kill the main + -- thread if the PostgreSQL's version is not supported. mainTid <- myThreadId - - connectionWorker mainTid pool (configSchema conf) refDbStructure refIsWorkerOn - + -- + -- Sets the refDbStructure + connectionWorker + mainTid + pool + (configSchema conf) + refDbStructure + refIsWorkerOn + -- + -- Only for systems with signals: + -- + -- releases the connection pool whenever the program is terminated, + -- see issue #268 + -- + -- Plus the SIGHUP signal updates the internal 'DbStructure' by running + -- 'connectionWorker' exactly as before. #ifndef mingw32_HOST_OS forM_ [sigINT, sigTERM] $ \sig -> void $ installHandler sig (Catch $ do @@ -144,38 +207,75 @@ ) Nothing void $ installHandler sigHUP ( - Catch $ connectionWorker mainTid pool (configSchema conf) refDbStructure refIsWorkerOn - ) Nothing + Catch $ connectionWorker + mainTid + pool + (configSchema conf) + refDbStructure + refIsWorkerOn + ) Nothing #endif - -- ask for the OS time at most once per second - getTime <- mkAutoUpdate - defaultUpdateSettings { updateAction = getPOSIXTime } + -- + -- run the postgrest application + runSettings appSettings $ + postgrest + conf + refDbStructure + pool + (connectionWorker + mainTid + pool + (configSchema conf) + refDbStructure + refIsWorkerOn) - runSettings appSettings $ postgrest conf refDbStructure pool getTime - (connectionWorker mainTid pool (configSchema conf) refDbStructure refIsWorkerOn) +{-| + The purpose of this function is to load the JWT secret from a file if + configJwtSecret is actually a filepath and replaces some characters if the JWT + is base64 encoded. + The reason some characters need to be replaced is because JWT is actually + base64url encoded which must be turned into just base64 before decoding. + + To check if the JWT secret is provided is in fact a file path, it must be + decoded as 'Text' to be processed. + + decodeUtf8: Decode a ByteString containing UTF-8 encoded text that is known to + be valid. +-} loadSecretFile :: AppConfig -> IO AppConfig loadSecretFile conf = extractAndTransform mSecret where - mSecret = decodeUtf8 <$> configJwtSecret conf - isB64 = configJwtSecretIsBase64 conf - + mSecret = decodeUtf8 <$> configJwtSecret conf + isB64 = configJwtSecretIsBase64 conf + -- + -- The Text (variable name secret) here is mSecret from above which is the JWT + -- decoded as Utf8 + -- + -- stripPrefix: Return the suffix of the second string if its prefix matches + -- the entire first string. + -- + -- The configJwtSecret is a filepath instead of the JWT secret itself if the + -- secret has @ as its prefix. extractAndTransform :: Maybe Text -> IO AppConfig - extractAndTransform Nothing = return conf - extractAndTransform (Just s) = - fmap setSecret $ transformString isB64 =<< - case stripPrefix "@" s of - Nothing -> return s - Just filename -> readFile (toS filename) - + extractAndTransform Nothing = return conf + extractAndTransform (Just secret) = + fmap setSecret $ + transformString isB64 =<< + case stripPrefix "@" secret of + Nothing -> return secret + Just filename -> readFile (toS filename) + -- + -- Turns the Base64url encoded JWT into Base64 transformString :: Bool -> Text -> IO ByteString transformString False t = return . encodeUtf8 $ t - transformString True t = - case decode (encodeUtf8 $ replaceUrlChars t) of + transformString True t = + case decode (encodeUtf8 $ strip $ replaceUrlChars t) of Left errMsg -> panic $ pack errMsg Right bs -> return bs - - setSecret bs = conf { configJwtSecret = Just bs } - - replaceUrlChars = replace "_" "/" . replace "-" "+" . replace "." "=" + setSecret bs = conf {configJwtSecret = Just bs} + -- + -- replace: Replace every occurrence of one substring with another + replaceUrlChars = + replace "_" "/" . replace "-" "+" . replace "." "=" diff --git a/postgrest.cabal b/postgrest.cabal --- a/postgrest.cabal +++ b/postgrest.cabal @@ -2,7 +2,7 @@ description: Reads the schema of a PostgreSQL database and creates RESTful routes for the tables and views, supporting all HTTP verbs that security permits. -version: 0.4.2.0 +version: 0.4.3.0 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE @@ -29,14 +29,12 @@ -rtsopts "-with-rtsopts=-N -I2" default-language: Haskell2010 - build-depends: auto-update - , base + build-depends: base , hasql , hasql-pool , postgrest , protolude , text - , time , warp , bytestring , base64-bytestring @@ -52,6 +50,7 @@ build-depends: aeson , ansi-wl-pprint , base >= 4.8 && < 6 + , base64-bytestring , bytestring , case-insensitive , cassava @@ -67,20 +66,19 @@ , http-types , insert-ordered-containers , interpolatedstring-perl6 - , jwt + , jose , lens , lens-aeson , network-uri - , optparse-applicative >= 0.13 && < 0.14 + , optparse-applicative >= 0.13 && < 0.15 , parsec - , protolude + , protolude >= 0.2 , Ranged-sets == 0.3.0 , regex-tdfa , safe , scientific , swagger2 , text - , time , unordered-containers , vector , wai @@ -113,6 +111,7 @@ Hs-Source-Dirs: test Main-Is: Main.hs Other-Modules: Feature.AuthSpec + , Feature.AsymmetricJwtSpec , Feature.BinaryJwtSecretSpec , Feature.ConcurrentSpec , Feature.CorsSpec @@ -132,7 +131,6 @@ Build-Depends: aeson , aeson-qq , async - , auto-update , base , bytestring , base64-bytestring @@ -144,7 +142,7 @@ , hasql-pool , heredoc , hjsonpointer - , hjsonschema + , hjsonschema == 1.5.0.1 , hspec , hspec-wai >= 0.7.0 , hspec-wai-json @@ -156,7 +154,6 @@ , process , protolude , regex-tdfa - , time , transformers-base , wai , wai-extra diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} ---module PostgREST.App where + module PostgREST.App ( postgrest ) where @@ -11,7 +10,6 @@ import Data.Maybe import Data.IORef (IORef, readIORef) import Data.Text (intercalate) -import Data.Time.Clock.POSIX (POSIXTime) import qualified Hasql.Pool as P import qualified Hasql.Transaction as HT @@ -22,7 +20,6 @@ import Network.HTTP.Types.URI (renderSimpleQuery) import Network.Wai import Network.Wai.Middleware.RequestLogger (logStdout) -import Web.JWT (binarySecret) import qualified Data.Vector as V import qualified Hasql.Transaction as H @@ -35,7 +32,7 @@ , mutuallyAgreeable , userApiRequest ) -import PostgREST.Auth (jwtClaims, containsRole) +import PostgREST.Auth (jwtClaims, containsRole, parseJWK) import PostgREST.Config (AppConfig (..)) import PostgREST.DbStructure import PostgREST.DbRequestBuilder( readRequest @@ -63,13 +60,12 @@ import Protolude hiding (intercalate, Proxy) import Safe (headMay) -postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO POSIXTime -> - IO () -> Application -postgrest conf refDbStructure pool getTime worker = - let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in +postgrest :: AppConfig -> IORef (Maybe DbStructure) -> P.Pool -> IO () -> Application +postgrest conf refDbStructure pool 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 @@ -78,9 +74,9 @@ response <- case userApiRequest (configSchema conf) req body of Left err -> return $ apiRequestError err Right apiRequest -> do - let jwtSecret = binarySecret <$> configJwtSecret conf - eClaims = jwtClaims jwtSecret (iJWT apiRequest) time - authed = containsRole eClaims + eClaims <- jwtClaims jwtSecret (toS $ iJWT apiRequest) + + let authed = containsRole eClaims handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest txMode = transactionMode dbStructure (iTarget apiRequest) (iAction apiRequest) @@ -232,15 +228,25 @@ return $ responseLBS status200 [allOrigins, acceptH] "" (ActionInvoke, TargetProc qi, Just (PayloadJSON payload)) -> - case readSqlParts of + let proc = M.lookup (qiName qi) allProcs + returnsScalar = case proc of + Just ProcDescription{pdReturnType = (Single (Scalar _))} -> True + _ -> False + rpcBinaryField = if returnsScalar + then Right Nothing + else binaryField contentType =<< fldNames + partsField = (,) <$> readSqlParts <*> rpcBinaryField in + case partsField of Left errorResponse -> return errorResponse - Right (q, cq) -> do + Right ((q, cq), bField) -> do let p = V.head payload singular = contentType == CTSingularJSON paramsAsSingleObject = iPreferSingleObjectParameter apiRequest row <- H.query () $ - callProc qi p q cq topLevelRange shouldCount singular - paramsAsSingleObject (contentType == CTTextCSV) + callProc qi p returnsScalar q cq topLevelRange shouldCount + singular paramsAsSingleObject + (contentType == CTTextCSV) + (contentType == CTOctetStream) bField let (tableTotal, queryTotal, body) = fromMaybe (Just 0, 0, "[]") row (status, contentRange) = rangeHeader queryTotal tableTotal @@ -257,8 +263,8 @@ 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 = encodeOpenAPI (M.elems $ dbProcs dbStructure) ti uri' - body <- encodeApi . toTableInfo <$> H.query schema accessibleTables + encodeApi ti sd = encodeOpenAPI (M.elems allProcs) (toTableInfo ti) uri' sd (dbPrimaryKeys dbStructure) + body <- encodeApi <$> H.query schema accessibleTables <*> H.query schema schemaDescription return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body _ -> return notFound @@ -276,6 +282,7 @@ 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 @@ -287,7 +294,7 @@ status = rangeStatus lower upper (toInteger <$> tableTotal) in (status, contentRange) - readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (dbProcs dbStructure) apiRequest + readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) allProcs apiRequest fldNames = fieldNames <$> readReq readDbRequest = DbRead <$> readReq mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames) @@ -306,14 +313,14 @@ ActionCreate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ActionUpdate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ActionDelete -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] - ActionInvoke -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] + ActionInvoke -> [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream] ActionInspect -> [CTOpenAPI, CTApplicationJSON] ActionInfo -> [CTTextCSV] serves sProduces cAccepts = case mutuallyAgreeable sProduces cAccepts of Nothing -> do let failed = intercalate ", " $ map (toS . toMime) cAccepts - Left $ simpleError status415 $ + Left $ simpleError status415 [] $ "None of these Content-Types are available: " <> failed Just ct -> Right ct diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -14,63 +14,48 @@ module PostgREST.Auth ( containsRole , jwtClaims - , tokenJWT , JWTAttempt(..) + , parseJWK ) where -import Protolude +import Protolude hiding ((&)) import Control.Lens -import Data.Aeson (Value (..), parseJSON, toJSON) -import Data.Aeson.Lens -import Data.Aeson.Types (parseMaybe, emptyObject, emptyArray) -import qualified Data.Vector as V +import Data.Aeson (Value (..), decode, toJSON) +import qualified Data.ByteString.Lazy as BL import qualified Data.HashMap.Strict as M -import Data.Maybe (fromJust) -import Data.Time.Clock (NominalDiffTime) -import qualified Web.JWT as JWT +import Crypto.JOSE.Compact +import Crypto.JOSE.JWK +import Crypto.JOSE.JWS +import Crypto.JOSE.Types +import Crypto.JWT {-| Possible situations encountered with client JWTs -} -data JWTAttempt = JWTExpired - | JWTInvalid +data JWTAttempt = JWTInvalid JWTError | JWTMissingSecret | JWTClaims (M.HashMap Text Value) - deriving Eq + deriving (Eq, Show) {-| Receives the JWT secret (from config) and a JWT and returns a map of JWT claims. -} -jwtClaims :: Maybe JWT.Secret -> Text -> NominalDiffTime -> JWTAttempt -jwtClaims _ "" _ = JWTClaims M.empty -jwtClaims secret jwt time = +jwtClaims :: Maybe JWK -> BL.ByteString -> IO JWTAttempt +jwtClaims _ "" = return $ JWTClaims M.empty +jwtClaims secret payload = case secret of - Nothing -> JWTMissingSecret - Just s -> - let mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature s jwt in - case isExpired <$> mClaims of - Just True -> JWTExpired - Nothing -> JWTInvalid - Just False -> JWTClaims $ value2map $ fromJust mClaims - where - isExpired claims = - let mExp = claims ^? key "exp" . _Integer - in fromMaybe False $ (<= time) . fromInteger <$> mExp - value2map (Object o) = o - value2map _ = M.empty - -{-| - Receives the JWT secret (from config) and a JWT and a JSON value - and returns a signed JWT. --} -tokenJWT :: JWT.Secret -> Value -> Text -tokenJWT secret (Array arr) = - let obj = if V.null arr then emptyObject else V.head arr - jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in - JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs -tokenJWT secret _ = tokenJWT secret emptyArray + Nothing -> return JWTMissingSecret + Just jwk -> do + let validation = defaultJWTValidationSettings + eJwt <- runExceptT $ do + jwt <- decodeCompact payload + validateJWSJWT validation jwk jwt + return jwt + return $ case eJwt of + Left e -> JWTInvalid e + Right jwt -> JWTClaims . claims2map . jwtClaimsSet $ jwt {-| Whether a response from jwtClaims contains a role claim @@ -78,3 +63,30 @@ 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) + +{-| + Internal helper to generate HMAC-SHA256. When the jwt key in the + config file is a simple string rather than a JWK object, we'll + apply this function to it. +-} +hs256jwk :: ByteString -> JWK +hs256jwk key = + fromKeyMaterial km + & jwkUse .~ Just Sig + & jwkAlg .~ (Just $ JWSAlg HS256) + where + km = OctKeyMaterial (OctKeyParameters Oct (Base64Octets key)) diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -45,7 +45,7 @@ import Text.Heredoc import Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>)) import qualified Text.PrettyPrint.ANSI.Leijen as L -import Protolude hiding (intercalate, (<>)) +import Protolude hiding (intercalate, (<>), hPutStrLn) -- | Config file settings for the server data AppConfig = AppConfig { @@ -108,13 +108,13 @@ <*> C.key "db-anon-role" <*> C.key "server-proxy-uri" <*> C.key "db-schema" - <*> (fromMaybe "*4" <$> C.key "server-host") + <*> (fromMaybe "*4" . mfilter (/= "") <$> C.key "server-host") <*> (fromMaybe 3000 . join . fmap coerceInt <$> C.key "server-port") <*> (fmap encodeUtf8 . mfilter (/= "") <$> C.key "jwt-secret") - <*> (fromMaybe False <$> C.key "secret-is-base64") + <*> (fromMaybe False . join . fmap coerceBool <$> C.key "secret-is-base64") <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool") <*> (join . fmap coerceInt <$> C.key "max-rows") - <*> C.key "pre-request" + <*> (mfilter (/= "") <$> C.key "pre-request") <*> pure False case mAppConf of @@ -129,6 +129,11 @@ coerceInt (Number x) = rightToMaybe $ floatingOrInteger x coerceInt (String x) = readMaybe $ toS x coerceInt _ = Nothing + + coerceBool :: Value -> Maybe Bool + coerceBool (Bool b) = Just b + coerceBool (String x) = readMaybe $ toS x + coerceBool _ = Nothing opts = info (helper <*> pathParser) $ fullDesc diff --git a/src/PostgREST/DbRequestBuilder.hs b/src/PostgREST/DbRequestBuilder.hs --- a/src/PostgREST/DbRequestBuilder.hs +++ b/src/PostgREST/DbRequestBuilder.hs @@ -30,7 +30,7 @@ import PostgREST.Error (apiRequestError) import PostgREST.Parsers import PostgREST.RangeQuery (NonnegRange, restrictRange) -import PostgREST.QueryBuilder (getJoinConditions, sourceCTEName) +import PostgREST.QueryBuilder (getJoinFilters, sourceCTEName) import PostgREST.Types import Protolude hiding (from, dropWhile, drop) @@ -88,12 +88,12 @@ augumentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either ApiRequestError ReadRequest augumentRequestWithJoin schema allRels request = addRelations schema allRels Nothing request - >>= addJoinConditions schema + >>= addJoinFilters schema addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest -addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias)) forest) = +addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias, relationDetail)) forest) = case parentNode of - (Just (Node (Select{from=[parentNodeTable]}, (_, _, _)) _)) -> + (Just (Node (Select{from=[parentNodeTable]}, (_, _, _, _)) _)) -> Node <$> readNode' <*> forest' where forest' = updateForest $ hush node' @@ -101,10 +101,10 @@ readNode' = addRel readNode <$> rel rel :: Either ApiRequestError Relation rel = note (NoRelationBetween parentNodeTable name) - $ findRelation schema name parentNodeTable - + $ findRelation schema name parentNodeTable relationDetail where - findRelation s nodeTableName parentNodeTableName = + + 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 @@ -141,35 +141,68 @@ -- addRelation will turn project_id to project so the above condition will match ) ) allRelations - where n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString) - addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) - addRel (query', (n, _, a)) r = (query' {from=fromRelation}, (n, Just r, a)) + + 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) => 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 + ) + || + + + -- (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') _ -> n' <$> updateForest (Just (n' forest)) where - n' = Node (query, (name, Just r, alias)) - t = Table schema name True -- !!! TODO find another way to get the table from the query + 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 -addJoinConditions :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest -addJoinConditions schema (Node nn@(query, (n, r, a)) forest) = - case r of - Just Relation{relType=Root} -> Node nn <$> updatedForest -- this is the root node - Just rel@Relation{relType=Child} -> Node (addCond query (getJoinConditions rel),(n,r,a)) <$> updatedForest - Just Relation{relType=Parent} -> Node nn <$> updatedForest +addJoinFilters :: Schema -> ReadRequest -> Either ApiRequestError ReadRequest +addJoinFilters schema (Node node@(query, nodeProps@(_, relation, _, _)) forest) = + case relation of + Just Relation{relType=Root} -> Node node <$> updatedForest -- this is the root node + Just Relation{relType=Parent} -> Node node <$> updatedForest + Just rel@Relation{relType=Child} -> Node (augmentQuery rel, nodeProps) <$> updatedForest Just rel@Relation{relType=Many, relLTable=(Just linkTable)} -> - Node (qq, (n, r, a)) <$> updatedForest - where - query' = addCond query (getJoinConditions rel) - qq = query'{from=tableName linkTable : from query'} + let rq = augmentQuery rel in + Node (rq{from=tableName linkTable:from rq}, nodeProps) <$> updatedForest _ -> Left UnknownRelation where - updatedForest = mapM (addJoinConditions schema) forest - addCond query' con = query'{flt_=con ++ flt_ query'} + updatedForest = mapM (addJoinFilters schema) forest + augmentQuery rel = foldr addFilterToReadQuery query (getJoinFilters rel) + addFilterToReadQuery flt rq@Select{where_=lf} = rq{where_=addFilterToLogicForest flt lf}::ReadQuery addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest) addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [ @@ -198,7 +231,7 @@ ranges = mapM pRequestRange $ M.toList $ iRange apiRequest addFilterToNode :: Filter -> ReadRequest -> ReadRequest -addFilterToNode flt (Node (q@Select {flt_=flts}, i) f) = Node (q {flt_=flt:flts}, i) f +addFilterToNode flt (Node (q@Select {where_=lf}, i) f) = Node (q{where_=addFilterToLogicForest flt lf}::ReadQuery, i) f addFilter :: (EmbedPath, Filter) -> ReadRequest -> ReadRequest addFilter = addProperty addFilterToNode @@ -216,7 +249,7 @@ addRange = addProperty addRangeToNode addLogicTreeToNode :: LogicTree -> ReadRequest -> ReadRequest -addLogicTreeToNode t (Node (q@Select{logic=l},i) f) = Node (q{logic=t:l}::ReadQuery, i) f +addLogicTreeToNode t (Node (q@Select{where_=lf},i) f) = Node (q{where_=t:lf}::ReadQuery, i) f addLogicTree :: (EmbedPath, LogicTree) -> ReadRequest -> ReadRequest addLogicTree = addProperty addLogicTreeToNode @@ -240,7 +273,7 @@ maybeNode = find fnd forst where fnd :: ReadRequest -> Bool - fnd (Node (_,(n,_,_)) _) = n == name + fnd (Node (_,(n,_,_,_)) _) = n == name -- in a relation where one of the tables mathces "TableName" -- replace the name to that table with pg_source @@ -258,8 +291,8 @@ mutateRequest apiRequest fldNames = mapLeft apiRequestError $ case action of ActionCreate -> Right $ Insert rootTableName payload returnings - ActionUpdate -> Update rootTableName <$> pure payload <*> filters <*> logic_ <*> pure returnings - ActionDelete -> Delete rootTableName <$> filters <*> logic_ <*> pure returnings + ActionUpdate -> Update rootTableName <$> pure payload <*> combinedLogic <*> pure returnings + ActionDelete -> Delete rootTableName <$> combinedLogic <*> pure returnings _ -> Left UnsupportedVerb where action = iAction apiRequest @@ -271,10 +304,10 @@ _ -> undefined returnings = if iPreferRepresentation apiRequest == None then [] else fldNames filters = map snd <$> mapM pRequestFilter mutateFilters - logic_ = map snd <$> mapM pRequestLogicTree logicFilters + logic = map snd <$> mapM pRequestLogicTree logicFilters + combinedLogic = foldr addFilterToLogicForest <$> logic <*> filters -- update/delete filters can be only on the root table - mutateFilters = onlyRoot $ iFilters apiRequest - logicFilters = onlyRoot $ iLogic apiRequest + (mutateFilters, logicFilters) = join (***) onlyRoot (iFilters apiRequest, iLogic apiRequest) onlyRoot = filter (not . ( "." `isInfixOf` ) . fst) fieldNames :: ReadRequest -> [FieldName] @@ -282,5 +315,10 @@ 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 +-- they are later concatenated with AND in the QueryBuilder +addFilterToLogicForest :: Filter -> [LogicTree] -> [LogicTree] +addFilterToLogicForest flt lf = Stmnt flt : lf diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -6,6 +6,7 @@ module PostgREST.DbStructure ( getDbStructure , accessibleTables +, schemaDescription ) where import qualified Hasql.Decoders as HD @@ -52,7 +53,9 @@ decodeTables = HD.rowsList tblRow where - tblRow = Table <$> HD.value HD.text <*> HD.value HD.text + tblRow = Table <$> HD.value HD.text + <*> HD.value HD.text + <*> HD.nullableValue HD.text <*> HD.value HD.bool decodeColumns :: [Table] -> HD.Result [Column] @@ -60,11 +63,11 @@ mapMaybe (columnFromRow tables) <$> HD.rowsList colRow where colRow = - (,,,,,,,,,,) + (,,,,,,,,,,,) <$> HD.value HD.text <*> HD.value HD.text - <*> HD.value HD.text <*> HD.value HD.int4 - <*> HD.value HD.bool <*> HD.value HD.text - <*> HD.value HD.bool + <*> HD.value HD.text <*> HD.nullableValue HD.text + <*> HD.value HD.int4 <*> HD.value HD.bool + <*> HD.value HD.text <*> HD.value HD.bool <*> HD.nullableValue HD.int4 <*> HD.nullableValue HD.int4 <*> HD.nullableValue HD.text @@ -103,6 +106,7 @@ (M.fromList . map addName <$> HD.rowsList ( ProcDescription <$> HD.value HD.text + <*> HD.nullableValue HD.text <*> (parseArgs <$> HD.value HD.text) <*> (parseRetType <$> HD.value HD.text <*> @@ -137,7 +141,9 @@ qi = QualifiedIdentifier schema name pgType = case typ of 'c' -> Composite qi - 'p' -> Pseudo name + 'p' -> if name == "record" -- Only pg pseudo type that is a row type is 'record' + then Composite qi + else Scalar qi _ -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange parseVolatility :: Char -> ProcVolatility @@ -148,6 +154,7 @@ sql = [q| SELECT p.proname as "proc_name", + d.description as "proc_description", pg_get_function_arguments(p.oid) as "args", tn.nspname as "rettype_schema", coalesce(comp.relname, t.typname) as "rettype_name", @@ -159,8 +166,22 @@ JOIN pg_type t ON t.oid = p.prorettype JOIN pg_namespace tn ON tn.oid = t.typnamespace LEFT JOIN pg_class comp ON comp.oid = t.typrelid + LEFT JOIN pg_catalog.pg_description as d on d.objoid = p.oid WHERE pn.nspname = $1|] +schemaDescription :: H.Query Schema (Maybe Text) +schemaDescription = + H.statement sql (HE.value HE.text) (HD.singleRow $ HD.nullableValue HD.text) True + where + sql = [q| + select + description + from + pg_catalog.pg_namespace n + left join pg_catalog.pg_description d on d.objoid = n.oid + where + n.nspname = $1 |] + accessibleTables :: H.Query Schema [Table] accessibleTables = H.statement sql (HE.value HE.text) decodeTables True @@ -169,6 +190,7 @@ select n.nspname as table_schema, relname as table_name, + d.description as table_description, c.relkind = 'r' or (c.relkind IN ('v', 'f')) and (pg_relation_is_updatable(c.oid::regclass, false) & 8) = 8 or (exists ( select 1 @@ -178,6 +200,7 @@ from pg_class c 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') and n.nspname = $1 @@ -230,7 +253,11 @@ 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 - combinations k ns = filter ((k==).length) (subsequences ns) + -- 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' link2Relation [ @@ -269,6 +296,7 @@ SELECT n.nspname AS table_schema, c.relname AS table_name, + NULL AS table_description, c.relkind = 'r' OR (c.relkind IN ('v','f')) AND (pg_relation_is_updatable(c.oid::regclass, FALSE) & 8) = 8 OR (EXISTS @@ -292,6 +320,7 @@ info.table_schema AS schema, info.table_name AS table_name, info.column_name AS name, + info.description AS description, info.ordinal_position AS position, info.is_nullable::boolean AS nullable, info.data_type AS col_type, @@ -309,6 +338,7 @@ nc.nspname::information_schema.sql_identifier AS table_schema, c.relname::information_schema.sql_identifier AS table_name, a.attname::information_schema.sql_identifier AS column_name, + d.description::information_schema.sql_identifier AS description, a.attnum::information_schema.cardinal_number AS ordinal_position, pg_get_expr(ad.adbin, ad.adrelid)::information_schema.character_data AS column_default, CASE @@ -381,6 +411,7 @@ ELSE 'NO'::text END::information_schema.yes_or_no AS is_updatable FROM pg_attribute a + LEFT JOIN pg_catalog.pg_description AS d ON d.objoid = a.attrelid and d.objsubid = a.attnum LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid AND a.attnum = ad.adnum JOIN (pg_class c JOIN pg_namespace nc ON c.relnamespace = nc.oid) ON a.attrelid = c.oid @@ -397,6 +428,7 @@ table_schema, table_name, column_name, + description, ordinal_position, is_nullable, data_type, @@ -422,14 +454,14 @@ ORDER BY schema, position |] columnFromRow :: [Table] -> - (Text, Text, Text, - Int32, Bool, Text, - Bool, Maybe Int32, Maybe Int32, - Maybe Text, Maybe Text) + (Text, Text, Text, + Maybe Text, Int32, Bool, + Text, Bool, Maybe Int32, + Maybe Int32, Maybe Text, Maybe Text) -> Maybe Column -columnFromRow tabs (s, t, n, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table +columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn <$> table where - buildColumn tbl = Column tbl n pos nul typ u l p d (parseEnum e) Nothing + buildColumn tbl = Column tbl n desc pos nul typ u l p d (parseEnum e) Nothing table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs parseEnum :: Maybe Text -> [Text] parseEnum str = fromMaybe [] $ split (==',') <$> str diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -18,12 +18,15 @@ import Data.Text (unwords) import qualified Hasql.Pool as P import qualified Hasql.Session as H +import Network.HTTP.Types.Header import qualified Network.HTTP.Types.Status as HT import Network.Wai (Response, responseLBS) import PostgREST.Types apiRequestError :: ApiRequestError -> Response -apiRequestError err = errorResponse status err +apiRequestError err = + errorResponse status + [toHeader CTApplicationJSON] err where status = case err of @@ -35,13 +38,14 @@ InvalidRange -> HT.status416 UnknownRelation -> HT.status404 -simpleError :: HT.Status -> Text -> Response -simpleError status message = - errorResponse status $ JSON.object ["message" .= message] +simpleError :: HT.Status -> [Header] -> Text -> Response +simpleError status hdrs message = + errorResponse status (toHeader CTApplicationJSON : hdrs) $ + JSON.object ["message" .= message] -errorResponse :: JSON.ToJSON a => HT.Status -> a -> Response -errorResponse status e = - responseLBS status [toHeader CTApplicationJSON] $ encodeError e +errorResponse :: JSON.ToJSON a => HT.Status -> [Header] -> a -> Response +errorResponse status hdrs e = + responseLBS status hdrs $ encodeError e pgError :: Bool -> P.UsageError -> Response pgError authed e = @@ -71,12 +75,12 @@ binaryFieldError :: Response binaryFieldError = - simpleError HT.status406 (toS (toMime CTOctetStream) <> + simpleError HT.status406 [] (toS (toMime CTOctetStream) <> " requested but a single column was not selected") connectionLostError :: Response connectionLostError = - simpleError HT.status503 "Database connection lost, retrying the connection." + simpleError HT.status503 [] "Database connection lost, retrying the connection." encodeError :: JSON.ToJSON a => a -> LByteString encodeError = JSON.encode diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -4,13 +4,13 @@ module PostgREST.Middleware where +import Crypto.JWT import Data.Aeson (Value (..)) import qualified Data.HashMap.Strict as M import qualified Hasql.Transaction as H import Network.HTTP.Types.Status (unauthorized401, status500) -import Network.Wai (Application, Response, - responseLBS) +import Network.Wai (Application, Response) import Network.Wai.Middleware.Cors (cors) import Network.Wai.Middleware.Gzip (def, gzip) import Network.Wai.Middleware.Static (only, staticPolicy) @@ -19,7 +19,6 @@ import PostgREST.Auth (JWTAttempt(..)) import PostgREST.Config (AppConfig (..), corsPolicy) import PostgREST.Error (simpleError) -import PostgREST.Types (ContentType (..), toHeader) import PostgREST.QueryBuilder (pgFmtLit, unquoted, pgFmtEnvVar) import Protolude hiding (concat, null) @@ -29,9 +28,9 @@ ApiRequest -> H.Transaction Response runWithClaims conf eClaims app req = case eClaims of - JWTExpired -> return $ unauthed "JWT expired" - JWTInvalid -> return $ unauthed "JWT invalid" - JWTMissingSecret -> return $ simpleError status500 "Server lacks JWT secret" + JWTInvalid JWTExpired -> return $ unauthed "JWT expired" + 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 mapM_ H.sql customReqCheck @@ -47,14 +46,13 @@ anon = String . toS $ configAnonRole conf customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf where - unauthed message = responseLBS unauthorized401 - [ toHeader CTApplicationJSON - , ( "WWW-Authenticate" + unauthed message = simpleError + unauthorized401 + [( "WWW-Authenticate" , "Bearer error=\"invalid_token\", " <> - "error_description=\"" <> message <> "\"" - ) - ] - (toS $ "{\"message\":\""<>message<>"\"}") + "error_description=" <> show message + )] + message defaultMiddle :: Application -> Application defaultMiddle = diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -6,25 +6,25 @@ , pickProxy ) where +import Control.Arrow ((&&&)) import Control.Lens import Data.Aeson (decode, encode) -import qualified Data.HashMap.Strict as M import Data.HashMap.Strict.InsOrd (InsOrdHashMap, fromList) import Data.Maybe (fromJust) import qualified Data.Set as Set import Data.String (IsString (..)) -import Data.Text (unpack, pack, concat, intercalate, init, tail, toLower) +import Data.Text (unpack, pack, init, tail, toLower, intercalate, append, dropWhile, breakOn) import Network.URI (parseURI, isAbsoluteURI, URI (..), URIAuth (..)) -import Protolude hiding (concat, (&), Proxy, get, intercalate) +import Protolude hiding ((&), Proxy, get, intercalate, dropWhile) import Data.Swagger import PostgREST.ApiRequest (ContentType(..)) import PostgREST.Config (prettyVersion) -import PostgREST.Types (Table(..), Column(..), PgArg(..), - Proxy(..), ProcDescription(..), toMime, operators) +import PostgREST.Types (Table(..), Column(..), PgArg(..), ForeignKey(..), + PrimaryKey(..), Proxy(..), ProcDescription(..), toMime) makeMimeList :: [ContentType] -> MimeList makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs @@ -36,30 +36,48 @@ toSwaggerType "numeric" = SwaggerNumber toSwaggerType _ = SwaggerString -makeTableDef :: (Table, [Column], [Text]) -> (Text, Schema) -makeTableDef (t, cs, _) = +makeTableDef :: [PrimaryKey] -> (Table, [Column], [Text]) -> (Text, Schema) +makeTableDef pks (t, cs, _) = let tn = tableName t in (tn, (mempty :: Schema) + & description .~ tableDescription t & type_ .~ SwaggerObject - & properties .~ fromList (map makeProperty cs)) + & properties .~ fromList (map (makeProperty pks) cs)) -makeProperty :: Column -> (Text, Referenced Schema) -makeProperty c = (colName c, Inline u) +makeProperty :: [PrimaryKey] -> Column -> (Text, Referenced Schema) +makeProperty pks c = (colName c, Inline s) where - r = mempty :: Schema - s = if null $ colEnum c - then r - else r & enum_ .~ decode (encode (colEnum c)) - t = s & type_ .~ toSwaggerType (colType c) - u = t & format ?~ colType c + e = if null $ colEnum c then Nothing else decode $ encode $ colEnum c + fk ForeignKey{fkCol=Column{colTable=Table{tableName=a}, colName=b}} = + intercalate "" ["This is a Foreign Key to `", a, ".", b, "`."] + pk :: Bool + pk = any (\p -> pkTable p == colTable c && pkName p == colName c) pks + n = catMaybes + [ Just "Note:" + , if pk then Just "This is a Primary Key." else Nothing + , fk <$> colFK c + ] + d = + if length n > 1 then + Just $ append (fromMaybe "" ((`append` "\n\n") <$> colDescription c)) (intercalate "\n" n) + else + colDescription c + s = + (mempty :: Schema) + & default_ .~ (decode . toS =<< colDefault c) + & description .~ d + & enum_ .~ e + & format ?~ colType c + & maxLength .~ (fromIntegral <$> colMaxLen c) + & type_ .~ toSwaggerType (colType c) -makeProcDef :: ProcDescription -> (Text, Schema) -makeProcDef pd = ("(rpc) " <> pdName pd, s) - where - s = (mempty :: Schema) - & type_ .~ SwaggerObject - & properties .~ fromList (map makeProcProperty (pdArgs pd)) - & required .~ map pgaName (filter pgaReq (pdArgs pd)) +makeProcSchema :: ProcDescription -> Schema +makeProcSchema pd = + (mempty :: Schema) + & description .~ pdDescription pd + & type_ .~ SwaggerObject + & properties .~ fromList (map makeProcProperty (pdArgs pd)) + & required .~ map pgaName (filter pgaReq (pdArgs pd)) makeProcProperty :: PgArg -> (Text, Referenced Schema) makeProcProperty (PgArg n t _) = (n, Inline s) @@ -68,68 +86,6 @@ & type_ .~ toSwaggerType t & format ?~ t -makeOperatorPattern :: Text -makeOperatorPattern = - intercalate "|" - [ concat ["^", x, y, "[.]"] | - x <- ["not[.]", ""], - y <- M.keys operators ] - -makeRowFilter :: Column -> Param -makeRowFilter c = - (mempty :: Param) - & name .~ colName c - & required ?~ False - & schema .~ ParamOther ((mempty :: ParamOtherSchema) - & in_ .~ ParamQuery - & type_ .~ SwaggerString - & format ?~ colType c - & pattern ?~ makeOperatorPattern) - -makeRowFilters :: [Column] -> [Param] -makeRowFilters = map makeRowFilter - -makeOrderItems :: [Column] -> [Text] -makeOrderItems cs = - [ concat [x, y, z] | - x <- map colName cs, - y <- [".asc", ".desc", ""], - z <- [".nullsfirst", ".nulllast", ""] - ] - -makeRangeParams :: [Param] -makeRangeParams = - [ (mempty :: Param) - & name .~ "Range" - & description ?~ "Limiting and Pagination" - & required ?~ False - & schema .~ ParamOther ((mempty :: ParamOtherSchema) - & in_ .~ ParamHeader - & type_ .~ SwaggerString) - , (mempty :: Param) - & name .~ "Range-Unit" - & description ?~ "Limiting and Pagination" - & required ?~ False - & schema .~ ParamOther ((mempty :: ParamOtherSchema) - & in_ .~ ParamHeader - & type_ .~ SwaggerString - & default_ .~ decode "\"items\"") - , (mempty :: Param) - & name .~ "offset" - & description ?~ "Limiting and Pagination" - & required ?~ False - & schema .~ ParamOther ((mempty :: ParamOtherSchema) - & in_ .~ ParamQuery - & type_ .~ SwaggerString) - , (mempty :: Param) - & name .~ "limit" - & description ?~ "Limiting and Pagination" - & required ?~ False - & schema .~ ParamOther ((mempty :: ParamOtherSchema) - & in_ .~ ParamQuery - & type_ .~ SwaggerString) - ] - makePreferParam :: [Text] -> Param makePreferParam ts = (mempty :: Param) @@ -141,92 +97,131 @@ & type_ .~ SwaggerString & enum_ .~ decode (encode ts)) -makeSelectParam :: Param -makeSelectParam = - (mempty :: Param) - & name .~ "select" - & description ?~ "Filtering Columns" - & required ?~ False - & schema .~ ParamOther ((mempty :: ParamOtherSchema) - & in_ .~ ParamQuery - & type_ .~ SwaggerString) +makeProcParam :: ProcDescription -> [Referenced Param] +makeProcParam pd = + [ Inline $ (mempty :: Param) + & name .~ "args" + & required ?~ True + & schema .~ (ParamBody $ Inline $ makeProcSchema pd) + , Ref $ Reference "preferParams" + ] -makeGetParams :: [Column] -> [Param] -makeGetParams [] = - makeRangeParams ++ - [ makeSelectParam - , makePreferParam ["count=none"] +makeParamDefs :: [(Table, [Column], [Text])] -> [(Text, Param)] +makeParamDefs ti = + [ ("preferParams", makePreferParam ["params=single-object"]) + , ("preferReturn", makePreferParam ["return=representation", "return=minimal", "return=none"]) + , ("preferCount", makePreferParam ["count=none"]) + , ("select", (mempty :: Param) + & name .~ "select" + & description ?~ "Filtering Columns" + & required ?~ False + & schema .~ ParamOther ((mempty :: ParamOtherSchema) + & in_ .~ ParamQuery + & type_ .~ SwaggerString)) + , ("order", (mempty :: Param) + & name .~ "order" + & description ?~ "Ordering" + & required ?~ False + & schema .~ ParamOther ((mempty :: ParamOtherSchema) + & in_ .~ ParamQuery + & type_ .~ SwaggerString)) + , ("range", (mempty :: Param) + & name .~ "Range" + & description ?~ "Limiting and Pagination" + & required ?~ False + & schema .~ ParamOther ((mempty :: ParamOtherSchema) + & in_ .~ ParamHeader + & type_ .~ SwaggerString)) + , ("rangeUnit", (mempty :: Param) + & name .~ "Range-Unit" + & description ?~ "Limiting and Pagination" + & required ?~ False + & schema .~ ParamOther ((mempty :: ParamOtherSchema) + & in_ .~ ParamHeader + & type_ .~ SwaggerString + & default_ .~ decode "\"items\"")) + , ("offset", (mempty :: Param) + & name .~ "offset" + & description ?~ "Limiting and Pagination" + & required ?~ False + & schema .~ ParamOther ((mempty :: ParamOtherSchema) + & in_ .~ ParamQuery + & type_ .~ SwaggerString)) + , ("limit", (mempty :: Param) + & name .~ "limit" + & description ?~ "Limiting and Pagination" + & required ?~ False + & schema .~ ParamOther ((mempty :: ParamOtherSchema) + & in_ .~ ParamQuery + & type_ .~ SwaggerString)) ] -makeGetParams cs = - makeRangeParams ++ - [ makeSelectParam - , (mempty :: Param) - & name .~ "order" - & description ?~ "Ordering" - & required ?~ False + <> concat [ makeObjectBody (tableName t) : makeRowFilters (tableName t) cs + | (t, cs, _) <- ti + ] + +makeObjectBody :: Text -> (Text, Param) +makeObjectBody tn = + ("body." <> tn, (mempty :: Param) + & name .~ tn + & description ?~ tn + & required ?~ False + & schema .~ ParamBody (Ref (Reference tn))) + +makeRowFilter :: Text -> Column -> (Text, Param) +makeRowFilter tn c = + (intercalate "." ["rowFilter", tn, colName c], (mempty :: Param) + & name .~ colName c + & description .~ colDescription c + & required ?~ False & schema .~ ParamOther ((mempty :: ParamOtherSchema) & in_ .~ ParamQuery & type_ .~ SwaggerString - & enum_ .~ decode (encode $ makeOrderItems cs)) - , makePreferParam ["count=none"] - ] - -makePostParams :: Text -> [Param] -makePostParams tn = - [ makePreferParam ["return=representation", - "return=minimal", "return=none"] - , (mempty :: Param) - & name .~ "body" - & description ?~ tn - & required ?~ False - & schema .~ ParamBody (Ref (Reference tn)) - ] - -makeProcParam :: Text -> [Param] -makeProcParam refName = - [ makePreferParam ["params=single-object"] - , (mempty :: Param) - & name .~ "args" - & required ?~ True - & schema .~ ParamBody (Ref (Reference refName)) - ] + & format ?~ colType c)) -makeDeleteParams :: [Param] -makeDeleteParams = - [ makePreferParam ["return=representation", "return=minimal", "return=none"] ] +makeRowFilters :: Text -> [Column] -> [(Text, Param)] +makeRowFilters tn = map (makeRowFilter tn) makePathItem :: (Table, [Column], [Text]) -> (FilePath, PathItem) makePathItem (t, cs, _) = ("/" ++ unpack tn, p $ tableInsertable t) where + -- Use first line of table description as summary; rest as description (if present) + -- We strip leading newlines from description so that users can include a blank line between summary and description + (tSum, tDesc) = fmap fst &&& fmap (dropWhile (=='\n') . snd) $ + breakOn "\n" <$> tableDescription t tOp = (mempty :: Operation) & tags .~ Set.fromList [tn] - & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV] - & at 200 ?~ "OK" + & summary .~ tSum + & description .~ mfilter (/="") tDesc getOp = tOp - & parameters .~ map Inline (makeGetParams cs ++ rs) + & parameters .~ map ref (rs <> ["select", "order", "range", "rangeUnit", "offset", "limit", "preferCount"]) & at 206 ?~ "Partial Content" + & at 200 ?~ Inline ((mempty :: Response) + & description .~ "OK" + & schema ?~ (Ref $ Reference $ tableName t) + ) postOp = tOp - & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV] - & parameters .~ map Inline (makePostParams tn) + & parameters .~ map ref ["body." <> tn, "preferReturn"] & at 201 ?~ "Created" patchOp = tOp - & consumes ?~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV] - & parameters .~ map Inline (makePostParams tn ++ rs) + & parameters .~ map ref (rs <> ["body." <> tn, "preferReturn"]) & at 204 ?~ "No Content" deletOp = tOp - & parameters .~ map Inline (makeDeleteParams ++ rs) + & parameters .~ map ref (rs <> ["preferReturn"]) + & at 204 ?~ "No Content" pr = (mempty :: PathItem) & get ?~ getOp pw = pr & post ?~ postOp & patch ?~ patchOp & delete ?~ deletOp p False = pr p True = pw - rs = makeRowFilters cs tn = tableName t + rs = [ intercalate "." ["rowFilter", tn, colName c ] | c <- cs ] + ref = Ref . Reference makeProcPathItem :: ProcDescription -> (FilePath, PathItem) makeProcPathItem pd = ("/rpc/" ++ toS (pdName pd), pe) where postOp = (mempty :: Operation) - & parameters .~ map Inline (makeProcParam $ "(rpc) " <> pdName pd) + & description .~ pdDescription pd + & parameters .~ makeProcParam pd & tags .~ Set.fromList ["(rpc) " <> pdName pd] & produces ?~ makeMimeList [CTApplicationJSON, CTSingularJSON] & at 200 ?~ "OK" @@ -236,7 +231,8 @@ makeRootPathItem = ("/", p) where getOp = (mempty :: Operation) - & tags .~ Set.fromList ["/"] + & tags .~ Set.fromList ["Introspection"] + & summary ?~ "OpenAPI description (this document)" & produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON] & at 200 ?~ "OK" pr = (mempty :: PathItem) & get ?~ getOp @@ -254,23 +250,30 @@ escapeHostName "!6" = "0.0.0.0" escapeHostName h = h -postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Swagger -postgrestSpec pds ti (s, h, p, b) = (mempty :: Swagger) +postgrestSpec :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> Swagger +postgrestSpec pds ti (s, h, p, b) sd pks = (mempty :: Swagger) & basePath ?~ unpack b & schemes ?~ [s'] & info .~ ((mempty :: Info) & version .~ prettyVersion & title .~ "PostgREST API" - & description ?~ "This is a dynamic API generated by PostgREST") + & description ?~ d) + & externalDocs ?~ ((mempty :: ExternalDocs) + & description ?~ "PostgREST Documentation" + & url .~ URL "https://postgrest.com/en/latest/api.html") & host .~ h' - & definitions .~ fromList (map makeTableDef ti <> map makeProcDef pds) + & definitions .~ fromList (map (makeTableDef pks) ti) + & parameters .~ fromList (makeParamDefs ti) & paths .~ makePathItems pds ti + & produces .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV] + & consumes .~ makeMimeList [CTApplicationJSON, CTSingularJSON, CTTextCSV] where s' = if s == "http" then Http else Https h' = Just $ Host (unpack $ escapeHostName h) (Just (fromInteger p)) + d = fromMaybe "This is a dynamic API generated by PostgREST" sd -encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> LByteString -encodeOpenAPI pds ti uri = encode $ postgrestSpec pds ti uri +encodeOpenAPI :: [ProcDescription] -> [(Table, [Column], [Text])] -> (Text, Text, Integer, Text) -> Maybe Text -> [PrimaryKey] -> LByteString +encodeOpenAPI pds ti uri sd pks = encode $ postgrestSpec pds ti uri sd pks {-| Test whether a proxy uri is malformed or not. diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -1,6 +1,6 @@ module PostgREST.Parsers where -import Protolude hiding (try, intercalate) +import Protolude hiding (try, intercalate, replace) import Control.Monad ((>>)) import Data.Foldable (foldl1) import qualified Data.HashMap.Strict as M @@ -56,17 +56,17 @@ pReadRequest :: Text -> Parser ReadRequest pReadRequest rootNodeName = do fieldTree <- pFieldForest - return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing)) []) fieldTree + return $ foldr treeEntry (Node (readQuery, (rootNodeName, Nothing, Nothing, Nothing)) []) fieldTree where - readQuery = Select [] [rootNodeName] [] [] Nothing allRange + readQuery = Select [] [rootNodeName] [] Nothing allRange treeEntry :: Tree SelectItem -> ReadRequest -> ReadRequest - treeEntry (Node fld@((fn, _),_,alias) fldForest) (Node (q, i) rForest) = + 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)) []) fldForest:rForest + foldr treeEntry (Node (Select [] [fn] [] Nothing allRange, (fn, Nothing, alias, relationDetail)) []) fldForest:rForest pTreePath :: Parser (EmbedPath, Field) pTreePath = do @@ -78,9 +78,9 @@ pFieldForest = pFieldTree `sepBy1` lexeme (char ',') pFieldTree :: Parser (Tree SelectItem) -pFieldTree = try (Node <$> pSimpleSelect <*> between (char '{') (char '}') pFieldForest) - <|> try (Node <$> pSimpleSelect <*> between (char '(') (char ')') pFieldForest) - <|> Node <$> pSelect <*> pure [] +pFieldTree = try (Node <$> pRelationSelect <*> between (char '{') (char '}') pFieldForest) + <|> try (Node <$> pRelationSelect <*> between (char '(') (char ')') pFieldForest) + <|> Node <$> pFieldSelect <*> pure [] pStar :: Parser Text pStar = toS <$> (string "*" *> pure ("*"::ByteString)) @@ -109,25 +109,27 @@ aliasSeparator :: Parser () aliasSeparator = char ':' >> notFollowedBy (char ':') -pSimpleSelect :: Parser SelectItem -pSimpleSelect = lexeme $ try ( do +pRelationSelect :: Parser SelectItem +pRelationSelect = lexeme $ try ( do alias <- optionMaybe ( try(pFieldName <* aliasSeparator) ) fld <- pField - return (fld, Nothing, alias) + relationDetail <- optionMaybe ( try( char '.' *> pFieldName ) ) + + return (fld, Nothing, alias, relationDetail) ) -pSelect :: Parser SelectItem -pSelect = lexeme $ +pFieldSelect :: Parser SelectItem +pFieldSelect = lexeme $ try ( do alias <- optionMaybe ( try(pFieldName <* aliasSeparator) ) fld <- pField cast' <- optionMaybe (string "::" *> many letter) - return (fld, toS <$> cast', alias) + return (fld, toS <$> cast', alias, Nothing) ) <|> do s <- pStar - return ((s, Nothing), Nothing, Nothing) + return ((s, Nothing), Nothing, Nothing, Nothing) pOperation :: Parser Operand -> Parser Operand -> Parser Operation pOperation parserVText parserVTextL = try ( string "not" *> pDelimiter *> (Operation True <$> pExpr)) <|> Operation False <$> pExpr @@ -177,12 +179,12 @@ pLogicTree :: Parser LogicTree pLogicTree = Stmnt <$> try pLogicFilter - <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree) <*> (lexeme (char ',') *> pLogicTree <* lexeme (char ')')) + <|> Expr <$> pNot <*> pLogicOp <*> (lexeme (char '(') *> pLogicTree `sepBy1` lexeme (char ',') <* lexeme (char ')')) where pLogicFilter :: Parser Filter pLogicFilter = Filter <$> pField <* pDelimiter <*> pOperation pLogicVText pLogicVTextL pNot :: Parser Bool - pNot = try (string "not" *> pDelimiter *> pure True) + pNot = try (string "not" *> pDelimiter *> pure True) <|> pure False "negation operator (not)" pLogicOp :: Parser LogicOperator diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : PostgREST.QueryBuilder @@ -15,7 +14,7 @@ callProc , createReadStatement , createWriteStatement - , getJoinConditions + , getJoinFilters , pgFmtIdent , pgFmtLit , requestToQuery @@ -48,7 +47,7 @@ , formatScientific , isInteger ) -import Protolude hiding (from, intercalate, ord, cast) +import Protolude hiding (from, intercalate, ord, cast, replace) import PostgREST.ApiRequest (PreferRepresentation (..)) {-| The generic query result format used by API responses. The location header @@ -144,42 +143,45 @@ | otherwise = asJsonF type ProcResults = (Maybe Int64, Int64, ByteString) -callProc :: QualifiedIdentifier -> JSON.Object -> SqlQuery -> SqlQuery -> NonnegRange -> - Bool -> Bool -> Bool -> Bool -> H.Query () (Maybe ProcResults) -callProc qi params selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv = +callProc :: QualifiedIdentifier -> JSON.Object -> Bool -> SqlQuery -> SqlQuery -> NonnegRange -> + Bool -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> H.Query () (Maybe ProcResults) +callProc qi params returnsScalar selectQuery countQuery _ countTotal isSingle paramsAsJson asCsv asBinary binaryField = unicodeStatement sql HE.unit decodeProc True where - sql = [qc| - WITH {sourceCTEName} AS ({_callSql}) - SELECT - {countResultF} AS total_result_set, - pg_catalog.count(_postgrest_t) AS page_total, - case - when pg_catalog.count(*) > 1 then - {bodyF} - else - coalesce(((array_agg(row_to_json(_postgrest_t)))[1]->{_procName})::character varying, {bodyF}) + sql = + if returnsScalar then [qc| + WITH {sourceCTEName} AS ({_callSql}) + SELECT + {countResultF} AS total_result_set, + 1 AS page_total, + {scalarBodyF} as body + FROM ({selectQuery}) _postgrest_t;|] + else [qc| + WITH {sourceCTEName} AS ({_callSql}) + SELECT + {countResultF} AS total_result_set, + pg_catalog.count(_postgrest_t) AS page_total, + {bodyF} as body + FROM ({selectQuery}) _postgrest_t;|] - end as body - FROM ({selectQuery}) _postgrest_t; - |] - -- FROM (select * from {sourceCTEName} {limitF range}) t; - countResultF = if countTotal then "("<>countQuery<>")" else "null::bigint" :: Text + countResultF = if countTotal then "( "<> countQuery <> ")" else "null::bigint" :: Text _args = if paramsAsJson then insertableValueWithType "json" $ JSON.Object params else intercalate "," $ map _assignment (HM.toList params) - _procName = pgFmtLit $ qiName qi + _procName = qiName qi _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v _callSql = [qc|select * from {fromQi qi}({_args}) |] :: Text - _countExpr = if countTotal - then [qc|(select pg_catalog.count(*) from {sourceCTEName})|] - else "null::bigint" :: Text decodeProc = HD.maybeRow procRow procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8 <*> HD.value HD.bytea + scalarBodyF + | asBinary = asBinaryF _procName + | otherwise = "(row_to_json(_postgrest_t)->" <> pgFmtLit _procName <> ")::character varying" + bodyF | isSingle = asJsonSingleF | asCsv = asCsvF + | isJust binaryField = asBinaryF $ fromJust binaryField | otherwise = asJsonF pgFmtIdent :: SqlFragment -> SqlFragment @@ -196,25 +198,23 @@ requestToCountQuery :: Schema -> DbRequest -> SqlQuery requestToCountQuery _ (DbMutate _) = undefined -requestToCountQuery schema (DbRead (Node (Select _ _ conditions logic_ _ _, (mainTbl, _, _)) _)) = +requestToCountQuery schema (DbRead (Node (Select _ _ logicForest _ _, (mainTbl, _, _, _)) _)) = unwords [ "SELECT pg_catalog.count(*)", "FROM ", fromQi qi, - -- logic_ doesn't not need localFilter filtering because it doesn't have VForeignKey vals - ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) localConditions ++ map (pgFmtLogicTree qi) logic_)) - `emptyOnFalse` (null conditions && null logic_) + ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) filteredLogic)) `emptyOnFalse` null filteredLogic ] where qi = removeSourceCTESchema schema mainTbl - localFilter :: Filter -> Bool - localFilter Filter{operation=Operation{expr=(_, val)}} = case val of - VText _ -> True - VTextL _ -> True - VForeignKey _ _ -> False - localConditions = filter localFilter conditions + -- all foreing key filters are root nodes(see addFilterToLogicForest), only those are filtered + nonFKRoot :: LogicTree -> Bool + nonFKRoot (Stmnt (Filter _ Operation{expr=(_, VForeignKey _ _)})) = False + nonFKRoot (Stmnt _) = True + nonFKRoot Expr{} = True + filteredLogic = filter nonFKRoot logicForest requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery -requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions logic_ ord range, (nodeName, maybeRelation, _)) forest)) = +requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest ord range, (nodeName, maybeRelation, _, _)) forest)) = query where mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation) @@ -224,8 +224,7 @@ "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), "FROM ", intercalate ", " (map (fromQi . toQi) tbls), unwords joins, - ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) conditions ++ map (pgFmtLogicTree qi) logic_)) - `emptyOnFalse` (null conditions && null logic_), + ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest, orderF (fromMaybe [] ord), if isParent then "" else limitF range ] @@ -243,14 +242,14 @@ (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 array_to_json(array_agg(row_to_json("<>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 r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (joi:j,sel:s) + getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias, _)) forst) (j,s) = (joi:j,sel:s) where node_name = fromMaybe name alias local_table_name = table <> "_" <> node_name @@ -258,9 +257,9 @@ replaceTableName _ x = x sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name <> - " ON " <> intercalate " AND " ( map (pgFmtFilter qi . replaceTableName local_table_name) (getJoinConditions r) ) + " ON " <> intercalate " AND " ( map (pgFmtFilter qi . replaceTableName local_table_name) (getJoinFilters r) ) 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 array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) " @@ -286,7 +285,7 @@ ret = if null returnings then "" else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)] -requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions logic_ returnings)) = +requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) logicForest returnings)) = case rows V.!? 0 of Just obj -> let assignments = map @@ -294,21 +293,19 @@ unwords [ "UPDATE ", fromQi qi, " SET " <> intercalate "," assignments <> " ", - ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) conditions ++ map (pgFmtLogicTree qi) logic_)) - `emptyOnFalse` (null conditions && null logic_), + ("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 -requestToQuery schema _ (DbMutate (Delete mainTbl conditions logic_ returnings)) = +requestToQuery schema _ (DbMutate (Delete mainTbl logicForest returnings)) = query where qi = QualifiedIdentifier schema mainTbl query = unwords [ "DELETE FROM ", fromQi qi, - ("WHERE " <> intercalate " AND " (map (pgFmtFilter qi) conditions ++ map (pgFmtLogicTree qi) logic_)) - `emptyOnFalse` (null conditions && null logic_), + ("WHERE " <> intercalate " AND " (map (pgFmtLogicTree qi) logicForest)) `emptyOnFalse` null logicForest, ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnFalse` null returnings ] @@ -375,13 +372,13 @@ n = qiName t s = qiSchema t -getJoinConditions :: Relation -> [Filter] -getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) = +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 getJoinConditions" + Root -> undefined --error "undefined getJoinFilters" where s = if typ == Parent then "" else tableSchema t tN = tableName t @@ -412,15 +409,17 @@ pgFmtField table (c, jp) = pgFmtColumn table c <> pgFmtJsonPath jp pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SqlFragment -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 +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 pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment pgFmtFilter table (Filter fld (Operation hasNot_ ex)) = notOp <> " " <> case ex of (op, VText val) -> pgFmtFieldOp op <> " " <> case op of "like" -> unknownLiteral (T.map star val) "ilike" -> unknownLiteral (T.map star val) + -- TODO: The '@@' was deprecated, remove in v0.5.0.0 "@@" -> "to_tsquery(" <> unknownLiteral val <> ") " + "fts" -> "to_tsquery(" <> unknownLiteral val <> ") " "is" -> whiteList val "isnot" -> whiteList val _ -> unknownLiteral val @@ -449,7 +448,7 @@ Nothing -> emptyValForIn op pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SqlFragment -pgFmtLogicTree qi (Expr hasNot_ op lt rt) = notOp <> " (" <> pgFmtLogicTree qi lt <> " " <> show op <> " " <> pgFmtLogicTree qi rt <> ")" +pgFmtLogicTree qi (Expr hasNot_ op forest) = notOp <> " (" <> intercalate (" " <> show op <> " ") (pgFmtLogicTree qi <$> forest) <> ")" where notOp = if hasNot_ then "NOT" else "" pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -38,7 +38,7 @@ , pgaReq :: Bool } deriving (Show, Eq) -data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier | Pseudo Text deriving (Eq, Show) +data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier deriving (Eq, Show) data RetType = Single PgType | SetOf PgType deriving (Eq, Show) @@ -46,10 +46,11 @@ deriving (Eq, Show) data ProcDescription = ProcDescription { - pdName :: Text -, pdArgs :: [PgArg] -, pdReturnType :: RetType -, pdVolatility :: ProcVolatility + pdName :: Text +, pdDescription :: Maybe Text +, pdArgs :: [PgArg] +, pdReturnType :: RetType +, pdVolatility :: ProcVolatility } deriving (Show, Eq) type Schema = Text @@ -59,26 +60,28 @@ type RequestBody = BL.ByteString data Table = Table { - tableSchema :: Schema -, tableName :: TableName -, tableInsertable :: Bool + tableSchema :: Schema +, tableName :: TableName +, tableDescription :: Maybe Text +, tableInsertable :: Bool } deriving (Show, Ord) newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord) data Column = Column { - colTable :: Table - , colName :: Text - , colPosition :: Int32 - , colNullable :: Bool - , colType :: Text - , colUpdatable :: Bool - , colMaxLen :: Maybe Int32 - , colPrecision :: Maybe Int32 - , colDefault :: Maybe Text - , colEnum :: [Text] - , colFK :: Maybe ForeignKey + colTable :: Table + , colName :: Text + , colDescription :: Maybe Text + , colPosition :: Int32 + , colNullable :: Bool + , colType :: Text + , colUpdatable :: Bool + , colMaxLen :: Maybe Int32 + , colPrecision :: Maybe Int32 + , colDefault :: Maybe Text + , colEnum :: [Text] + , colFK :: Maybe ForeignKey } deriving (Show, Ord) type Synonym = (Column,Column) @@ -111,6 +114,12 @@ data RelationType = Child | Parent | Many | Root deriving (Show, Eq) + +{-| + The name 'Relation' here is used with the meaning + "What is the relation between the current node and the parent node". + It has nothing to do with PostgreSQL referring to tables/views as relations. +-} data Relation = Relation { relTable :: Table , relColumns :: [Column] @@ -152,6 +161,16 @@ ("notin", "NOT IN"), ("isnot", "IS NOT"), ("is", "IS"), + ("fts", "@@"), + ("cs", "@>"), + ("cd", "<@"), + ("ov", "&&"), + ("sl", "<<"), + ("sr", ">>"), + ("nxr", "&<"), + ("nxl", "&>"), + ("adj", "-|-"), + -- TODO: these are deprecated and should be removed in v0.5.0.0 ("@@", "@@"), ("@>", "@>"), ("<@", "<@")] @@ -171,7 +190,7 @@ / \ id.eq.1 id.eq.2 -} -data LogicTree = Expr Bool LogicOperator LogicTree LogicTree | Stmnt Filter deriving (Show, Eq) +data LogicTree = Expr Bool LogicOperator [LogicTree] | Stmnt Filter deriving (Show, Eq) type FieldName = Text type JsonPath = [Text] @@ -179,50 +198,25 @@ type Alias = Text type Cast = Text type NodeName = Text -type SelectItem = (Field, Maybe Cast, Maybe Alias) + +{-| + This type will hold information about which particular 'Relation' between two tables to choose when there are multiple ones. + Specifically, it will contain the name of the foreign key or the join table in many to many relations. +-} +type RelationDetail = Text +type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe RelationDetail) -- | Path of the embedded levels, e.g "clients.projects.name=eq.." gives Path ["clients", "projects"] type EmbedPath = [Text] data Filter = Filter { field::Field, operation::Operation } deriving (Show, Eq) -data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], logic::[LogicTree], order::Maybe [OrderTerm], range_::NonnegRange } 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] } - | Delete { in_::TableName, where_::[Filter], logic::[LogicTree], returning::[FieldName] } - | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter], logic::[LogicTree], returning::[FieldName] } deriving (Show, Eq) -type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) + | 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 ReadRequest = Tree ReadNode type MutateRequest = MutateQuery data DbRequest = DbRead ReadRequest | DbMutate MutateRequest - -instance ToJSON Column where - toJSON c = object [ - "schema" .= tableSchema t - , "name" .= colName c - , "position" .= colPosition c - , "nullable" .= colNullable c - , "type" .= colType c - , "updatable" .= colUpdatable c - , "maxLen" .= colMaxLen c - , "precision" .= colPrecision c - , "references".= colFK c - , "default" .= colDefault c - , "enum" .= colEnum c ] - where - t = colTable c - -instance ToJSON ForeignKey where - toJSON fk = object [ - "schema" .= tableSchema t - , "table" .= tableName t - , "column" .= colName c ] - where - c = fkCol fk - t = colTable c - -instance ToJSON Table where - toJSON v = object [ - "schema" .= tableSchema v - , "name" .= tableName v - , "insertable" .= tableInsertable v ] instance Eq Table where Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2 diff --git a/test/Feature/AndOrParamsSpec.hs b/test/Feature/AndOrParamsSpec.hs --- a/test/Feature/AndOrParamsSpec.hs +++ b/test/Feature/AndOrParamsSpec.hs @@ -70,20 +70,66 @@ it "can handle is" $ get "/entities?and=(name.is.null,arr.is.null)&select=id" `shouldRespondWith` [json|[{ "id": 4 }]|] { matchHeaders = [matchContentTypeJson] } - it "can handle @@" $ + it "can handle fts" $ do + get "/entities?or=(text_search_vector.fts.bar,text_search_vector.fts.baz)&select=id" `shouldRespondWith` + [json|[{ "id": 1 }, { "id": 2 }]|] { 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 @> and <@" $ + it "can handle cs and cd" $ do + 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` + [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=neq.[1,3]&select=id" `shouldRespondWith` + [json|[{ "id": 2 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=lt.[1,10]&select=id" `shouldRespondWith` + [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=gt.[8,11]&select=id" `shouldRespondWith` + [json|[{ "id": 4 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=lte.[1,3]&select=id" `shouldRespondWith` + [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=gte.[2,3]&select=id" `shouldRespondWith` + [json|[{ "id": 2 }, { "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=cs.[1,2]&select=id" `shouldRespondWith` + [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=cd.[1,6]&select=id" `shouldRespondWith` + [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=ov.[0,4]&select=id" `shouldRespondWith` + [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=sl.[9,10]&select=id" `shouldRespondWith` + [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=sr.[3,4]&select=id" `shouldRespondWith` + [json|[{ "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=nxr.[4,7]&select=id" `shouldRespondWith` + [json|[{ "id": 1 }, { "id": 2 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=nxl.[4,7]&select=id" `shouldRespondWith` + [json|[{ "id": 3 }, { "id": 4 }]|] { matchHeaders = [matchContentTypeJson] } + get "/ranges?range=adj.(3,10]&select=id" `shouldRespondWith` + [json|[{ "id": 1 }]|] { matchHeaders = [matchContentTypeJson] } + context "operators with not" $ do - it "eq, @>, like can be negated" $ + it "eq, cs, like can be negated" $ do + 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, @@ can be negated" $ + it "in, is, fts can be negated" $ do + 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, <@ can be negated" $ + it "lt, gte, cd can be negated" $ do + 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" $ @@ -105,6 +151,29 @@ get "/entities?and=( and ( id.in.( 1, 2, 3 ) , id.eq.3 ) , or ( id.eq.2 , id.eq.3 ) )&select=id" `shouldRespondWith` [json|[{ "id": 3 }]|] { matchHeaders = [matchContentTypeJson] } + context "multiple and/or conditions" $ do + it "cannot have zero conditions" $ + get "/entities?or=()" `shouldRespondWith` + [json|{ + "details": "unexpected \")\" expecting field name (* or [a..z0..9_]), negation operator (not) or logic operator (and, or)", + "message": "\"failed to parse logic tree (())\" (line 1, column 4)" + }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] } + it "can have a single condition" $ do + get "/entities?or=(id.eq.1)&select=id" `shouldRespondWith` + [json|[{"id":1}]|] { matchHeaders = [matchContentTypeJson] } + get "/entities?and=(id.eq.1)&select=id" `shouldRespondWith` + [json|[{"id":1}]|] { matchHeaders = [matchContentTypeJson] } + it "can have three conditions" $ do + get "/grandchild_entities?or=(id.eq.1, id.eq.2, id.eq.3)&select=id" `shouldRespondWith` + [json|[{"id":1}, {"id":2}, {"id":3}]|] { matchHeaders = [matchContentTypeJson] } + get "/grandchild_entities?and=(id.in.(1,2), id.in.(3,1), id.in.(1,4))&select=id" `shouldRespondWith` + [json|[{"id":1}]|] { matchHeaders = [matchContentTypeJson] } + it "can have four conditions combining and/or" $ do + get "/grandchild_entities?or=( id.eq.1, id.eq.2, and(id.in.(1,3), id.in.(2,3)), id.eq.4 )&select=id" `shouldRespondWith` + [json|[{"id":1}, {"id":2}, {"id":3}, {"id":4}]|] { matchHeaders = [matchContentTypeJson] } + get "/grandchild_entities?and=( id.eq.1, not.or(id.eq.2, id.eq.3), id.in.(1,4), or(id.eq.1, id.eq.4) )&select=id" `shouldRespondWith` + [json|[{"id":1}]|] { matchHeaders = [matchContentTypeJson] } + 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}" @@ -145,20 +214,10 @@ }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] } it "fails on malformed query params and provides meaningful error message" $ do - get "/entities?or=()" `shouldRespondWith` - [json|{ - "details": "unexpected \")\" expecting field name (* or [a..z0..9_]), negation operator (not) or logic operator (and, or)", - "message": "\"failed to parse logic tree (())\" (line 1, column 4)" - }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] } get "/entities?or=)(" `shouldRespondWith` [json|{ "details": "unexpected \")\" expecting \"(\"", "message": "\"failed to parse logic tree ()()\" (line 1, column 3)" - }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] } - get "/entities?or=(id.eq.1)" `shouldRespondWith` - [json|{ - "details": "unexpected \")\" expecting \",\"", - "message": "\"failed to parse logic tree ((id.eq.1))\" (line 1, column 11)" }|] { matchStatus = 400, matchHeaders = [matchContentTypeJson] } get "/entities?and=(ord(id.eq.1,id.eq.1),id.eq.2)" `shouldRespondWith` [json|{ diff --git a/test/Feature/AsymmetricJwtSpec.hs b/test/Feature/AsymmetricJwtSpec.hs new file mode 100644 --- /dev/null +++ b/test/Feature/AsymmetricJwtSpec.hs @@ -0,0 +1,21 @@ +module Feature.AsymmetricJwtSpec where + +-- {{{ Imports +import Test.Hspec +import Test.Hspec.Wai +import Network.HTTP.Types + +import SpecHelper +import Network.Wai (Application) + +import Protolude hiding (get) +-- }}} + +spec :: SpecWith Application +spec = describe "server started with asymmetric JWK" $ + + -- this test will stop working 9999999999s after the UNIX EPOCH + it "succeeds with jwt token signed with an asymmetric key" $ do + let auth = authHeaderJWT "eyJhbGciOiJSUzI1NiJ9.eyJyb2xlIjogInBvc3RncmVzdF90ZXN0X2F1dGhvciJ9Cg.CBOYWDvqgAR0YYnZnyDGTQi6AJLc2Pds6_eV3YuBG6I36mj_h05eLhkEKNEDA5ZteMzCiY83P60rC_xtxVd7B6vo3BeF5uoanPS3rrbuHzKPwzsrgrD_CqvEuJ4n7Q9epkQiLsNkcexneENZDRqFjbwZx3DrXiCWwlK3Ytr5NAIGxmy0od-0xNpb2U1nXQyO_Q3mumWFViRt4tmFn_3goDHNKG3Ha_AzImfUNvHnWL78kAc4rbn15vLtWXD8PwtSnZaB4lY4V6RfsaW937srQsmRetvytM1i_bHBnjkjQLAqGbXPyItjtlXPs0uGNBadE8-wgkLtfmSCC4v2DjUthw" + request methodGet "/authors_only" [auth] "" + `shouldRespondWith` 200 diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -28,7 +28,7 @@ } it "denies access to tables that postgrest_test_author does not own" $ - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" in + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIn0.Xod-F15qsGL0WhdOCr2j3DdKuTw9QJERVgoFD3vGaWA" in request methodGet "/private_table" [auth] "" `shouldRespondWith` [json| { "hint":null, @@ -42,41 +42,41 @@ it "returns jwt functions as jwt tokens" $ request methodPost "/rpc/login" [single] [json| { "id": "jdoe", "pass": "1234" } |] - `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |] + `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.KO-0PGp_rU-utcDBP6qwdd-Th2Fk-ICVt01I7QtTDWs"} |] { matchStatus = 200 , matchHeaders = [matchContentTypeSingular] } it "sql functions can encode custom and standard claims" $ request methodPost "/rpc/jwt_test" [single] "{}" - `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |] + `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.G2REtPnOQMUrVRDA9OnkPJTd8R0tf4wdYOlauh1E2Ek"} |] { matchStatus = 200 , matchHeaders = [matchContentTypeSingular] } it "sql functions can read custom and standard claims variables" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwLCJhdWQiOiJldmVyeW9uZSJ9.AQmCA7CMScvfaDRMqRPeUY6eNf--69gpW-kxaWfq9X0" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwfQ.V5fEpXfpb7feqwVqlcDleFdKu86bdwU2cBRT4fcMhXg" request methodPost "/rpc/reveal_big_jwt" [auth] "{}" - `shouldRespondWith` [str|[{"iss":"joe","sub":"fun","aud":"everyone","exp":9999999999,"nbf":1300819380,"iat":1300819380,"jti":"foo","http://postgrest.com/foo":true}]|] + `shouldRespondWith` [str|[{"iss":"joe","sub":"fun","exp":9999999999,"nbf":1300819380,"iat":1300819380,"jti":"foo","http://postgrest.com/foo":true}]|] it "allows users with permissions to see their tables" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.B-lReuGNDwAlU1GOC476MlO0vAt9JNoHIlxg2vwMaO0" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200 it "works with tokens which have extra fields" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.GfydCh-F4wnM379xs0n1zUgalwJIsb6YoBapCo8HlFk" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIiwia2V5MSI6InZhbHVlMSIsImtleTIiOiJ2YWx1ZTIiLCJrZXkzIjoidmFsdWUzIiwiYSI6MSwiYiI6MiwiYyI6M30.b0eglDKYEmGi-hCvD-ddSqFl7vnDO5qkUaviaHXm3es" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200 -- this test will stop working 9999999999s after the UNIX EPOCH it "succeeds with an unexpired token" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200 it "fails with an expired token" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.f8__E6VQwYcDqwHmr9PG03uaZn8Zh1b0vbJ9DYS0AdM" request methodGet "/authors_only" [auth] "" `shouldRespondWith` [json| {"message":"JWT expired"} |] { matchStatus = 401 @@ -89,27 +89,27 @@ it "hides tables from users with invalid JWT" $ do let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" request methodGet "/authors_only" [auth] "" - `shouldRespondWith` [json| {"message":"JWT invalid"} |] + `shouldRespondWith` [json| {"message":"JWSError (CompactDecodeError \"expected 3 parts, got 2\")"} |] { matchStatus = 401 , matchHeaders = [ "WWW-Authenticate" <:> - "Bearer error=\"invalid_token\", error_description=\"JWT invalid\"" + "Bearer error=\"invalid_token\", error_description=\"JWSError (CompactDecodeError \\\"expected 3 parts, got 2\\\")\"" ] } it "should fail when jwt contains no claims" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.lu-rG8aSCiw-aOlN0IxpRGz5r7Jwq7K9r3tuMPUpytI" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.e30.CUIP5V9thWsGGFsFyGijSZf1fJMfarLHI9CEJL-TGNk" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401 it "hides tables from users with JWT that contain no claims about role" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.Jneso9X519Vh0z7i9PbXIu7W1HEoq9RRw9BBbyQKFCQ" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Impkb2UifQ.RVlZDaSyKbFPvxUf3V_NQXybfRB4dlBIkAUQXVXLUAI" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401 it "recovers after 401 error with logged in user" $ do _ <- post "/authors_only" [json| { "owner": "jdoe", "secret": "test content" } |] - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.B-lReuGNDwAlU1GOC476MlO0vAt9JNoHIlxg2vwMaO0" _ <- request methodPost "/rpc/problem" [auth] "" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200 @@ -117,7 +117,7 @@ describe "custom pre-request proc acting on id claim" $ do it "able to switch to postgrest_test_author role (id=1)" $ - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6MX0.mI2HNoOum6xM3sc4oHLxU4yLv-_WV5W1kqBfY_wEvLw" in + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6MX0.gKw7qI50i9hMrSJW8BlTpdMEVmMXJYxlAqueGqpa_mE" in request methodPost "/rpc/get_current_user" [auth] [json| {} |] `shouldRespondWith` [str|"postgrest_test_author"|] @@ -126,7 +126,7 @@ } it "able to switch to postgrest_test_default_role (id=2)" $ - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.W7jLsG-zswM91AJkCvZeIMHrnz7_6ceY2jnscVl3Yhk" in + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.nwzjMI0YLvVGJQTeoCPEBsK983b__gxdpLXisBNaO2A" in request methodPost "/rpc/get_current_user" [auth] [json| {} |] `shouldRespondWith` [str|"postgrest_test_default_role"|] @@ -135,7 +135,7 @@ } it "raises error (id=3)" $ - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6M30.15Gy8PezQhJIaHYDJVLa-Gmz9T3sJnW66EKAYIsXc7c" in + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6M30.OGxEJAf60NKZiTn-tIb2jy4rqKs_ZruLGWZ40TjrJsM" in request methodPost "/rpc/get_current_user" [auth] [json| {} |] `shouldRespondWith` [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|] diff --git a/test/Feature/BinaryJwtSecretSpec.hs b/test/Feature/BinaryJwtSecretSpec.hs --- a/test/Feature/BinaryJwtSecretSpec.hs +++ b/test/Feature/BinaryJwtSecretSpec.hs @@ -16,6 +16,6 @@ -- this test will stop working 9999999999s after the UNIX EPOCH it "succeeds with jwt token encoded with a binary secret" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.l_EcSRWeNtL4OKUTIplrHyioNrff9Rd0MV7RXNCxCyk" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200 diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -451,7 +451,7 @@ describe "Row level permission" $ it "set user_id when inserting rows" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.B-lReuGNDwAlU1GOC476MlO0vAt9JNoHIlxg2vwMaO0" _ <- post "/postgrest/users" [json| { "id":"jdoe", "pass": "1234", "role": "postgrest_test_author" } |] _ <- post "/postgrest/users" [json| { "id":"jroe", "pass": "1234", "role": "postgrest_test_author" } |] @@ -464,7 +464,7 @@ p2 <- request methodPost "/authors_only" -- jwt token for jroe - [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.YuF_VfmyIxWyuceT7crnNKEprIYXsJAyXid3rjPjIow", ("Prefer", "return=representation") ] + [ authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqcm9lIn0.2e7mx0U4uDcInlbJVOBGlrRufwqWLINDIEDC1vS0nw8", ("Prefer", "return=representation") ] [json| { "secret": "lolcat", "owner": "hacker" } |] liftIO $ do simpleBody p2 `shouldBe` [str|[{"owner":"jroe","secret":"lolcat"}]|] diff --git a/test/Feature/NoJwtSpec.hs b/test/Feature/NoJwtSpec.hs --- a/test/Feature/NoJwtSpec.hs +++ b/test/Feature/NoJwtSpec.hs @@ -16,7 +16,7 @@ -- this test will stop working 9999999999s after the UNIX EPOCH it "responds with error on attempted auth" $ do - let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.QaPPLWTuyydMu_q7H4noMT7Lk6P4muet1OpJXF6ofhc" + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjk5OTk5OTk5OTksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.Dpss-QoLYjec5OTsOaAc3FNVsSjA89wACoV-0ra3ClA" request methodGet "/authors_only" [auth] "" `shouldRespondWith` 500 diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -98,15 +98,29 @@ it "matches with ilike using not operator" $ get "/simple_pk?k=not.ilike.xy*&order=extra.asc" `shouldRespondWith` "[]" - it "matches with tsearch @@" $ - get "/tsearch?text_search_vector=@@.foo" `shouldRespondWith` - [json| [{"text_search_vector":"'bar':2 'foo':1"}] |] + it "matches with tsearch fts" $ do + get "/tsearch?text_search_vector=fts.impossible" `shouldRespondWith` + [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |] { matchHeaders = [matchContentTypeJson] } + get "/tsearch?text_search_vector=fts.possible" `shouldRespondWith` + [json| [{"text_search_vector": "'also':2 'fun':3 'possibl':8" }] |] + { matchHeaders = [matchContentTypeJson] } + -- TODO: remove in 0.5.0 as deprecated + get "/tsearch?text_search_vector=@@.impossible" `shouldRespondWith` + [json| [{"text_search_vector": "'fun':5 'imposs':9 'kind':3" }] |] + { matchHeaders = [matchContentTypeJson] } + get "/tsearch?text_search_vector=@@.possible" `shouldRespondWith` + [json| [{"text_search_vector": "'also':2 'fun':3 'possibl':8" }] |] + { matchHeaders = [matchContentTypeJson] } - it "matches with tsearch @@ using not operator" $ - get "/tsearch?text_search_vector=not.@@.foo" `shouldRespondWith` - [json| [{"text_search_vector":"'baz':1 'qux':2"}] |] + it "matches with tsearch fts using not operator" $ do + get "/tsearch?text_search_vector=not.fts.impossible" `shouldRespondWith` + [json| [{"text_search_vector": "'also':2 'fun':3 'possibl':8" }] |] { matchHeaders = [matchContentTypeJson] } + -- TODO: remove in 0.5.0 as deprecated + get "/tsearch?text_search_vector=not.@@.impossible" `shouldRespondWith` + [json| [{"text_search_vector": "'also':2 'fun':3 'possibl':8" }] |] + { matchHeaders = [matchContentTypeJson] } it "matches with computed column" $ get "/items?always_true=eq.true&order=id.asc" `shouldRespondWith` @@ -129,11 +143,17 @@ get "/clients?select=id,projects{id,tasks{id,name}}&projects.tasks.name=like.Design*" `shouldRespondWith` [str|[{"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"}]}]}]|] - it "matches with @> operator" $ + it "matches with cs operator" $ do + get "/complex_items?select=id&arr_data=cs.{2}" `shouldRespondWith` + [str|[{"id":2},{"id":3}]|] + -- TODO: remove in 0.5.0 as deprecated get "/complex_items?select=id&arr_data=@>.{2}" `shouldRespondWith` [str|[{"id":2},{"id":3}]|] - it "matches with <@ operator" $ + it "matches with cd operator" $ do + get "/complex_items?select=id&arr_data=cd.{1,2,4}" `shouldRespondWith` + [str|[{"id":1},{"id":2}]|] + -- TODO: remove in 0.5.0 as deprecated get "/complex_items?select=id&arr_data=<@.{1,2,4}" `shouldRespondWith` [str|[{"id":1},{"id":2}]|] @@ -258,10 +278,18 @@ get "/clients?id=eq.1&select=id,projects{id,tasks{id}}" `shouldRespondWith` [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|] + it "requesting children 2 levels (with relation path fixed)" $ + get "/clients?id=eq.1&select=id,projects:projects.client_id{id,tasks{id}}" `shouldRespondWith` + [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":3},{"id":4}]}]}]|] + it "requesting many<->many relation" $ get "/tasks?select=id,users{id}" `shouldRespondWith` [str|[{"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":[]}]|] + it "requesting many<->many relation (with relation path fixed)" $ + get "/tasks?select=id,users:users.users_tasks{id}" `shouldRespondWith` + [str|[{"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":[]}]|] + it "requesting many<->many relation with rename" $ get "/tasks?id=eq.1&select=id,theUsers:users{id}" `shouldRespondWith` [str|[{"id":1,"theUsers":[{"id":1},{"id":3}]}]|] @@ -553,6 +581,18 @@ [json|"Hello, ￥"|] { matchHeaders = [matchContentTypeJson] } + it "returns array" $ + post "/rpc/ret_array" [json|{}|] `shouldRespondWith` + [json|[1, 2, 3]|] + { matchHeaders = [matchContentTypeJson] } + + it "returns setof integers" $ + post "/rpc/ret_setof_integers" [json|{}|] `shouldRespondWith` + [json|[{ "ret_setof_integers": 1 }, + { "ret_setof_integers": 2 }, + { "ret_setof_integers": 3 }]|] + { matchHeaders = [matchContentTypeJson] } + it "returns enum value" $ post "/rpc/ret_enum" [json|{ "val": "foo" }|] `shouldRespondWith` [json|"foo"|] @@ -655,6 +695,10 @@ [json| "Return value of no parameters procedure." |] { matchHeaders = [matchContentTypeJson] } + it "returns proper output when having the same return col name as the proc name" $ + post "/rpc/test" [json|{}|] `shouldRespondWith` + [json|[{"test":"hello","value":1}]|] { matchHeaders = [matchContentTypeJson] } + describe "weird requests" $ do it "can query as normal" $ do get "/Escap3e;" `shouldRespondWith` @@ -681,27 +725,50 @@ { matchHeaders = [matchContentTypeJson] } describe "binary output" $ do - it "can query if a single column is selected" $ - request methodGet "/images_base64?select=img&name=eq.A.png" (acceptHdrs "application/octet-stream") "" - `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC" - { matchStatus = 200 - , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"] - } + context "on GET" $ do + it "can query if a single column is selected" $ + request methodGet "/images_base64?select=img&name=eq.A.png" (acceptHdrs "application/octet-stream") "" + `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC" + { matchStatus = 200 + , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"] + } - it "fails if a single column is not selected" $ do - request methodGet "/images?select=img,name&name=eq.A.png" (acceptHdrs "application/octet-stream") "" - `shouldRespondWith` 406 - request methodGet "/images?select=*&name=eq.A.png" (acceptHdrs "application/octet-stream") "" - `shouldRespondWith` 406 - request methodGet "/images?name=eq.A.png" (acceptHdrs "application/octet-stream") "" - `shouldRespondWith` 406 + it "fails if a single column is not selected" $ do + request methodGet "/images?select=img,name&name=eq.A.png" (acceptHdrs "application/octet-stream") "" + `shouldRespondWith` 406 + request methodGet "/images?select=*&name=eq.A.png" (acceptHdrs "application/octet-stream") "" + `shouldRespondWith` 406 + request methodGet "/images?name=eq.A.png" (acceptHdrs "application/octet-stream") "" + `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") "" - `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCCiVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII=" - { matchStatus = 200 - , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"] - } + 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") "" + `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCCiVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEX///8AAP94wDzzAAAAL0lEQVQIW2NgwAb+HwARH0DEDyDxwAZEyGAhLODqHmBRzAcn5GAS///A1IF14AAA5/Adbiiz/0gAAAAASUVORK5CYII=" + { matchStatus = 200 + , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"] + } + + context "on RPC" $ do + context "Proc that returns scalar" $ + it "can query without selecting column" $ + request methodPost "/rpc/ret_base64_bin" (acceptHdrs "application/octet-stream") "" + `shouldRespondWith` "iVBORw0KGgoAAAANSUhEUgAAAB4AAAAeAQMAAAAB/jzhAAAABlBMVEUAAAD/AAAb/40iAAAAP0lEQVQI12NgwAbYG2AE/wEYwQMiZB4ACQkQYZEAIgqAhAGIKLCAEQ8kgMT/P1CCEUwc4IMSzA3sUIIdCHECAGSQEkeOTUyCAAAAAElFTkSuQmCC" + { matchStatus = 200 + , matchHeaders = ["Content-Type" <:> "application/octet-stream; charset=utf-8"] + } + + context "Proc that returns rows" $ do + it "can query if a single column is selected" $ + request methodPost "/rpc/ret_rows_with_base64_bin?select=img" (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"] + } + + it "fails if a single column is not selected" $ + request methodPost "/rpc/ret_rows_with_base64_bin" (acceptHdrs "application/octet-stream") "" + `shouldRespondWith` 406 + describe "HTTP request env vars" $ do it "custom header is set" $ request methodPost "/rpc/get_guc_value" diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -27,18 +27,96 @@ (acceptHdrs "application/openapi+json") "" `shouldRespondWith` 415 - describe "RPC" $ + describe "table" $ - it "includes a representative function with parameters" $ do + it "includes paths to tables" $ do r <- simpleBody <$> get "/" - let ref = r ^? key "paths" . key "/rpc/varied_arguments" - . key "post" . key "parameters" - . nth 1 . key "schema" - . key "$ref" . _String - args = r ^? key "definitions" . key "(rpc) varied_arguments" + let method s = key "paths" . key "/child_entities" . key s + childGetSummary = r ^? method "get" . key "summary" + childGetDescription = r ^? method "get" . key "description" + getParameters = r ^? method "get" . key "parameters" + postResponse = r ^? method "post" . key "responses" . key "201" . key "description" + patchResponse = r ^? method "patch" . key "responses" . key "204" . key "description" + deleteResponse = r ^? method "delete" . key "responses" . key "204" . key "description" + + let grandChildGet s = key "paths" . key "/grandchild_entities" . key "get" . key s + grandChildGetSummary = r ^? grandChildGet "summary" + grandChildGetDescription = r ^? grandChildGet "description" + liftIO $ do - ref `shouldBe` Just "#/definitions/(rpc) varied_arguments" + + childGetSummary `shouldBe` Just "child_entities comment" + + childGetDescription `shouldBe` Nothing + + grandChildGetSummary `shouldBe` Just "grandchild_entities summary" + + grandChildGetDescription `shouldBe` Just "grandchild_entities description\nthat spans\nmultiple lines" + + getParameters `shouldBe` Just + [aesonQQ| + [ + { "$ref": "#/parameters/rowFilter.child_entities.id" }, + { "$ref": "#/parameters/rowFilter.child_entities.name" }, + { "$ref": "#/parameters/rowFilter.child_entities.parent_id" }, + { "$ref": "#/parameters/select" }, + { "$ref": "#/parameters/order" }, + { "$ref": "#/parameters/range" }, + { "$ref": "#/parameters/rangeUnit" }, + { "$ref": "#/parameters/offset" }, + { "$ref": "#/parameters/limit" }, + { "$ref": "#/parameters/preferCount" } + ] + |] + + postResponse `shouldBe` Just "Created" + + patchResponse `shouldBe` Just "No Content" + + deleteResponse `shouldBe` Just "No Content" + + it "includes definitions to tables" $ do + r <- simpleBody <$> get "/" + + let def = r ^? key "definitions" . key "child_entities" + + liftIO $ + + def `shouldBe` Just + [aesonQQ| + { + "type": "object", + "description": "child_entities comment", + "properties": { + "id": { + "description": "child_entities id comment\n\nNote:\nThis is a Primary Key.", + "format": "integer", + "type": "integer" + }, + "name": { + "description": "child_entities name comment", + "format": "text", + "type": "string" + }, + "parent_id": { + "description": "Note:\nThis is a Foreign Key to `entities.id`.", + "format": "integer", + "type": "integer" + } + } + } + |] + + describe "RPC" $ + + it "includes body schema for arguments" $ do + r <- simpleBody <$> get "/" + let args = r ^? key "paths" . key "/rpc/varied_arguments" + . key "post" . key "parameters" + . nth 0 . key "schema" + + liftIO $ args `shouldBe` Just [aesonQQ| { diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -7,12 +7,11 @@ import PostgREST.DbStructure (getDbStructure) import PostgREST.App (postgrest) -import Control.AutoUpdate import Data.Function (id) import Data.IORef -import Data.Time.Clock.POSIX (getPOSIXTime) import qualified Feature.AuthSpec +import qualified Feature.AsymmetricJwtSpec import qualified Feature.BinaryJwtSecretSpec import qualified Feature.ConcurrentSpec import qualified Feature.CorsSpec @@ -36,19 +35,16 @@ setupDb testDbConn pool <- P.acquire (3, 10, toS testDbConn) - -- ask for the OS time at most once per second - getTime <- mkAutoUpdate - defaultUpdateSettings { updateAction = getPOSIXTime } - result <- P.use pool $ getDbStructure "test" refDbStructure <- newIORef $ Just $ either (panic.show) id result - 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 () + 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 () + asymJwkApp = return $ postgrest (testCfgAsymJWK testDbConn) refDbStructure pool $ pure () let reset = resetDb testDbConn hspec $ do @@ -73,6 +69,10 @@ -- this test runs with a binary JWT secret beforeAll_ reset . before binaryJwtApp $ describe "Feature.BinaryJwtSecretSpec" Feature.BinaryJwtSecretSpec.spec + + -- this test runs with asymmetric JWK + beforeAll_ reset . before asymJwkApp $ + describe "Feature.AsymmetricJwtSpec" Feature.AsymmetricJwtSpec.spec where specs = map (uncurry describe) [ diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -13,7 +13,8 @@ import Text.Regex.TDFA ((=~)) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BL -import System.Process (readProcess) +import System.Process (readProcess) +import Text.Heredoc import PostgREST.Config (AppConfig(..)) @@ -67,7 +68,7 @@ _baseCfg = -- Connection Settings AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000 -- Jwt settings - (Just $ encodeUtf8 "safe") False + (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False -- Connection Modifiers 10 Nothing (Just "test.switch_role") -- Debug Settings @@ -89,9 +90,16 @@ testProxyCfg testDbConn = (testCfg testDbConn) { configProxyUri = Just "https://postgrest.com/openapi.json" } testCfgBinaryJWT :: Text -> AppConfig -testCfgBinaryJWT testDbConn = (testCfg testDbConn) { configJwtSecret = Just secretBs } - where secretBs = B64.decodeLenient "h2CGB1FoBd51aQooCS2g+UmRgYQfTPQ6v3+9ALbaqM4=" +testCfgBinaryJWT testDbConn = (testCfg testDbConn) { + configJwtSecret = Just . B64.decodeLenient $ + "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=" + } +testCfgAsymJWK :: Text -> AppConfig +testCfgAsymJWK testDbConn = (testCfg testDbConn) { + configJwtSecret = Just $ encodeUtf8 + [str|{"alg":"RS256","e":"AQAB","key_ops":["verify"],"kty":"RSA","n":"0etQ2Tg187jb04MWfpuogYGV75IFrQQBxQaGH75eq_FpbkyoLcEpRUEWSbECP2eeFya2yZ9vIO5ScD-lPmovePk4Aa4SzZ8jdjhmAbNykleRPCxMg0481kz6PQhnHRUv3nF5WP479CnObJKqTVdEagVL66oxnX9VhZG9IZA7k0Th5PfKQwrKGyUeTGczpOjaPqbxlunP73j9AfnAt4XCS8epa-n3WGz1j-wfpr_ys57Aq-zBCfqP67UYzNpeI1AoXsJhD9xSDOzvJgFRvc3vm2wjAW4LEMwi48rCplamOpZToIHEPIaPzpveYQwDnB1HFTR1ove9bpKJsHmi-e2uzQ","use":"sig"}|] + } setupDb :: Text -> IO () setupDb dbConn = do