-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, David Mosbach <david.mosbach@uniworx.de>, Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Admin.ExternalUser
  ( getAdminExternalUserR
  , postAdminExternalUserR
  ) where

import Import

import Foundation.Yesod.Auth (userLookupAndUpsert) -- decodeUserTest
import Auth.OAuth2 (queryOAuth2User)
import Auth.LDAP

import Handler.Utils

import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import qualified Ldap.Client as Ldap


getAdminExternalUserR,  postAdminExternalUserR :: Handler Html
getAdminExternalUserR = postAdminExternalUserR
postAdminExternalUserR = do
  ((presult, pwidget), penctype) <- runFormPost $ identifyForm ("adminExternalUserLookup"::Text) $ \html -> 
    flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing

  let
    presentUtf8   v = Text.intercalate ", " (either tshow id . Text.decodeUtf8' <$> v)
    presentLatin1 v = Text.intercalate ", " (                 Text.decodeLatin1 <$> v)

    procFormPerson :: Text -> Handler (Maybe [(AuthSourceIdent, [(Text,(Int,Text,Text))])])
    procFormPerson needle = getsYesod (view _appUserAuthConf) >>= \case
      UserAuthConfSingleSource{..} -> case userAuthConfSingleSource of
        AuthSourceConfAzureAdV2 AzureConf{..} -> do
          -- only singleton results supported right now, i.e. lookups by email, userPrincipalName (aka fraport ident), or id
          queryOAuth2User @[(Text,[ByteString])] needle >>= \case
            Left _ -> addMessage Error (text2Html "Encountered UserDataException while Azure user query!") >> return Nothing
            Right azureData -> return . Just . singleton . (AuthSourceIdAzure azureConfTenantId,) $ azureData <&> \(k,vs) -> (k, (length vs, presentUtf8 vs, presentLatin1 vs))
        AuthSourceConfLdap LdapConf{ ldapConfSourceId = authSourceIdLdapHost } -> do
          getsYesod (view _appLdapPool) >>= \case
            Nothing -> addMessage Error (text2Html "LDAP Pool configuration missing!") >> return Nothing
            Just pool -> do
              ldapData <- ldapSearch pool needle
              -- decodedErr <- decodeUserTest $ NonEmpty.singleton UpsertUserDataLdap{ upsertUserLdapHost = ldapConfSourceId, upsertUserLdapData = concat ldapData }
              -- whenIsLeft decodedErr $ addMessageI Error
              return . Just $ ldapData <&> \(Ldap.SearchEntry _dn attrs) -> (AuthSourceIdLdap{..}, (\(k,v) -> (tshow k, (length v, presentUtf8 v, presentLatin1 v))) <$> attrs)

  mbData <- formResultMaybe presult procFormPerson


  ((uresult, uwidget), uenctype) <- runFormPost $ identifyForm ("adminExternalUserUpsert"::Text) $ \html -> 
    flip (renderAForm FormStandard) html $ areq textField (fslI MsgAdminUserIdent) Nothing
  let procFormUpsert :: Text -> Handler (Maybe (Entity User))
      procFormUpsert lid = runDB (userLookupAndUpsert lid UpsertUserGuessUser)

  mbUpsert <- formResultMaybe uresult procFormUpsert


  actionUrl <- fromMaybe AdminExternalUserR <$> getCurrentRoute
  siteLayoutMsg MsgMenuExternalUser $ do
    setTitleI MsgMenuExternalUser
    let personForm = wrapForm pwidget def
                      { formAction = Just $ SomeRoute actionUrl
                      , formEncoding = penctype
                      }
        upsertForm = wrapForm uwidget def 
                      { formAction = Just $ SomeRoute actionUrl
                      , formEncoding = uenctype
                      }
    $(widgetFile "admin/external-user")