-- SPDX-FileCopyrightText: 2023 David Mosbach <david.mosbach@uniworx.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

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

module Auth.OAuth2
( AzureUserException(..)
, azurePluginName
, oauth2MockServer
, mockPluginName
, queryOAuth2User
, UserDataException
) where

import Data.Maybe (fromJust)
import Data.Text

import Import.NoFoundation hiding (unpack)

import Network.HTTP.Simple (httpJSONEither, getResponseBody, JSONException)

import System.Environment (lookupEnv)

import Yesod.Auth.OAuth2
import Yesod.Auth.OAuth2.Prelude hiding (encodeUtf8)


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

instance Exception AzureUserException

azurePluginName :: Text
azurePluginName = "azureadv2"

-----------------------------------------------
---- OAuth2 + OIDC development auth plugin ----
-----------------------------------------------

mockPluginName :: Text
mockPluginName = "dev-oauth2-mock"

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

oauth2MockServer :: YesodAuth m => String -> AuthPlugin m
oauth2MockServer port =
  let oa = OAuth2
            { oauth2ClientId = "42"
            , oauth2ClientSecret = Just "shhh"
            , oauth2AuthorizeEndpoint = (fromString $ mockServerURL <> "/auth")
              `withQuery` [ scopeParam " " ["openid", "profile", "email", "offline_access"] -- TODO read scopes from config
                          , ("response_type", "code id_token")
                          , ("nonce", "Foo") -- TODO generate meaningful value
                          ]
            , oauth2TokenEndpoint = fromString $ mockServerURL <> "/token"
            , oauth2RedirectUri = Nothing
            }
      mockServerURL = "http://localhost:" <> fromString port
      profileSrc = fromString $ mockServerURL <> "/users/me"
  in  authOAuth2 mockPluginName oa $ \manager token -> do
        (UserID userID, userResponse) <- authGetProfile mockPluginName manager token profileSrc
        return Creds
                { credsPlugin = mockPluginName
                , credsIdent = userID
                , credsExtra = setExtra token userResponse
                }

----------------------
---- User Queries ----
----------------------

data UserDataException = UserDataJSONException JSONException
                       | UserDataInternalException Text
                       deriving Show

instance Exception UserDataException

queryOAuth2User :: forall j m . (FromJSON j, MonadIO m, MonadThrow m, MonadHandler m)
                => Text
                -> m (Either UserDataException j)
queryOAuth2User userID = runExceptT $ do
  (queryUrl, tokenUrl) <- liftIO mkBaseUrls
  req <- parseRequest $ "GET " ++ queryUrl ++ unpack userID
  mTokens <- lookupSessionJson SessionOAuth2Token
  unless (isJust mTokens) . throwE $ UserDataInternalException "Tried to load session Oauth2 tokens, but there are none"
# ifdef DEVELOPMENT
  let secure = False
# else
  let secure = True
# endif
  newTokens <- refreshOAuth2Token @m (fromJust mTokens) tokenUrl secure
  setSessionJson SessionOAuth2Token (Just $ accessToken newTokens, refreshToken newTokens)
  eResult <- lift $ getResponseBody <$> httpJSONEither @m @j (req
    { secure = secure
    , requestHeaders = [("Authorization", encodeUtf8 . ("Bearer " <>) . atoken $ accessToken newTokens)]
    })
  case eResult of
    Left x -> throwE $ UserDataJSONException x
    Right x -> return x


mkBaseUrls :: IO (String, String)
mkBaseUrls = do
# ifndef DEVELOPMENT
  Just tenantID <- lookupEnv "AZURE_TENANT_ID"
  return ( "https://graph.microsoft.com/v1.0/users/"
         , "https://login.microsoftonline.com/" ++ tenantID ++ "/oauth2/v2.0" )
# else
  Just port <- lookupEnv "OAUTH2_SERVER_PORT"
  let base = "http://localhost:" ++ port
  return ( base ++ "/users/query?id="
         , base ++ "/token" )
# endif


refreshOAuth2Token :: forall m. (MonadIO m, MonadThrow m, MonadHandler m)
                   => (Maybe AccessToken, Maybe RefreshToken)
                   -> String
                   -> Bool
                   -> ExceptT UserDataException m OAuth2Token
refreshOAuth2Token (_, rToken) url secure
  | isJust rToken = do
    req <- parseRequest $ "POST " ++ url
    let
      body =
        [ ("grant_type", "refresh_token")
        , ("refresh_token", encodeUtf8 . rtoken $ fromJust rToken)
        ]
    body' <- if secure then do
        clientID <- liftIO $ fromJust <$> lookupEnv "CLIENT_ID"
        clientSecret <- liftIO $ fromJust <$> lookupEnv "CLIENT_SECRET"
        return $ body ++ [("client_id", fromString clientID), ("client_secret", fromString clientSecret), ("scope", "openid profile offline_access")] -- TODO read from config
      else return $ ("scope", "openid profile offline_access") : body -- TODO read from config
    $logErrorS "\27[31mAdmin Handler\27[0m" $ tshow (requestBody $ urlEncodedBody body' req{ secure = secure })
    eResult <- lift $ getResponseBody <$> httpJSONEither @m @OAuth2Token (urlEncodedBody body' req{ secure = secure })
    case eResult of
      Left x -> throwE $ UserDataJSONException x
      Right x -> return x
  | otherwise = throwE $ UserDataInternalException "Could not refresh access token. Refresh token is missing."

instance Show RequestBody where
  show (RequestBodyLBS x) = show x
  show _ = error ":("