-- SPDX-FileCopyrightText: 2023-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, David Mosbach <david.mosbach@uniworx.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Auth.OAuth2
  ( apAzure
  , azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage
  , azureUser, azureUser'
  , AzureUserException(..), _AzureUserError, _AzureUserNoResult, _AzureUserAmbiguous
  , apAzureMock
  , azureMockServer
  ) where

import qualified Data.CaseInsensitive as CI
import Data.Text

import Import.NoFoundation

import Yesod.Auth.OAuth2
import Yesod.Auth.OAuth2.Prelude

-- | Plugin name of the OAuth2 yesod plugin for Azure ADv2
apAzure :: Text
apAzure = "AzureADv2"


data AzureUserException = AzureUserError
                        | AzureUserNoResult
                        | AzureUserAmbiguous
                        deriving (Show, Eq, Generic)

instance Exception AzureUserException

makePrisms ''AzureUserException


azurePrimaryKey, azureUserPrincipalName, azureUserDisplayName, azureUserGivenName, azureUserSurname, azureUserMail, azureUserTelephone, azureUserMobile, azureUserPreferredLanguage :: Text
azurePrimaryKey = "id"
azureUserPrincipalName = "userPrincipalName"
azureUserDisplayName = "displayName"
azureUserGivenName = "givenName"
azureUserSurname = "surname"
azureUserMail = "mail"
azureUserTelephone = "businessPhones"
azureUserMobile = "mobilePhone"
azureUserPreferredLanguage = "preferredLanguage"


-- | User lookup in Microsoft Graph with given credentials
azureUser :: ( MonadMask m
             , MonadUnliftIO m
          -- , MonadThrow m
             )
             => AzureConf
             -> Creds site
             -> m [(Text, [ByteString])] -- (Either AzureUserException [(Text, [ByteString])])
azureUser _conf _creds = fmap throwLeft . liftIO . runExceptT $ do
  results <- return [] -- TODO
  case results of
    [] -> throwE AzureUserNoResult
    [res] -> return res
    _multiple -> throwE AzureUserAmbiguous

-- | User lookup in Microsoft Graph with given user
azureUser' :: ( MonadMask m
              , MonadUnliftIO m
          -- , MonadThrow m
             )
             => AzureConf
             -> User
             -> m (Maybe [(Text, [ByteString])]) -- (Either AzureUserException [(Text, [ByteString])])
azureUser' conf User{userIdent}
  = runMaybeT . catchIfMaybeT (is _AzureUserNoResult) $ azureUser conf (Creds apAzure (CI.original userIdent) [])


----------------------------------------
---- OAuth2 development auth plugin ----
----------------------------------------

apAzureMock :: Text
apAzureMock = "uniworx_dev"

newtype UserID = UserID Text
instance FromJSON UserID where
  parseJSON = withObject "UserID" $ \o ->
    UserID <$> o .: "id"

azureMockServer :: YesodAuth m => AuthPlugin m
azureMockServer =
  let oa = OAuth2
            { oauth2ClientId = "uniworx"
            , oauth2ClientSecret = Just "shh"
            , oauth2AuthorizeEndpoint = fromString $ mockServerURL <> "/authorize"
            , oauth2TokenEndpoint = fromString $ mockServerURL <> "/token"
            , oauth2RedirectUri = Nothing
            }
      mockServerURL = "0.0.0.0/"
      profileSrc = fromString $ mockServerURL <> "/foo"
  in  authOAuth2 apAzureMock oa $ \manager token -> do
        (UserID userID, userResponse) <- authGetProfile apAzureMock manager token profileSrc
        return Creds
                { credsPlugin = apAzureMock
                , credsIdent = userID
                , credsExtra = setExtra token userResponse
                }
