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.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
|
||||||
|
|||||||
Reference in New Issue
Block a user