module Jobs.Handler.SynchroniseLdap
  ( dispatchJobSynchroniseLdap, dispatchJobSynchroniseLdapUser
  , SynchroniseLdapException(..)
  ) where

import Import

import qualified Data.Conduit.List as C

import Auth.LDAP

import Jobs.Queue
  

data SynchroniseLdapException
  = SynchroniseLdapNoLdap
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
instance Exception SynchroniseLdapException

dispatchJobSynchroniseLdap :: Natural -> Natural -> Natural -> JobHandler UniWorX
dispatchJobSynchroniseLdap 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 "SynchroniseLdap" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|]
      guard $ userIteration == currentIteration

      return $ JobSynchroniseLdapUser userId

dispatchJobSynchroniseLdapUser :: UserId -> JobHandler UniWorX
dispatchJobSynchroniseLdapUser jUser = JobHandlerException $ do
  UniWorX{..} <- getYesod
  case appLdapPool of
    Just ldapPool -> 
      runDB . void . runMaybeT . handleExc $ do
        user@User{userIdent} <- MaybeT $ get jUser

        $logInfoS "SynchroniseLdap" [st|Synchronising #{userIdent}|]

        reTestAfter <- getsYesod $ view _appLdapReTestFailover
        ldapAttrs <- MaybeT $ campusUserReTest' ldapPool ((>= reTestAfter) . realToFrac) FailoverUnlimited user
        void . lift $ upsertCampusUser UpsertCampusUser ldapAttrs
    Nothing ->
      throwM SynchroniseLdapNoLdap
  where
    handleExc :: MaybeT DB a -> MaybeT DB a
    handleExc
      = catchMPlus (Proxy @CampusUserException)
      . catchMPlus (Proxy @CampusUserConversionException)