chore(lms): implement job handler to enqueue renewals

models/lms.model

@@ -58,9 +58,9 @@ QualificationUser
   -- LMS Interface Tables, need regular processing by background jobs, per QualificationId:
   -- 
   -- 1. Daily Job: Add to LmsUser daily all qualification holders with 
-  --       0 <= QualificationUserValidUntil - now  < QualificationRefreshWithin  (time to schedule refresher)
-  --       /\ now - max(LmsUserStarted) > QualificationRefreshWithin             (not already enlisted; Problem: QualificationELearningOnly!)        
-  --    generate fresh ident and pin. (Bools?)
+  --          QualificationUserValidUntil >= now 
+  --       /\ QualificationUserValudUntil <= now + QualificationRefreshWithin    (time to schedule refresher)
+  --       /\ not already enlisted  
   -- 
   -- 2. REST GET User.csv:
   --     - where LmsUserReceived == Nothing \/ (LmsUserResetPin /\ LmsUserEnded == Nothing)

src/Jobs/Handler/LMS.hs

@@ -1,13 +1,14 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Jobs.Handler.LMS 
-  ( dispatchJobLmsEnqueue
+  ( dispatchJobLmsEnqueue, dispatchJobLmsEnqueueUser
   , dispatchJobLmsDequeue
   , dispatchJobLmsResults
   , dispatchJobLmsUserlist
   ) where 
 
 import Import    
+import Jobs.Queue
 
 -- import Jobs.Handler.Intervals.Utils
 import qualified Database.Esqueleto.Experimental as E
@@ -18,14 +19,32 @@ import qualified Database.Esqueleto.Utils as E
 -- import Handler.Utils.DateTime (addDiffDays)
 
 dispatchJobLmsEnqueue :: QualificationId -> JobHandler UniWorX
-dispatchJobLmsEnqueue _qid = JobHandlerAtomic act
+dispatchJobLmsEnqueue qid = JobHandlerAtomic act
   where 
     -- act :: YesodJobDB UniWorX ()
-    act = hoist lift $ do      
-      {-
-      now <- liftIO getCurrentTime
-      mbq <- E.selectOne $ E.from $ \quali -> E.where_ (quali E.^. QualificationId E.==. E.val qid) >> pure quali      
-      -- Just quali <- get qid 
+    act = do
+      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
+          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 E.^. QualificationUserUser)
+          forM_ renewalUsers (\uid -> queueDBJob JobLmsEnqueueUser { jQualification = qid, jUser = E.unValue uid } )
+
+
+{-
+      hoist lift $ do            
       
       let (Entity _ quali) = fromMaybe (error "TODO") mbq  -- HACK / TODO
           refreshTime = fromMaybe (error "TODO") $ qualificationRefreshWithin quali -- HACK / TODO
@@ -51,7 +70,7 @@ dispatchJobLmsEnqueue _qid = JobHandlerAtomic act
             E.<# E.val qid 
             E.<&> (quser E.^. QualificationUserUser)               
             E.<&> E.val freshIdent -- ident     -- THIS IS A PROBLEM! MUST ALSO BE UNIQUE!
-            E.<&> E.val freshPin   -- pin       -- THIS IS A PROBLEM!
+            E.<&> E.val freshPin   -- pin       -- can be done: E.unsafeSqlFunction "substring(gen_random_uuid()::text from 1  for 8)"
             E.<&> E.false          -- reset
             E.<&> E.nothing        -- status
             E.<&> E.val now        -- started
@@ -60,15 +79,22 @@ dispatchJobLmsEnqueue _qid = JobHandlerAtomic act
         )
       
       -- find qualification holders
-      -}
+      -
       error "lms dequeu stub"
+      -}
+
+dispatchJobLmsEnqueueUser :: QualificationId -> UserId -> JobHandler UniWorX
+dispatchJobLmsEnqueueUser _qid _uid = 
+  -- lident <- randomLMSIdent 
+  -- lpw    <- randomLMSpw
+  error "lms enqueue user stub"
 
 dispatchJobLmsDequeue :: QualificationId -> JobHandler UniWorX
 dispatchJobLmsDequeue _qid = 
   -- wenn bestanden: qualification verlängern & LmsIdent löschen
   -- wenn durchgefallen: LmsIdent löschen
   -- wenn Zeit abgelaufen: LmsIdent löschen 
-  error "lms dequeu stub"
+  error "lms dequeue stub"
 
 dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX
 dispatchJobLmsResults qid = JobHandlerAtomic act 

src/Jobs/Types.hs

@@ -105,10 +105,11 @@ data Job
                                      , jEpoch
                                      , jIteration :: Natural
                                      }
-  | JobLmsEnqueue  { jQualification :: QualificationId }
-  | JobLmsDequeue  { jQualification :: QualificationId }
-  | JobLmsUserlist { jQualification :: QualificationId }
-  | JobLmsResults  { jQualification :: QualificationId }
+  | JobLmsEnqueue     { jQualification :: QualificationId }
+  | JobLmsEnqueueUser { jQualification :: QualificationId, jUser :: UserId }
+  | JobLmsDequeue     { jQualification :: QualificationId }
+  | JobLmsUserlist    { jQualification :: QualificationId }
+  | JobLmsResults     { jQualification :: QualificationId }
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 data Notification
   = NotificationSubmissionRated { nSubmission :: SubmissionId }