gonito/Handler/JWT.hs

module Handler.JWT where

import Import hiding (Proxy, fromList)

import qualified Data.ByteString as BS
import           Data.Word8 (isSpace, toLower)
import           Network.Wai (requestHeaders)
import qualified Jose.Jwt as JWT
import qualified Jose.Jwa as JWA

import Data.Aeson

data JwtAuthInfo = JwtAuthInfo Text
  deriving (Show, Eq)

instance FromJSON JwtAuthInfo where
 parseJSON (Object v) =
    JwtAuthInfo <$> v .: "preferred_username"
 parseJSON _ = mzero

jwtAuthInfoIdent :: JwtAuthInfo -> Text
jwtAuthInfoIdent (JwtAuthInfo ident) = ident

authorizationTokenAuth :: Handler (Maybe JwtAuthInfo)
authorizationTokenAuth = do
  app <- getYesod
  let mJwk = appJSONWebKey $ appSettings app

  case mJwk of
    Just jwk -> do
      req <- waiRequest
      case lookup "Authorization" (Network.Wai.requestHeaders req) of
        Nothing -> return Nothing
        Just authHead -> case BS.break isSpace authHead of
           (strategy, token')
             | BS.map Data.Word8.toLower strategy == "bearer" -> do
                let token = BS.filter (/= 32) token'
                einfo <- liftIO $ JWT.decode [jwk] (Just (JWT.JwsEncoding JWA.RS256)) token
                return $ case einfo of
                           Right (JWT.Jws (_, infos)) -> decode $ fromStrict infos
                           _ -> Nothing
             | otherwise -> return Nothing
    Nothing -> return Nothing

maybeAuthPossiblyByToken :: Handler (Maybe (Entity User))
maybeAuthPossiblyByToken = do
  mInfo <- authorizationTokenAuth
  case mInfo of
    Just infos -> do
      x <- runDB $ getBy $ UniqueUser $ jwtAuthInfoIdent infos
      case x of
        Just entUser -> return $ Just entUser
        Nothing -> maybeAuth
    Nothing -> maybeAuth


requireAuthPossiblyByToken :: Handler (Entity User)
requireAuthPossiblyByToken = do
  mInfo <- authorizationTokenAuth
  case mInfo of
    Just infos -> do
      x <- runDB $ getBy $ UniqueUser $ jwtAuthInfoIdent infos
      case x of
        Just entUser -> return entUser
        Nothing -> requireAuth
    Nothing -> requireAuth