{-# LANGUAGE TypeApplications #-}

module Jobs.Handler.LMS 
  ( dispatchJobLmsQualificationsEnqueue
  , dispatchJobLmsQualificationsDequeue
  , dispatchJobLmsEnqueue, dispatchJobLmsEnqueueUser
  , dispatchJobLmsDequeue
  , dispatchJobLmsResults
  , dispatchJobLmsUserlist
  ) where 

import Import    
import Jobs.Queue

-- import Jobs.Handler.Intervals.Utils
import qualified Database.Esqueleto.Experimental as E
--import qualified Database.Esqueleto.Legacy as E
-- import qualified Database.Esqueleto.PostgreSQL as E -- for insertSelect variant
import qualified Database.Esqueleto.Utils as E

import Handler.Utils.DateTime (fromMonths, addMonths)
import Handler.Utils.LMS (randomLMSIdent, randomLMSpw, maxLmsUserIdentRetries)


dispatchJobLmsQualificationsEnqueue :: JobHandler UniWorX
dispatchJobLmsQualificationsEnqueue = JobHandlerAtomic act
  where
    act :: YesodJobDB UniWorX ()
    act = do 
      qids <- E.select $ do 
                q <- E.from $ E.table @Qualification
                E.where_ $  E.isJust (q E.^. QualificationRefreshWithin)
                    -- E.&&. q E.^. QualificationElearningStart -- checked later, since we need to send out notifications regardless
                pure $ q E.^. QualificationId
      forM_ qids $ \(E.unValue -> qid) ->
        queueDBJob $ JobLmsEnqueue qid 


-- | enlist expiring qualification holders to e-learning 
--   NOTE: getting rid of QualificationId parameter and using a DB-join fails, since addGregorianDurationClip cannot be performed within DB
dispatchJobLmsEnqueue :: QualificationId -> JobHandler UniWorX
dispatchJobLmsEnqueue qid = JobHandlerAtomic act
  where     
    -- act :: YesodJobDB UniWorX ()
    act = do
      $logInfoS "lms" $ "Start e-learning users for qualification " <> tshow qid <> "."        
      quali <- getJust qid -- may throw an error, aborting the job
      now <- liftIO getCurrentTime      
      case qualificationRefreshWithin quali of 
        Nothing -> return () -- no automatic scheduling for this qid 
        (Just renewalPeriod) -> do
          let nowaday     = utctDay now
              renewalDate = addGregorianDurationClip renewalPeriod nowaday
          renewalUsers <- E.select $ do
            quser <- E.from $ E.table @QualificationUser 
            E.where_ $  quser E.^. QualificationUserQualification E.==. E.val qid 
                  E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
                  E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val renewalDate
                  E.&&. E.notExists (do
                          luser <- E.from $ E.table @LmsUser
                          E.where_ $  luser E.^. LmsUserQualification E.==. E.val qid 
                                E.&&. luser E.^. LmsUserUser E.==. quser E.^. QualificationUserUser
                        )
            pure quser
          let usr_job :: Entity QualificationUser -> Job 
              usr_job quser = 
                let uid = quser ^. _entityVal . _qualificationUserUser      
                    uex = quser ^. _entityVal . _qualificationUserValidUntil
                in if qualificationElearningStart quali
                    then JobLmsEnqueueUser { jQualification = qid, jUser = uid  }
                    else JobSendNotification { jRecipient = uid, jNotification = 
                              NotificationQualificationExpiry { nQualification = qid, nExpiry = uex }
                         }
          forM_ renewalUsers (queueDBJob . usr_job)
      case qualificationAuditDuration quali of 
        Nothing -> return () -- no automatic removal
        (Just auditDuration) -> 
          let deleteDate = addMonths auditDuration now
          in  deleteWhere [LmsUserQualification ==. qid, LmsUserEnded !=. Nothing, LmsUserEnded >. Just deleteDate]

dispatchJobLmsEnqueueUser :: QualificationId -> UserId -> JobHandler UniWorX
dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act 
  where 
    act :: YesodJobDB UniWorX ()
    act = do 
      now <- liftIO getCurrentTime
      let mkLmsUser lid lpin = LmsUser
            { lmsUserQualification = qid
            , lmsUserUser          = uid 
            , lmsUserIdent         = lid 
            , lmsUserPin           = lpin 
            , lmsUserResetPin      = False 
            , lmsUserDatePin       = now
            , lmsUserStatus        = Nothing
            , lmsUserStarted       = now 
            , lmsUserReceived      = Nothing
            , lmsUserEnded         = Nothing 
            }
          -- startLmsUser :: YesodJobDB UniWorX (Maybe (Entity LmsUser))
          startLmsUser = E.insertUniqueEntity =<< (mkLmsUser <$> randomLMSIdent <*> randomLMSpw)
      inserted <- untilJustMaxM maxLmsUserIdentRetries startLmsUser
      case inserted of 
        Nothing  -> $logErrorS "LMS" $ "Generating and inserting fresh LmsIdent failed for uid " <> tshow uid <> " and qid " <> tshow qid <> "!"
        (Just _) -> queueDBJob JobSendNotification { jRecipient = uid, jNotification = 
                        NotificationQualificationRenewal { nQualification = qid }
                      }


dispatchJobLmsQualificationsDequeue :: JobHandler UniWorX
dispatchJobLmsQualificationsDequeue = JobHandlerAtomic act
  where
    act :: YesodJobDB UniWorX ()
    act = do 
      qids <- E.select $ do 
                q <- E.from $ E.table @Qualification
                E.where_ $  E.isJust (q E.^. QualificationRefreshWithin)
                    -- E.&&. q E.^. QualificationElearningStart -- checked later, since we need to send out notifications regardless
                pure $ q E.^. QualificationId
      forM_ qids $ \(E.unValue -> qid) ->        
        queueDBJob $ JobLmsEnqueue qid 

dispatchJobLmsDequeue :: QualificationId -> JobHandler UniWorX
dispatchJobLmsDequeue qid = JobHandlerAtomic act
  -- wenn bestanden: qualification verlängern 
  -- wenn Aufbewahrungszeit abgelaufen: LmsIdent löschen (verhindert verfrühten neustart)
  where 
    act = do
      $logInfoS "lms" $ "Process e-learning results for qualification " <> tshow qid <> "."        
      quali <- getJust qid -- may throw an error, aborting the job
      case qualificationRefreshWithin quali of 
        Nothing -> return () -- no automatic scheduling for this qid 
        (Just renewalPeriod) -> do
          nowaday <- utctDay <$> liftIO getCurrentTime
          let renewalDate = addGregorianDurationClip renewalPeriod nowaday
          
          -- CONTINUE HERE:
          --   select users that need renewal due to success
          --   delete users after audit period has expired            

          renewalUsers <- E.select $ do
            (quser E.:& luser) <- E.from $ E.table @QualificationUser `E.innerJoin` E.table @LmsUser
                    `E.on` (\(quser E.:& luser) -> quser E.^. QualificationUserUser          E.==. luser E.^. LmsUserUser
                                            E.&&.  quser E.^. QualificationUserQualification E.==. luser E.^. LmsUserQualification
                            )
            E.where_ $  E.val qid E.==. quser E.^. QualificationUserQualification 
                  E.&&. E.val qid E.==. luser E.^. LmsUserQualification             
                  E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday              -- still valid
                  E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val renewalDate          -- due to renewal
                  E.&&. E.isJust (luser E.^. LmsUserStatus) -- TODO: should check for success   -- result already known                                 
            pure (quser, luser)
          let usr_job (quser, luser) = 
                let vold   = quser ^. _entityVal . _qualificationUserValidUntil
                    pmonth = fromMonths $ fromMaybe 0 $ qualificationValidDuration quali -- TODO: decide how to deal with qualfication that have infinite validity?!
                    vnew   = addGregorianDurationClip pmonth vold
                    lmsstatus = luser ^. _entityVal . _lmsUserStatus
                in case lmsstatus of 
                  Just (LmsSuccess refreshDay) -> update (quser ^. _entityKey) [QualificationUserValidUntil =. vnew, QualificationUserLastRefresh =. refreshDay] 
                  _ -> return ()
          forM_ renewalUsers usr_job


dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX
dispatchJobLmsResults qid = JobHandlerAtomic act 
  where
    -- act :: YesodJobDB UniWorX ()
    act = hoist lift $ do
      now <- liftIO getCurrentTime
      -- result :: [(Entity LmsUser, Entity LmsResult)]
      results <- E.select $ do 
        (luser E.:& lresult) <- E.from $ 
            E.table @LmsUser `E.innerJoin` E.table @LmsResult 
            `E.on` (\(luser E.:& lresult) -> luser E.^. LmsUserIdent         E.==. lresult E.^. LmsResultIdent 
                                       E.&&. luser E.^. LmsUserQualification E.==. lresult E.^. LmsResultQualification)
        E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
          E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners
        return (luser, lresult)
      forM_ results $ \(Entity luid luser, Entity lrid lresult) -> do 
        -- three separate DB operations per result is not so nice. All within one transaction though.
        let lreceived = lmsResultTimestamp lresult 
            newStatus = lmsResultSuccess   lresult & LmsSuccess 
            oldStatus = lmsUserStatus luser
            saneDate  = lmsResultSuccess   lresult `inBetween` (utctDay $ lmsUserStarted luser, utctDay now)
        -- always log success, since this is only transmitted once
        if saneDate 
          then  
            update luid [ LmsUserStatus   =. (oldStatus <> Just newStatus)
                        , LmsUserReceived =. Just lreceived 
                        ]
          else 
            $logErrorS "LmsResult" [st|LMS success with insane date #{tshow (lmsResultSuccess lresult)} received|]
        insert_ $ LmsAudit qid (lmsUserIdent luser) newStatus lreceived now
        delete lrid                   
      $logInfoS "LmsResult" [st|Processed #{tshow (length results)} LMS results|]

dispatchJobLmsUserlist :: QualificationId -> JobHandler UniWorX
dispatchJobLmsUserlist  qid = JobHandlerAtomic act 
  where
    -- act :: YesodJobDB UniWorX ()
    act = hoist lift $ do
      now <- liftIO getCurrentTime
      -- result :: [(Entity LmsUser, Entity LmsUserlist)]
      results <- E.select $ do 
        (luser E.:& lulist) <- E.from $ 
            E.table @LmsUser `E.leftJoin` E.table @LmsUserlist
            `E.on` (\(luser E.:& lulist) ->  luser E.^. LmsUserIdent         E.=?. lulist E.?. LmsUserlistIdent 
                                       E.&&. luser E.^. LmsUserQualification E.=?. lulist E.?. LmsUserlistQualification)
        E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
                  E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners
        return (luser, lulist)
      forM_ results $ \case 
        (Entity luid luser, Nothing) 
          | isJust    $ lmsUserReceived luser
          , isNothing $ lmsUserEnded    luser ->            
              update luid [LmsUserEnded =. Just now]
          | otherwise -> return () -- likely not yet started

        (Entity luid luser, Just (Entity lulid lulist)) -> do           
          let lReceived = lmsUserlistTimestamp lulist
              isBlocked = lmsUserlistFailed lulist
              newStatus = LmsBlocked $ utctDay lReceived
              oldStatus = lmsUserStatus luser
          update luid   [ LmsUserStatus   =. (oldStatus <> toMaybe isBlocked newStatus)
                        , LmsUserReceived =. Just lReceived ]
          when isBlocked . insert_ $ LmsAudit qid (lmsUserIdent luser) newStatus lReceived now -- always log blocked
          delete lulid

      $logInfoS "LmsUserlist" [st|Processed LMS Userlist with ${tshow (length results)} entries|]
