-- SPDX-FileCopyrightText: 2022-2023 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Jobs.Handler.SynchroniseAvs
  ( dispatchJobSynchroniseAvs
  -- , dispatchJobSynchroniseAvsId
  -- , dispatchJobSynchroniseAvsUser
  , dispatchJobSynchroniseAvsQueue
  , dispatchJobSynchroniseAvsLicences
  , dispatchJobSynchroniseByAvsDataContact
  ) where

import Import

import qualified Data.Text            as Text
import qualified Data.Set             as Set
-- import qualified Data.Map             as Map
import qualified Data.Conduit.List as C

import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
-- import qualified Database.Esqueleto.Legacy as E hiding (upsert)
-- import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Utils as E

import Jobs.Queue

import Handler.Utils.Avs
import Handler.Utils.Qualification

-- pause is a date in the past; don't synch again if the last synch was after pause
dispatchJobSynchroniseAvs :: Natural -> Natural -> Natural -> Maybe Day -> JobHandler UniWorX
dispatchJobSynchroniseAvs numIterations epoch iteration pause
  = JobHandlerException . runDB $ do
      now <- liftIO getCurrentTime
      todos <- runConduit $ readUsers .| filterIteration now .| sinkList
      putMany todos
      $logInfoS "SynchronisAvs" [st|AVS synch summary for #{tshow numIterations}/#{tshow epoch}/#{tshow iteration}: #{length todos}|]
      void $ queueJob JobSynchroniseAvsQueue
  where
    readUsers :: ConduitT () UserId _ ()
    readUsers = selectKeys [] []

    filterIteration :: UTCTime -> ConduitT UserId AvsSync _ ()
    filterIteration now = 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 "SynchronisAvs" [st|User ##{tshow (fromSqlKey userId)}: AVS sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|]
      guard $ userIteration == currentIteration
      return $ AvsSync userId now pause

-- dispatchJobSynchroniseAvsId :: AvsPersonId -> Maybe Day -> JobHandler UniWorX
-- dispatchJobSynchroniseAvsId apid pause = JobHandlerException $
--     maybeM insertUnknown processKnown $ runDB $ getBy (UniqueUserAvsId apid)
--   where
--     processKnown Entity{entityVal=UserAvs{userAvsUser=uid}} = workJobSychronizeAvs uid pause
--     insertUnknown = void $ maybeCatchAll $ Just <$> upsertAvsUserById apid

-- dispatchJobSynchroniseAvsUser :: UserId -> Maybe Day -> JobHandler UniWorX
-- dispatchJobSynchroniseAvsUser uid pause = JobHandlerException $ workJobSychronizeAvs uid pause

-- workJobSychronizeAvs :: UserId -> Maybe Day -> Handler ()
-- workJobSychronizeAvs uid pause = do
--     now <- liftIO getCurrentTime
--     -- void $ E.upsert
--     --   AvsSync { avsSyncUser         = uid
--     --           , avsSyncCreationTime = now
--     --           , avsSyncPause        = pause
--     --           }
--     --   [ \oldSync -> (AvsSyncPause E.=. E.greatest (E.val pause) (oldSync E.^. AvsSyncPause)) oldSync ] -- causes Esqueleto to call undefined at Database.Esqueleto.Internal.Internal.renderUpdates:1308
--     runDB $ maybeM
--       (insert_ AvsSync{avsSyncUser=uid, avsSyncCreationTime=now, avsSyncPause=pause})
--       (\Entity{entityKey=asid, entityVal=AvsSync{avsSyncPause=oldPause}} ->
--         update asid [AvsSyncPause =. max pause oldPause, AvsSyncCreationTime =. now])
--       (getBy $ UniqueAvsSyncUser uid)
--     void $ queueJob JobSynchroniseAvsQueue


-- dispatchJobSynchroniseAvsQueue :: JobHandler UniWorX
-- dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
--     (unlinked,linked) <- runDB $ do
--       jobs <- E.select (do
--           (avsSync :& usrAvs) <- E.from $  E.table @AvsSync
--                               `E.leftJoin` E.table @UserAvs
--             `E.on` (\(avsSync :& usrAvs) -> avsSync E.^. AvsSyncUser E.=?. usrAvs E.?. UserAvsUser)
--           let pause    = avsSync E.^. AvsSyncPause
--               lastSync = usrAvs  E.?. UserAvsLastSynch
--           E.where_ $  E.isNothing pause
--                 E.||. E.isNothing lastSync
--                 E.||. pause E.>. E.dayMaybe lastSync
--           return (avsSync E.^. AvsSyncId, avsSync E.^. AvsSyncUser, usrAvs E.?. UserAvsPersonId)
--         )
--       let (syncIds, unlinked, linked) = foldl' discernJob mempty jobs
--       E.deleteWhere [AvsSyncId <-. syncIds]
--       return (unlinked, linked)

--     void $ updateAvsUserByIds  linked
--     void $ linktoAvsUserByUIDs unlinked
--     -- we do not reschedule failed synchs here in order to avoid a loop
--   where
--     discernJob (accSync, accUid, accApi) (E.Value k,           _, E.Value (Just api)) = (k:accSync, accUid, Set.insert api accApi)
--     discernJob (accSync, accUid, accApi) (E.Value k, E.Value uid, E.Value  Nothing  ) = (k:accSync, Set.insert uid accUid, accApi)

dispatchJobSynchroniseAvsQueue :: JobHandler UniWorX
dispatchJobSynchroniseAvsQueue = JobHandlerException $ do
    jobs <- runDBRead $ do
      E.select (do
          (avsSync :& usrAvs) <- E.from $  E.table @AvsSync
                              `E.leftJoin` E.table @UserAvs
            `E.on` (\(avsSync :& usrAvs) -> avsSync E.^. AvsSyncUser E.=?. usrAvs E.?. UserAvsUser)
          let pause    = avsSync E.^. AvsSyncPause
              lastSync = usrAvs  E.?. UserAvsLastSynch
              proceed  =        E.isNothing pause
                          E.||. E.isNothing lastSync
                          E.||. pause E.>. E.dayMaybe lastSync
          -- E.where_ proceed -- we still want to delete all paused jobs, rather than to delay them only
          return (avsSync E.^. AvsSyncUser, usrAvs E.?. UserAvsPersonId, proceed)
        )
      -- now <- liftIO getCurrentTime
      -- E.truncateTable $ AvsSync (error "truncateTable: AvsSyncUser not needed") now Nothing
      -- return jobs
    let (unlinked, linked) = foldl' discernJob mempty jobs
    $logInfoS "SynchronisAvs" [st|AVS synch start for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
    void $ updateAvsUserByIds  linked
    void $ linktoAvsUserByUIDs unlinked
    runDB $ deleteWhere [AvsSyncUser <-. (E.unValue . fst3 <$> jobs)]
    $logInfoS "SynchronisAvs" [st|AVS synch end for #{length linked} AVS linked users and #{length unlinked} unlinked users|]
    -- we do not reschedule failed synchs here in order to avoid a loop
  where
    discernJob accs (         _ , E.Value (Just api), E.Value True  ) = accs & over _2 (Set.insert api)
    discernJob accs (E.Value uid, E.Value  Nothing  , E.Value True  ) = accs & over _1 (Set.insert uid)
    discernJob accs (         _ ,                 _ , E.Value False ) = accs


-----------------
-- AVS Licences

dispatchJobSynchroniseAvsLicences :: JobHandler UniWorX
-- dispatchJobSynchroniseAvsLicences = error "TODO"
dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel > 0) $ do
  AvsLicenceSynchConf
    { avsLicenceSynchLevel        = synchLevel   -- SynchLevel corresponds to tables of ProblemAvsSynchR: 4=top grant R, 3= reduce R->F, 2= grant F, 1= revoke F
    , avsLicenceSynchReasonFilter = reasonFilter
    , avsLicenceSynchMaxChanges   = maxChanges
    } <- getsYesod $ view _appAvsLicenceSynchConf

  let procLic :: AvsLicence -> Bool -> Set AvsPersonId -> Handler ()
      procLic aLic up apids
        | n <- Set.size apids, n > 0 =
          let subtype = Text.cons (bool '↧' '↥' up) $ Text.singleton $ licence2char aLic
              logit errm = runDB $ logInterface' "AVS" subtype False (isNothing errm) (Just n) (fromMaybe "Automatic synch" errm)
              catchAllAvs = flip catch (\err -> logit (Just $ tshow (err :: SomeException)) >> return (-1))
          in if NTop (Just n) <= NTop maxChanges
              then do
                oks <- catchAllAvs $ setLicencesAvs $ Set.map (AvsPersonLicence aLic) apids
                when (oks > 0) $ logit $ toMaybe (oks /= n) [st|Only #{tshow oks}/#{tshow n} licence changes accepted by AVS|]
              else
                logit $ Just [st|Too many changes at once. Consider increasing avs-licence-synch-max-changes #{tshow maxChanges}|]
        | otherwise = return ()

  (AvsLicenceDifferences{..}, rsChanged) <- retrieveDifferingLicences
  -- prevent automatic changes to users blocked with certain reasons and with currently being associated with multiple companies
  reasonFltrdIds <- ifNothingM reasonFilter mempty $ \reasons -> do
    now <- liftIO getCurrentTime
    firmBlocks <- runDBRead $ E.select $ do
      (uavs :& _qualUser :& qblock) <- E.from $ E.table @UserAvs
        `E.innerJoin` E.table @QualificationUser      `E.on` (\(uavs :& qualUser) -> uavs E.^. UserAvsUser E.==. qualUser E.^. QualificationUserUser)
        `E.innerJoin` E.table @QualificationUserBlock `E.on` (\(_uavs :& qualUser :& qblock) ->
            qualUser E.^. QualificationUserId E.==. qblock E.^. QualificationUserBlockQualificationUser
            E.&&. qblock `isLatestBlockBefore'` E.val now)
      E.where_ $ (qblock E.^. QualificationUserBlockReason E.~*. E.val reasons)
          E.&&.  uavs E.^. UserAvsPersonId `E.in_` E.vals (Set.unions [avsLicenceDiffRevokeAll, avsLicenceDiffRevokeRollfeld, avsLicenceDiffGrantVorfeld, avsLicenceDiffGrantRollfeld])
      return $ uavs E.^. UserAvsPersonId
    return $ Set.fromList $ map E.unValue firmBlocks

  let fltrIds
        | synchLevel >= 5 = id
        | synchLevel >= 3 = flip Set.difference   reasonFltrdIds
        | otherwise       = flip Set.difference $ reasonFltrdIds `Set.union` rsChanged

  when (synchLevel >= 1) $ procLic AvsNoLicence       False $ fltrIds avsLicenceDiffRevokeAll        --revoke    Vorfeld and maybe also Rollfeld
  when (synchLevel >= 2) $ procLic AvsLicenceVorfeld  True  $ fltrIds avsLicenceDiffGrantVorfeld     --grant     Vorfeld
  when (synchLevel >= 3) $ procLic AvsLicenceVorfeld  False $ fltrIds avsLicenceDiffRevokeRollfeld   --downgrade Rollfeld -> Vorfeld
  when (synchLevel >= 4) $ procLic AvsLicenceRollfeld True  $ fltrIds avsLicenceDiffGrantRollfeld    --grant     Rollfeld


-- | delayed exection of already received contact info
dispatchJobSynchroniseByAvsDataContact :: AvsDataContact -> JobHandler UniWorX
dispatchJobSynchroniseByAvsDataContact adc =
  JobHandlerException . runDB . void $ updateAvsUserByADC adc