Michał KłeczekandTaimoor Zaeem
13c0e7061e
Currently, authentication and response execution each unwrap ExceptT with separate runExceptT calls, which split the main request flow across nested pattern matching and Either handling. Control flow is complex and difficult to understand. The goal of this change is to make request execution as sequential monadic code with clear error handling. To implement that, request handling is now run in ExceptT over WriterT (Last ByteString) IO monad stack. Auth role is written after authentication succeeds and further returned along the response. Thanks to it response observation generation is centralized at the end of request handling. It was necessary to abstract monad stack in getAuthResult, lookupJwtCache, postgrestResponse, and withTiming to enable introduction of WriterT.
35 lines
1.3 KiB
Haskell
35 lines
1.3 KiB
Haskell
{-|
|
|
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.
|
|
-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
module PostgREST.Auth
|
|
( getAuthResult )
|
|
where
|
|
|
|
import PostgREST.AppState (AppState, getConfig, getJwtCacheState,
|
|
getTime)
|
|
import PostgREST.Auth.Jwt (parseClaims)
|
|
import PostgREST.Auth.JwtCache (lookupJwtCache)
|
|
import PostgREST.Auth.Types (AuthResult)
|
|
import PostgREST.Error (Error)
|
|
|
|
import Protolude
|
|
|
|
-- | Perform authentication and authorization
|
|
-- Parse JWT and return AuthResult
|
|
getAuthResult :: (MonadError Error m, MonadIO m) => AppState -> Maybe ByteString -> m AuthResult
|
|
getAuthResult appState token = do
|
|
conf <- liftIO $ getConfig appState
|
|
time <- liftIO $ getTime appState
|
|
|
|
parseClaims conf time =<< lookupJwtCache (getJwtCacheState appState) token
|