perf: Purge JWT cache asynchronously in a separate thread

src/PostgREST/Auth/JwtCache.hs

@@ -16,6 +16,8 @@
 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 (..))
@@ -25,19 +27,29 @@
 
 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
+  cache <- C.newCache Nothing
+  -- 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
+    { 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
 
@@ -58,12 +70,16 @@
 
       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.
+      -- If cache purging is slow it should trigger
+      -- asynchronous purge operation
+      purgeCache
+
     _                    -> pure ()
 
   return authResult