Skip to content

Commit

Permalink
refactor: Use namespaced types
Browse files Browse the repository at this point in the history
  • Loading branch information
wolfgangwalther committed Feb 18, 2023
1 parent a07d416 commit ab2b874
Show file tree
Hide file tree
Showing 2 changed files with 10 additions and 11 deletions.
7 changes: 3 additions & 4 deletions src/PostgREST/App.hs
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,6 @@ import qualified PostgREST.Workers as Workers
import PostgREST.ApiRequest (Action (..), ApiRequest (..),
Mutation (..), Target (..))
import PostgREST.AppState (AppState)
import PostgREST.Auth (AuthResult)
import PostgREST.Config (AppConfig (..), LogLevel (..))
import PostgREST.Config.PgVersion (PgVersion (..))
import PostgREST.Error (Error)
Expand Down Expand Up @@ -104,7 +103,7 @@ postgrest logLevel appState connWorker =
Auth.middleware appState .
Logger.middleware logLevel $
-- fromJust can be used, because the auth middleware will **always** add
-- some AuthResult to the vault.
-- some Auth.Result to the vault.
\req respond -> case fromJust $ Auth.getResult req of
Left err -> respond $ Error.errorResponseFor err
Right authResult -> do
Expand Down Expand Up @@ -134,7 +133,7 @@ postgrestResponse
-> Maybe SchemaCache
-> ByteString
-> PgVersion
-> AuthResult
-> Auth.Result
-> Wai.Request
-> Handler IO Wai.Response
postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jsonDbS pgVer authResult req = do
Expand Down Expand Up @@ -170,7 +169,7 @@ runDbHandler appState mode authenticated prepared handler = do

liftEither resp

handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
handleRequest :: Auth.Result -> AppConfig -> AppState.AppState -> Bool -> Bool -> ByteString -> PgVersion -> ApiRequest -> SchemaCache -> Handler IO Wai.Response
handleRequest authResult conf appState authenticated prepared jsonDbS pgVer apiReq@ApiRequest{..} sCache =
case (iAction, iTarget) of
(ActionRead headersOnly, TargetIdent identifier) -> do
Expand Down
14 changes: 7 additions & 7 deletions src/PostgREST/Auth.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ very simple authentication system inside the PostgreSQL database.
-}
{-# LANGUAGE RecordWildCards #-}
module PostgREST.Auth
( AuthResult (..)
( Result (..)
, getResult
, getRole
, middleware
Expand Down Expand Up @@ -45,7 +45,7 @@ import PostgREST.Error (Error (..))
import Protolude


data AuthResult = AuthResult
data Result = Result
{ claims :: KM.KeyMap JSON.Value
, rol :: Text
}
Expand Down Expand Up @@ -73,12 +73,12 @@ parseToken AppConfig{..} token time = do
jwtClaimsError e = JwtTokenInvalid $ show e

parseClaims :: Monad m =>
AppConfig -> JSON.Value -> ExceptT Error m AuthResult
AppConfig -> JSON.Value -> ExceptT Error m Result
parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
-- role defaults to anon if not specified in jwt
role <- liftEither . maybeToRight JwtTokenRequired $
unquoted <$> walkJSPath (Just jclaims) configJwtRoleClaimKey <|> configDbAnonRole
return AuthResult
return Result
{ claims = mclaims & KM.insert "role" (JSON.toJSON role)
, rol = role
}
Expand All @@ -93,7 +93,7 @@ parseClaims AppConfig{..} jclaims@(JSON.Object mclaims) = do
unquoted (JSON.String t) = t
unquoted v = T.decodeUtf8 . LBS.toStrict $ JSON.encode v
-- impossible case - just added to please -Wincomplete-patterns
parseClaims _ _ = return AuthResult { claims = KM.empty, rol = mempty }
parseClaims _ _ = return Result { claims = KM.empty, rol = mempty }

Check warning on line 96 in src/PostgREST/Auth.hs

View check run for this annotation

Codecov / codecov/patch

src/PostgREST/Auth.hs#L96

Added line #L96 was not covered by tests

-- | Validate authorization header.
-- Parse and store JWT claims for future use in the request.
Expand All @@ -110,11 +110,11 @@ middleware appState app req respond = do
let req' = req { Wai.vault = Wai.vault req & Vault.insert authResultKey authResult }
app req' respond

authResultKey :: Vault.Key (Either Error AuthResult)
authResultKey :: Vault.Key (Either Error Result)
authResultKey = unsafePerformIO Vault.newKey
{-# NOINLINE authResultKey #-}

getResult :: Wai.Request -> Maybe (Either Error AuthResult)
getResult :: Wai.Request -> Maybe (Either Error Result)
getResult = Vault.lookup authResultKey . Wai.vault

getRole :: Wai.Request -> Maybe Text
Expand Down

0 comments on commit ab2b874

Please sign in to comment.