fix: purge JWT cache asynchronously in a separate thread

Otherwise performance was reduced unnecessarily.
This commit is contained in:
Michal Kleczek
2025-04-18 17:50:32 -05:00
committed by GitHub
parent 58b5dff188
commit 4d8502371d
+22 -7
View File
@@ -17,6 +17,8 @@ import qualified Data.Aeson.KeyMap as KM
import qualified Data.Cache as C import qualified Data.Cache as C
import qualified Data.Scientific as Sci import qualified Data.Scientific as Sci
import Control.Debounce
import Data.Time.Clock (UTCTime, nominalDiffTimeToSeconds) import Data.Time.Clock (UTCTime, nominalDiffTimeToSeconds)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import System.Clock (TimeSpec (..)) import System.Clock (TimeSpec (..))
@@ -26,19 +28,30 @@ import PostgREST.Error (Error (..))
import Protolude import Protolude
newtype JwtCacheState = JwtCacheState -- | JWT Cache and IO action that triggers purging old entries from the cache
{ jwtCache :: C.Cache ByteString AuthResult data JwtCacheState = JwtCacheState
{ jwtCache :: C.Cache ByteString AuthResult
, purgeCache :: IO ()
} }
-- | Initialize JwtCacheState -- | Initialize JwtCacheState
init :: IO JwtCacheState init :: IO JwtCacheState
init = do init = do
cache <- C.newCache Nothing -- no default expiration cache <- C.newCache Nothing -- no default expiration
return $ JwtCacheState cache -- purgeExpired has O(n^2) complexity
-- so we wrap it in debounce to make sure it:
-- 1) is executed asynchronously
-- 2) only a single purge operation is running at a time
debounce <- mkDebounce defaultDebounceSettings
-- debounceFreq is set to default 1 second
{ debounceAction = C.purgeExpired cache
, debounceEdge = leadingEdge
}
pure $ JwtCacheState cache debounce
-- | Used to retrieve and insert JWT to JWT Cache -- | Used to retrieve and insert JWT to JWT Cache
lookupJwtCache :: JwtCacheState -> ByteString -> Int -> IO (Either Error AuthResult) -> UTCTime -> IO (Either Error AuthResult) lookupJwtCache :: JwtCacheState -> ByteString -> Int -> IO (Either Error AuthResult) -> UTCTime -> IO (Either Error AuthResult)
lookupJwtCache JwtCacheState{jwtCache} token maxLifetime parseJwt utc = do lookupJwtCache JwtCacheState{jwtCache, purgeCache} token maxLifetime parseJwt utc = do
checkCache <- C.lookup jwtCache token checkCache <- C.lookup jwtCache token
authResult <- maybe parseJwt (pure . Right) checkCache authResult <- maybe parseJwt (pure . Right) checkCache
@@ -59,12 +72,14 @@ lookupJwtCache JwtCacheState{jwtCache} token maxLifetime parseJwt utc = do
let timeSpec = getTimeSpec res maxLifetime utc let timeSpec = getTimeSpec res maxLifetime utc
-- purge expired cache entries
C.purgeExpired jwtCache
-- insert new cache entry -- insert new cache entry
C.insert' jwtCache (Just timeSpec) token res C.insert' jwtCache (Just timeSpec) token res
-- Execute IO action to purge the cache
-- It is assumed this action returns immidiately
-- so that request processing is not blocked.
purgeCache
_ -> pure () _ -> pure ()
return authResult return authResult