postgrest 0.4.0.0 → 0.4.1.0
raw patch · 24 files changed
+922/−593 lines, 24 filesdep +cookiedep ~hspec-waidep ~optparse-applicative
Dependencies added: cookie
Dependency ranges changed: hspec-wai, optparse-applicative
Files
- main/Main.hs +3/−3
- postgrest.cabal +4/−3
- src/PostgREST/ApiRequest.hs +26/−39
- src/PostgREST/App.hs +60/−27
- src/PostgREST/Auth.hs +1/−18
- src/PostgREST/Config.hs +6/−4
- src/PostgREST/DbRequestBuilder.hs +42/−45
- src/PostgREST/DbStructure.hs +46/−12
- src/PostgREST/Error.hs +59/−32
- src/PostgREST/Middleware.hs +18/−10
- src/PostgREST/OpenAPI.hs +4/−5
- src/PostgREST/Parsers.hs +43/−25
- src/PostgREST/QueryBuilder.hs +59/−81
- src/PostgREST/Types.hs +104/−11
- test/Feature/AuthSpec.hs +20/−29
- test/Feature/ConcurrentSpec.hs +2/−3
- test/Feature/DeleteSpec.hs +12/−18
- test/Feature/InsertSpec.hs +72/−61
- test/Feature/QueryLimitedSpec.hs +6/−10
- test/Feature/QuerySpec.hs +287/−87
- test/Feature/RangeSpec.hs +33/−56
- test/Feature/SingularSpec.hs +8/−13
- test/Feature/UnicodeSpec.hs +3/−0
- test/SpecHelper.hs +4/−1
main/Main.hs view
@@ -9,7 +9,7 @@ minimumPgVersion, prettyVersion, readOptions)-import PostgREST.Error (prettyUsageError)+import PostgREST.Error (encodeError) import PostgREST.OpenAPI (isMalformedProxyUri) import PostgREST.DbStructure @@ -57,6 +57,7 @@ appSettings = setHost ((fromString . toS) host) . setPort port . setServerName (toS $ "postgrest/" <> prettyVersion)+ . setTimeout 3600 $ defaultSettings when (isMalformedProxyUri $ toS <$> proxy) $ panic@@ -74,7 +75,7 @@ getDbStructure (toS $ configSchema conf) forM_ (lefts [result]) $ \e -> do- hPutStrLn stderr (prettyUsageError e)+ hPutStrLn stderr (toS $ encodeError e) exitFailure refDbStructure <- newIORef $ either (panic . show) id result@@ -124,4 +125,3 @@ setSecret bs = conf { configJwtSecret = Just bs } replaceUrlChars = replace "_" "/" . replace "-" "+" . replace "." "="-
postgrest.cabal view
@@ -2,7 +2,7 @@ description: Reads the schema of a PostgreSQL database and creates RESTful routes for the tables and views, supporting all HTTP verbs that security permits.-version: 0.4.0.0+version: 0.4.1.0 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE@@ -70,7 +70,7 @@ , lens , lens-aeson , network-uri- , optparse-applicative >= 0.12.0.0 && < 0.13.0.0+ , optparse-applicative >= 0.13 && < 0.14 , parsec , protolude , Ranged-sets == 0.3.0@@ -86,6 +86,7 @@ , wai-cors , wai-extra , wai-middleware-static+ , cookie Other-Modules: Paths_postgrest Exposed-Modules: PostgREST.ApiRequest@@ -143,7 +144,7 @@ , hjsonpointer , hjsonschema , hspec- , hspec-wai+ , hspec-wai >= 0.7.0 , hspec-wai-json , http-types , lens
src/PostgREST/ApiRequest.hs view
@@ -3,19 +3,17 @@ Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest. -} module PostgREST.ApiRequest ( ApiRequest(..)- , ApiRequestError(..) , ContentType(..) , Action(..) , Target(..) , PreferRepresentation (..) , mutuallyAgreeable- , toHeader , userApiRequest- , toMime ) where import Protolude import qualified Data.Aeson as JSON+import Data.Aeson.Types (emptyObject) import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS (c2w) import qualified Data.ByteString.Lazy as BL@@ -29,16 +27,21 @@ import qualified Data.Text as T import qualified Data.Vector as V import Network.HTTP.Base (urlEncodeVars)-import Network.HTTP.Types.Header (hAuthorization, hContentType, Header)+import Network.HTTP.Types.Header (hAuthorization, hCookie) import Network.HTTP.Types.URI (parseSimpleQuery) import Network.Wai (Request (..)) import Network.Wai.Parse (parseHttpAccept) import PostgREST.RangeQuery (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset) import Data.Ranged.Boundaries-import PostgREST.Types (QualifiedIdentifier (..),- Schema,- PayloadJSON(..))+import PostgREST.Types ( QualifiedIdentifier (..)+ , Schema+ , PayloadJSON(..)+ , ContentType(..)+ , ApiRequestError(..)+ , toMime) import Data.Ranged.Ranges (Range(..), rangeIntersection, emptyRange)+import qualified Data.CaseInsensitive as CI+import Web.Cookie (parseCookiesText) type RequestBody = BL.ByteString @@ -57,29 +60,6 @@ -- | How to return the inserted data data PreferRepresentation = Full | HeadersOnly | None deriving Eq ----- | Enumeration of currently supported response content types-data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI- | CTSingularJSON- | CTAny | CTOther BS.ByteString deriving Eq--data ApiRequestError = ErrorActionInappropriate- | ErrorInvalidBody ByteString- | ErrorInvalidRange- deriving (Show, Eq)---- | Convert from ContentType to a full HTTP Header-toHeader :: ContentType -> Header-toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")---- | Convert from ContentType to a ByteString representing the mime type-toMime :: ContentType -> ByteString-toMime CTApplicationJSON = "application/json"-toMime CTTextCSV = "text/csv"-toMime CTOpenAPI = "application/openapi+json"-toMime CTSingularJSON = "application/vnd.pgrst.object+json"-toMime CTAny = "*/*"-toMime (CTOther ct) = ct- {-| Describes what the user wants to do. This data type is a translation of the raw elements of an HTTP request into domain@@ -114,14 +94,18 @@ , iCanonicalQS :: ByteString -- | JSON Web Token , iJWT :: Text+ -- | HTTP request headers+ , iHeaders :: [(Text, Text)]+ -- | Request Cookies+ , iCookies :: [(Text, Text)] } -- | Examines HTTP request and translates it into user intent. userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest userApiRequest schema req reqBody- | isTargetingProc && method /= "POST" = Left ErrorActionInappropriate- | topLevelRange == emptyRange = Left ErrorInvalidRange- | shouldParsePayload && isLeft payload = either (Left . ErrorInvalidBody . toS) undefined payload+ | isTargetingProc && method /= "POST" = Left ActionInappropriate+ | topLevelRange == emptyRange = Left InvalidRange+ | shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) undefined payload | otherwise = Right ApiRequest { iAction = action , iTarget = target@@ -141,19 +125,21 @@ . parseSimpleQuery $ rawQueryString req , iJWT = tokenStr+ , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie]+ , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie" } where isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path payload = case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of CTApplicationJSON ->- either Left (\val -> case ensureUniform (pluralize val) of- Nothing -> Left "All object keys must match"- Just json -> Right json) (JSON.eitherDecode reqBody)+ note "All object keys must match" . ensureUniform . pluralize+ =<< if BL.null reqBody && isTargetingProc+ then Right emptyObject+ else JSON.eitherDecode reqBody CTTextCSV ->- either Left (\val -> case ensureUniform (csvToJson val) of- Nothing -> Left "All lines must have same number of fields"- Just json -> Right json) (CSV.decodeByName reqBody)+ note "All lines must have same number of fields" . ensureUniform . csvToJson+ =<< CSV.decodeByName reqBody CTOther "application/x-www-form-urlencoded" -> Right . PayloadJSON . V.singleton . M.fromList . map (toS *** JSON.String . toS) . parseSimpleQuery@@ -247,6 +233,7 @@ "application/openapi+json" -> CTOpenAPI "application/vnd.pgrst.object+json" -> CTSingularJSON "application/vnd.pgrst.object" -> CTSingularJSON+ "application/octet-stream" -> CTOctetStream "*/*" -> CTAny ct' -> CTOther ct'
src/PostgREST/App.hs view
@@ -8,6 +8,7 @@ import Control.Applicative import qualified Data.ByteString.Char8 as BS+import Data.Maybe import Data.IORef (IORef, readIORef) import Data.Text (intercalate) import Data.Time.Clock.POSIX (POSIXTime)@@ -32,15 +33,19 @@ , Action(..), Target(..) , PreferRepresentation (..) , mutuallyAgreeable- , toHeader , userApiRequest- , toMime ) import PostgREST.Auth (jwtClaims, containsRole) import PostgREST.Config (AppConfig (..)) import PostgREST.DbStructure-import PostgREST.DbRequestBuilder(readRequest, mutateRequest)-import PostgREST.Error (errResponse, pgErrResponse, apiRequestErrResponse, singularityError)+import PostgREST.DbRequestBuilder( readRequest+ , mutateRequest+ , fieldNames+ )+import PostgREST.Error ( simpleError, pgError+ , apiRequestError+ , singularityError, binaryFieldError+ ) import PostgREST.RangeQuery (allRange, rangeOffset) import PostgREST.Middleware import PostgREST.QueryBuilder ( callProc@@ -54,7 +59,8 @@ import PostgREST.OpenAPI import Data.Function (id)-import Protolude hiding (intercalate, Proxy)+import Protolude hiding (intercalate, Proxy)+import Safe (headMay) postgrest :: AppConfig -> IORef DbStructure -> P.Pool -> IO POSIXTime -> Application@@ -67,21 +73,35 @@ dbStructure <- readIORef refDbStructure response <- case userApiRequest (configSchema conf) req body of- Left err -> return $ apiRequestErrResponse err+ Left err -> return $ apiRequestError err Right apiRequest -> do let jwtSecret = binarySecret <$> configJwtSecret conf eClaims = jwtClaims jwtSecret (iJWT apiRequest) time authed = containsRole eClaims handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest- txMode = transactionMode $ iAction apiRequest+ txMode = transactionMode dbStructure+ (iTarget apiRequest) (iAction apiRequest) response <- P.use pool $ HT.transaction HT.ReadCommitted txMode handleReq- return $ either (pgErrResponse authed) identity response+ return $ either (pgError authed) identity response respond response -transactionMode :: Action -> H.Mode-transactionMode ActionRead = HT.Read-transactionMode ActionInfo = HT.Read-transactionMode _ = HT.Write+transactionMode :: DbStructure -> Target -> Action -> H.Mode+transactionMode structure target action =+ case action of+ ActionRead -> HT.Read+ ActionInfo -> HT.Read+ ActionInspect -> HT.Read+ ActionInvoke ->+ let proc =+ case target of+ (TargetProc qi) -> M.lookup (qiName qi) $+ dbProcs structure+ _ -> Nothing+ v = fromMaybe Volatile $ pdVolatility <$> proc in+ if v == Stable || v == Immutable+ then HT.Read+ else HT.Write+ _ -> HT.Write app :: DbStructure -> AppConfig -> ApiRequest -> H.Transaction Response app dbStructure conf apiRequest =@@ -91,10 +111,13 @@ case (iAction apiRequest, iTarget apiRequest, iPayload apiRequest) of (ActionRead, TargetIdent qi, Nothing) ->- case readSqlParts of+ let partsField = (,) <$> readSqlParts+ <*> (binaryField contentType =<< fldNames) in+ case partsField of Left errorResponse -> return errorResponse- Right (q, cq) -> do- let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount (contentType == CTTextCSV)+ Right ((q, cq), bField) -> do+ let stm = createReadStatement q cq (contentType == CTSingularJSON) shouldCount+ (contentType == CTTextCSV) bField row <- H.query () stm let (tableTotal, queryTotal, _ , body) = row (status, contentRange) = rangeHeader queryTotal tableTotal@@ -142,10 +165,12 @@ if iPreferRepresentation apiRequest == Full then toS body else "" - (ActionUpdate, TargetIdent _, Just payload) ->- case mutateSqlParts of- Left errorResponse -> return errorResponse- Right (sq, mq) -> do+ (ActionUpdate, TargetIdent _, Just payload@(PayloadJSON rows)) ->+ case (mutateSqlParts, null <$> rows V.!? 0, iPreferRepresentation apiRequest == Full) of+ (Left errorResponse, _, _) -> return errorResponse+ (_, Just True, True) -> return $ responseLBS status200 [contentRangeH 1 0 Nothing] "[]"+ (_, Just True, False) -> return $ responseLBS status204 [contentRangeH 1 0 Nothing] ""+ (Right (sq, mq), _, _) -> do let stm = createWriteStatement sq mq (contentType == CTSingularJSON) False (contentType == CTTextCSV) (iPreferRepresentation apiRequest) []@@ -223,7 +248,7 @@ 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 (map snd $ dbProcs dbStructure) ti uri'+ encodeApi ti = encodeOpenAPI (M.elems $ dbProcs dbStructure) ti uri' body <- encodeApi . toTableInfo <$> H.query schema accessibleTables return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body @@ -241,7 +266,6 @@ filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk filterCol :: Schema -> TableName -> Column -> Bool filterCol sc tb Column{colTable=Table{tableSchema=s, tableName=t}} = s==sc && t==tb- filterCol _ _ _ = False allPrKeys = dbPrimaryKeys dbStructure allOrigins = ("Access-Control-Allow-Origin", "*") :: Header jsonH = toHeader CTApplicationJSON@@ -255,10 +279,10 @@ status = rangeStatus lower upper (toInteger <$> tableTotal) in (status, contentRange) - mapSnd f (a, b) = (a, f b)- readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (map (mapSnd pdReturnType) $ dbProcs dbStructure) apiRequest+ readReq = readRequest (configMaxRows conf) (dbRelations dbStructure) (dbProcs dbStructure) apiRequest+ fldNames = fieldNames <$> readReq readDbRequest = DbRead <$> readReq- mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< readReq)+ mutateDbRequest = DbMutate <$> (mutateRequest apiRequest =<< fldNames) selectQuery = requestToQuery schema False <$> readDbRequest mutateQuery = requestToQuery schema False <$> mutateDbRequest countQuery = requestToCountQuery schema <$> readDbRequest@@ -270,20 +294,29 @@ where contentTypesForRequest = case action of- ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV]+ ActionRead -> [CTApplicationJSON, CTSingularJSON, CTTextCSV, CTOctetStream] ActionCreate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ActionUpdate -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ActionDelete -> [CTApplicationJSON, CTSingularJSON, CTTextCSV] ActionInvoke -> [CTApplicationJSON, CTSingularJSON]- ActionInspect -> [CTOpenAPI]+ ActionInspect -> [CTOpenAPI, CTApplicationJSON] ActionInfo -> [CTTextCSV] serves sProduces cAccepts = case mutuallyAgreeable sProduces cAccepts of Nothing -> do let failed = intercalate ", " $ map (toS . toMime) cAccepts- Left $ errResponse status415 $+ Left $ simpleError status415 $ "None of these Content-Types are available: " <> failed Just ct -> Right ct++binaryField :: ContentType -> [FieldName] -> Either Response (Maybe FieldName)+binaryField CTOctetStream fldNames =+ if length fldNames == 1 && fieldName /= Just "*"+ then Right fieldName+ else Left binaryFieldError+ where+ fieldName = headMay fldNames+binaryField _ _ = Right Nothing splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString) splitKeyValue kv = (k, BS.tail v)
src/PostgREST/Auth.hs view
@@ -12,8 +12,7 @@ very simple authentication system inside the PostgreSQL database. -} module PostgREST.Auth (- claimsToSQL- , containsRole+ containsRole , jwtClaims , tokenJWT , JWTAttempt(..)@@ -28,24 +27,8 @@ import qualified Data.HashMap.Strict as M import Data.Maybe (fromJust) import Data.Time.Clock (NominalDiffTime)-import PostgREST.QueryBuilder (pgFmtIdent, pgFmtLit, unquoted) import qualified Web.JWT as JWT -{-|- Receives a map of JWT claims and returns a list of PostgreSQL- statements to set the claims as user defined GUCs. Except if we- have a claim called role, this one is mapped to a SET ROLE- statement.--}-claimsToSQL :: M.HashMap Text Value -> [ByteString]-claimsToSQL claims = roleStmts <> varStmts- where- roleStmts = maybeToList $- (\r -> "set local role " <> r <> ";") . toS . valueToVariable <$> M.lookup "role" claims- varStmts = map setVar $ M.toList (M.delete "role" claims)- setVar (k, val) = "set local " <> toS (pgFmtIdent $ "request.jwt.claim." <> k)- <> " = " <> toS (valueToVariable val) <> ";"- valueToVariable = pgFmtLit . unquoted {-| Possible situations encountered with client JWTs
src/PostgREST/Config.hs view
@@ -29,6 +29,7 @@ import qualified Data.Configurator as C import qualified Data.Configurator.Types as C import Data.List (lookup)+import Data.Monoid import Data.Text (strip, intercalate, lines) import Data.Text.Encoding (encodeUtf8) import Data.Text.IO (hPutStrLn)@@ -39,9 +40,8 @@ import Paths_postgrest (version) import Text.Heredoc import Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>))--import Protolude hiding (intercalate- , (<>))+import qualified Text.PrettyPrint.ANSI.Leijen as L+import Protolude hiding (intercalate, (<>)) -- | Config file settings for the server data AppConfig = AppConfig {@@ -128,7 +128,7 @@ ) <> footerDoc (Just $ text "Example Config File:"- <> nest 2 (hardline <> exampleCfg)+ L.<> nest 2 (hardline L.<> exampleCfg) ) parserPrefs = prefs showHelpOnError@@ -143,6 +143,8 @@ missingKeyHint (C.KeyError n) = do hPutStrLn stderr $ "Required config parameter \"" <> n <> "\" is missing or of wrong type.\n" <>+ "Documentation for configuration options available at\n" <>+ "\thttp://postgrest.com/en/v0.4/admin.html#configuration\n\n" <> "Try the --example-config option to see how to configure PostgREST." exitFailure
src/PostgREST/DbRequestBuilder.hs view
@@ -2,31 +2,30 @@ module PostgREST.DbRequestBuilder ( readRequest , mutateRequest+, fieldNames ) where import Control.Applicative import Control.Lens.Getter (view) import Control.Lens.Tuple (_1) import qualified Data.ByteString.Char8 as BS-import Data.List (delete, lookup)+import Data.List (delete) import Data.Maybe (fromJust)-import Data.Text (isInfixOf, dropWhile, drop)+import Data.Text (isInfixOf) import Data.Tree import Data.Either.Combinators (mapLeft) -import Text.Parsec.Error--import Network.HTTP.Types.Status import Network.Wai import Data.Foldable (foldr1) import qualified Data.HashMap.Strict as M -import PostgREST.ApiRequest ( ApiRequest(..) +import PostgREST.ApiRequest ( ApiRequest(..)+ , PreferRepresentation(..) , Action(..), Target(..) , PreferRepresentation (..) )-import PostgREST.Error (errResponse, formatParserError)+import PostgREST.Error (apiRequestError) import PostgREST.Parsers import PostgREST.RangeQuery (NonnegRange, restrictRange) import PostgREST.QueryBuilder (getJoinConditions, sourceCTEName)@@ -36,31 +35,31 @@ import Text.Regex.TDFA ((=~)) import Unsafe (unsafeHead) -readRequest :: Maybe Integer -> [Relation] -> [(Text, Text)] -> ApiRequest -> Either Response ReadRequest+readRequest :: Maybe Integer -> [Relation] -> M.HashMap Text ProcDescription -> ApiRequest -> Either Response ReadRequest readRequest maxRows allRels allProcs apiRequest =- mapLeft (errResponse status400) $+ mapLeft apiRequestError $ treeRestrictRange maxRows =<< augumentRequestWithJoin schema relations =<<- first formatParserError parseReadRequest+ parseReadRequest where (schema, rootTableName) = fromJust $ -- Make it safe let target = iTarget apiRequest in case target of (TargetIdent (QualifiedIdentifier s t) ) -> Just (s, t)- (TargetProc (QualifiedIdentifier s p) ) -> Just (s, t)+ (TargetProc (QualifiedIdentifier s proc) ) -> Just (s, tName) where- returnType = fromMaybe "" $ lookup p allProcs- -- we are looking for results looking like "SETOF schema.tablename" and want to extract tablename- t = if "SETOF " `isInfixOf` returnType- then drop 1 $ dropWhile (/= '.') returnType- else p+ retType = pdReturnType <$> M.lookup proc allProcs+ tName = case retType of+ Just (SetOf (Composite qi)) -> qiName qi+ Just (Single (Composite qi)) -> qiName qi+ _ -> proc _ -> Nothing action :: Action action = iAction apiRequest - parseReadRequest :: Either ParseError ReadRequest+ parseReadRequest :: Either ApiRequestError ReadRequest parseReadRequest = addFiltersOrdersRanges apiRequest <*> pRequestSelect rootName selStr where@@ -78,20 +77,18 @@ _ -> allRels where fakeSourceRelations = mapMaybe (toSourceRelation rootTableName) allRels -- see comment in toSourceRelation -treeRestrictRange :: Maybe Integer -> ReadRequest -> Either Text ReadRequest+treeRestrictRange :: Maybe Integer -> ReadRequest -> Either ApiRequestError ReadRequest treeRestrictRange maxRows_ request = pure $ nodeRestrictRange maxRows_ `fmap` request where nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i) -augumentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either Text ReadRequest+augumentRequestWithJoin :: Schema -> [Relation] -> ReadRequest -> Either ApiRequestError ReadRequest augumentRequestWithJoin schema allRels request =- (first formatRelationError . addRelations schema allRels Nothing) request+ addRelations schema allRels Nothing request >>= addJoinConditions schema- where- formatRelationError = ("could not find foreign keys between these entities, " <>) -addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest+addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias)) forest) = case parentNode of (Just (Node (Select{from=[parentNodeTable]}, (_, _, _)) _)) ->@@ -100,8 +97,8 @@ forest' = updateForest $ hush node' node' = Node <$> readNode' <*> pure forest readNode' = addRel readNode <$> rel- rel :: Either Text Relation- rel = note ("no relation between " <> parentNodeTable <> " and " <> name)+ rel :: Either ApiRequestError Relation+ rel = note (NoRelationBetween parentNodeTable name) $ findRelation schema name parentNodeTable where@@ -153,10 +150,10 @@ t = Table schema name 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 Text [ReadRequest]+ updateForest :: Maybe ReadRequest -> Either ApiRequestError [ReadRequest] updateForest n = mapM (addRelations schema allRelations n) forest -addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest+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@@ -167,12 +164,12 @@ where query' = addCond query (getJoinConditions rel) qq = query'{from=tableName linkTable : from query'}- _ -> Left "unknown relation"+ _ -> Left UnknownRelation where updatedForest = mapM (addJoinConditions schema) forest addCond query' con = query'{flt_=con ++ flt_ query'} -addFiltersOrdersRanges :: ApiRequest -> Either ParseError (ReadRequest -> ReadRequest)+addFiltersOrdersRanges :: ApiRequest -> Either ApiRequestError (ReadRequest -> ReadRequest) addFiltersOrdersRanges apiRequest = foldr1 (liftA2 (.)) [ flip (foldr addFilter) <$> filters, flip (foldr addOrder) <$> orders,@@ -183,7 +180,7 @@ of type (ReadRequest->ReadRequest) that are in (Either ParseError a) context -} where- filters :: Either ParseError [(Path, Filter)]+ filters :: Either ApiRequestError [(Path, Filter)] filters = mapM pRequestFilter flts where action = iAction apiRequest@@ -191,9 +188,9 @@ | action == ActionRead = iFilters apiRequest | action == ActionInvoke = iFilters apiRequest | otherwise = filter (( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- there can be no filters on the root table whre we are doing insert/update- orders :: Either ParseError [(Path, [OrderTerm])]+ orders :: Either ApiRequestError [(Path, [OrderTerm])] orders = mapM pRequestOrder $ iOrder apiRequest- ranges :: Either ParseError [(Path, NonnegRange)]+ ranges :: Either ApiRequestError [(Path, NonnegRange)] ranges = mapM pRequestRange $ M.toList $ iRange apiRequest addFilterToNode :: Filter -> ReadRequest -> ReadRequest@@ -247,13 +244,13 @@ | Just mt == (tableName <$> rt) = Just $ r {relLTable=(\tbl -> tbl {tableName=sourceCTEName}) <$> rt} | otherwise = Nothing -mutateRequest :: ApiRequest -> ReadRequest -> Either Response MutateRequest-mutateRequest apiRequest readReq = mapLeft (errResponse status400) $+mutateRequest :: ApiRequest -> [FieldName] -> Either Response MutateRequest+mutateRequest apiRequest fldNames = mapLeft apiRequestError $ case action of ActionCreate -> Right $ Insert rootTableName payload returnings ActionUpdate -> Update rootTableName <$> pure payload <*> filters <*> pure returnings ActionDelete -> Delete rootTableName <$> filters <*> pure returnings- _ -> Left "Unsupported HTTP verb"+ _ -> Left UnsupportedVerb where action = iAction apiRequest payload = fromJust $ iPayload apiRequest@@ -262,14 +259,14 @@ case target of (TargetIdent (QualifiedIdentifier _ t) ) -> t _ -> undefined- fieldNames :: ReadRequest -> PreferRepresentation -> [FieldName]- fieldNames _ None = []- fieldNames (Node (sel, _) forest) _ =- map (fst . view _1) (select sel) ++ map colName fks- where- fks = concatMap (fromMaybe [] . f) forest- f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols- f _ = Nothing- returnings = fieldNames readReq (iPreferRepresentation apiRequest) - filters = first formatParserError $ map snd <$> mapM pRequestFilter mutateFilters+ returnings = if iPreferRepresentation apiRequest == None then [] else fldNames+ filters = map snd <$> mapM pRequestFilter mutateFilters where mutateFilters = filter (not . ( "." `isInfixOf` ) . fst) $ iFilters apiRequest -- update/delete filters can be only on the root table++fieldNames :: ReadRequest -> [FieldName]+fieldNames (Node (sel, _) forest) =+ map (fst . view _1) (select sel) ++ map colName fks+ where+ fks = concatMap (fromMaybe [] . f) forest+ f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols+ f _ = Nothing
src/PostgREST/DbStructure.hs view
@@ -13,6 +13,7 @@ import qualified Hasql.Query as H import Control.Applicative+import qualified Data.HashMap.Strict as M import Data.List (elemIndex) import Data.Maybe (fromJust) import Data.Text (split, strip,@@ -96,12 +97,22 @@ <*> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text <*> HD.value HD.text -accessibleProcs :: H.Query Schema [(Text, ProcDescription)]+accessibleProcs :: H.Query Schema (M.HashMap Text ProcDescription) accessibleProcs = H.statement sql (HE.value HE.text)- (map addName <$> HD.rowsList (ProcDescription <$> HD.value HD.text- <*> (parseArgs <$> HD.value HD.text)- <*> HD.value HD.text)) True+ (M.fromList . map addName <$>+ HD.rowsList (+ ProcDescription <$> HD.value HD.text+ <*> (parseArgs <$> HD.value HD.text)+ <*> (parseRetType <$>+ HD.value HD.text <*>+ HD.value HD.text <*>+ HD.value HD.bool <*>+ HD.value HD.char)+ <*> (parseVolatility <$>+ HD.value HD.char)+ )+ ) True where addName :: ProcDescription -> (Text, ProcDescription) addName pd = (pdName pd, pd)@@ -118,14 +129,37 @@ else Just $ PgArg (dropAround (== '"') name) (strip typ) (T.null def) + parseRetType :: Text -> Text -> Bool -> Char -> RetType+ parseRetType schema name isSetOf typ+ | isSetOf = SetOf pgType+ | otherwise = Single pgType+ where+ qi = QualifiedIdentifier schema name+ pgType = case typ of+ 'c' -> Composite qi+ 'p' -> Pseudo name+ _ -> Scalar qi -- 'b'ase, 'd'omain, 'e'num, 'r'ange++ parseVolatility :: Char -> ProcVolatility+ parseVolatility 'i' = Immutable+ parseVolatility 's' = Stable+ parseVolatility 'v' = Volatile+ parseVolatility _ = Volatile -- should not happen, but be pessimistic+ sql = [q|- SELECT p.proname as "proc_name",- pg_get_function_arguments(p.oid) as "args",- pg_get_function_result(p.oid) as "return_type"- FROM pg_namespace n- JOIN pg_proc p- ON pronamespace = n.oid- WHERE n.nspname = $1|]+ SELECT p.proname as "proc_name",+ pg_get_function_arguments(p.oid) as "args",+ tn.nspname as "rettype_schema",+ coalesce(comp.relname, t.typname) as "rettype_name",+ p.proretset as "rettype_is_setof",+ t.typtype as "rettype_typ",+ p.provolatile+ FROM pg_proc p+ JOIN pg_namespace pn ON pn.oid = p.pronamespace+ 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+ WHERE pn.nspname = $1|] accessibleTables :: H.Query Schema [Table] accessibleTables =@@ -606,7 +640,7 @@ select case when match is not null then coalesce(match[8], match[7], match[4]) end from regexp_matches( CONCAT('SELECT ', SPLIT_PART(vcu.view_definition, 'SELECT', 2)),- CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\s+AS\s+("([^"]+)"|([^, \n\t]+)))?.*?FROM.*?',vcu.table_schema,'\.(\2|',vcu.table_name,'\s+(as\s)?\3)'),+ CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\s+AS\s+("([^"]+)"|([^, \n\t]+)))?.*?FROM.*?(',vcu.table_schema,'\.|)(\2|',vcu.table_name,'\s+(as\s)?\3)'), 'nsi' ) match ) as view_column_name
src/PostgREST/Error.hs view
@@ -2,46 +2,55 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} -module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError, singularityError, formatGeneralError, formatParserError) where+module PostgREST.Error (+ apiRequestError+, pgError+, simpleError+, singularityError+, binaryFieldError+, encodeError+) where import Protolude import Data.Aeson ((.=)) import qualified Data.Aeson as JSON-import Data.Text (replace, strip, unwords)+import Data.Text (unwords) import qualified Hasql.Pool as P import qualified Hasql.Session as H import qualified Network.HTTP.Types.Status as HT import Network.Wai (Response, responseLBS)-import PostgREST.ApiRequest (toHeader, toMime, ContentType(..), ApiRequestError(..))-import Text.Parsec.Error+import PostgREST.Types -apiRequestErrResponse :: ApiRequestError -> Response-apiRequestErrResponse err =- case err of- ErrorActionInappropriate -> errResponse HT.status405 "Bad Request"- ErrorInvalidBody errorMessage -> errResponse HT.status400 $ toS errorMessage- ErrorInvalidRange -> errResponse HT.status416 "HTTP Range error"+apiRequestError :: ApiRequestError -> Response+apiRequestError err = errorResponse status err+ where+ status =+ case err of+ ActionInappropriate -> HT.status405+ UnsupportedVerb -> HT.status405+ InvalidBody _ -> HT.status400+ ParseRequestError _ _ -> HT.status400+ NoRelationBetween _ _ -> HT.status400+ InvalidRange -> HT.status416+ UnknownRelation -> HT.status404 -errResponse :: HT.Status -> Text -> Response-errResponse status message = jsonErrResponse status $ JSON.object ["message" .= message]+simpleError :: HT.Status -> Text -> Response+simpleError status message =+ errorResponse status $ JSON.object ["message" .= message] -jsonErrResponse :: HT.Status -> JSON.Value -> Response-jsonErrResponse status message = responseLBS status [toHeader CTApplicationJSON] $ JSON.encode message+errorResponse :: JSON.ToJSON a => HT.Status -> a -> Response+errorResponse status e =+ responseLBS status [toHeader CTApplicationJSON] $ encodeError e -pgErrResponse :: Bool -> P.UsageError -> Response-pgErrResponse authed e =+pgError :: Bool -> P.UsageError -> Response+pgError authed e = let status = httpStatus authed e jsonType = toHeader CTApplicationJSON wwwAuth = ("WWW-Authenticate", "Bearer") hdrs = if status == HT.status401 then [jsonType, wwwAuth] else [jsonType] in- responseLBS status hdrs (JSON.encode e)--prettyUsageError :: P.UsageError -> Text-prettyUsageError (P.ConnectionError e) =- "Database connection error:\n" <> toS (fromMaybe "" e)-prettyUsageError e = show $ JSON.encode e+ responseLBS status hdrs (encodeError e) singularityError :: Integer -> Response singularityError numRows =@@ -53,22 +62,40 @@ [ "Results contain", show numRows, "rows," , toS (toMime CTSingularJSON), "requires 1 row" ]--formatParserError :: ParseError -> Text-formatParserError e = formatGeneralError message details where- message = show $ errorPos e- details = strip $ replace "\n" " " $ toS- $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)+ formatGeneralError :: Text -> Text -> Text+ formatGeneralError message details = toS . JSON.encode $+ JSON.object ["message" .= message, "details" .= details] -formatGeneralError :: Text -> Text -> Text-formatGeneralError message details = toS . JSON.encode $- JSON.object ["message" .= message, "details" .= details] +binaryFieldError :: Response+binaryFieldError =+ simpleError HT.status406 (toS (toMime CTOctetStream) <>+ " requested but a single column was not selected")++encodeError :: JSON.ToJSON a => a -> LByteString+encodeError = JSON.encode++instance JSON.ToJSON ApiRequestError where+ toJSON (ParseRequestError message details) = JSON.object [+ "message" .= message, "details" .= details]+ toJSON ActionInappropriate = JSON.object [+ "message" .= ("Bad Request" :: Text)]+ toJSON (InvalidBody errorMessage) = JSON.object [+ "message" .= (toS errorMessage :: Text)]+ toJSON InvalidRange = JSON.object [+ "message" .= ("HTTP Range error" :: Text)]+ toJSON UnknownRelation = JSON.object [+ "message" .= ("Unknown relation" :: Text)]+ toJSON (NoRelationBetween parent child) = JSON.object [+ "message" .= ("Could not find foreign keys between these entities, No relation found between " <> parent <> " and " <> child :: Text)]+ toJSON UnsupportedVerb = JSON.object [+ "message" .= ("Unsupported HTTP verb" :: Text)]+ instance JSON.ToJSON P.UsageError where toJSON (P.ConnectionError e) = JSON.object [ "code" .= ("" :: Text),- "message" .= ("Connection error" :: Text),+ "message" .= ("Database connection error" :: Text), "details" .= (toS $ fromMaybe "" e :: Text)] toJSON (P.SessionError e) = JSON.toJSON e -- H.Error
src/PostgREST/Middleware.hs view
@@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-} module PostgREST.Middleware where @@ -14,11 +15,12 @@ import Network.Wai.Middleware.Gzip (def, gzip) import Network.Wai.Middleware.Static (only, staticPolicy) -import PostgREST.ApiRequest (ApiRequest(..), ContentType(..),- toHeader)-import PostgREST.Auth (claimsToSQL, JWTAttempt(..))+import PostgREST.ApiRequest (ApiRequest(..))+import PostgREST.Auth (JWTAttempt(..)) import PostgREST.Config (AppConfig (..), corsPolicy)-import PostgREST.Error (errResponse)+import PostgREST.Error (simpleError)+import PostgREST.Types (ContentType (..), toHeader)+import PostgREST.QueryBuilder (pgFmtLit, unquoted, pgFmtEnvVar) import Protolude hiding (concat, null) @@ -29,16 +31,22 @@ case eClaims of JWTExpired -> return $ unauthed "JWT expired" JWTInvalid -> return $ unauthed "JWT invalid"- JWTMissingSecret -> return $ errResponse status500 "Server lacks JWT secret"+ JWTMissingSecret -> return $ simpleError status500 "Server lacks JWT secret" JWTClaims claims -> do- -- role claim defaults to anon if not specified in jwt- let setClaims = claimsToSQL (M.union claims (M.singleton "role" anon))- H.sql $ mconcat setClaims+ H.sql $ toS.mconcat $ setRoleSql ++ claimsSql ++ headersSql ++ cookiesSql mapM_ H.sql customReqCheck app req+ where+ headersSql = map (pgFmtEnvVar "request.header.") $ iHeaders req+ cookiesSql = map (pgFmtEnvVar "request.cookie.") $ iCookies req+ claimsSql = map (pgFmtEnvVar "request.jwt.claim.") [(c,unquoted v) | (c,v) <- M.toList claimsWithRole]+ setRoleSql = maybeToList $+ (\r -> "set local role " <> r <> ";") . toS . pgFmtLit . unquoted <$> M.lookup "role" claimsWithRole+ -- role claim defaults to anon if not specified in jwt+ claimsWithRole = M.union claims (M.singleton "role" anon)+ anon = String . toS $ configAnonRole conf+ customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf where- anon = String . toS $ configAnonRole conf- customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf unauthed message = responseLBS unauthorized401 [ toHeader CTApplicationJSON , ( "WWW-Authenticate"
src/PostgREST/OpenAPI.hs view
@@ -20,11 +20,10 @@ import Data.Swagger -import PostgREST.ApiRequest (ContentType(..), toMime)+import PostgREST.ApiRequest (ContentType(..)) import PostgREST.Config (prettyVersion)-import PostgREST.QueryBuilder (operators) import PostgREST.Types (Table(..), Column(..), PgArg(..),- Proxy(..), ProcDescription(..))+ Proxy(..), ProcDescription(..), toMime, Operator(..)) makeMimeList :: [ContentType] -> MimeList makeMimeList cs = MimeList $ map (fromString . toS . toMime) cs@@ -73,7 +72,7 @@ intercalate "|" [ concat ["^", x, y, "[.]"] | x <- ["not[.]", ""],- y <- map fst operators ]+ y <- map show [Equals ..] ] makeRowFilter :: Column -> Param makeRowFilter c =@@ -237,7 +236,7 @@ where getOp = (mempty :: Operation) & tags .~ Set.fromList ["/"]- & produces ?~ makeMimeList [CTOpenAPI]+ & produces ?~ makeMimeList [CTOpenAPI, CTApplicationJSON] & at 200 ?~ "OK" pr = (mempty :: PathItem) & get ?~ getOp p = pr
src/PostgREST/Parsers.hs view
@@ -2,37 +2,38 @@ import Protolude hiding (try, intercalate) import Control.Monad ((>>))-import Data.Text (intercalate)+import Data.Foldable (foldl1)+import Data.Text (intercalate, replace, strip) import Data.List (init, last) import Data.Tree-import PostgREST.QueryBuilder (operators)+import Data.Either.Combinators (mapLeft) import PostgREST.Types import Text.ParserCombinators.Parsec hiding (many, (<|>))+import Text.Read (read) import PostgREST.RangeQuery (NonnegRange,allRange)+import Text.Parsec.Error -pRequestSelect :: Text -> Text -> Either ParseError ReadRequest-pRequestSelect rootName selStr = - parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr)+pRequestSelect :: Text -> Text -> Either ApiRequestError ReadRequest+pRequestSelect rootName selStr =+ mapError $ parse (pReadRequest rootName) ("failed to parse select parameter (" <> toS selStr <> ")") (toS selStr) -pRequestFilter :: (Text, Text) -> Either ParseError (Path, Filter)-pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)+pRequestFilter :: (Text, Text) -> Either ApiRequestError (Path, Filter)+pRequestFilter (k, v) = mapError $ (,) <$> path <*> (Filter <$> fld <*> oper) where treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k- opVal = parse pOpValueExp ("failed to parse filter (" ++ toS v ++ ")") $ toS v+ oper = parse pOperation ("failed to parse filter (" ++ toS v ++ ")") $ toS v path = fst <$> treePath fld = snd <$> treePath- op = fst <$> opVal- val = snd <$> opVal -pRequestOrder :: (Text, Text) -> Either ParseError (Path, [OrderTerm])-pRequestOrder (k, v) = (,) <$> path <*> ord'+pRequestOrder :: (Text, Text) -> Either ApiRequestError (Path, [OrderTerm])+pRequestOrder (k, v) = mapError $ (,) <$> path <*> ord' where treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k path = fst <$> treePath ord' = parse pOrder ("failed to parse order (" ++ toS v ++ ")") $ toS v -pRequestRange :: (ByteString, NonnegRange) -> Either ParseError (Path, NonnegRange)-pRequestRange (k, v) = (,) <$> path <*> pure v+pRequestRange :: (ByteString, NonnegRange) -> Either ApiRequestError (Path, NonnegRange)+pRequestRange (k, v) = mapError $ (,) <$> path <*> pure v where treePath = parse pTreePath ("failed to parser tree path (" ++ toS k ++ ")") $ toS k path = fst <$> treePath@@ -118,22 +119,29 @@ s <- pStar return ((s, Nothing), Nothing, Nothing) -pOperator :: Parser Operator-pOperator = toS <$> (pOp <?> "operator (eq, gt, ...)")- where pOp = foldl (<|>) empty $ map (try . string . toS . fst) operators+pOperation :: Parser Operation+pOperation = try ( string "not" *> pDelimiter *> (Operation True <$> pExpr)) <|> Operation False <$> pExpr+ where+ pExpr :: Parser (Operator, Operand)+ pExpr =+ ((,) <$> (read <$> foldl1 (<|>) (try . string . show <$> notInOps)) <*> (pDelimiter *> pVText))+ <|> try (string (show In) *> pDelimiter *> ((,) <$> pure In <*> pVTextL))+ <|> try (string (show NotIn) *> pDelimiter *> ((,) <$> pure NotIn <*> pVTextL))+ <?> "operator (eq, gt, ...)"+ notInOps = [Equals .. Contained] -pValue :: Parser FValue-pValue = VText <$> (toS <$> many anyChar)+pVText :: Parser Operand+pVText = VText . toS <$> many anyChar +pVTextL :: Parser Operand+pVTextL = VTextL <$> pLValue `sepBy1` char ','+ where+ pLValue :: Parser Text+ pLValue = toS <$> (try (char '"' *> many (noneOf "\"") <* char '"' <* notFollowedBy (noneOf ",") ) <|> many (noneOf ","))+ pDelimiter :: Parser Char pDelimiter = char '.' <?> "delimiter (.)" -pOperatiorWithNegation :: Parser Operator-pOperatiorWithNegation = try ( (<>) <$> ( toS <$> string "not." ) <*> pOperator) <|> pOperator--pOpValueExp :: Parser (Operator, FValue)-pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue)- pOrder :: Parser [OrderTerm] pOrder = lexeme pOrderTerm `sepBy` char ',' @@ -152,3 +160,13 @@ return $ OrderTerm c d nls ) <|> OrderTerm <$> pField <*> pure Nothing <*> pure Nothing++mapError :: Either ParseError a -> Either ApiRequestError a+mapError = mapLeft translateError+ where+ translateError e =+ ParseRequestError message details+ where+ message = show $ errorPos e+ details = strip $ replace "\n" " " $ toS+ $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
src/PostgREST/QueryBuilder.hs view
@@ -16,7 +16,6 @@ , createReadStatement , createWriteStatement , getJoinConditions- , operators , pgFmtIdent , pgFmtLit , requestToQuery@@ -24,6 +23,7 @@ , sourceCTEName , unquoted , ResultsWithCount+ , pgFmtEnvVar ) where import qualified Hasql.Query as H@@ -35,13 +35,13 @@ import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset, allRange) import Data.Functor.Contravariant (contramap) import qualified Data.HashMap.Strict as HM-import Data.Text (intercalate, unwords, replace, isInfixOf, toLower, split)+import Data.Maybe+import Data.Text (intercalate, unwords, replace, isInfixOf, toLower) import qualified Data.Text as T (map, takeWhile, null) import qualified Data.Text.Encoding as T import Data.Tree (Tree(..)) import qualified Data.Vector as V import PostgREST.Types-import qualified Data.Map as M import Text.InterpolatedString.Perl6 (qc) import qualified Data.ByteString.Char8 as BS import Data.Scientific ( FPFormat (..)@@ -86,9 +86,9 @@ encodeUniformObjs = contramap (JSON.Array . V.map JSON.Object . unPayloadJSON) (HE.value HE.json) -createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->+createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool -> Maybe FieldName -> H.Query () ResultsWithCount-createReadStatement selectQuery countQuery isSingle countTotal asCsv =+createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField = unicodeStatement sql HE.unit decodeStandard False where sql = [qc|@@ -104,6 +104,7 @@ bodyF | asCsv = asCsvF | isSingle = asJsonSingleF+ | isJust binaryField = asBinaryF $ fromJust binaryField | otherwise = asJsonF createWriteStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->@@ -179,25 +180,6 @@ | isSingle = asJsonSingleF | otherwise = asJsonF -operators :: [(Text, SqlFragment)]-operators = [- ("eq", "="),- ("gte", ">="), -- has to be before gt (parsers)- ("gt", ">"),- ("lte", "<="), -- has to be before lt (parsers)- ("lt", "<"),- ("neq", "<>"),- ("like", "like"),- ("ilike", "ilike"),- ("in", "in"),- ("notin", "not in"),- ("isnot", "is not"), -- has to be before is (parsers)- ("is", "is"),- ("@@", "@@"),- ("@>", "@>"),- ("<@", "<@")- ]- pgFmtIdent :: SqlFragment -> SqlFragment pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\"" @@ -216,31 +198,27 @@ unwords [ "SELECT pg_catalog.count(*)", "FROM ", fromQi qi,- ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi) localConditions )) `emptyOnNull` localConditions+ ("WHERE " <> intercalate " AND " ( map (pgFmtFilter qi) localConditions )) `emptyOnNull` localConditions ] where- qi = if mainTbl == sourceCTEName- then QualifiedIdentifier "" mainTbl- else QualifiedIdentifier schema mainTbl- fn Filter{value=VText _} = True- fn Filter{value=VForeignKey _ _} = False+ qi = removeSourceCTESchema schema mainTbl+ fn Filter{operation=Operation{expr=(_, VText _)}} = True+ fn Filter{operation=Operation{expr=(_, VTextL _)}} = True+ fn Filter{operation=Operation{expr=(_, VForeignKey _ _)}} = False localConditions = filter fn conditions requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) = query where- -- TODO! the following helper functions are just to remove the "schema" part when the table is "source" which is the name- -- of our WITH query part mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)- tblSchema tbl = if tbl == sourceCTEName then "" else schema- qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl- toQi t = QualifiedIdentifier (tblSchema t) t+ qi = removeSourceCTESchema schema mainTbl+ toQi = removeSourceCTESchema schema query = unwords [ "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), "FROM ", intercalate ", " (map (fromQi . toQi) tbls), unwords joins,- ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,+ ("WHERE " <> intercalate " AND " ( map (pgFmtFilter qi ) conditions )) `emptyOnNull` conditions, orderF (fromMaybe [] ord), if isParent then "" else limitF range ]@@ -269,11 +247,11 @@ where node_name = fromMaybe name alias local_table_name = table <> "_" <> node_name- replaceTableName localTableName (Filter a b (VForeignKey (QualifiedIdentifier "" _) c)) = Filter a b (VForeignKey (QualifiedIdentifier "" localTableName) c)+ replaceTableName localTableName (Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" _) d))) = Filter a (Operation b (c, VForeignKey (QualifiedIdentifier "" localTableName) d)) 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 (pgFmtCondition qi . replaceTableName local_table_name) (getJoinConditions r) )+ " ON " <> intercalate " AND " ( map (pgFmtFilter qi . replaceTableName local_table_name) (getJoinConditions 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) where@@ -298,7 +276,7 @@ if T.null colsString then if V.null rows then ["SELECT null WHERE false"] else ["DEFAULT VALUES"] else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]- ret = if null returnings + ret = if null returnings then "" else unwords [" RETURNING ", intercalate ", " (map (pgFmtColumn qi) returnings)] requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions returnings)) =@@ -309,7 +287,7 @@ unwords [ "UPDATE ", fromQi qi, " SET " <> intercalate "," assignments <> " ",- ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,+ ("WHERE " <> intercalate " AND " ( map (pgFmtFilter qi ) conditions )) `emptyOnNull` conditions, ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings ] Nothing -> undefined@@ -321,13 +299,16 @@ qi = QualifiedIdentifier schema mainTbl query = unwords [ "DELETE FROM ", fromQi qi,- ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,+ ("WHERE " <> intercalate " AND " ( map (pgFmtFilter qi ) conditions )) `emptyOnNull` conditions, ("RETURNING " <> intercalate ", " (map (pgFmtColumn qi) returnings)) `emptyOnNull` returnings ] sourceCTEName :: SqlFragment sourceCTEName = "pg_source" +removeSourceCTESchema :: Schema -> TableName -> QualifiedIdentifier+removeSourceCTESchema schema tbl = QualifiedIdentifier (if tbl == sourceCTEName then "" else schema) tbl+ unquoted :: JSON.Value -> Text unquoted (JSON.String t) = t unquoted (JSON.Number n) =@@ -356,6 +337,9 @@ asJsonSingleF :: SqlFragment --TODO! unsafe when the query actually returns multiple rows, used only on inserting and returning single element asJsonSingleF = "coalesce(string_agg(row_to_json(_postgrest_t)::text, ','), '')::character varying " +asBinaryF :: FieldName -> SqlFragment+asBinaryF fieldName = "coalesce(string_agg(_postgrest_t." <> pgFmtIdent fieldName <> ", ''), '')"+ locationF :: [Text] -> SqlFragment locationF pKeys = "(" <>@@ -395,7 +379,7 @@ ftN = tableName ft ltN = fromMaybe "" (tableName <$> lt) toFilter :: Text -> Text -> Column -> Column -> Filter- toFilter tb ftb c fc = Filter (colName c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))+ toFilter tb ftb c fc = Filter (colName c, Nothing) (Operation False (Equals, VForeignKey (QualifiedIdentifier s tb) (ForeignKey fc{colTable=(colTable fc){tableName=ftb}}))) unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b unicodeStatement = H.statement . T.encodeUtf8@@ -411,11 +395,6 @@ insertableValueWithType t v = pgFmtLit (unquoted v) <> "::" <> t -whiteList :: Text -> SqlFragment-whiteList val = fromMaybe- (toS (pgFmtLit val) <> "::unknown ")- (find ((==) . toLower $ val) ["null","true","false"])- pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment pgFmtColumn table "*" = fromQi table <> ".*" pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c@@ -427,45 +406,40 @@ 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 -pgFmtCondition :: QualifiedIdentifier -> Filter -> SqlFragment-pgFmtCondition table (Filter (col,jp) ops val) =- notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <>- if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue+pgFmtFilter :: QualifiedIdentifier -> Filter -> SqlFragment+pgFmtFilter table (Filter fld (Operation hasNot_ ex@(op, operand))) = notOp <> " " <> case operand of+ VForeignKey fQi (ForeignKey Column{colTable=Table{tableName=fTableName}, colName=fColName}) ->+ pgFmtField fQi fld <> " " <> opToSqlFragment op <> " " <> pgFmtColumn (removeSourceCTESchema (qiSchema fQi) fTableName) fColName+ _ -> pgFmtField table fld <> " " <> pgFmtExpr ex where- headPredicate:rest = split (=='.') ops- hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse- opCode = hasNot (headDef "eq" rest) headPredicate- notOp = hasNot headPredicate ""- sqlCol = case val of- VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp- VForeignKey qi _ -> pgFmtColumn qi col- sqlValue = valToStr val- getInner v = case v of- VText s -> s- _ -> ""- valToStr v = case v of- VText s -> pgFmtValue opCode s- VForeignKey (QualifiedIdentifier s _) (ForeignKey Column{colTable=Table{tableName=ft}, colName=fc}) -> pgFmtColumn qi fc- where qi = QualifiedIdentifier (if ft == sourceCTEName then "" else s) ft- _ -> ""+ notOp = if hasNot_ then "NOT" else "" -pgFmtValue :: Text -> Text -> SqlFragment-pgFmtValue opCode val =- case opCode of- "like" -> unknownLiteral $ T.map star val- "ilike" -> unknownLiteral $ T.map star val- "in" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "- "notin" -> "(" <> intercalate ", " (map unknownLiteral $ split (==',') val) <> ") "- "@@" -> "to_tsquery(" <> unknownLiteral val <> ") "- _ -> unknownLiteral val+pgFmtExpr :: (Operator, Operand) -> SqlFragment+pgFmtExpr ex =+ case ex of+ (Like, VText val) -> opToSqlFragment Like <> " " <> unknownLiteral (T.map star val)+ (ILike, VText val) -> opToSqlFragment ILike <> " " <> unknownLiteral (T.map star val)+ (TSearch, VText val) -> opToSqlFragment TSearch <> " " <> "to_tsquery(" <> unknownLiteral val <> ") "+ (Is, VText val) -> opToSqlFragment Is <> " " <> whiteList val+ (In, VTextL vals) -> exprForIn vals+ (NotIn, VTextL vals) -> opToSqlFragment NotIn <> " " <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "+ (op, VText val) -> opToSqlFragment op <> " " <> unknownLiteral val+ _ -> "" -- should not happen, all possible combinations are defined in Parsers where star c = if c == '*' then '%' else c unknownLiteral = (<> "::unknown ") . pgFmtLit--pgFmtOperator :: Text -> SqlFragment-pgFmtOperator opCode = fromMaybe "=" $ M.lookup opCode operatorsMap- where- operatorsMap = M.fromList operators+ whiteList :: Text -> SqlFragment+ whiteList v = fromMaybe+ (toS (pgFmtLit v) <> "::unknown ")+ (find ((==) . toLower $ v) ["null","true","false"])+ exprForIn :: [Text] -> SqlFragment+ exprForIn vals =+ let emptyValForIn = "= any('{}') " in+ case T.null <$> headMay vals of+ Just isNull -> if isNull && length vals == 1+ then emptyValForIn+ else opToSqlFragment In <> " " <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") "+ Nothing -> emptyValForIn pgFmtJsonPath :: Maybe JsonPath -> SqlFragment pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x@@ -478,6 +452,10 @@ Just alias -> " AS " <> pgFmtIdent alias Nothing -> "" pgFmtAs _ (Just alias) = " AS " <> pgFmtIdent alias++pgFmtEnvVar :: Text -> (Text, Text) -> SqlFragment+pgFmtEnvVar prefix (k, v) =+ "set local " <> pgFmtIdent (prefix <> k) <> " = " <> pgFmtLit v <> ";" trimNullChars :: Text -> Text trimNullChars = T.takeWhile (/= '\x0')
src/PostgREST/Types.hs view
@@ -1,18 +1,35 @@ module PostgREST.Types where import Protolude import qualified GHC.Show+import qualified GHC.Read import Data.Aeson import qualified Data.ByteString.Lazy as BL+import Data.HashMap.Strict as M import Data.Tree import qualified Data.Vector as V import PostgREST.RangeQuery (NonnegRange)+import Network.HTTP.Types.Header (hContentType, Header) +-- | Enumeration of currently supported response content types+data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI+ | CTSingularJSON | CTOctetStream+ | CTAny | CTOther ByteString deriving Eq++data ApiRequestError = ActionInappropriate+ | InvalidBody ByteString+ | InvalidRange+ | ParseRequestError Text Text+ | UnknownRelation+ | NoRelationBetween Text Text+ | UnsupportedVerb+ deriving (Show, Eq)+ data DbStructure = DbStructure { dbTables :: [Table] , dbColumns :: [Column] , dbRelations :: [Relation] , dbPrimaryKeys :: [PrimaryKey]-, dbProcs :: [(Text,ProcDescription)]+, dbProcs :: M.HashMap Text ProcDescription } deriving (Show, Eq) data PgArg = PgArg {@@ -21,10 +38,18 @@ , pgaReq :: Bool } deriving (Show, Eq) +data PgType = Scalar QualifiedIdentifier | Composite QualifiedIdentifier | Pseudo Text deriving (Eq, Show)++data RetType = Single PgType | SetOf PgType deriving (Eq, Show)++data ProcVolatility = Volatile | Stable | Immutable+ deriving (Eq, Show)+ data ProcDescription = ProcDescription { pdName :: Text , pdArgs :: [PgArg]-, pdReturnType :: Text+, pdReturnType :: RetType+, pdVolatility :: ProcVolatility } deriving (Show, Eq) type Schema = Text@@ -39,7 +64,7 @@ , tableInsertable :: Bool } deriving (Show, Ord) -data ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord)+newtype ForeignKey = ForeignKey { fkCol :: Column } deriving (Show, Eq, Ord) data Column = Column {@@ -54,9 +79,7 @@ , colDefault :: Maybe Text , colEnum :: [Text] , colFK :: Maybe ForeignKey- }- | Star { colTable :: Table }- deriving (Show, Ord)+ } deriving (Show, Ord) type Synonym = (Column,Column) @@ -114,8 +137,66 @@ , proxyPath :: Text } deriving (Show, Eq) -type Operator = Text-data FValue = VText Text | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq)+data Operator = Equals | Gte | Gt | Lte | Lt | Neq | Like | ILike | Is | IsNot |+ TSearch | Contains | Contained | In | NotIn deriving (Eq, Enum)++instance Show Operator where+ show op = case op of+ Equals -> "eq"+ Gte -> "gte"+ Gt -> "gt"+ Lte -> "lte"+ Lt -> "lt"+ Neq -> "neq"+ Like -> "like"+ ILike -> "ilike"+ In -> "in"+ NotIn -> "notin"+ IsNot -> "isnot"+ Is -> "is"+ TSearch -> "@@"+ Contains -> "@>"+ Contained -> "<@"++instance Read Operator where+ readsPrec _ op = case op of+ "eq" -> [(Equals, "")]+ "gte" -> [(Gte, "")]+ "gt" -> [(Gt, "")]+ "lte" -> [(Lte, "")]+ "lt" -> [(Lt, "")]+ "neq" -> [(Neq, "")]+ "like" -> [(Like, "")]+ "ilike" -> [(ILike, "")]+ "in" -> [(In, "")]+ "notin" -> [(NotIn, "")]+ "isnot" -> [(IsNot, "")]+ "is" -> [(Is, "")]+ "@@" -> [(TSearch, "")]+ "@>" -> [(Contains, "")]+ "<@" -> [(Contained, "")]+ _ -> []++opToSqlFragment :: Operator -> SqlFragment+opToSqlFragment op = case op of+ Equals -> "="+ Gte -> ">="+ Gt -> ">"+ Lte -> "<="+ Lt -> "<"+ Neq -> "<>"+ Like -> "LIKE"+ ILike -> "ILIKE"+ In -> "IN"+ NotIn -> "NOT IN"+ IsNot -> "IS NOT"+ Is -> "IS"+ TSearch -> "@@"+ Contains -> "@>"+ Contained -> "<@"++data Operation = Operation{ hasNot::Bool, expr::(Operator, Operand) } deriving (Eq, Show)+data Operand = VText Text | VTextL [Text] | VForeignKey QualifiedIdentifier ForeignKey deriving (Show, Eq) type FieldName = Text type JsonPath = [Text] type Field = (FieldName, Maybe JsonPath)@@ -128,13 +209,12 @@ data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON, returning::[FieldName] } | Delete { in_::TableName, where_::[Filter], returning::[FieldName] } | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter], returning::[FieldName] } deriving (Show, Eq)-data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)+data Filter = Filter { field::Field, operation::Operation } deriving (Show, Eq) type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) type ReadRequest = Tree ReadNode type MutateRequest = MutateQuery data DbRequest = DbRead ReadRequest | DbMutate MutateRequest - instance ToJSON Column where toJSON c = object [ "schema" .= tableSchema t@@ -171,4 +251,17 @@ instance Eq Column where Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2- _ == _ = False++-- | Convert from ContentType to a full HTTP Header+toHeader :: ContentType -> Header+toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")++-- | Convert from ContentType to a ByteString representing the mime type+toMime :: ContentType -> ByteString+toMime CTApplicationJSON = "application/json"+toMime CTTextCSV = "text/csv"+toMime CTOpenAPI = "application/openapi+json"+toMime CTSingularJSON = "application/vnd.pgrst.object+json"+toMime CTOctetStream = "application/octet-stream"+toMime CTAny = "*/*"+toMime (CTOther ct) = ct
test/Feature/AuthSpec.hs view
@@ -18,44 +18,40 @@ let single = ("Accept","application/vnd.pgrst.object+json") it "denies access to tables that anonymous does not own" $- get "/authors_only" `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| {+ get "/authors_only" `shouldRespondWith` [json| { "hint":null, "details":null, "code":"42501", "message":"permission denied for relation authors_only"} |]- , matchStatus = 401+ { matchStatus = 401 , matchHeaders = ["WWW-Authenticate" <:> "Bearer"] } it "denies access to tables that postgrest_test_author does not own" $ let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" in request methodGet "/private_table" [auth] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| {+ `shouldRespondWith` [json| { "hint":null, "details":null, "code":"42501", "message":"permission denied for relation private_table"} |]- , matchStatus = 403+ { matchStatus = 403 , matchHeaders = [] } it "returns jwt functions as jwt tokens" $ request methodPost "/rpc/login" [single] [json| { "id": "jdoe", "pass": "1234" } |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]- , matchStatus = 200- , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]+ `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xuYW1lIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.P2G9EVSVI22MWxXWFuhEYd9BZerLS1WDlqzdqplM15s"} |]+ { matchStatus = 200+ , matchHeaders = [matchContentTypeJson] } it "sql functions can encode custom and standard claims" $ request methodPost "/rpc/jwt_test" [single] "{}"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]- , matchStatus = 200- , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]+ `shouldRespondWith` [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpc3MiOiJqb2UiLCJzdWIiOiJmdW4iLCJhdWQiOiJldmVyeW9uZSIsImV4cCI6MTMwMDgxOTM4MCwibmJmIjoxMzAwODE5MzgwLCJpYXQiOjEzMDA4MTkzODAsImp0aSI6ImZvbyIsInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdCIsImh0dHA6Ly9wb3N0Z3Jlc3QuY29tL2ZvbyI6dHJ1ZX0.IHF16ZSU6XTbOnUWO8CCpUn2fJwt8P00rlYVyXQjpWc"} |]+ { matchStatus = 200+ , matchHeaders = [matchContentTypeJson] } it "sql functions can read custom and standard claims variables" $ do@@ -82,9 +78,8 @@ it "fails with an expired token" $ do let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJleHAiOjE0NDY2NzgxNDksInJvbGUiOiJwb3N0Z3Jlc3RfdGVzdF9hdXRob3IiLCJpZCI6Impkb2UifQ.enk_qZ_u6gZsXY4R8bREKB_HNExRpM0lIWSLktk9JJQ" request methodGet "/authors_only" [auth] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Nothing- , matchStatus = 401+ `shouldRespondWith` [json| {"message":"JWT expired"} |]+ { matchStatus = 401 , matchHeaders = [ "WWW-Authenticate" <:> "Bearer error=\"invalid_token\", error_description=\"JWT expired\""@@ -94,9 +89,8 @@ it "hides tables from users with invalid JWT" $ do let auth = authHeaderJWT "ey9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" request methodGet "/authors_only" [auth] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Nothing- , matchStatus = 401+ `shouldRespondWith` [json| {"message":"JWT invalid"} |]+ { matchStatus = 401 , matchHeaders = [ "WWW-Authenticate" <:> "Bearer error=\"invalid_token\", error_description=\"JWT invalid\""@@ -126,9 +120,8 @@ let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6MX0.mI2HNoOum6xM3sc4oHLxU4yLv-_WV5W1kqBfY_wEvLw" in request methodPost "/rpc/get_current_user" [auth] [json| {} |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|"postgrest_test_author"|]- , matchStatus = 200+ `shouldRespondWith` [str|"postgrest_test_author"|]+ { matchStatus = 200 , matchHeaders = [] } @@ -136,9 +129,8 @@ let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6Mn0.W7jLsG-zswM91AJkCvZeIMHrnz7_6ceY2jnscVl3Yhk" in request methodPost "/rpc/get_current_user" [auth] [json| {} |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|"postgrest_test_default_role"|]- , matchStatus = 200+ `shouldRespondWith` [str|"postgrest_test_default_role"|]+ { matchStatus = 200 , matchHeaders = [] } @@ -146,8 +138,7 @@ let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJpZCI6M30.15Gy8PezQhJIaHYDJVLa-Gmz9T3sJnW66EKAYIsXc7c" in request methodPost "/rpc/get_current_user" [auth] [json| {} |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]- , matchStatus = 400+ `shouldRespondWith` [str|{"hint":"Please contact administrator","details":null,"code":"P0001","message":"Disabled ID --> 3"}|]+ { matchStatus = 400 , matchHeaders = [] }
test/Feature/ConcurrentSpec.hs view
@@ -24,14 +24,13 @@ it "should not raise 'transaction in progress' error" $ raceTest 10 $ get "/fakefake"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json|+ `shouldRespondWith` [json| { "hint": null, "details":null, "code":"42P01", "message":"relation \"test.fakefake\" does not exist" } |]- , matchStatus = 404+ { matchStatus = 404 , matchHeaders = [] }
test/Feature/DeleteSpec.hs view
@@ -15,24 +15,21 @@ context "existing record" $ do it "succeeds with 204 and deletion count" $ request methodDelete "/items?id=eq.1" [] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Nothing- , matchStatus = 204+ `shouldRespondWith` ""+ { matchStatus = 204 , matchHeaders = ["Content-Range" <:> "*/*"] } it "returns the deleted item and count if requested" $ request methodDelete "/items?id=eq.2" [("Prefer", "return=representation"), ("Prefer", "count=exact")] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":2}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":2}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/1"] } it "returns the deleted item and shapes the response" $ request methodDelete "/complex_items?id=eq.2&select=id,name" [("Prefer", "return=representation")] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":2,"name":"Two"}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":2,"name":"Two"}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/*"] } it "can rename and cast the selected columns" $@@ -40,18 +37,16 @@ `shouldRespondWith` [str|[{"ciId":"3","ciName":"Three"}]|] it "can embed (parent) entities" $ request methodDelete "/tasks?id=eq.8&select=id,name,project{id}" [("Prefer", "return=representation")] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":8,"name":"Code OSX","project":{"id":4}}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/*"] } it "actually clears items ouf the db" $ do _ <- request methodDelete "/items?id=lt.15" [] "" get "/items"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":15}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":15}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-0/*"] } @@ -59,9 +54,8 @@ it "includes [] body if return=rep" $ request methodDelete "/items?id=eq.101" [("Prefer", "return=representation")] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just "[]"- , matchStatus = 200+ `shouldRespondWith` "[]"+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/*"] }
test/Feature/InsertSpec.hs view
@@ -3,6 +3,7 @@ import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai import Test.Hspec.Wai.JSON+import Test.Hspec.Wai.Matcher (bodyEquals) import Network.Wai.Test (SResponse(simpleBody,simpleHeaders,simpleStatus)) import SpecHelper@@ -43,31 +44,29 @@ "integer": 14, "double": 3.14159, "varchar": "testing!" , "boolean": false, "date": "1900-01-01", "money": "$3.99" , "enum": "foo"- }] |] `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"integer":14,"varchar":"testing!"}]|]- , matchStatus = 201- , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"]+ }] |] `shouldRespondWith` [str|[{"integer":14,"varchar":"testing!"}]|]+ { matchStatus = 201+ , matchHeaders = [matchContentTypeJson] } context "requesting full representation" $ do it "includes related data after insert" $ request methodPost "/projects?select=id,name,clients{id,name}" [("Prefer", "return=representation"), ("Prefer", "count=exact")]- [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]- , matchStatus = 201- , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"+ [str|{"id":6,"name":"New Project","client_id":2}|] `shouldRespondWith` [str|[{"id":6,"name":"New Project","clients":{"id":2,"name":"Apple"}}]|]+ { matchStatus = 201+ , matchHeaders = [ matchContentTypeJson , "Location" <:> "/projects?id=eq.6" , "Content-Range" <:> "*/1" ] } it "can rename and cast the selected columns" $ request methodPost "/projects?select=pId:id::text,pName:name,cId:client_id::text"- [("Prefer", "return=representation")] - [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"pId":"7","pName":"New Project","cId":"2"}]|]- , matchStatus = 201- , matchHeaders = [ "Content-Type" <:> "application/json; charset=utf-8"+ [("Prefer", "return=representation")]+ [str|{"id":7,"name":"New Project","client_id":2}|] `shouldRespondWith`+ [str|[{"pId":"7","pName":"New Project","cId":"2"}]|]+ { matchStatus = 201+ , matchHeaders = [ matchContentTypeJson , "Location" <:> "/projects?id=eq.7" , "Content-Range" <:> "*/*" ] }@@ -201,9 +200,8 @@ request methodPost "/json" [("Prefer", "return=representation")] inserted- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"data":{"foo":"bar"}}]|]- , matchStatus = 201+ `shouldRespondWith` [str|[{"data":{"foo":"bar"}}]|]+ { matchStatus = 201 , matchHeaders = ["Location" <:> location] } @@ -213,39 +211,35 @@ request methodPost "/json" [("Prefer", "return=representation")] inserted- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"data":[1,2,3]}]|]- , matchStatus = 201+ `shouldRespondWith` [str|[{"data":[1,2,3]}]|]+ { matchStatus = 201 , matchHeaders = ["Location" <:> location] } context "empty object" $ it "successfully populates table with all-default columns" $- post "/items" "{}" `shouldRespondWith` ResponseMatcher {- matchBody = Just ""- , matchStatus = 201+ post "/items" "{}" `shouldRespondWith` ""+ { matchStatus = 201 , matchHeaders = [] } context "table with limited privileges" $ do it "succeeds if correct select is applied" $ request methodPost "/limited_article_stars?select=article_id,user_id" [("Prefer", "return=representation")]- [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"article_id":2,"user_id":1}]|]- , matchStatus = 201+ [json| {"article_id": 2, "user_id": 1} |] `shouldRespondWith` [str|[{"article_id":2,"user_id":1}]|]+ { matchStatus = 201 , matchHeaders = [] } it "fails if more columns are selected" $ request methodPost "/limited_article_stars?select=article_id,user_id,created_at" [("Prefer", "return=representation")]- [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]- , matchStatus = 401+ [json| {"article_id": 2, "user_id": 2} |] `shouldRespondWith`+ [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]+ { matchStatus = 401 , matchHeaders = [] } it "fails if select is not specified" $ request methodPost "/limited_article_stars" [("Prefer", "return=representation")]- [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]- , matchStatus = 401+ [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` [str|{"hint":null,"details":null,"code":"42501","message":"permission denied for relation limited_article_stars"}|]+ { matchStatus = 401 , matchHeaders = [] } @@ -259,11 +253,10 @@ |12,0.1,a string,true,1929-10-01,12,bar |] request methodPost "/menagerie" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] inserted-- `shouldRespondWith` ResponseMatcher {- matchBody = Just inserted- , matchStatus = 201+ `shouldRespondWith` ResponseMatcher+ { matchStatus = 201 , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"]+ , matchBody = bodyEquals inserted } context "requesting full representation" $ do@@ -271,9 +264,8 @@ request methodPost "/no_pk" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] "a,b\nbar,baz"- `shouldRespondWith` ResponseMatcher {- matchBody = Just "a,b\nbar,baz"- , matchStatus = 201+ `shouldRespondWith` "a,b\nbar,baz"+ { matchStatus = 201 , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8", "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"] }@@ -282,9 +274,8 @@ request methodPost "/no_pk" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] "a,b\nNULL,foo"- `shouldRespondWith` ResponseMatcher {- matchBody = Just "a,b\n,foo"- , matchStatus = 201+ `shouldRespondWith` "a,b\n,foo"+ { matchStatus = 201 , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8", "Location" <:> "/no_pk?a=is.null&b=eq.foo"] }@@ -293,9 +284,8 @@ request methodPost "/projects?select=id" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] "id,name,client_id\n8,Xenix,1\n9,Windows NT,1"- `shouldRespondWith` ResponseMatcher {- matchBody = Just "id\n8\n9"- , matchStatus = 201+ `shouldRespondWith` "id\n8\n9"+ { matchStatus = 201 , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8", "Content-Range" <:> "*/*"] }@@ -334,9 +324,8 @@ it "indicates no records found to update" $ request methodPatch "/empty_table" [] [json| { "extra":20 } |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just "",- matchStatus = 204,+ `shouldRespondWith` ""+ { matchStatus = 204, matchHeaders = ["Content-Range" <:> "*/*"] } @@ -346,9 +335,8 @@ liftIO $ simpleHeaders g `shouldSatisfy` matchHeader "Content-Range" "\\*/\\*" p <- request methodPatch "/items?id=eq.2" [] [json| { "id":42 } |]- pure p `shouldRespondWith` ResponseMatcher {- matchBody = Nothing,- matchStatus = 204,+ pure p `shouldRespondWith` ""+ { matchStatus = 204, matchHeaders = ["Content-Range" <:> "0-0/*"] } liftIO $ lookup hContentType (simpleHeaders p) `shouldBe` Nothing@@ -363,8 +351,8 @@ it "returns empty array when no rows updated and return=rep" $ request methodPatch "/items?id=eq.999999" [("Prefer", "return=representation")] [json| { "id":999999 } |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just "[]",+ `shouldRespondWith` "[]"+ { matchStatus = 200, matchHeaders = ["Content-Range" <:> "*/*"] }@@ -372,9 +360,8 @@ it "returns updated object as array when return=rep" $ request methodPatch "/items?id=eq.2" [("Prefer", "return=representation")] [json| { "id":2 } |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":2}]|],- matchStatus = 200,+ `shouldRespondWith` [str|[{"id":2}]|]+ { matchStatus = 200, matchHeaders = ["Content-Range" <:> "0-0/*"] } @@ -395,15 +382,15 @@ _ <- request methodPatch "/no_pk?b=eq.nullme" [] [json| { b: null } |] get "/no_pk?a=eq.keepme" `shouldRespondWith` [json| [{ a: "keepme", b: null }] |]+ { matchHeaders = [matchContentTypeJson] } it "can set a json column to escaped value" $ do _ <- post "/json" [json| { data: {"escaped":"bar"} } |] request methodPatch "/json?data->>escaped=eq.bar" [("Prefer", "return=representation")] [json| { "data": { "escaped":" \"bar" } } |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{ "data": { "escaped":" \"bar" } }] |]- , matchStatus = 200+ `shouldRespondWith` [json| [{ "data": { "escaped":" \"bar" } }] |]+ { matchStatus = 200 , matchHeaders = [] } @@ -412,9 +399,8 @@ "/items?always_true=eq.false" [("Prefer", "return=representation")] [json| { id: 100 } |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just "[]",- matchStatus = 200,+ `shouldRespondWith` "[]"+ { matchStatus = 200, matchHeaders = ["Content-Range" <:> "*/*"] } @@ -426,6 +412,31 @@ [("Prefer", "return=representation")] [json| { id: 99 } |] `shouldRespondWith` [json| [{id:99}] |]+ { matchHeaders = [matchContentTypeJson] }+ -- put value back for other tests+ void $ request methodPatch "/items?id=eq.99" [] [json| { "id":1 } |]++ it "makes no updates and returns 204, when patching with an empty json object" $ do+ request methodPatch "/items" [] [json| {} |]+ `shouldRespondWith` ""+ {+ matchStatus = 204,+ matchHeaders = ["Content-Range" <:> "*/*"]+ }++ g <- get "/items"+ liftIO $ simpleBody g `shouldBe` [json| [{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}] |]++ it "makes no updates and and returns 200, when patching with an empty json object and return=rep" $ do+ request methodPatch "/items" [("Prefer", "return=representation")] [json| {} |]+ `shouldRespondWith` "[]"+ {+ matchStatus = 200,+ matchHeaders = ["Content-Range" <:> "*/*"]+ }++ g <- get "/items"+ liftIO $ simpleBody g `shouldBe` [json| [{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15},{id:16},{"id":2},{"id":1}] |] context "with unicode values" $ it "succeeds and returns values intact" $ do
test/Feature/QueryLimitedSpec.hs view
@@ -16,9 +16,8 @@ describe "Requesting many items with server limits enabled" $ do it "restricts results" $ get "/items"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":2}] |]- , matchStatus = 200+ `shouldRespondWith` [json| [{"id":1},{"id":2}] |]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] } @@ -32,17 +31,14 @@ it "limit works on all levels" $ get "/users?select=id,tasks{id}&order=id.asc&tasks.order=id.asc"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":1,"tasks":[{"id":1},{"id":2}]},{"id":2,"tasks":[{"id":5},{"id":6}]}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] } it "limit is not applied to parent embeds" $ get "/tasks?select=id,project{id}&id=gt.5"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":6,"project":{"id":3}},{"id":7,"project":{"id":4}}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] }-
test/Feature/QuerySpec.hs view
@@ -5,6 +5,7 @@ import Test.Hspec.Wai.JSON import Network.HTTP.Types import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus,simpleBody))+import qualified Data.ByteString.Lazy as BL (empty) import SpecHelper import Text.Heredoc@@ -30,68 +31,49 @@ describe "Filtering response" $ do it "matches with equality" $ get "/items?id=eq.5"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":5}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-0/*"]- }+ `shouldRespondWith` [json| [{"id":5}] |]+ { matchHeaders = ["Content-Range" <:> "0-0/*"] } it "matches with equality using not operator" $ get "/items?id=not.eq.5"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-13/*"]- }+ `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]+ { matchHeaders = ["Content-Range" <:> "0-13/*"] } it "matches with more than one condition using not operator" $ get "/simple_pk?k=like.*yx&extra=not.eq.u" `shouldRespondWith` "[]" it "matches with inequality using not operator" $ do get "/items?id=not.lt.14&order=id.asc"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":14},{"id":15}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-1/*"]- }+ `shouldRespondWith` [json| [{"id":14},{"id":15}] |]+ { matchHeaders = ["Content-Range" <:> "0-1/*"] } get "/items?id=not.gt.2&order=id.asc"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":2}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-1/*"]- }+ `shouldRespondWith` [json| [{"id":1},{"id":2}] |]+ { matchHeaders = ["Content-Range" <:> "0-1/*"] } it "matches items IN" $ get "/items?id=in.1,3,5"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":3},{"id":5}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-2/*"]- }+ `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |]+ { matchHeaders = ["Content-Range" <:> "0-2/*"] } it "matches items NOT IN" $ get "/items?id=notin.2,4,6,7,8,9,10,11,12,13,14,15"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":3},{"id":5}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-2/*"]- }+ `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |]+ { matchHeaders = ["Content-Range" <:> "0-2/*"] } it "matches items NOT IN using not operator" $ get "/items?id=not.in.2,4,6,7,8,9,10,11,12,13,14,15"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":3},{"id":5}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-2/*"]- }+ `shouldRespondWith` [json| [{"id":1},{"id":3},{"id":5}] |]+ { matchHeaders = ["Content-Range" <:> "0-2/*"] } it "matches nulls using not operator" $ get "/no_pk?a=not.is.null" `shouldRespondWith` [json| [{"a":"1","b":"0"},{"a":"2","b":"0"}] |]+ { matchHeaders = [matchContentTypeJson] } it "matches nulls in varchar and numeric fields alike" $ do get "/no_pk?a=is.null" `shouldRespondWith` [json| [{"a": null, "b": null}] |]+ { matchHeaders = [matchContentTypeJson] } get "/nullable_integer?a=is.null" `shouldRespondWith` [str|[{"a":null}]|] @@ -119,25 +101,28 @@ it "matches with tsearch @@" $ get "/tsearch?text_search_vector=@@.foo" `shouldRespondWith` [json| [{"text_search_vector":"'bar':2 'foo':1"}] |]+ { 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"}] |]+ { matchHeaders = [matchContentTypeJson] } it "matches with computed column" $ get "/items?always_true=eq.true&order=id.asc" `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]+ { matchHeaders = [matchContentTypeJson] } it "order by computed column" $ get "/items?order=anti_id.desc" `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]+ { matchHeaders = [matchContentTypeJson] } it "matches filtering nested items 2" $ get "/clients?select=id,projects{id,tasks2{id,name}}&projects.tasks.name=like.Design*"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| {"message":"could not find foreign keys between these entities, no relation between projects and tasks2"}|]- , matchStatus = 400- , matchHeaders = []+ `shouldRespondWith` [json| {"message":"Could not find foreign keys between these entities, No relation found between projects and tasks2"}|]+ { matchStatus = 400+ , matchHeaders = [matchContentTypeJson] } it "matches filtering nested items" $@@ -166,45 +151,50 @@ it "one simple column" $ get "/complex_items?select=id" `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3}] |]+ { matchHeaders = [matchContentTypeJson] } it "rename simple column" $ get "/complex_items?id=eq.1&select=myId:id" `shouldRespondWith` [json| [{"myId":1}] |]+ { matchHeaders = [matchContentTypeJson] } it "one simple column with casting (text)" $ get "/complex_items?select=id::text" `shouldRespondWith` [json| [{"id":"1"},{"id":"2"},{"id":"3"}] |]+ { matchHeaders = [matchContentTypeJson] } it "rename simple column with casting" $ get "/complex_items?id=eq.1&select=myId:id::text" `shouldRespondWith` [json| [{"myId":"1"}] |]+ { matchHeaders = [matchContentTypeJson] } it "json column" $ get "/complex_items?id=eq.1&select=settings" `shouldRespondWith` [json| [{"settings":{"foo":{"int":1,"bar":"baz"}}}] |]+ { matchHeaders = [matchContentTypeJson] } it "json subfield one level with casting (json)" $ get "/complex_items?id=eq.1&select=settings->>foo::json" `shouldRespondWith` [json| [{"foo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"+ { matchHeaders = [matchContentTypeJson] } it "rename json subfield one level with casting (json)" $ get "/complex_items?id=eq.1&select=myFoo:settings->>foo::json" `shouldRespondWith` [json| [{"myFoo":{"int":1,"bar":"baz"}}] |] -- the value of foo here is of type "text"+ { matchHeaders = [matchContentTypeJson] } it "fails on bad casting (data of the wrong format)" $ get "/complex_items?select=settings->foo->>bar::integer"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"baz\""} |]- , matchStatus = 400+ `shouldRespondWith` [json| {"hint":null,"details":null,"code":"22P02","message":"invalid input syntax for integer: \"baz\""} |]+ { matchStatus = 400 , matchHeaders = [] } it "fails on bad casting (wrong cast type)" $ get "/complex_items?select=id::fakecolumntype"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| {"hint":null,"details":null,"code":"42704","message":"type \"fakecolumntype\" does not exist"} |]- , matchStatus = 400+ `shouldRespondWith` [json| {"hint":null,"details":null,"code":"42704","message":"type \"fakecolumntype\" does not exist"} |]+ { matchStatus = 400 , matchHeaders = [] } @@ -212,19 +202,23 @@ it "json subfield two levels (string)" $ get "/complex_items?id=eq.1&select=settings->foo->>bar" `shouldRespondWith` [json| [{"bar":"baz"}] |]+ { matchHeaders = [matchContentTypeJson] } it "rename json subfield two levels (string)" $ get "/complex_items?id=eq.1&select=myBar:settings->foo->>bar" `shouldRespondWith` [json| [{"myBar":"baz"}] |]+ { matchHeaders = [matchContentTypeJson] } it "json subfield two levels with casting (int)" $ get "/complex_items?id=eq.1&select=settings->foo->>int::integer" `shouldRespondWith` [json| [{"int":1}] |] -- the value in the db is an int, but here we expect a string for now+ { matchHeaders = [matchContentTypeJson] } it "rename json subfield two levels with casting (int)" $ get "/complex_items?id=eq.1&select=myInt:settings->foo->>int::integer" `shouldRespondWith` [json| [{"myInt":1}] |] -- the value in the db is an int, but here we expect a string for now+ { matchHeaders = [matchContentTypeJson] } it "requesting parents and children" $ get "/projects?id=eq.1&select=id, name, clients{*}, tasks{id, name}" `shouldRespondWith`@@ -302,70 +296,70 @@ get "/projects?id=in.1,3&select=id,name,client_id,client{id,name}" `shouldRespondWith` [str|[{"id":1,"name":"Windows 7","client_id":1,"client":{"id":1,"name":"Microsoft"}},{"id":3,"name":"IOS","client_id":2,"client":{"id":2,"name":"Apple"}}]|] + it "can detect fk relations through views to tables in the public schema" $+ get "/consumers_view?select=*,orders_view{*}" `shouldRespondWith` 200++ describe "ordering response" $ do it "by a column asc" $ get "/items?id=lte.2&order=id.asc"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":2}] |]- , matchStatus = 200+ `shouldRespondWith` [json| [{"id":1},{"id":2}] |]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] } it "by a column desc" $ get "/items?id=lte.2&order=id.desc"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":2},{"id":1}] |]- , matchStatus = 200+ `shouldRespondWith` [json| [{"id":2},{"id":1}] |]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] } it "by a column with nulls first" $ get "/no_pk?order=a.nullsfirst"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"a":null,"b":null},+ `shouldRespondWith` [json| [{"a":null,"b":null}, {"a":"1","b":"0"}, {"a":"2","b":"0"} ] |]- , matchStatus = 200+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-2/*"] } it "by a column asc with nulls last" $ get "/no_pk?order=a.asc.nullslast"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"a":"1","b":"0"},+ `shouldRespondWith` [json| [{"a":"1","b":"0"}, {"a":"2","b":"0"}, {"a":null,"b":null}] |]- , matchStatus = 200+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-2/*"] } it "by a column desc with nulls first" $ get "/no_pk?order=a.desc.nullsfirst"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"a":null,"b":null},+ `shouldRespondWith` [json| [{"a":null,"b":null}, {"a":"2","b":"0"}, {"a":"1","b":"0"}] |]- , matchStatus = 200+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-2/*"] } it "by a column desc with nulls last" $ get "/no_pk?order=a.desc.nullslast"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"a":"2","b":"0"},+ `shouldRespondWith` [json| [{"a":"2","b":"0"}, {"a":"1","b":"0"}, {"a":null,"b":null}] |]- , matchStatus = 200+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-2/*"] } it "by a json column property asc" $ get "/json?order=data->>id.asc" `shouldRespondWith` [json| [{"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}, {"data": {"id": 3}}] |]+ { matchHeaders = [matchContentTypeJson] } it "by a json column with two level property nulls first" $ get "/json?order=data->foo->>bar.nullsfirst" `shouldRespondWith` [json| [{"data": {"id": 3}}, {"data": {"id": 0}}, {"data": {"id": 1, "foo": {"bar": "baz"}}}] |]+ { matchHeaders = [matchContentTypeJson] } it "without other constraints" $ get "/items?order=id.asc" `shouldRespondWith` 200@@ -432,18 +426,16 @@ it "should respond with CSV to 'text/csv' request" $ request methodGet "/simple_pk" (acceptHdrs "text/csv; version=1") ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just "k,extra\nxyyx,u\nxYYx,v"- , matchStatus = 200+ `shouldRespondWith` "k,extra\nxyyx,u\nxYYx,v"+ { matchStatus = 200 , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"] } describe "Canonical location" $ do it "Sets Content-Location with alphabetized params" $ get "/no_pk?b=eq.1&a=eq.1"- `shouldRespondWith` ResponseMatcher {- matchBody = Just "[]"- , matchStatus = 200+ `shouldRespondWith` "[]"+ { matchStatus = 200 , matchHeaders = ["Content-Location" <:> "/no_pk?a=eq.1&b=eq.1"] } @@ -458,23 +450,26 @@ it "can filter by properties inside json column" $ do get "/json?data->foo->>bar=eq.baz" `shouldRespondWith` [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]+ { matchHeaders = [matchContentTypeJson] } get "/json?data->foo->>bar=eq.fake" `shouldRespondWith` [json| [] |]+ { matchHeaders = [matchContentTypeJson] } it "can filter by properties inside json column using not" $ get "/json?data->foo->>bar=not.eq.baz" `shouldRespondWith` [json| [] |]+ { matchHeaders = [matchContentTypeJson] } it "can filter by properties inside json column using ->>" $ get "/json?data->>id=eq.1" `shouldRespondWith` [json| [{"data": {"id": 1, "foo": {"bar": "baz"}}}] |]+ { matchHeaders = [matchContentTypeJson] } describe "remote procedure call" $ do context "a proc that returns a set" $ do it "returns paginated results" $ request methodPost "/rpc/getitemrange" (rangeHdrs (ByteRangeFromTo 0 0)) [json| { "min": 2, "max": 4 } |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":3}] |]- , matchStatus = 200+ `shouldRespondWith` [json| [{"id":3}] |]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-0/*"] } @@ -482,16 +477,15 @@ request methodPost "/rpc/getitemrange" (rangeHdrsWithCount (ByteRangeFromTo 0 0)) [json| { "min": 2, "max": 4 } |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":3}] |]- , matchStatus = 206 -- it now knows the response is partial+ `shouldRespondWith` [json| [{"id":3}] |]+ { matchStatus = 206 -- it now knows the response is partial , matchHeaders = ["Content-Range" <:> "0-0/2"] } - it "returns proper json" $ post "/rpc/getitemrange" [json| { "min": 2, "max": 4 } |] `shouldRespondWith` [json| [ {"id": 3}, {"id":4} ] |]+ { matchHeaders = [matchContentTypeJson] } context "unknown function" $ it "returns 404" $@@ -505,12 +499,12 @@ it "can filter proc results" $ post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id" [json| {} |] `shouldRespondWith` [json|[{"id":2},{"id":3},{"id":4}]|]+ { matchHeaders = [matchContentTypeJson] } it "can limit proc results" $ post "/rpc/getallprojects?id=gt.1&id=lt.5&select=id?limit=2&offset=1" [json| {} |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json|[{"id":3},{"id":4}]|]- , matchStatus = 200+ `shouldRespondWith` [json|[{"id":3},{"id":4}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "1-2/*"] } @@ -518,24 +512,76 @@ post "/rpc/getproject?select=id,name" [json| { "id": 1} |] `shouldRespondWith` [str|[{"id":1,"name":"Windows 7"}]|] - it "can embed foreign entities to the items returned by a proc" $+ context "foreign entities embedding" $ do+ it "can embed if related tables are in the exposed schema" $ post "/rpc/getproject?select=id,name,client{id},tasks{id}" [json| { "id": 1} |] `shouldRespondWith` [str|[{"id":1,"name":"Windows 7","client":{"id":1},"tasks":[{"id":1},{"id":2}]}]|] + it "cannot embed if the related table is not in the exposed schema" $+ post "/rpc/single_article?select=*,article_stars{*}" [json|{ "id": 1}|]+ `shouldRespondWith` 400++ it "can embed if the related tables are in a hidden schema but exposed as views" $+ post "/rpc/single_article?select=id,articleStars{userId}" [json|{ "id": 2}|]+ `shouldRespondWith` [json|[{"id": 2, "articleStars": [{"userId": 3}]}]|]+ { matchHeaders = [matchContentTypeJson] }+ context "a proc that returns an empty rowset" $ it "returns empty json array" $ post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith` [json| [] |]+ { matchHeaders = [matchContentTypeJson] } - context "a proc that returns plain text" $ do- it "returns proper json" $- post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`- [json|"Hello, world"|]+ context "proc return types" $ do+ context "returns text" $ do+ it "returns proper json" $+ post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`+ [json|"Hello, world"|]+ { matchHeaders = [matchContentTypeJson] } - it "can handle unicode" $- post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`- [json|"Hello, ￥"|]+ it "can handle unicode" $+ post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith`+ [json|"Hello, ￥"|]+ { matchHeaders = [matchContentTypeJson] } + it "returns enum value" $+ post "/rpc/ret_enum" [json|{ "val": "foo" }|] `shouldRespondWith`+ [json|"foo"|]+ { matchHeaders = [matchContentTypeJson] }++ it "returns domain value" $+ post "/rpc/ret_domain" [json|{ "val": "8" }|] `shouldRespondWith`+ [json|8|]+ { matchHeaders = [matchContentTypeJson] }++ it "returns range" $+ post "/rpc/ret_range" [json|{ "low": 10, "up": 20 }|] `shouldRespondWith`+ [json|"[10,20)"|]+ { matchHeaders = [matchContentTypeJson] }++ it "returns row of scalars" $+ post "/rpc/ret_scalars" [json|{}|] `shouldRespondWith`+ [json|[{"a":"scalars", "b":"foo", "c":1, "d":"[10,20)"}]|]+ { matchHeaders = [matchContentTypeJson] }++ it "returns composite type in exposed schema" $+ post "/rpc/ret_point_2d" [json|{}|] `shouldRespondWith`+ [json|[{"x": 10, "y": 5}]|]+ { matchHeaders = [matchContentTypeJson] }++ it "cannot return composite type in hidden schema" $+ post "/rpc/ret_point_3d" [json|{}|] `shouldRespondWith` 401++ it "returns single row from table" $+ post "/rpc/single_article?select=id" [json|{"id": 2}|] `shouldRespondWith`+ [json|[{"id": 2}]|]+ { matchHeaders = [matchContentTypeJson] }++ it "returns null for void" $+ post "/rpc/ret_void" [json|{}|] `shouldRespondWith`+ [json|null|]+ { matchHeaders = [matchContentTypeJson] }+ context "improper input" $ do it "rejects unknown content type even if payload is good" $ request methodPost "/rpc/sayhello"@@ -573,14 +619,17 @@ it "executes the proc exactly once per request" $ do post "/rpc/callcounter" [json| {} |] `shouldRespondWith` [json|1|]+ { matchHeaders = [matchContentTypeJson] } post "/rpc/callcounter" [json| {} |] `shouldRespondWith` [json|2|]+ { matchHeaders = [matchContentTypeJson] } context "expects a single json object" $ do it "does not expand posted json into parameters" $ request methodPost "/rpc/singlejsonparam" [("Prefer","params=single-object")] [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |] `shouldRespondWith` [json| { "p1": 1, "p2": "text", "p3" : {"obj":"text"} } |]+ { matchHeaders = [matchContentTypeJson] } it "accepts parameters from an html form" $ request methodPost "/rpc/singlejsonparam"@@ -589,18 +638,169 @@ "boolean=false&date=1900-01-01&money=$3.99&enum=foo") `shouldRespondWith` [json| { "integer": "7", "double": "2.71828", "varchar" : "forms are fun" , "boolean":"false", "date":"1900-01-01", "money":"$3.99", "enum":"foo" } |]+ { matchHeaders = [matchContentTypeJson] } + context "a proc that receives no parameters" $+ it "interprets empty string as empty json object on a post request" $+ post "/rpc/noparamsproc" BL.empty `shouldRespondWith`+ [json| "Return value of no parameters procedure." |]+ { matchHeaders = [matchContentTypeJson] }+ describe "weird requests" $ do it "can query as normal" $ do get "/Escap3e;" `shouldRespondWith` [json| [{"so6meIdColumn":1},{"so6meIdColumn":2},{"so6meIdColumn":3},{"so6meIdColumn":4},{"so6meIdColumn":5}] |]+ { matchHeaders = [matchContentTypeJson] } get "/ghostBusters" `shouldRespondWith` [json| [{"escapeId":1},{"escapeId":3},{"escapeId":5}] |]+ { matchHeaders = [matchContentTypeJson] } + it "fails if an operator is not given" $+ get "/ghostBusters?id=0" `shouldRespondWith` [json| {"details":"unexpected \"0\" expecting \"not\" or operator (eq, gt, ...)","message":"\"failed to parse filter (0)\" (line 1, column 1)"} |]+ { matchStatus = 400+ , matchHeaders = [matchContentTypeJson]+ }+ it "will embed a collection" $ get "/Escap3e;?select=ghostBusters{*}" `shouldRespondWith` [json| [{"ghostBusters":[{"escapeId":1}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":3}]},{"ghostBusters":[]},{"ghostBusters":[{"escapeId":5}]}] |]+ { matchHeaders = [matchContentTypeJson] } it "will embed using a column" $ get "/ghostBusters?select=escapeId{*}" `shouldRespondWith` [json| [{"escapeId":{"so6meIdColumn":1}},{"escapeId":{"so6meIdColumn":3}},{"escapeId":{"so6meIdColumn":5}}] |]+ { 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"]+ }++ 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"]+ }+ describe "HTTP request env vars" $ do+ it "custom header is set" $+ request methodPost "/rpc/get_guc_value"+ [("Custom-Header", "test")]+ [json| { "name": "request.header.custom-header" } |]+ `shouldRespondWith`+ [str|"test"|]+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson ]+ }+ it "standard header is set" $+ request methodPost "/rpc/get_guc_value"+ [("Origin", "http://example.com")]+ [json| { "name": "request.header.origin" } |]+ `shouldRespondWith`+ [str|"http://example.com"|]+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson ]+ }+ it "current role is available as GUC claim" $+ request methodPost "/rpc/get_guc_value" []+ [json| { "name": "request.jwt.claim.role" } |]+ `shouldRespondWith`+ [str|"postgrest_test_anonymous"|]+ { matchStatus = 200+ , matchHeaders = [ matchContentTypeJson ]+ }+ it "single cookie ends up as claims" $+ request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue")]+ [json| {"name":"request.cookie.acookie"} |]+ `shouldRespondWith`+ [str|"cookievalue"|]+ { matchStatus = 200+ , matchHeaders = []+ }++ it "multiple cookies ends up as claims" $+ request methodPost "/rpc/get_guc_value" [("Cookie","acookie=cookievalue;secondcookie=anothervalue")]+ [json| {"name":"request.cookie.secondcookie"} |]+ `shouldRespondWith`+ [str|"anothervalue"|]+ { matchStatus = 200+ , matchHeaders = []+ }++ describe "values with quotes in IN and NOTIN operators" $ do+ it "succeeds when only quoted values are present" $ do+ get "/w_or_wo_comma_names?name=in.\"Hebdon, John\"" `shouldRespondWith`+ [json| [{"name":"Hebdon, John"}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=in.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith`+ [json| [{"name":"Hebdon, John"},{"name":"Williams, Mary"},{"name":"Smith, Joseph"}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=notin.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith`+ [json| [{"name":"David White"},{"name":"Larry Thompson"}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=not.in.\"Hebdon, John\",\"Williams, Mary\",\"Smith, Joseph\"" `shouldRespondWith`+ [json| [{"name":"David White"},{"name":"Larry Thompson"}] |]+ { matchHeaders = [matchContentTypeJson] }++ it "succeeds w/ and w/o quoted values" $ do+ get "/w_or_wo_comma_names?name=in.David White,\"Hebdon, John\"" `shouldRespondWith`+ [json| [{"name":"Hebdon, John"},{"name":"David White"}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=not.in.\"Hebdon, John\",Larry Thompson,\"Smith, Joseph\"" `shouldRespondWith`+ [json| [{"name":"Williams, Mary"},{"name":"David White"}] |]+ { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=notin.\"Hebdon, John\",David White,\"Williams, Mary\",Larry Thompson" `shouldRespondWith`+ [json| [{"name":"Smith, Joseph"}] |]+ { matchHeaders = [matchContentTypeJson] }++ it "checks well formed quoted values" $ do+ get "/w_or_wo_comma_names?name=in.\"\"Hebdon, John\"" `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=in.\"\"Hebdon, John\"\"Mary" `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ get "/w_or_wo_comma_names?name=in.Williams\"Hebdon, John\"" `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }++ describe "IN empty set" $ do+ context "returns an empty result set when no value is present" $ do+ it "works for integer" $+ get "/items_with_different_col_types?int_data=in." `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ it "works for text" $+ get "/items_with_different_col_types?text_data=in." `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ it "works for bool" $+ get "/items_with_different_col_types?bool_data=in." `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ it "works for bytea" $+ get "/items_with_different_col_types?bin_data=in." `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ it "works for char" $+ get "/items_with_different_col_types?char_data=in." `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ it "works for date" $+ get "/items_with_different_col_types?date_data=in." `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ it "works for real" $+ get "/items_with_different_col_types?real_data=in." `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }+ it "works for time" $+ get "/items_with_different_col_types?time_data=in." `shouldRespondWith`+ [json| [] |] { matchHeaders = [matchContentTypeJson] }++ it "returns an empty result ignoring spaces" $+ get "/items_with_different_col_types?int_data=in. " `shouldRespondWith` 400++ it "only returns an empty result set if the in value is empty" $+ get "/items_with_different_col_types?int_data=in. ,3,4" `shouldRespondWith` 400
test/Feature/RangeSpec.hs view
@@ -31,19 +31,12 @@ context "when I don't want the count" $ do it "returns range Content-Range with */* for empty range" $ request methodPost "/rpc/getitemrange" [] emptyRange- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "*/*"]- }+ `shouldRespondWith` [json| [] |] {matchHeaders = ["Content-Range" <:> "*/*"]} it "returns range Content-Range with range/*" $ request methodPost "/rpc/getitemrange" [] defaultRange- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-14/*"]- }+ `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]+ { matchHeaders = ["Content-Range" <:> "0-14/*"] } context "with range headers" $ do @@ -64,9 +57,8 @@ it "returns an empty body when there are no results" $ request methodPost "/rpc/getitemrange" (rangeHdrs $ ByteRangeFromTo 0 1) emptyRange- `shouldRespondWith` ResponseMatcher {- matchBody = Just "[]"- , matchStatus = 200+ `shouldRespondWith` "[]"+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/*"] } @@ -95,18 +87,16 @@ it "refuses a range with nonzero start when there are no items" $ request methodPost "/rpc/getitemrange" (rangeHdrsWithCount $ ByteRangeFromTo 1 2) emptyRange- `shouldRespondWith` ResponseMatcher {- matchBody = Nothing- , matchStatus = 416+ `shouldRespondWith` "[]"+ { matchStatus = 416 , matchHeaders = ["Content-Range" <:> "*/0"] } it "refuses a range requesting start past last item" $ request methodPost "/rpc/getitemrange" (rangeHdrsWithCount $ ByteRangeFromTo 100 199) defaultRange- `shouldRespondWith` ResponseMatcher {- matchBody = Nothing- , matchStatus = 416+ `shouldRespondWith` "[]"+ { matchStatus = 416 , matchHeaders = ["Content-Range" <:> "*/15"] } @@ -120,68 +110,58 @@ it "returns range Content-Range with /*" $ request methodGet "/menagerie" [("Prefer", "count=none")] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just "[]"- , matchStatus = 200+ `shouldRespondWith` "[]"+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/*"] } it "returns range Content-Range with range/*" $ request methodGet "/items?order=id" [("Prefer", "count=none")] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-14/*"]- }+ `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}] |]+ { matchHeaders = ["Content-Range" <:> "0-14/*"] } it "returns range Content-Range with range/* even using other filters" $ request methodGet "/items?id=eq.1&order=id" [("Prefer", "count=none")] ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just [json| [{"id":1}] |]- , matchStatus = 200- , matchHeaders = ["Content-Range" <:> "0-0/*"]- }+ `shouldRespondWith` [json| [{"id":1}] |]+ { matchHeaders = ["Content-Range" <:> "0-0/*"] } context "with limit/offset parameters" $ do it "no parameters return everything" $ get "/items?select=id&order=id.asc"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]- , matchStatus = 200+ `shouldRespondWith`+ [str|[{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10},{"id":11},{"id":12},{"id":13},{"id":14},{"id":15}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-14/*"] } it "top level limit with parameter" $ get "/items?select=id&order=id.asc&limit=3"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":1},{"id":2},{"id":3}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":1},{"id":2},{"id":3}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-2/*"] } it "headers override get parameters" $ request methodGet "/items?select=id&order=id.asc&limit=3" (rangeHdrs $ ByteRangeFromTo 0 1) ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":1},{"id":2}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":1},{"id":2}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/*"] } it "limit works on all levels" $ get "/clients?select=id,projects{id,tasks{id}}&order=id.asc&limit=1&projects.order=id.asc&projects.limit=2&projects.tasks.order=id.asc&projects.tasks.limit=1"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]- , matchStatus = 200+ `shouldRespondWith`+ [str|[{"id":1,"projects":[{"id":1,"tasks":[{"id":1}]},{"id":2,"tasks":[{"id":3}]}]}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-0/*"] } it "limit and offset works on first level" $ get "/items?select=id&order=id.asc&limit=3&offset=2"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":3},{"id":4},{"id":5}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":3},{"id":4},{"id":5}]|]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "2-4/*"] } @@ -204,9 +184,8 @@ it "returns an empty body when there are no results" $ request methodGet "/menagerie" (rangeHdrs $ ByteRangeFromTo 0 1) ""- `shouldRespondWith` ResponseMatcher {- matchBody = Just "[]"- , matchStatus = 200+ `shouldRespondWith` "[]"+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "*/*"] } @@ -235,17 +214,15 @@ it "refuses a range with nonzero start when there are no items" $ request methodGet "/menagerie" (rangeHdrsWithCount $ ByteRangeFromTo 1 2) ""- `shouldRespondWith` ResponseMatcher {- matchBody = Nothing- , matchStatus = 416+ `shouldRespondWith` "[]"+ { matchStatus = 416 , matchHeaders = ["Content-Range" <:> "*/0"] } it "refuses a range requesting start past last item" $ request methodGet "/items" (rangeHdrsWithCount $ ByteRangeFromTo 100 199) ""- `shouldRespondWith` ResponseMatcher {- matchBody = Nothing- , matchStatus = 416+ `shouldRespondWith` "[]"+ { matchStatus = 416 , matchHeaders = ["Content-Range" <:> "*/15"] }
test/Feature/SingularSpec.hs view
@@ -86,16 +86,14 @@ request methodPost "/addresses" [("Prefer", "return=minimal"), singular] [json| [ { id: 101, address: "xxx" } ] |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just ""- , matchStatus = 201+ `shouldRespondWith` ""+ { matchStatus = 201 , matchHeaders = ["Content-Range" <:> "*/*"] } -- and the element should exist get "/addresses?id=eq.101"- `shouldRespondWith` ResponseMatcher {- matchBody = Just [str|[{"id":101,"address":"xxx"}]|]- , matchStatus = 200+ `shouldRespondWith` [str|[{"id":101,"address":"xxx"}]|]+ { matchStatus = 200 , matchHeaders = [] } @@ -113,9 +111,8 @@ request methodPost "/addresses" [("Prefer", "return=minimal"), singular] [json| [ { id: 200, address: "xxx" }, { id: 201, address: "yyy" } ] |]- `shouldRespondWith` ResponseMatcher {- matchBody = Just ""- , matchStatus = 201+ `shouldRespondWith` ""+ { matchStatus = 201 , matchHeaders = ["Content-Range" <:> "*/*"] } @@ -142,11 +139,9 @@ [("Prefer", "return=representation"), singular] "" `shouldRespondWith` 406 - -- the rows should not exist, either get firstItems- `shouldRespondWith` ResponseMatcher {- matchBody = Nothing- , matchStatus = 200+ `shouldRespondWith` [json| [{"id":1},{"id":2},{"id":3},{"id":4},{"id":5},{"id":6},{"id":7},{"id":8},{"id":9},{"id":10}] |]+ { matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-9/*"] }
test/Feature/UnicodeSpec.hs view
@@ -6,6 +6,8 @@ import Network.Wai (Application) import Control.Monad (void) +import SpecHelper+ import Protolude hiding (get) spec :: SpecWith Application@@ -20,3 +22,4 @@ get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF" `shouldRespondWith` [json| [{ "هویت": 1 }] |]+ { matchHeaders = [matchContentTypeJson] }
test/SpecHelper.hs view
@@ -25,9 +25,12 @@ import Data.Maybe (fromJust) import Data.Aeson (decode, Value(..))-import qualified Data.JsonSchema.Draft4 as D4+import qualified JSONSchema.Draft4 as D4 import Protolude++matchContentTypeJson :: MatchHeader+matchContentTypeJson = "Content-Type" <:> "application/json; charset=utf-8" validateOpenApiResponse :: [Header] -> WaiSession () validateOpenApiResponse headers = do