diff --git a/src/PostgREST/ApiRequest/Preferences.hs b/src/PostgREST/ApiRequest/Preferences.hs index 4e86610ae48..fdb8c024749 100644 --- a/src/PostgREST/ApiRequest/Preferences.hs +++ b/src/PostgREST/ApiRequest/Preferences.hs @@ -10,12 +10,12 @@ module PostgREST.ApiRequest.Preferences ( Preferences(..) , PreferCount(..) + , PreferHandling(..) , PreferMissing(..) , PreferParameters(..) , PreferRepresentation(..) , PreferResolution(..) , PreferTransaction(..) - , PreferHandling(..) , fromHeaders , shouldCount , prefAppliedHeader @@ -49,6 +49,7 @@ data Preferences , preferTransaction :: Maybe PreferTransaction , preferMissing :: Maybe PreferMissing , preferHandling :: Maybe PreferHandling + , preferTimezone :: Maybe ByteString , invalidPrefs :: [ByteString] } @@ -57,7 +58,7 @@ data Preferences -- -- One header with comma-separated values can be used to set multiple preferences: -- --- >>> pPrint $ fromHeaders True [("Prefer", "resolution=ignore-duplicates, count=exact")] +-- >>> pPrint $ fromHeaders True [("Prefer", "resolution=ignore-duplicates, count=exact, timezone=America/Los_Angeles")] -- Preferences -- { preferResolution = Just IgnoreDuplicates -- , preferRepresentation = Nothing @@ -66,6 +67,7 @@ data Preferences -- , preferTransaction = Nothing -- , preferMissing = Nothing -- , preferHandling = Nothing +-- , preferTimezone = Just "America/Los_Angeles" -- , invalidPrefs = [] -- } -- @@ -80,6 +82,7 @@ data Preferences -- , preferTransaction = Nothing -- , preferMissing = Just ApplyNulls -- , preferHandling = Just Lenient +-- , preferTimezone = Nothing -- , invalidPrefs = [ "invalid" ] -- } -- @@ -110,6 +113,7 @@ data Preferences -- , preferTransaction = Just Commit -- , preferMissing = Just ApplyDefaults -- , preferHandling = Just Strict +-- , preferTimezone = Nothing -- , invalidPrefs = [ "anything" ] -- } -- @@ -123,7 +127,8 @@ fromHeaders allowTxEndOverride headers = , preferTransaction = if allowTxEndOverride then parsePrefs [Commit, Rollback] else Nothing , preferMissing = parsePrefs [ApplyDefaults, ApplyNulls] , preferHandling = parsePrefs [Strict, Lenient] - , invalidPrefs = filter (`notElem` acceptedPrefs) prefs + , preferTimezone = listToMaybe timezonePref -- In "timezone=America/Los_Angeles", drop timezone= and get "America/Los_Angeles" + , invalidPrefs = filter ((/= "timezone=") . BS.take 9) $ filter (`notElem` acceptedPrefs) prefs } where mapToHeadVal :: ToHeaderValue a => [a] -> [ByteString] @@ -138,6 +143,7 @@ fromHeaders allowTxEndOverride headers = prefHeaders = filter ((==) HTTP.hPrefer . fst) headers prefs = fmap BS.strip . concatMap (BS.split ',' . snd) $ prefHeaders + timezonePref = [ BS.drop 9 p | p <- prefs, BS.take 9 p == "timezone="] parsePrefs :: ToHeaderValue a => [a] -> Maybe a parsePrefs vals = diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index aa175ff6983..5855083ad4e 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -249,10 +249,12 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A where roleSettings = fromMaybe mempty (HM.lookup authRole $ configRoleSettings conf) roleIsoLvl = HM.findWithDefault SQL.ReadCommitted authRole $ configRoleIsoLvl conf + timezoneNames = configTimezoneNames conf runQuery isoLvl mode query = runDbHandler appState isoLvl mode authenticated prepared $ do Query.setPgLocals conf authClaims authRole (HM.toList roleSettings) apiReq pgVer Query.runPreReq conf + Query.setTimezone timezoneNames iPreferences query pgrstResponse :: ServerTimingData -> Response.PgrstResponse -> Wai.Response diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index ed20481f601..21c3db6aa41 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -57,7 +57,8 @@ import PostgREST.Config (AppConfig (..), readAppConfig) import PostgREST.Config.Database (queryDbSettings, queryPgVersion, - queryRoleSettings) + queryRoleSettings, + queryTimezones) import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) import PostgREST.SchemaCache (SchemaCache, @@ -405,7 +406,18 @@ reReadConfig startingUp appState = do Right x -> pure x else pure mempty - readAppConfig dbSettings configFilePath (Just configDbUri) roleSettings roleIsolationLvl >>= \case + timezoneNames <- + if configDbConfig then do + names <- usePool appState $ queryTimezones configDbPreparedStatements + case names of + Left e -> do + logWithZTime appState "An error ocurred when trying to query the timezones" + logPgrstError appState e + pure mempty + Right x -> pure x + else + pure mempty + readAppConfig dbSettings configFilePath (Just configDbUri) roleSettings roleIsolationLvl timezoneNames >>= \case Left err -> if startingUp then panic err -- die on invalid config if the program is starting up diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index 268b94924e2..4a78bab381c 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -32,7 +32,7 @@ import Protolude hiding (hPutStrLn) main :: App.SignalHandlerInstaller -> Maybe App.SocketRunner -> CLI -> IO () main installSignalHandlers runAppWithSocket CLI{cliCommand, cliPath} = do conf@AppConfig{..} <- - either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty + either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty mempty -- Per https://github.com/PostgREST/postgrest/issues/268, we want to -- explicitly close the connections to PostgreSQL on shutdown. diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 8c6aa24efe8..25e306e6234 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -56,7 +56,7 @@ import System.Environment (getEnvironment) import System.Posix.Types (FileMode) import PostgREST.Config.Database (RoleIsolationLvl, - RoleSettings) + RoleSettings, TimezoneNames) import PostgREST.Config.JSPath (JSPath, JSPathExp (..), dumpJSPath, pRoleClaimKey) import PostgREST.Config.Proxy (Proxy (..), @@ -110,6 +110,7 @@ data AppConfig = AppConfig , configAdminServerPort :: Maybe Int , configRoleSettings :: RoleSettings , configRoleIsoLvl :: RoleIsolationLvl + , configTimezoneNames :: TimezoneNames , configInternalSCSleep :: Maybe Int32 } @@ -207,13 +208,13 @@ instance JustIfMaybe a (Maybe a) where -- | Reads and parses the config and overrides its parameters from env vars, -- files or db settings. -readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> RoleSettings -> RoleIsolationLvl -> IO (Either Text AppConfig) -readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do +readAppConfig :: [(Text, Text)] -> Maybe FilePath -> Maybe Text -> RoleSettings -> RoleIsolationLvl -> TimezoneNames -> IO (Either Text AppConfig) +readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl timezoneNames = do env <- readPGRSTEnvironment -- if no filename provided, start with an empty map to read config from environment conf <- maybe (return $ Right M.empty) loadConfig optPath - case C.runParser (parser optPath env dbSettings roleSettings roleIsolationLvl) =<< mapLeft show conf of + case C.runParser (parser optPath env dbSettings roleSettings roleIsolationLvl timezoneNames) =<< mapLeft show conf of Left err -> return . Left $ "Error in config " <> err Right parsedConfig -> @@ -228,8 +229,8 @@ readAppConfig dbSettings optPath prevDbUri roleSettings roleIsolationLvl = do decodeJWKS <$> (decodeSecret =<< readSecretFile =<< readDbUriFile prevDbUri parsedConfig) -parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> C.Parser C.Config AppConfig -parser optPath env dbSettings roleSettings roleIsolationLvl = +parser :: Maybe FilePath -> Environment -> [(Text, Text)] -> RoleSettings -> RoleIsolationLvl -> TimezoneNames -> C.Parser C.Config AppConfig +parser optPath env dbSettings roleSettings roleIsolationLvl timezoneNames = AppConfig <$> parseAppSettings "app.settings" <*> (fmap encodeUtf8 <$> optString "db-anon-role") @@ -280,6 +281,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl = <*> optInt "admin-server-port" <*> pure roleSettings <*> pure roleIsolationLvl + <*> pure timezoneNames <*> optInt "internal-schema-cache-sleep" where parseAppSettings :: C.Key -> C.Parser C.Config [(Text, Text)] diff --git a/src/PostgREST/Config/Database.hs b/src/PostgREST/Config/Database.hs index ef0af795196..97e7868bfb5 100644 --- a/src/PostgREST/Config/Database.hs +++ b/src/PostgREST/Config/Database.hs @@ -3,10 +3,12 @@ module PostgREST.Config.Database ( pgVersionStatement , queryDbSettings - , queryRoleSettings , queryPgVersion + , queryRoleSettings + , queryTimezones , RoleSettings , RoleIsolationLvl + , TimezoneNames , toIsolationLevel ) where @@ -29,6 +31,7 @@ import Protolude type RoleSettings = (HM.HashMap ByteString (HM.HashMap ByteString ByteString)) type RoleIsolationLvl = HM.HashMap ByteString SQL.IsolationLevel +type TimezoneNames = [Text] -- cache timezone names for prefer timezone= toIsolationLevel :: (Eq a, IsString a) => a -> SQL.IsolationLevel toIsolationLevel a = case a of @@ -174,6 +177,15 @@ queryRoleSettings prepared = rows :: HD.Result [(Text, Maybe Text, [(Text, Text)])] rows = HD.rowList $ (,,) <$> column HD.text <*> nullableColumn HD.text <*> compositeArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text) +queryTimezones :: Bool -> Session TimezoneNames +queryTimezones prepared = + let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in + transaction SQL.ReadCommitted SQL.Read $ SQL.statement mempty $ SQL.Statement sql HE.noParams decodeTimezones prepared + where + sql = "SELECT name FROM pg_timezone_names" + decodeTimezones :: HD.Result [Text] + decodeTimezones = HD.rowList $ column HD.text + column :: HD.Value a -> HD.Row a column = HD.column . HD.nonNullable diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index 1b1544618c4..9358ae044ac 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -11,6 +11,7 @@ module PostgREST.Query , setPgLocals , runPreReq , DbHandler + , setTimezone ) where import qualified Data.Aeson as JSON @@ -19,6 +20,7 @@ import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.HashMap.Strict as HM +import qualified Data.List as L import qualified Data.Set as S import qualified Data.Text.Encoding as T import qualified Hasql.Decoders as HD @@ -42,6 +44,7 @@ import PostgREST.ApiRequest.Preferences (PreferCount (..), shouldCount) import PostgREST.Config (AppConfig (..), OpenAPIMode (..)) +import PostgREST.Config.Database (TimezoneNames) import PostgREST.Config.PgVersion (PgVersion (..), pgVersion140) import PostgREST.Error (Error) @@ -278,3 +281,15 @@ runPreReq conf = lift $ traverse_ (SQL.statement mempty . stmt) (configDbPreRequ ("select " <> fromQi req <> "()") HD.noResult (configDbPreparedStatements conf) + +-- | Sets Timezone from prefer header +setTimezone :: TimezoneNames -> Preferences -> DbHandler () +setTimezone allowedTimezones preferences = + lift $ + when (isJust $ L.find (== timezone) allowedTimezones) + $ do + SQL.sql $ "set local time zone '" <> T.encodeUtf8 timezone <> "'" + SQL.sql $ "select set_config('timezone', '" <> T.encodeUtf8 timezone <> "', true)" + where + defaultTimezone = "select current_setting('timezone', false)" + timezone = maybe defaultTimezone T.decodeUtf8 $ preferTimezone preferences diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index 96faaf8f3b9..3b11ce74beb 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -74,7 +74,7 @@ readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRe RSStandard{..} -> do let (status, contentRange) = RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal - prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing Nothing preferCount preferTransaction Nothing preferHandling [] + prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing Nothing preferCount preferTransaction Nothing preferHandling Nothing [] headers = [ contentRange , ( "Content-Location" @@ -105,7 +105,7 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctx pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;} prefHeader = prefAppliedHeader $ Preferences (if null pkCols && isNothing (qsOnConflict iQueryParams) then Nothing else preferResolution) - preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling [] + preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling Nothing [] headers = catMaybes [ if null rsLocation then @@ -146,7 +146,7 @@ updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre contentRangeHeader = Just . RangeQuery.contentRangeH 0 (rsQueryTotal - 1) $ if shouldCount preferCount then Just rsQueryTotal else Nothing - prefHeader = prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling [] + prefHeader = prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction preferMissing preferHandling Nothing [] headers = catMaybes [contentRangeHeader, prefHeader] let (status, headers', body) = @@ -166,7 +166,7 @@ singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Erro singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of RSStandard {..} -> do let - prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling [] + prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling Nothing [] cTHeader = contentTypeHeaders mrMedia ctxApiRequest let isInsertIfGTZero i = if i > 0 then HTTP.status201 else HTTP.status200 @@ -190,7 +190,7 @@ deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre contentRangeHeader = RangeQuery.contentRangeH 1 0 $ if shouldCount preferCount then Just rsQueryTotal else Nothing - prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling [] + prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling Nothing [] headers = contentRangeHeader : prefHeader let (status, headers', body) = @@ -243,7 +243,7 @@ invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPr then Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange $ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal) else LBS.fromStrict rsBody - prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling [] + prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling Nothing [] headers = contentRange : prefHeader let (status', headers', body) = diff --git a/test/io/fixtures.sql b/test/io/fixtures.sql index bc1dd967077..db866a305f9 100644 --- a/test/io/fixtures.sql +++ b/test/io/fixtures.sql @@ -178,3 +178,13 @@ $$; create function terminate_pgrst() returns setof record as $$ select pg_terminate_backend(pid) from pg_stat_activity where application_name iLIKE '%postgrest%'; $$ language sql security definer; + +create table timezone_values ( + t timestamp with time zone +); +grant all on timezone_values to postgrest_test_anonymous; + +truncate table timezone_values cascade; +insert into timezone_values values ('2023-10-18 12:37:59.611000+0000'); +insert into timezone_values values ('2023-10-18 14:37:59.611000+0000'); +insert into timezone_values values ('2023-10-18 16:37:59.611000+0000'); diff --git a/test/io/test_io.py b/test/io/test_io.py index 91b5421adae..d40d0fec20c 100644 --- a/test/io/test_io.py +++ b/test/io/test_io.py @@ -1294,3 +1294,33 @@ def test_no_preflight_request_with_CORS_config_should_not_return_header(defaulte with run(env=env) as postgrest: response = postgrest.session.get("/items", headers=headers) assert "Access-Control-Allow-Origin" not in response.headers + + +def test_prefer_timezone(defaultenv): + "timezone=America/Los_Angeles should change timezone successfully" + + env = {**defaultenv, "PGRST_DB_CONFIG": "true", "PGRST_JWT_SECRET": SECRET} + + headers = { + "Prefer": "handling=strict, timezone=America/Los_Angeles", + } + + with run(env=env) as postgrest: + response = postgrest.session.get("/timezone_values", headers=headers) + response_body = '[{"t":"2023-10-18T05:37:59.611-07:00"}, \n {"t":"2023-10-18T07:37:59.611-07:00"}, \n {"t":"2023-10-18T09:37:59.611-07:00"}]' + assert response.text == response_body + + +def test_prefer_timezone_with_invalid_timezone(defaultenv): + "timezone=America/XXX should set time to default timezone" + + env = {**defaultenv, "PGRST_DB_CONFIG": "true", "PGRST_JWT_SECRET": SECRET} + + headers = { + "Prefer": "handling=strict, timezone=America/XXX", + } + + with run(env=env) as postgrest: + response = postgrest.session.get("/timezone_values", headers=headers) + response_body = '[{"t":"2023-10-18T17:37:59.611+05:00"}, \n {"t":"2023-10-18T19:37:59.611+05:00"}, \n {"t":"2023-10-18T21:37:59.611+05:00"}]' + assert response.text == response_body diff --git a/test/spec/SpecHelper.hs b/test/spec/SpecHelper.hs index 1f5eba65793..99885deb4ed 100644 --- a/test/spec/SpecHelper.hs +++ b/test/spec/SpecHelper.hs @@ -139,6 +139,7 @@ baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in , configAdminServerPort = Nothing , configRoleSettings = mempty , configRoleIsoLvl = mempty + , configTimezoneNames = mempty , configInternalSCSleep = Nothing }