diff --git a/postgrest.cabal b/postgrest.cabal --- a/postgrest.cabal +++ b/postgrest.cabal @@ -2,7 +2,7 @@ description: Reads the schema of a PostgreSQL database and creates RESTful routes for the tables and views, supporting all HTTP verbs that security permits. -version: 0.3.1.0 +version: 0.3.1.1 synopsis: REST API for any Postgres database license: MIT license-file: LICENSE @@ -40,6 +40,8 @@ , http-types , interpolatedstring-perl6 , jwt + , lens >=3.8 && < 5.0 + , lens-aeson >= 1.0.0.0 && < 1.1.0.0 , mtl , optparse-applicative >= 0.11 && < 0.13 , parsec @@ -93,6 +95,8 @@ , http-types , interpolatedstring-perl6 , jwt + , lens + , lens-aeson , mtl , optparse-applicative , parsec @@ -104,12 +108,13 @@ , time , unordered-containers , vector - , wai - , wai-cors - , wai-extra - , wai-middleware-static , HTTP , Ranged-sets + , wai >= 3.0.1 + , wai-cors + , wai-extra + , wai-middleware-static >= 0.6.0 + , warp >= 3.1.0 Other-Modules: Paths_postgrest Exposed-Modules: PostgREST.App @@ -141,6 +146,7 @@ , Feature.QueryLimitedSpec , Feature.RangeSpec , Feature.StructureSpec + , Feature.UnicodeSpec , Paths_postgrest , PostgREST.App , PostgREST.Auth @@ -175,6 +181,8 @@ , http-types , interpolatedstring-perl6 , jwt + , lens + , lens-aeson , monad-control , mtl , optparse-applicative diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -41,8 +41,8 @@ -- route responses and upload payloads data ContentType = ApplicationJSON | TextCSV deriving Eq instance Show ContentType where - show ApplicationJSON = "application/json" - show TextCSV = "text/csv" + show ApplicationJSON = "application/json; charset=utf-8" + show TextCSV = "text/csv; charset=utf-8" {-| Describes what the user wants to do. This data type is a @@ -130,7 +130,7 @@ , iPayload = relevantPayload , iPreferRepresentation = representation , iPreferSingular = singular - , iPreferCount = not $ hasPrefer "count=none" + , iPreferCount = not $ singular || hasPrefer "count=none" , iFilters = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ] , iSelect = if method == "DELETE" then "*" @@ -145,7 +145,11 @@ hdrs = requestHeaders req qParams = [(cs k, cs <$> v)|(k,v) <- queryString req] lookupHeader = flip lookup hdrs - hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs + hasPrefer :: T.Text -> Bool + hasPrefer val = any (\(h,v) -> h == "Prefer" && val `elem` split v) hdrs + where + split :: BS.ByteString -> [T.Text] + split = map T.strip . T.split (==';') . cs singular = hasPrefer "plurality=singular" representation | hasPrefer "return=representation" = Full diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -249,7 +249,7 @@ fromInRange = frm <= to jsonH :: Header -jsonH = (hContentType, "application/json") +jsonH = (hContentType, "application/json; charset=utf-8") formatRelationError :: Text -> Text formatRelationError = formatGeneralError diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -18,19 +18,20 @@ , tokenJWT ) where -import Control.Monad (join) -import Data.Aeson (Value (..), Object) -import Data.Aeson.Types (emptyObject, emptyArray) +import Control.Lens +import Data.Aeson (Value (..), parseJSON, toJSON) +import Data.Aeson.Lens +import Data.Aeson.Types (parseMaybe, emptyObject, emptyArray) import qualified Data.ByteString as BS -import Data.Vector as V (null, head) -import Data.Map as M (fromList, toList) +import qualified Data.Vector as V +import qualified Data.HashMap.Strict as M +import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.String.Conversions (cs) import Data.Text (Text) import Data.Time.Clock (NominalDiffTime) -import PostgREST.QueryBuilder (pgFmtLit, pgFmtIdent, unquoted) +import PostgREST.QueryBuilder (pgFmtIdent, pgFmtLit, unquoted) import qualified Web.JWT as JWT -import qualified Data.HashMap.Lazy as H {-| Receives a map of JWT claims and returns a list @@ -39,12 +40,12 @@ this one is mapped to a SET ROLE statement. In case there is any problem decoding the JWT it returns Nothing. -} -claimsToSQL :: JWT.ClaimsMap -> [BS.ByteString] -claimsToSQL = map setVar . toList +claimsToSQL :: M.HashMap Text Value -> [BS.ByteString] +claimsToSQL = map setVar . M.toList where setVar ("role", String val) = setRole val - setVar (k, val) = "set local postgrest.claims." <> cs (pgFmtIdent k) <> - " = " <> cs (valueToVariable val) <> ";" + setVar (k, val) = "set local " <> cs (pgFmtIdent $ "postgrest.claims." <> k) + <> " = " <> cs (valueToVariable val) <> ";" valueToVariable = pgFmtLit . unquoted {-| @@ -52,19 +53,22 @@ returns a map of JWT claims In case there is any problem decoding the JWT it returns Nothing. -} -jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Maybe JWT.ClaimsMap + + +jwtClaims :: JWT.Secret -> Text -> NominalDiffTime -> Either Text (M.HashMap Text Value) jwtClaims secret input time = - case join $ claim JWT.exp of - Just expires -> - if JWT.secondsSinceEpoch expires > time - then customClaims - else Nothing - _ -> customClaims - where - decoded = JWT.decodeAndVerifySignature secret input - claim :: (JWT.JWTClaimsSet -> a) -> Maybe a - claim prop = prop . JWT.claims <$> decoded - customClaims = claim JWT.unregisteredClaims + case mClaims of + Nothing -> Right M.empty + Just claims -> do + let mExp = claims ^? key "exp" . _Integer + expired = fromMaybe False $ (<= time) . fromInteger <$> mExp + if expired + then Left "JWT expired" + else Right (value2map claims) + where + mClaims = toJSON . JWT.claims <$> JWT.decodeAndVerifySignature secret input + value2map (Object o) = o + value2map _ = M.empty {-| Receives the name of a role and returns a SET ROLE statement -} setRole :: Text -> BS.ByteString @@ -76,10 +80,8 @@ and returns a signed JWT. -} tokenJWT :: JWT.Secret -> Value -> Text -tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 secret - JWT.def { JWT.unregisteredClaims = fromHashMap o } - where - Object o = if V.null a then emptyObject else V.head a - fromHashMap :: Object -> JWT.ClaimsMap - fromHashMap = M.fromList . H.toList -tokenJWT secret _ = tokenJWT secret emptyArray +tokenJWT secret (Array arr) = + let obj = if V.null arr then emptyObject else V.head arr + jcs = parseMaybe parseJSON obj :: Maybe JWT.JWTClaimsSet in + JWT.encodeSigned JWT.HS256 secret $ fromMaybe JWT.def jcs +tokenJWT secret _ = tokenJWT secret emptyArray diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -30,9 +30,9 @@ import Network.Wai.Middleware.Cors (CorsResourcePolicy (..)) import Options.Applicative import Paths_postgrest (version) +import Prelude import Safe (readMay) import Web.JWT (Secret, secret) -import Prelude -- | Data type to store all command line options data AppConfig = AppConfig { diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -10,23 +10,25 @@ , doesProcReturnJWT ) where -import qualified Hasql.Query as H -import qualified Hasql.Encoders as HE -import qualified Hasql.Decoders as HD +import qualified Hasql.Decoders as HD +import qualified Hasql.Encoders as HE +import qualified Hasql.Query as H import Control.Applicative -import Control.Monad (join, replicateM) -import Data.Functor.Contravariant (contramap) -import Text.InterpolatedString.Perl6 (q) -import Data.List (elemIndex, find, subsequences, sort, transpose) -import Data.Maybe (fromMaybe, fromJust, isJust, mapMaybe, listToMaybe) +import Control.Monad (join, replicateM) +import Data.Functor.Contravariant (contramap) +import Data.List (elemIndex, find, sort, + subsequences, transpose) +import Data.Maybe (fromJust, fromMaybe, isJust, + listToMaybe, mapMaybe) import Data.Monoid -import Data.Text (Text, split) -import qualified Hasql.Session as H +import Data.Text (Text, split) +import qualified Hasql.Session as H import PostgREST.Types +import Text.InterpolatedString.Perl6 (q) -import GHC.Exts (groupWith) -import Data.Int (Int32) +import Data.Int (Int32) +import GHC.Exts (groupWith) import Prelude getDbStructure :: Schema -> H.Session DbStructure @@ -556,69 +558,76 @@ allSynonyms cols = H.statement sql HE.unit (decodeSynonyms cols) True where + -- query explanation at https://gist.github.com/ruslantalpa/2eab8c930a65e8043d8f sql = [q| - WITH synonyms AS ( - /* - -- CTE to replace the view from information_schema because the information in it depended on the logged in role - -- notice the commented line - */ - WITH view_column_usage AS ( - SELECT DISTINCT - CAST(current_database() AS character varying) AS view_catalog, - CAST(nv.nspname AS character varying) AS view_schema, - CAST(v.relname AS character varying) AS view_name, - CAST(current_database() AS character varying) AS table_catalog, - CAST(nt.nspname AS character varying) AS table_schema, - CAST(t.relname AS character varying) AS table_name, - CAST(a.attname AS character varying) AS column_name - FROM pg_namespace nv, pg_class v, pg_depend dv, - pg_depend dt, pg_class t, pg_namespace nt, - pg_attribute a - WHERE nv.oid = v.relnamespace - AND v.relkind = 'v' - AND v.oid = dv.refobjid - AND dv.refclassid = 'pg_catalog.pg_class'::regclass - AND dv.classid = 'pg_catalog.pg_rewrite'::regclass - AND dv.deptype = 'i' - AND dv.objid = dt.objid - AND dv.refobjid <> dt.refobjid - AND dt.classid = 'pg_catalog.pg_rewrite'::regclass - AND dt.refclassid = 'pg_catalog.pg_class'::regclass - AND dt.refobjid = t.oid - AND t.relnamespace = nt.oid - AND t.relkind IN ('r', 'v', 'f') - AND t.oid = a.attrelid - AND dt.refobjsubid = a.attnum - /*--AND pg_has_role(t.relowner, 'USAGE')*/ - ) - SELECT - vcu.table_schema AS src_table_schema, - vcu.table_name AS src_table_name, - vcu.column_name AS src_column_name, - view.schemaname AS syn_table_schema, - view.viewname AS syn_table_name, - view.definition AS view_definition - FROM - pg_catalog.pg_views AS view, - view_column_usage AS vcu - WHERE - view.schemaname = vcu.view_schema AND - view.viewname = vcu.view_name AND - view.schemaname NOT IN ('pg_catalog', 'information_schema') - /*--AND (SELECT COUNT(*) FROM information_schema.view_table_usage WHERE view_schema = view.schemaname AND view_name = view.viewname) = 1*/ + WITH view_columns AS ( + SELECT + c.oid AS view_oid, + a.attname::information_schema.sql_identifier AS column_name + FROM pg_attribute a + JOIN pg_class c ON a.attrelid = c.oid + JOIN pg_namespace nc ON c.relnamespace = nc.oid + WHERE + NOT pg_is_other_temp_schema(nc.oid) + AND a.attnum > 0 + AND NOT a.attisdropped + AND (c.relkind = 'v'::"char") + AND nc.nspname NOT IN ('information_schema', 'pg_catalog') + ), + view_column_usage AS ( + SELECT DISTINCT + v.oid as view_oid, + nv.nspname::information_schema.sql_identifier AS view_schema, + v.relname::information_schema.sql_identifier AS view_name, + nt.nspname::information_schema.sql_identifier AS table_schema, + t.relname::information_schema.sql_identifier AS table_name, + a.attname::information_schema.sql_identifier AS column_name, + pg_get_viewdef(v.oid)::information_schema.character_data AS view_definition + FROM pg_namespace nv + JOIN pg_class v ON nv.oid = v.relnamespace + JOIN pg_depend dv ON v.oid = dv.refobjid + JOIN pg_depend dt ON dv.objid = dt.objid + JOIN pg_class t ON dt.refobjid = t.oid + JOIN pg_namespace nt ON t.relnamespace = nt.oid + JOIN pg_attribute a ON t.oid = a.attrelid AND dt.refobjsubid = a.attnum + + WHERE + nv.nspname not in ('information_schema', 'pg_catalog') + AND v.relkind = 'v'::"char" + AND dv.refclassid = 'pg_class'::regclass::oid + AND dv.classid = 'pg_rewrite'::regclass::oid + AND dv.deptype = 'i'::"char" + AND dv.refobjid <> dt.refobjid + AND dt.classid = 'pg_rewrite'::regclass::oid + AND dt.refclassid = 'pg_class'::regclass::oid + AND (t.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"])) + ), + candidates AS ( + SELECT + vcu.*, + ( + SELECT CASE WHEN match IS NOT NULL THEN coalesce(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, ')(\sAS\s(")?([^"]+)\6)?.*?FROM.*?',vcu.table_schema,'\.(\2|',vcu.table_name,'\s+(AS\s)?\3)'), + 'ns' + ) match + ) AS view_column_name + FROM view_column_usage AS vcu ) SELECT - src_table_schema, src_table_name, src_column_name, - syn_table_schema, syn_table_name, - (regexp_matches(view_definition, CONCAT('\.(', src_column_name, ')(?=,|$)'), 'gn'))[1] AS syn_column_name - FROM synonyms - UNION ( - SELECT - src_table_schema, src_table_name, src_column_name, - syn_table_schema, syn_table_name, - (regexp_matches(view_definition, CONCAT('\.', src_column_name, '\sAS\s("?)(.+?)\1(,|$)'), 'gn'))[2] AS syn_column_name /* " <- for syntax highlighting */ - FROM synonyms - ) |] + c.table_schema, + c.table_name, + c.column_name AS table_column_name, + c.view_schema, + c.view_name, + c.view_column_name + FROM view_columns AS vc, candidates AS c + WHERE + vc.view_oid = c.view_oid AND + vc.column_name = c.view_column_name + ORDER BY c.view_schema, c.view_name, c.table_name, c.view_column_name + |] synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column) synonymFromRow allCols (s1,t1,c1,s2,t2,c2) = (,) <$> col1 <*> col2 diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -12,8 +12,8 @@ import Data.String.Conversions (cs) import Data.Text (Text) import qualified Data.Text as T -import qualified Hasql.Session as H import qualified Hasql.Pool as P +import qualified Hasql.Session as H import Network.HTTP.Types.Header import qualified Network.HTTP.Types.Status as HT import Network.Wai (Response, responseLBS) diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -60,10 +60,11 @@ #ifndef mingw32_HOST_OS tid <- myThreadId - void $ installHandler keyboardSignal (Catch $ do - P.release pool - throwTo tid UserInterrupt - ) Nothing + forM_ [sigINT, sigTERM] $ \sig -> + void $ installHandler sig (Catch $ do + P.release pool + throwTo tid UserInterrupt + ) Nothing #endif result <- P.use pool $ do diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -3,52 +3,55 @@ module PostgREST.Middleware where +import Control.Monad (unless) +import qualified Data.ByteString as BS +import qualified Data.HashMap.Strict as M import Data.Maybe (fromMaybe) -import Data.Text import Data.String.Conversions (cs) +import Data.Text import Data.Time.Clock (NominalDiffTime) import qualified Hasql.Transaction as H import Network.HTTP.Types.Header (hAccept, hAuthorization) -import Network.HTTP.Types.Status (status415, status400) -import Network.Wai (Application, Request (..), Response, - requestHeaders) +import Network.HTTP.Types.Status (status400, status415) +import Network.Wai (Application, Request (..), + Response, requestHeaders) import Network.Wai.Middleware.Cors (cors) import Network.Wai.Middleware.Gzip (def, gzip) import Network.Wai.Middleware.Static (only, staticPolicy) -import PostgREST.ApiRequest (pickContentType) +import PostgREST.ApiRequest (pickContentType) import PostgREST.Auth (setRole, jwtClaims, claimsToSQL) import PostgREST.Config (AppConfig (..), corsPolicy) import PostgREST.Error (errResponse) -import Prelude hiding(concat) - -import qualified Data.Map.Lazy as M +import Prelude hiding (concat, null) runWithClaims :: AppConfig -> NominalDiffTime -> (Request -> H.Transaction Response) -> Request -> H.Transaction Response runWithClaims conf time app req = do H.sql setAnon - case split (== ' ') (cs auth) of - ("Bearer" : tokenStr : _) -> - case jwtClaims jwtSecret tokenStr time of - Just claims -> - if M.member "role" claims - then do - mapM_ H.sql $ claimsToSQL claims - app req - else invalidJWT - _ -> invalidJWT - _ -> app req + let tokenStr = case split (== ' ') (cs auth) of + ("Bearer" : t : _) -> t + _ -> "" + eClaims = jwtClaims jwtSecret tokenStr time + case eClaims of + Left e -> clientErr e + Right claims -> + if M.null claims && not (null tokenStr) + then clientErr "Invalid JWT" + else do + let cmdBatch = mconcat $ claimsToSQL claims + unless (BS.null cmdBatch) (H.sql cmdBatch) + app req where hdrs = requestHeaders req jwtSecret = configJwtSecret conf auth = fromMaybe "" $ lookup hAuthorization hdrs anon = cs $ configAnonRole conf setAnon = setRole anon - invalidJWT = return $ errResponse status400 "Invalid JWT" + clientErr = return . errResponse status400 unsupportedAccept :: Application -> Application unsupportedAccept app req respond = diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -3,14 +3,14 @@ -- ) where -import Control.Applicative hiding ((<$>)) +import Control.Applicative hiding ((<$>)) import Data.Monoid import Data.String.Conversions (cs) import Data.Text (Text) import Data.Tree +import PostgREST.QueryBuilder (operators) import PostgREST.Types import Text.ParserCombinators.Parsec hiding (many, (<|>)) -import PostgREST.QueryBuilder (operators) pRequestSelect :: Text -> Parser ReadRequest pRequestSelect rootNodeName = do diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -43,6 +43,7 @@ import Data.Monoid ((<>)) import Data.Text (Text, intercalate, unwords, replace, isInfixOf, toLower, split) import qualified Data.Text as T (map, takeWhile) +import qualified Data.Text.Encoding as T import Data.String.Conversions (cs) import Control.Applicative ((<|>)) import Control.Monad (join) @@ -93,7 +94,7 @@ createReadStatement :: SqlQuery -> SqlQuery -> NonnegRange -> Bool -> Bool -> Bool -> H.Query () ResultsWithCount createReadStatement selectQuery countQuery range isSingle countTotal asCsv = - H.statement sql HE.unit decodeStandard True + unicodeStatement sql HE.unit decodeStandard True where sql = [qc| WITH {sourceCTEName} AS ({selectQuery}) SELECT {cols} @@ -116,7 +117,7 @@ createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined createWriteStatement _ _ mutateQuery _ None _ _ (PayloadJSON (UniformObjects _)) = - H.statement sql encodeUniformObjs decodeStandardMay True + unicodeStatement sql encodeUniformObjs decodeStandardMay True where sql = [qc| WITH {sourceCTEName} AS ({mutateQuery}) @@ -124,7 +125,7 @@ createWriteStatement qi _ mutateQuery isSingle HeadersOnly pKeys _ (PayloadJSON (UniformObjects _)) = - H.statement sql encodeUniformObjs decodeStandardMay True + unicodeStatement sql encodeUniformObjs decodeStandardMay True where sql = [qc| WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*) @@ -139,7 +140,7 @@ createWriteStatement qi selectQuery mutateQuery isSingle Full pKeys asCsv (PayloadJSON (UniformObjects _)) = - H.statement sql encodeUniformObjs decodeStandardMay True + unicodeStatement sql encodeUniformObjs decodeStandardMay True where sql = [qc| WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*) @@ -206,20 +207,24 @@ type ProcResults = (Maybe Int64, Int64, JSON.Value) callProc :: QualifiedIdentifier -> JSON.Object -> NonnegRange -> Bool -> H.Query () (Maybe ProcResults) callProc qi params range countTotal = - H.statement sql HE.unit decodeProc True + unicodeStatement sql HE.unit decodeProc True where - sql = [qc| SELECT - {countQuery} as countTotal, - {countResult} as countResult, + sql = [qc| + WITH t AS (select * {_callSql}) + SELECT + {_countExpr} as countTotal, + pg_catalog.count(1) as countResult, array_to_json( - coalesce(array_agg(row_to_json(t)), '\{}') + coalesce(array_agg(row_to_json(r)), '\{}') )::character varying - from (select * {_callSql} {limitF range}) t |] + FROM (select * from t {limitF range}) r; + |] _args = intercalate "," $ map _assignment (HM.toList params) _assignment (n,v) = pgFmtIdent n <> ":=" <> insertableValue v - _callSql = [qc| from {fromQi qi}({_args}) |] :: BS.ByteString - countQuery = if countTotal then [qc| (select pg_catalog.count(1) {_callSql} c) |] else "null::bigint" :: BS.ByteString - countResult = "pg_catalog.count(t)" :: BS.ByteString + _callSql = [qc| from {fromQi qi}({_args}) |] :: Text + _countExpr = if countTotal + then "(select pg_catalog.count(1) from t)" + else "null::bigint" :: Text decodeProc = HD.maybeRow procRow procRow = (,,) <$> HD.nullableValue HD.int8 <*> HD.value HD.int8 <*> HD.value HD.json @@ -434,6 +439,9 @@ 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}})) + +unicodeStatement :: Text -> HE.Params a -> HD.Result b -> Bool -> H.Query a b +unicodeStatement = H.statement . T.encodeUtf8 emptyOnNull :: Text -> [a] -> Text emptyOnNull val x = if null x then "" else val diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -1,16 +1,16 @@ module PostgREST.Types where -import Data.Text -import Data.Tree -import qualified Data.ByteString.Lazy as BL +import Data.Aeson import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import Data.Int (Int32) +import Data.Text +import Data.Tree import qualified Data.Vector as V -import Data.Aeson -import Data.Int (Int32) data DbStructure = DbStructure { - dbTables :: [Table] -, dbColumns :: [Column] -, dbRelations :: [Relation] + dbTables :: [Table] +, dbColumns :: [Column] +, dbRelations :: [Relation] , dbPrimaryKeys :: [PrimaryKey] } deriving (Show, Eq) diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -21,8 +21,24 @@ `shouldRespondWith` ResponseMatcher { matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0"} |] , matchStatus = 200 - , matchHeaders = ["Content-Type" <:> "application/json"] + , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"] } + + it "sql functions can encode custom and standard claims" $ + post "/rpc/jwt_test" "{}" + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| {"token":"eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6MTMwMDgxOTM4MCwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3QiLCJpYXQiOjEzMDA4MTkzODAsImF1ZCI6ImV2ZXJ5b25lIn0._tQCF79-ZZGMlLktd3csM_bVaiMg7A8YvIb6K2hcu5w"} |] + , matchStatus = 200 + , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"] + } + + it "sql functions can read custom and standard claims variables" $ do + let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiJmdW4iLCJqdGkiOiJmb28iLCJuYmYiOjEzMDA4MTkzODAsImV4cCI6OTk5OTk5OTk5OSwiaHR0cDovL3Bvc3RncmVzdC5jb20vZm9vIjp0cnVlLCJpc3MiOiJqb2UiLCJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWF0IjoxMzAwODE5MzgwLCJhdWQiOiJldmVyeW9uZSJ9.AQmCA7CMScvfaDRMqRPeUY6eNf--69gpW-kxaWfq9X0" + request methodPost "/rpc/reveal_big_jwt" [auth] "{}" + `shouldRespondWith` [json| [ + {"sub":"fun", "jti":"foo", "nbf":1300819380, "exp":9999999999, + "http://postgrest.com/foo":true, "iss":"joe", "iat":1300819380, + "aud":"everyone"}] |] it "allows users with permissions to see their tables" $ do let auth = authHeaderJWT "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJyb2xlIjoicG9zdGdyZXN0X3Rlc3RfYXV0aG9yIiwiaWQiOiJqZG9lIn0.y4vZuu1dDdwAl0-S00MCRWRYMlJ5YAMSir6Es6WtWx0" diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -9,10 +9,11 @@ import qualified Data.Aeson as JSON import Data.Maybe (fromJust) +import Data.Monoid ((<>)) import Text.Heredoc import Network.HTTP.Types.Header import Network.HTTP.Types -import Control.Monad (replicateM_) +import Control.Monad (replicateM_, void) import TestTypes(IncPK(..), CompoundPK(..)) import Network.Wai (Application) @@ -41,7 +42,7 @@ } |] `shouldRespondWith` ResponseMatcher { matchBody = Just [str|{"integer":14,"varchar":"testing!"}|] , matchStatus = 201 - , matchHeaders = ["Content-Type" <:> "application/json"] + , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8"] } it "includes related data after insert" $ @@ -49,7 +50,7 @@ [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", "Location" <:> "/projects?id=eq.6"] + , matchHeaders = ["Content-Type" <:> "application/json; charset=utf-8", "Location" <:> "/projects?id=eq.6"] } @@ -145,13 +146,6 @@ , matchHeaders = ["Location" <:> [str|/json?data=eq.{"foo":"bar"}|]] } - -- TODO! the test above seems right, why was the one below working before and not now - -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted - -- liftIO $ do - -- simpleBody p `shouldBe` inserted - -- simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%7B%22foo%22%3A%22bar%22%7D" - -- simpleStatus p `shouldBe` created201 - it "serializes nested array" $ do let inserted = [json| { "data": [1,2,3] } |] request methodPost "/json" @@ -162,12 +156,6 @@ , matchStatus = 201 , matchHeaders = ["Location" <:> [str|/json?data=eq.[1,2,3]|]] } - -- TODO! the test above seems right, why was the one below working before and not now - -- p <- request methodPost "/json" [("Prefer", "return=representation")] inserted - -- liftIO $ do - -- simpleBody p `shouldBe` inserted - -- simpleHeaders p `shouldSatisfy` matchHeader hLocation "/json\\?data=eq\\.%5B1%2C2%2C3%5D" - -- simpleStatus p `shouldBe` created201 describe "CSV insert" $ do @@ -183,16 +171,8 @@ `shouldRespondWith` ResponseMatcher { matchBody = Just inserted , matchStatus = 201 - , matchHeaders = ["Content-Type" <:> "text/csv"] + , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"] } - -- p <- request methodPost "/menagerie" [("Content-Type", "text/csv")] - -- [str|integer,double,varchar,boolean,date,money,enum - -- |13,3.14159,testing!,false,1900-01-01,$3.99,foo - -- |12,0.1,a string,true,1929-10-01,12,bar - -- |] - -- liftIO $ do - -- simpleBody p `shouldBe` "Content-Type: application/json\nLocation: /menagerie?integer=eq.13\n\n\n--postgrest_boundary\nContent-Type: application/json\nLocation: /menagerie?integer=eq.12\n\n" - -- simpleStatus p `shouldBe` created201 context "requesting full representation" $ do it "returns full details of inserted record" $ @@ -202,21 +182,10 @@ `shouldRespondWith` ResponseMatcher { matchBody = Just "a,b\nbar,baz" , matchStatus = 201 - , matchHeaders = ["Content-Type" <:> "text/csv", + , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8", "Location" <:> "/no_pk?a=eq.bar&b=eq.baz"] } - -- it "can post nulls (old way)" $ do - -- pendingWith "changed the response when in csv mode" - -- request methodPost "/no_pk" - -- [("Content-Type", "text/csv"), ("Prefer", "return=representation")] - -- "a,b\nNULL,foo" - -- `shouldRespondWith` ResponseMatcher { - -- matchBody = Just [json| { "a":null, "b":"foo" } |] - -- , matchStatus = 201 - -- , matchHeaders = ["Content-Type" <:> "application/json", - -- "Location" <:> "/no_pk?a=is.null&b=eq.foo"] - -- } it "can post nulls" $ request methodPost "/no_pk" [("Content-Type", "text/csv"), ("Accept", "text/csv"), ("Prefer", "return=representation")] @@ -224,7 +193,7 @@ `shouldRespondWith` ResponseMatcher { matchBody = Just "a,b\n,foo" , matchStatus = 201 - , matchHeaders = ["Content-Type" <:> "text/csv", + , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8", "Location" <:> "/no_pk?a=is.null&b=eq.foo"] } @@ -233,11 +202,22 @@ it "fails for too few" $ do p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz" liftIO $ simpleStatus p `shouldBe` badRequest400 - -- it does not fail because the extra columns are ignored - -- it "fails for too many" $ do - -- p <- request methodPost "/no_pk" [("Content-Type", "text/csv")] "a,b\nfoo,bar\nbaz,bat,bad" - -- liftIO $ simpleStatus p `shouldBe` badRequest400 + context "with unicode values" $ + it "succeeds and returns usable location header" $ do + let payload = [json| { "a":"圍棋", "b":"￥" } |] + p <- request methodPost "/no_pk" + [("Prefer", "return=representation")] + payload + liftIO $ do + simpleBody p `shouldBe` payload + simpleStatus p `shouldBe` created201 + + let Just location = lookup hLocation $ simpleHeaders p + r <- get location + liftIO $ simpleBody r `shouldBe` "["<>payload<>"]" + + describe "Putting record" $ do context "to unknown uri" $ @@ -386,6 +366,17 @@ , matchStatus = 200 , matchHeaders = [] } + + context "with unicode values" $ + it "succeeds and returns values intact" $ do + void $ request methodPost "/no_pk" [] + [json| { "a":"patchme", "b":"patchme" } |] + let payload = [json| { "a":"圍棋", "b":"￥" } |] + p <- request methodPatch "/no_pk?a=eq.patchme&b=eq.patchme" + [("Prefer", "return=representation")] payload + liftIO $ do + simpleBody p `shouldBe` "["<>payload<>"]" + simpleStatus p `shouldBe` ok200 describe "Row level permission" $ it "set user_id when inserting rows" $ do diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -246,6 +246,14 @@ , matchHeaders = [] } + it "can combine multiple prefer values" $ + request methodGet "/items?id=eq.5" [("Prefer","plurality=singular ; future=new; count=none")] "" + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| {"id":5} |] + , matchStatus = 200 + , matchHeaders = [] + } + it "works in the presence of a range header" $ let headers = ("Prefer","plurality=singular") : rangeHdrs (ByteRangeFromTo 0 9) in @@ -337,7 +345,7 @@ `shouldRespondWith` ResponseMatcher { matchBody = Just "k,extra\nxyyx,u\nxYYx,v" , matchStatus = 200 - , matchHeaders = ["Content-Type" <:> "text/csv"] + , matchHeaders = ["Content-Type" <:> "text/csv; charset=utf-8"] } describe "Canonical location" $ do @@ -390,11 +398,15 @@ post "/rpc/test_empty_rowset" [json| {} |] `shouldRespondWith` [json| [] |] - context "a proc that returns plain text" $ + context "a proc that returns plain text" $ do it "returns proper json" $ post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith` [json| [{"sayhello":"Hello, world"}] |] + it "can handle unicode" $ + post "/rpc/sayhello" [json| { "name": "￥" } |] `shouldRespondWith` + [json| [{"sayhello":"Hello, ￥"}] |] + context "improper input" $ do it "rejects unknown content type even if payload is good" $ request methodPost "/rpc/sayhello" @@ -421,6 +433,12 @@ get "/rpc/fake" `shouldRespondWith` 405 it "GET with 405 on known procs" $ get "/rpc/sayhello" `shouldRespondWith` 405 + + it "executes the proc exactly once per request" $ do + post "/rpc/callcounter" [json| {} |] `shouldRespondWith` + [json| [{"callcounter":1}] |] + post "/rpc/callcounter" [json| {} |] `shouldRespondWith` + [json| [{"callcounter":2}] |] describe "weird requests" $ do it "can query as normal" $ do diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -24,6 +24,7 @@ , {"schema":"test","name":"comments","insertable":true} , {"schema":"test","name":"complex_items","insertable":true} , {"schema":"test","name":"compound_pk","insertable":true} + , {"schema":"test","name":"filtered_tasks","insertable":true} , {"schema":"test","name":"ghostBusters","insertable":true} , {"schema":"test","name":"has_count_column","insertable":false} , {"schema":"test","name":"has_fk","insertable":true} @@ -57,6 +58,61 @@ {matchStatus = 200} describe "Table info" $ do + it "The structure of complex views is correctly detected" $ + request methodOptions "/filtered_tasks" [] "" `shouldRespondWith` + [json| + { + "pkey": [ + "myId" + ], + "columns": [ + { + "references": null, + "default": null, + "precision": 32, + "updatable": true, + "schema": "test", + "name": "myId", + "type": "integer", + "maxLen": null, + "enum": [], + "nullable": true, + "position": 1 + }, + { + "references": null, + "default": null, + "precision": null, + "updatable": true, + "schema": "test", + "name": "name", + "type": "text", + "maxLen": null, + "enum": [], + "nullable": true, + "position": 2 + }, + { + "references": { + "schema": "test", + "column": "id", + "table": "projects" + }, + "default": null, + "precision": 32, + "updatable": true, + "schema": "test", + "name": "projectID", + "type": "integer", + "maxLen": null, + "enum": [], + "nullable": true, + "position": 3 + } + ] + } + |] + it "is available with OPTIONS verb" $ request methodOptions "/menagerie" [] "" `shouldRespondWith` [json| diff --git a/test/Feature/UnicodeSpec.hs b/test/Feature/UnicodeSpec.hs new file mode 100644 --- /dev/null +++ b/test/Feature/UnicodeSpec.hs @@ -0,0 +1,20 @@ +module Feature.UnicodeSpec where + +import Test.Hspec +import Test.Hspec.Wai +import Test.Hspec.Wai.JSON +import Network.Wai (Application) +import Control.Monad (void) + +spec :: SpecWith Application +spec = + describe "Reading and writing to unicode schema and table names" $ + it "Can read and write values" $ do + get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF" + `shouldRespondWith` "[]" + + void $ post "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF" + [json| { "هویت": 1 } |] + + get "/%D9%85%D9%88%D8%A7%D8%B1%D8%AF" + `shouldRespondWith` [json| [{ "هویت": 1 }] |] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -18,6 +18,7 @@ import qualified Feature.QuerySpec import qualified Feature.RangeSpec import qualified Feature.StructureSpec +import qualified Feature.UnicodeSpec main :: IO () main = do @@ -29,6 +30,7 @@ let dbStructure = either (error.show) id result withApp = return $ postgrest testCfg dbStructure pool ltdApp = return $ postgrest testLtdRowsCfg dbStructure pool + unicodeApp = return $ postgrest testUnicodeCfg dbStructure pool hspec $ do mapM_ (beforeAll_ resetDb . before withApp) specs @@ -36,6 +38,10 @@ -- this test runs with a different server flag beforeAll_ resetDb . before ltdApp $ describe "Feature.QueryLimitedSpec" Feature.QueryLimitedSpec.spec + + -- this test runs with a different schema + beforeAll_ resetDb . before unicodeApp $ + describe "Feature.UnicodeSpec" Feature.UnicodeSpec.spec where specs = map (uncurry describe) [ diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -21,6 +21,10 @@ testCfg = AppConfig testDbConn "postgrest_test_anonymous" "test" 3000 (secret "safe") 10 Nothing True +testUnicodeCfg :: AppConfig +testUnicodeCfg = + AppConfig testDbConn "postgrest_test_anonymous" "تست" 3000 (secret "safe") 10 Nothing True + testLtdRowsCfg :: AppConfig testLtdRowsCfg = AppConfig testDbConn "postgrest_test_anonymous" "test" 3000 (secret "safe") 10 (Just 3) True