chore(lms): WIP reset tries and lock logic part 1

models/lms.model

@@ -117,7 +117,7 @@ LmsUser
   datePin           UTCTime         default=now() -- time pin was created
   status            LmsStatus Maybe               -- Nothing=open, LmsSuccess, LmsBlocked or LmsExpired; status should never change unless isNothing; isJust indicates lms is finished and user shall be deleted from LMS
   --toDelete encoded by Handler.Utils.LMS.lmsUserToDelete
-  statusDay         Day Maybe                     -- date of status change; should be isJust iff isJust status; modelling as a separate table too bothersome, unlike qualification block
+  statusDay         Day Maybe                     -- date of status change; should be isJust iff isJust status; modelling as a separate table too bothersome, unlike qualification block  
   started           UTCTime         default=now()
   received          UTCTime Maybe                 -- last acknowledgement by LMS
   notified          UTCTime Maybe                 -- last notified by FRADrive

src/Handler/LMS/Learners.hs

@@ -40,9 +40,9 @@ lmsUser2csv cutoff lu@LmsUser{..} = LmsUserTableCsv
   , csvLUTpin       = lmsUserPin
   , csvLUTresetPin  = LmsBool  lmsUserResetPin          
   , csvLUTdelete    = LmsBool (lmsUserToDelete cutoff lu)
-  , csvLUTstaff     = LmsBool  False                    
-  , csvLUTresetTries= LmsBool  False -- TODO -- wie wird das festgelegt? Als Attribut in der DB?
-  , csvLUTlock      = LmsBool  False -- TODO -- kann dies rein aus der Zeit berechnet werden?
+  , csvLUTstaff     = LmsBool (lmsUserStaff lu)
+  , csvLUTresetTries= LmsBool (lmsUserToResetTries lu) -- TODO: verify this works as intended!
+  , csvLUTlock      = LmsBool (lmsUserToLock lu)
   }
 
 -- csv without headers
@@ -110,9 +110,9 @@ mkUserTable _sid qsh qid = do
                                                                          ) $ \(view $ _dbrOutput . _entityVal . _lmsUserPin                  -> pin  ) -> textCell pin
           , sortable (Just csvLmsResetPin)  (i18nCell MsgTableLmsResetPin) $ \(view $ _dbrOutput . _entityVal . _lmsUserResetPin             -> reset) -> ifIconCell reset IconReset
           , sortable (Just csvLmsDelete)    (i18nCell MsgTableLmsDelete)   $ \(view $ _dbrOutput . _entityVal . _lmsUserToDelete cutoff           -> del  ) -> ifIconCell del   IconRemoveUser
-          , sortable Nothing                (i18nCell MsgTableLmsStaff)       $ const mempty
-          , sortable Nothing                (i18nCell MsgTableLmsResetTries)  $ const mempty -- TODO
-          , sortable Nothing                (i18nCell MsgTableLmsLock)        $ const mempty -- TODO
+          , sortable Nothing                (i18nCell MsgTableLmsStaff)       $ \(view $ _dbrOutput . _entityVal -> lu) -> iconBoolCell (lmsUserStaff lu)
+          , sortable Nothing                (i18nCell MsgTableLmsResetTries)  $ \(view $ _dbrOutput . _entityVal -> lu) -> iconBoolCell (lmsUserToResetTries lu)
+          , sortable Nothing                (i18nCell MsgTableLmsLock)        $ \(view $ _dbrOutput . _entityVal -> lu) -> ifIconCell   (lmsUserToLock lu) IconLocked
           ]
         dbtSorting = Map.fromList
           [ (csvLmsIdent    , SortColumn (E.^. LmsUserIdent))
@@ -144,9 +144,9 @@ mkUserTable _sid qsh qid = do
               <*> view (_dbrOutput . _entityVal . _lmsUserPin)
               <*> view (_dbrOutput . _entityVal . _lmsUserResetPin . _lmsBool)
               <*> view (_dbrOutput . _entityVal . _lmsUserToDelete cutoff . _lmsBool)
-              <*> const (LmsBool False)
-              <*> const (LmsBool False) -- TODO
-              <*> const (LmsBool False) -- TODO
+              <*> view (_dbrOutput . _entityVal . to lmsUserStaff         . _lmsBool)
+              <*> view (_dbrOutput . _entityVal . to lmsUserToResetTries  . _lmsBool)
+              <*> view (_dbrOutput . _entityVal . to lmsUserToLock        . _lmsBool)
 
         dbtCsvDecode = Nothing
         dbtExtraReps = []

src/Handler/Utils/LMS.hs

@@ -25,6 +25,9 @@ module Handler.Utils.LMS
   , lmsDeletionDate
   , lmsUserToDelete, _lmsUserToDelete
   , lmsUserToDeleteExpr
+  , lmsUserToResetTries
+  , lmsUserToLock
+  , lmsUserStaff
   , lmsStatusInfoCell
   , lmsStatusIcon, lmsUserStatusWidget
   , randomLMSIdent, randomLMSIdentBut
@@ -149,6 +152,16 @@ lmsUserToDelete _ _ = False
 _lmsUserToDelete :: Day -> Getter LmsUser Bool
 _lmsUserToDelete cutoff = to $ lmsUserToDelete cutoff
 
+
+lmsUserToResetTries :: LmsUser -> Bool
+lmsUserToResetTries LmsUser{..} = lmsUserResetTries && lmsUserLocked && lmsUserStatus == Just LmsBlocked -- only reset blocked learners
+
+lmsUserToLock :: LmsUser -> Bool
+lmsUserToLock LmsUser{..} = lmsUserLocked && not (lmsUserResetTries && isNothing lmsUserStatus)
+
+lmsUserStaff :: LmsUser -> Bool
+lmsUserStaff = const False -- legacy, currently ignored
+
 -- random generation of LmsIdentifiers, maybe this should be in Model.Types.Lms since length specifications are type-y?
 
 lengthIdent :: Int

src/Jobs/Handler/LMS.hs

@@ -318,6 +318,10 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
                           E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
                           E.&&. lreport E.^. LmsReportLock          E.==. E.val lockstatus            -- Maybe more efficient, but less readable: bool E.not_ id lockstatus (lreport E.^. LmsReport Lock)
                   )
+      -- TODO: implement tries-reset here: 
+      --    if  | LmsUserResetTries && LmsReportStatus = LmsOpen => LmsUserStatus =. Nothing
+      --        | LmsUserResetTries && LmsUserStatus == Nothing && not LmsReportLock => LmsUserResetTries =. False
+
       -- TODO: check whether this works too:
       -- let updateReceivedLocked' lockstatus = E.update $ \luser -> do -- attempt to use 'from'-clause in update as per PostgreSQL
       --       E.set luser [ LmsUserReceived E.=. E.justVal now