Michal KleczekandGitHub
77ff11de95
Changes: 1. Refactoring and some cleanup of JWT handling code: * Instead of caching AuthResult cache decoded claims (which signature was verified). Validating claims and determining role is done after cache lookup * Cleaned up API so that usage of it is simplified: lookupJwtCache cache key >>= parseClaims configJwtAud time * Handling of JwtCacheState initialization and updates of configuration is encapsulated in Auth.JwtCache module 2. Generic high performance (hopefully) scalable, dynamically resizeable cache implementation based on stm, stm-hamt and sieve algorithm. It also integrates with PostgREST measurements infrastructure providing usage stats (ie. hit ratio, evictions count)
78 lines
2.8 KiB
Haskell
78 lines
2.8 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
{-|
|
|
Module : PostgREST.Auth
|
|
Description : PostgREST authentication functions.
|
|
|
|
This module provides functions to deal with the JWT authentication (http://jwt.io).
|
|
It also can be used to define other authentication functions,
|
|
in the future Oauth, LDAP and similar integrations can be coded here.
|
|
|
|
Authentication should always be implemented in an external service.
|
|
In the test suite there is an example of simple login function that can be used for a
|
|
very simple authentication system inside the PostgreSQL database.
|
|
-}
|
|
module PostgREST.Auth
|
|
( getResult
|
|
, getJwtDur
|
|
, getRole
|
|
, middleware
|
|
) where
|
|
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.Vault.Lazy as Vault
|
|
import qualified Network.HTTP.Types.Header as HTTP
|
|
import qualified Network.Wai as Wai
|
|
import qualified Network.Wai.Middleware.HttpAuth as Wai
|
|
|
|
import Data.List (lookup)
|
|
import System.IO.Unsafe (unsafePerformIO)
|
|
import System.TimeIt (timeItT)
|
|
|
|
import PostgREST.AppState (AppState, getConfig, getJwtCacheState,
|
|
getTime)
|
|
import PostgREST.Auth.Jwt (parseClaims)
|
|
import PostgREST.Auth.JwtCache (lookupJwtCache)
|
|
import PostgREST.Auth.Types (AuthResult (..))
|
|
import PostgREST.Config (AppConfig (..))
|
|
import PostgREST.Error (Error (..))
|
|
|
|
import Protolude
|
|
|
|
-- | Validate authorization header
|
|
-- Parse and store JWT claims for future use in the request.
|
|
middleware :: AppState -> Wai.Middleware
|
|
middleware appState app req respond = do
|
|
conf@AppConfig{..} <- getConfig appState
|
|
time <- getTime appState
|
|
|
|
let token = Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req)
|
|
parseJwt = runExceptT $ lookupJwtCache jwtCacheState token >>= parseClaims conf time
|
|
jwtCacheState = getJwtCacheState appState
|
|
|
|
-- If ServerTimingEnabled -> calculate JWT validation time
|
|
req' <- if configServerTimingEnabled then do
|
|
(dur, authResult) <- timeItT parseJwt
|
|
pure $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult & Vault.insert jwtDurKey dur }
|
|
else do
|
|
authResult <- parseJwt
|
|
pure $ req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
|
|
|
|
app req' respond
|
|
|
|
authResultKey :: Vault.Key (Either Error AuthResult)
|
|
authResultKey = unsafePerformIO Vault.newKey
|
|
{-# NOINLINE authResultKey #-}
|
|
|
|
getResult :: Wai.Request -> Maybe (Either Error AuthResult)
|
|
getResult = Vault.lookup authResultKey . Wai.vault
|
|
|
|
jwtDurKey :: Vault.Key Double
|
|
jwtDurKey = unsafePerformIO Vault.newKey
|
|
{-# NOINLINE jwtDurKey #-}
|
|
|
|
getJwtDur :: Wai.Request -> Maybe Double
|
|
getJwtDur = Vault.lookup jwtDurKey . Wai.vault
|
|
|
|
getRole :: Wai.Request -> Maybe BS.ByteString
|
|
getRole req = authRole <$> (rightToMaybe =<< getResult req)
|