-- 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'