module Handler.Utils.Tokens
  ( maybeBearerToken, requireBearerToken
  , maybeCurrentTokenRestrictions, requireCurrentTokenRestrictions
  ) where

import Import


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 = liftHandler $ 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

requireCurrentTokenRestrictions :: ( MonadHandler m
                                   , HandlerSite m ~ UniWorX
                                   , FromJSON a
                                   , ToJSON a
                                   )
                                => m (Maybe a)
requireCurrentTokenRestrictions = runMaybeT $ do
  token <- requireBearerToken
  route <- MaybeT getCurrentRoute
  hoistMaybe $ token ^? _tokenRestrictionIx route
  
maybeCurrentTokenRestrictions :: ( MonadHandler m
                                 , HandlerSite m ~ UniWorX
                                 , MonadCatch m
                                 , FromJSON a
                                 , ToJSON a
                                 )
                              => m (Maybe a)
maybeCurrentTokenRestrictions = runMaybeT $ do
  token <- MaybeT maybeBearerToken
  route <- MaybeT getCurrentRoute
  hoistMaybe $ token ^? _tokenRestrictionIx route