diff --git a/src/PostgREST/Auth/JwtCache.hs b/src/PostgREST/Auth/JwtCache.hs index c95dea6f9..79d511201 100644 --- a/src/PostgREST/Auth/JwtCache.hs +++ b/src/PostgREST/Auth/JwtCache.hs @@ -17,6 +17,8 @@ import qualified Data.Aeson.KeyMap as KM import qualified Data.Cache as C import qualified Data.Scientific as Sci +import Control.Debounce + import Data.Time.Clock (UTCTime, nominalDiffTimeToSeconds) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import System.Clock (TimeSpec (..)) @@ -26,19 +28,30 @@ import PostgREST.Error (Error (..)) import Protolude -newtype JwtCacheState = JwtCacheState - { jwtCache :: C.Cache ByteString AuthResult +-- | JWT Cache and IO action that triggers purging old entries from the cache +data JwtCacheState = JwtCacheState + { jwtCache :: C.Cache ByteString AuthResult + , purgeCache :: IO () } -- | Initialize JwtCacheState init :: IO JwtCacheState init = do 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 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 authResult <- maybe parseJwt (pure . Right) checkCache @@ -59,12 +72,14 @@ lookupJwtCache JwtCacheState{jwtCache} token maxLifetime parseJwt utc = do let timeSpec = getTimeSpec res maxLifetime utc - -- purge expired cache entries - C.purgeExpired jwtCache - -- insert new cache entry 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 () return authResult