fix: purge JWT cache asynchronously in a separate thread
Otherwise performance was reduced unnecessarily.
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user