From 877071f50eb35cd973589b1a1ca93abf795882c5 Mon Sep 17 00:00:00 2001 From: Taimoor Zaeem Date: Sun, 12 Nov 2023 10:24:23 +0500 Subject: [PATCH] change timezone cache data structure from list to set --- src/PostgREST/ApiRequest/Preferences.hs | 30 +++++++++++++++++-------- src/PostgREST/Config/Database.hs | 2 +- src/PostgREST/Query.hs | 3 ++- src/PostgREST/SchemaCache.hs | 2 +- 4 files changed, 25 insertions(+), 12 deletions(-) diff --git a/src/PostgREST/ApiRequest/Preferences.hs b/src/PostgREST/ApiRequest/Preferences.hs index 274905a5e4..7af3491d1a 100644 --- a/src/PostgREST/ApiRequest/Preferences.hs +++ b/src/PostgREST/ApiRequest/Preferences.hs @@ -16,6 +16,7 @@ module PostgREST.ApiRequest.Preferences , PreferRepresentation(..) , PreferResolution(..) , PreferTransaction(..) + , PreferTimezone(..) , fromHeaders , shouldCount , prefAppliedHeader @@ -23,6 +24,7 @@ module PostgREST.ApiRequest.Preferences import qualified Data.ByteString.Char8 as BS import qualified Data.Map as Map +import qualified Data.Set as S import qualified Network.HTTP.Types.Header as HTTP import PostgREST.Config.Database (TimezoneNames) @@ -39,6 +41,7 @@ import Protolude -- >>> deriving instance Show PreferTransaction -- >>> deriving instance Show PreferMissing -- >>> deriving instance Show PreferHandling +-- >>> deriving instance Show PreferTimezone -- >>> deriving instance Show Preferences -- | Preferences recognized by the application. @@ -51,14 +54,14 @@ data Preferences , preferTransaction :: Maybe PreferTransaction , preferMissing :: Maybe PreferMissing , preferHandling :: Maybe PreferHandling - , preferTimezone :: Maybe ByteString + , preferTimezone :: Maybe PreferTimezone , invalidPrefs :: [ByteString] } -- | -- Parse HTTP headers based on RFC7240[1] to identify preferences. -- --- >>> let sc = ["America/Los_Angeles"] +-- >>> let sc = S.fromList ["America/Los_Angeles"] -- -- One header with comma-separated values can be used to set multiple preferences: -- >>> pPrint $ fromHeaders True sc [("Prefer", "resolution=ignore-duplicates, count=exact, timezone=America/Los_Angeles")] @@ -70,7 +73,8 @@ data Preferences -- , preferTransaction = Nothing -- , preferMissing = Nothing -- , preferHandling = Nothing --- , preferTimezone = Just "America/Los_Angeles" +-- , preferTimezone = Just +-- ( PreferTimezone "America/Los_Angeles" ) -- , invalidPrefs = [] -- } -- @@ -121,7 +125,7 @@ data Preferences -- } -- fromHeaders :: Bool -> TimezoneNames -> [HTTP.Header] -> Preferences -fromHeaders allowTxDbOverride tzNames headers = +fromHeaders allowTxDbOverride acceptedTzNames headers = Preferences { preferResolution = parsePrefs [MergeDuplicates, IgnoreDuplicates] , preferRepresentation = parsePrefs [Full, None, HeadersOnly] @@ -131,24 +135,25 @@ fromHeaders allowTxDbOverride tzNames headers = , preferMissing = parsePrefs [ApplyDefaults, ApplyNulls] , preferHandling = parsePrefs [Strict, Lenient] , preferTimezone = getTimezoneFromPrefs - , invalidPrefs = filter (`notElem` acceptedPrefs) prefs + , invalidPrefs = filter checkPrefs prefs } where mapToHeadVal :: ToHeaderValue a => [a] -> [ByteString] mapToHeadVal = map toHeaderValue - timezonePrefs = map ((<>) "timezone=" . encodeUtf8) tzNames acceptedPrefs = mapToHeadVal [MergeDuplicates, IgnoreDuplicates] ++ mapToHeadVal [Full, None, HeadersOnly] ++ mapToHeadVal [SingleObject] ++ mapToHeadVal [ExactCount, PlannedCount, EstimatedCount] ++ mapToHeadVal [Commit, Rollback] ++ mapToHeadVal [ApplyDefaults, ApplyNulls] ++ - mapToHeadVal [Strict, Lenient] ++ timezonePrefs + mapToHeadVal [Strict, Lenient] prefHeaders = filter ((==) HTTP.hPrefer . fst) headers prefs = fmap BS.strip . concatMap (BS.split ',' . snd) $ prefHeaders + hasTimezone p = BS.take 9 p == "timezone=" - getTimezoneFromPrefs = listToMaybe [ BS.drop 9 p | p <- prefs, hasTimezone p && elem p timezonePrefs] + getTimezoneFromPrefs = listToMaybe [ PreferTimezone (BS.drop 9 p) | p <- prefs, hasTimezone p && S.member (BS.drop 9 p) acceptedTzNames] + checkPrefs p = p `notElem` acceptedPrefs && BS.drop 9 p `S.notMember` acceptedTzNames parsePrefs :: ToHeaderValue a => [a] -> Maybe a parsePrefs vals = @@ -172,7 +177,7 @@ prefAppliedHeader Preferences {preferResolution, preferRepresentation, preferPar , toHeaderValue <$> preferCount , toHeaderValue <$> preferTransaction , toHeaderValue <$> preferHandling - , ("timezone=" <>) <$> preferTimezone + , toHeaderValue <$> preferTimezone ] -- | @@ -265,3 +270,10 @@ data PreferHandling instance ToHeaderValue PreferHandling where toHeaderValue Strict = "handling=strict" toHeaderValue Lenient = "handling=lenient" + +-- | +-- Change timezone +newtype PreferTimezone = PreferTimezone ByteString + +instance ToHeaderValue PreferTimezone where + toHeaderValue (PreferTimezone tz) = "timezone=" <> tz diff --git a/src/PostgREST/Config/Database.hs b/src/PostgREST/Config/Database.hs index 443b410e3d..29e87a4a3a 100644 --- a/src/PostgREST/Config/Database.hs +++ b/src/PostgREST/Config/Database.hs @@ -30,7 +30,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= +type TimezoneNames = Set ByteString -- cache timezone names for prefer timezone= toIsolationLevel :: (Eq a, IsString a) => a -> SQL.IsolationLevel toIsolationLevel a = case a of diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index d2d8d5178b..835559a52f 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -33,6 +33,7 @@ import qualified PostgREST.SchemaCache as SchemaCache import PostgREST.ApiRequest (ApiRequest (..)) import PostgREST.ApiRequest.Preferences (PreferCount (..), + PreferTimezone (..), PreferTransaction (..), Preferences (..), shouldCount) @@ -248,7 +249,7 @@ setPgLocals AppConfig{..} claims role roleSettings ApiRequest{..} = lift $ roleSql = [setConfigWithConstantName ("role", role)] roleSettingsSql = setConfigWithDynamicName <$> roleSettings appSettingsSql = setConfigWithDynamicName <$> (join bimap toUtf8 <$> configAppSettings) - timezoneSql = maybe mempty (\tz -> [setConfigWithConstantName ("timezone", tz)]) $ preferTimezone iPreferences + timezoneSql = maybe mempty (\(PreferTimezone tz) -> [setConfigWithConstantName ("timezone", tz)]) $ preferTimezone iPreferences searchPathSql = let schemas = escapeIdentList (iSchema : configDbExtraSearchPath) in setConfigWithConstantName ("search_path", schemas) diff --git a/src/PostgREST/SchemaCache.hs b/src/PostgREST/SchemaCache.hs index 749c2bdbf7..9f80e19bd8 100644 --- a/src/PostgREST/SchemaCache.hs +++ b/src/PostgREST/SchemaCache.hs @@ -1190,7 +1190,7 @@ timezones = SQL.Statement sql HE.noParams decodeTimezones where sql = "SELECT name FROM pg_timezone_names" decodeTimezones :: HD.Result TimezoneNames - decodeTimezones = HD.rowList $ column HD.text + decodeTimezones = S.fromList . map encodeUtf8 <$> HD.rowList (column HD.text) param :: HE.Value a -> HE.Params a param = HE.param . HE.nonNullable