55 lines
1.9 KiB
Haskell
55 lines
1.9 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Utils.Auth
|
|
( requireAuth, requireAuthId, requireAuthPair, authorizationCheck
|
|
) where
|
|
|
|
import ClassyPrelude.Yesod hiding (authorizationCheck)
|
|
import Yesod.Auth hiding (requireAuth, requireAuthId, requireAuthPair)
|
|
import GHC.Stack
|
|
|
|
|
|
requireAuthId :: (MonadHandler m, YesodAuth (HandlerSite m), HasCallStack) => m (AuthId (HandlerSite m))
|
|
requireAuthId = do
|
|
$logDebugS "requireAuthId" . pack $ prettyCallStack callStack
|
|
maybeAuthId >>= maybe notAuthenticated return
|
|
|
|
requireAuth :: ( YesodAuthPersist master
|
|
, val ~ AuthEntity master
|
|
, Key val ~ AuthId master
|
|
, PersistEntity val
|
|
, Typeable val
|
|
, MonadHandler m
|
|
, HandlerSite m ~ master
|
|
, HasCallStack
|
|
) => m (Entity val)
|
|
requireAuth = do
|
|
$logDebugS "requireAuth" . pack $ prettyCallStack callStack
|
|
maybeAuth >>= maybe notAuthenticated return
|
|
|
|
requireAuthPair :: ( YesodAuthPersist master
|
|
, Typeable (AuthEntity master)
|
|
, MonadHandler m
|
|
, HandlerSite m ~ master
|
|
, HasCallStack
|
|
)
|
|
=> m (AuthId master, AuthEntity master)
|
|
requireAuthPair = do
|
|
$logDebugS "requireAuthPair" . pack $ prettyCallStack callStack
|
|
maybeAuthPair >>= maybe notAuthenticated return
|
|
|
|
authorizationCheck :: (Yesod site, HasCallStack) => HandlerFor site ()
|
|
authorizationCheck = do
|
|
$logDebugS "authorizationCheck" . pack $ prettyCallStack callStack
|
|
getCurrentRoute >>= maybe (return ()) checkUrl
|
|
where
|
|
checkUrl url = do
|
|
isWrite <- isWriteRequest url
|
|
ar <- isAuthorized url isWrite
|
|
case ar of
|
|
Authorized -> return ()
|
|
AuthenticationRequired -> notAuthenticated
|
|
Unauthorized s' -> permissionDenied s'
|