-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Jobs.Handler.SynchroniseUserdb
  ( dispatchJobSynchroniseUserdb, dispatchJobSynchroniseUserdbUser
  , SynchroniseUserdbException(..)
  ) where

import Import

import qualified Data.CaseInsensitive as CI
import qualified Data.Conduit.List as C

import Auth.LDAP
import Foundation.Yesod.Auth (CampusUserConversionException, upsertLdapUser, upsertAzureUser)

import Jobs.Queue


data SynchroniseUserdbException
  = SynchroniseUserdbNoUserdb
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
instance Exception SynchroniseUserdbException

dispatchJobSynchroniseUserdb :: Natural -> Natural -> Natural -> JobHandler UniWorX
dispatchJobSynchroniseUserdb numIterations epoch iteration
  = JobHandlerAtomic . runConduit $
      readUsers .| filterIteration .| sinkDBJobs
  where
    readUsers :: ConduitT () UserId (YesodJobDB UniWorX) ()
    readUsers = selectKeys [] []

    filterIteration :: ConduitT UserId Job (YesodJobDB UniWorX) ()
    filterIteration = C.mapMaybeM $ \userId -> runMaybeT $ do
      let
        userIteration, currentIteration :: Integer
        userIteration = toInteger (hash epoch `hashWithSalt` userId) `mod` toInteger numIterations
        currentIteration = toInteger iteration `mod` toInteger numIterations
      $logDebugS "SynchroniseUserdb" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|]
      guard $ userIteration == currentIteration

      return $ JobSynchroniseUserdbUser userId

dispatchJobSynchroniseUserdbUser :: UserId -> JobHandler UniWorX
dispatchJobSynchroniseUserdbUser jUser = JobHandlerException $ do
  UniWorX{..} <- getYesod
  case appUserSourceConf of
    UserSourceConfSingleSource (UserSourceLdap ldapConf) ->
      runDB . void . runMaybeT . handleExc $ do
        user@User{userIdent,userLdapPrimaryKey} <- MaybeT $ get jUser
        let upsertIdent = maybe userIdent CI.mk userLdapPrimaryKey
        $logInfoS "SynchroniseUserdb" [st|Synchronising #{upsertIdent} with LDAP|]
        -- reTestAfter <- getsYesod $ view _appUserdbRetestFailover
        -- ldapAttrs <- MaybeT $ campusUserReTest' ldapConf ((>= reTestAfter) . realToFrac) FailoverUnlimited user
        ldapAttrs <- MaybeT $ ldapUser ldapConf user
        void . lift $ upsertLdapUser (UpsertUserSync upsertIdent) ldapAttrs
    UserSourceConfSingleSource (UserSourceAzureAdV2 azureConf) ->
      runDB . void . runMaybeT . handleExc $ do
        user@User{userIdent,userAzurePrimaryKey} <- MaybeT $ get jUser
        let upsertIdent = maybe userIdent CI.mk userAzurePrimaryKey
        $logInfoS "SynchroniseUserdb" [st|Synchronising #{upsertIdent} with Azure|]
        void . lift $ upsertAzureUser (UpsertUserSync upsertIdent) azureConf
  where
    handleExc :: MaybeT DB a -> MaybeT DB a
    handleExc
      = catchMPlus (Proxy @CampusUserException)
      . catchMPlus (Proxy @CampusUserConversionException)