module Handler.Utils.Tokens
  ( maybeBearerToken, requireBearerToken
  , currentTokenRestrictions
  ) where

import Import

import Utils.Lens

import Control.Monad.Trans.Maybe (runMaybeT)


maybeBearerToken :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m) => m (Maybe (BearerToken UniWorX))
maybeBearerToken = runMaybeT $ catchIfMaybeT cPred requireBearerToken
  where
    cPred err = any ($ err)
      [ is $ _HCError . _PermissionDenied
      , is $ _HCError . _NotAuthenticated
      ]

requireBearerToken :: (MonadHandler m, HandlerSite m ~ UniWorX) => m (BearerToken UniWorX)
requireBearerToken = liftHandlerT $ do
  token <- exceptT (guardAuthResult >=> error "askToken should not throw `Authorized`") return askTokenUnsafe
  mAuthId <- maybeAuthId
  currentRoute <- maybe (permissionDeniedI MsgUnauthorizedToken404) return =<< getCurrentRoute
  isWrite <- isWriteRequest currentRoute
  guardAuthResult <=< runDB $ validateToken mAuthId currentRoute isWrite token
  return token

currentTokenRestrictions :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m, MonadLogger m, FromJSON a, ToJSON a) => m (Maybe a)
currentTokenRestrictions = runMaybeT $ do
  token <- requireBearerToken
  route <- MaybeT getCurrentRoute
  hoistMaybe $ preview (_tokenRestrictionIx route) token