fix: purge JWT cache asynchronously in a separate thread

Otherwise performance was reduced unnecessarily.

Author: mkleczek

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