{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module provides authentication utilities for the Jamaa server.
module Auth (authHandler, UserAuth) where

import Servant
import Servant.Server.Experimental.Auth (AuthServerData, AuthHandler, mkAuthHandler)
import Network.Wai (Request, requestHeaders)
import Database.Persist
import Database (runDb)
import Control.Monad.IO.Class (liftIO)
import Jose.Jws (hmacDecode)
import Data.Aeson as A
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as B

import Data.User (User (..), Unique (UniqueName))
import Model.AuthenticationHolder (AuthenticationHolder (..), server_password)

----------------------------------------------------------------------------------------------------
type UserAuth = AuthProtect "user-auth"
type instance AuthServerData UserAuth = User

authHandler :: AuthHandler Request User
authHandler =
  mkAuthHandler $ \req -> case lookup "Authorization" (requestHeaders req) of
    Just header ->
      case B.stripPrefix "Bearer " header of
        Just token -> do
          let either_auth_holder = hmacDecode server_password token

          case either_auth_holder of
            Right (_, auth_holder_body) -> do
              let maybe_auth_holder = A.decode $ BL.fromStrict $ auth_holder_body :: Maybe AuthenticationHolder

              case maybe_auth_holder of
                Just auth_holder -> do
                  maybe_user <- liftIO $ runDb $ getBy $ UniqueName $ username $ auth_holder

                  case maybe_user of
                    Just (Entity _ db_user) -> return db_user
                    _ -> throwError err401
                _ -> throwError err401
            _ -> throwError err401
        _ -> throwError err401
    _ -> throwError err401