chore(lms): complete import jobs

models/lms.model

@@ -63,7 +63,7 @@ QualificationUser
   -- 
   -- 2. REST GET User.csv:
   --     - where LmsUserReceived == Nothing \/ (LmsUserResetPin /\ LmsUserEnded == Nothing)
-  --     - delete-flag: isJust LmsUserSuccess
+  --     - delete-flag: isJust LmsUserStatus
   --   Note: REST means that LmsUserResetPin and LmsUserDelete remain unchanged by this GET request!
   --
   -- 3. REST POST Userlist.csv:   
@@ -77,13 +77,13 @@ QualificationUser
   --         + if contained, set LmsUserReceived to Just now()
   --         + otherwise,    set LmsUserEnded    to Just now()      
   --     - if LmsUserlistFailed: 
-  --         + set LmsUserSuccess to Just False
+  --         + set LmsUserStatus to Just Day
   --         + set LmsUserDelete  to True 
   --     - move row to LmsAudit
   --
   -- 6. Daily Job LmsResult:
   --     - set LmsUserReceived to Just now()
-  --     - set LmsUserSuccess  to Just True
+  --     - set LmsUserStatus  to Just Day
   --     - move row to LmsAudit
 
 
@@ -92,10 +92,10 @@ LmsUser
   user              UserId
   ident             LmsIdent                    -- must be unique accross all LMS courses!
   pin               Text
-  resetPin          Bool        default=false   -- should pin be reset?
+  resetPin          Bool          default=false -- should pin be reset?
-  success           LmsStatus Maybe                  -- open, success or failure; isJust indicates user will be deleted from LMS 
+  status            LmsStatus Maybe             -- open, success or failure; isJust indicates user will be deleted from LMS 
   --toDelete encoded by Handler.Utils.LMS.lmsUserToDelete
-  started           UTCTime     default=now()
+  started           UTCTime       default=now()
   received          UTCTime Maybe               -- last acknowledgement by LMS 
   ended             UTCTime Maybe               -- ident was deleted from LMS 
   UniqueLmsUser ident -- idents must be unique accross all qualifications, since idents are global within LMS!

src/Database/Esqueleto/Utils.hs

@@ -7,6 +7,7 @@ module Database.Esqueleto.Utils
   , isJust, alt
   , isInfixOf, hasInfix
   , strConcat, substring
+  , (=?.), (?=.)
   , or, and
   , any, all
   , subSelectAnd, subSelectOr
@@ -91,6 +92,14 @@ justVal = E.val . Just
 justValList :: PersistField typ => [typ] -> E.SqlExpr (E.ValueList (Maybe typ))
 justValList = E.valList . map Just
 
+infixl 4 =?.
+(=?.) ::  PersistField typ => E.SqlExpr (E.Value typ) ->  E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
+(=?.) a b = E.just a E.==. b
+
+infixl 4 ?=.
+(?=.) ::  PersistField typ => E.SqlExpr (E.Value (Maybe typ)) ->  E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value Bool)
+(?=.) a b = a E.==. E.just b
+
 -- | Negation of `isNothing` which is missing
 isJust :: PersistField typ => E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
 isJust = E.not_ . E.isNothing

src/Handler/LMS/Result.hs

@@ -19,6 +19,8 @@ import qualified Data.Conduit.List as C
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
 
+import Jobs.Queue
+
 
 data LmsResultTableCsv = LmsResultTableCsv
   { csvLRTident   :: LmsIdent
@@ -166,9 +168,9 @@ mkResultTable sid qsh qid = do
                     }
                   [ LmsResultSuccess          =. lmsResultInsertSuccess actionData
                   , LmsResultTimestamp        =. now
-                  ]
+                  ]                
-                -- queueDBJob?? -- todo
+                -- audit $ Transaction.. (add to Audit.Types)
-                -- audit 
+            lift . queueDBJob $ JobLmsResults qid
             return $ LmsResultR sid qsh 
           , dbtCsvRenderKey           = const $ \case 
               LmsResultInsertData{..} -> do -- TODO: i18n

src/Handler/LMS/Userlist.hs

@@ -19,6 +19,7 @@ import qualified Data.Conduit.List as C
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
 
+import Jobs.Queue
 
 data LmsUserlistTableCsv = LmsUserlistTableCsv
   { csvLULident  :: LmsIdent
@@ -160,9 +161,9 @@ mkUserlistTable sid qsh qid = do
                   [
                     LmsUserlistFailed         =. lmsUserlistInsertFailed  actionData -- TODO: should we allow a reset from failed: True to False?
                   , LmsUserlistTimestamp      =. now
-                  ]      
+                  ]                      
-                -- queueDBJob?? -- todo
+                -- audit               
-                -- audit 
+              lift $ queueDBJob $ JobLmsUserlist qid
               return $ LmsUserlistR sid qsh
             dbtCsvRenderKey = const $ \case 
               LmsUserlistInsertData{..} -> do -- TODO: i18n

src/Handler/LMS/Users.hs

@@ -160,7 +160,7 @@ getLmsUsersDirectR sid qsh = do
           { csvLUTident    = lmsuser Ex.^. LmsUserIdent 
           , csvLUTpin      = lmsuser Ex.^. LmsUserPin 
           , csvLUTresetPin = LmsBool . Ex.unValue $ lmsuser Ex.^. LmsUserResetPin
-          , csvLUTdelete   = LmsBool . Ex.unValue $ Ex.isNothing (lmsuser Ex.^. LmsUserEnded) Ex.&&. Ex.not_ (Ex.isNothing $ lmsuser Ex.^. LmsUserSuccess)
+          , csvLUTdelete   = LmsBool . Ex.unValue $ Ex.isNothing (lmsuser Ex.^. LmsUserEnded) Ex.&&. Ex.not_ (Ex.isNothing $ lmsuser Ex.^. LmsUserStatus)
           , csvLUTstaff    = LmsBool False
           }
       -} 

src/Handler/Utils/LMS.hs

@@ -75,10 +75,10 @@ getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime
 
 -- | Deceide whether LMS platform should delete an identifier
 lmsUserToDeleteExpr :: E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
-lmsUserToDeleteExpr lmslist = E.isNothing (lmslist E.^. LmsUserEnded) E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserSuccess)
+lmsUserToDeleteExpr lmslist = E.isNothing (lmslist E.^. LmsUserEnded) E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserStatus)
 
 lmsUserToDelete :: LmsUser -> Bool 
-lmsUserToDelete LmsUser{lmsUserEnded, lmsUserSuccess} = isNothing lmsUserEnded && isJust lmsUserSuccess
+lmsUserToDelete LmsUser{lmsUserEnded, lmsUserStatus} = isNothing lmsUserEnded && isJust lmsUserStatus
 
 _lmsUserToDelete :: Getter LmsUser Bool 
 _lmsUserToDelete = to lmsUserToDelete

src/Jobs/Handler/LMS.hs

@@ -11,7 +11,7 @@ import Import
 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 qualified Database.Esqueleto.Utils as E
 
 
 dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX
@@ -40,7 +40,7 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
                           E.<&> (luser   E.^. LmsUserEnded)
         )
         (\current _excluded ->
-          [ LmsUserSuccess E.=. current E.^. LmsUserSuccess, LmsUserReceived E.=. current E.^. LmsUserReceived ] -- I believe this list could just be empty, since excluded is not uses?!
+          [ LmsUserStatus E.=. current E.^. LmsUserStatus, LmsUserReceived E.=. current E.^. LmsUserReceived ] -- I believe this list could just be empty, since excluded is not uses?!
         )
       -- Unclear how to delete here
       -}
@@ -50,14 +50,14 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
             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_ $ lresult E.^. LmsResultQualification E.==. E.val qid
+        E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
-                  E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners
+          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 lstatus   = lmsResultSuccess   lresult & LmsSuccess 
+        let lreceived = lmsResultTimestamp lresult 
-            lreceived = lmsResultTimestamp lresult 
+            lstatus   = lmsResultSuccess   lresult & LmsSuccess 
-        update luid [ LmsUserSuccess  =. Just lstatus
+        update luid [ LmsUserStatus   =. Just lstatus
                     , LmsUserReceived =. Just lreceived 
                     ]
         insert_ $ LmsAudit qid (lmsUserIdent luser) lstatus lreceived now
@@ -65,4 +65,31 @@ dispatchJobLmsResults qid = JobHandlerAtomic act
       $logInfoS "LmsResult" [st|Processed ${tshow (length results)} LMS results|]
 
 dispatchJobLmsUserlist :: QualificationId -> JobHandler UniWorX
-dispatchJobLmsUserlist _qid = JobHandlerAtomic $ return ()
+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) -> 
+          update luid [LmsUserEnded =. Just now]
+
+        (Entity luid luser, Just (Entity lulid lulist)) -> do           
+          let lreceived = lmsUserlistTimestamp lulist
+              lblocked  = lmsUserlistFailed    lulist
+              lstatus   = LmsBlocked $ utctDay lreceived
+          update luid $ [ LmsUserStatus   =. Just lstatus   | lblocked ]        
+                     <> [ LmsUserReceived =. Just lreceived ]
+          when lblocked . insert_ $ LmsAudit qid (lmsUserIdent luser) lstatus lreceived now
+          delete lulid
+
+      $logInfoS "LmsUserlist" [st|Processed LMS Userlist with ${tshow (length results)} entries|]

src/Model/Types/Lms.hs

@@ -33,10 +33,10 @@ data LmsStatus = LmsBlocked { lmsStatusDay :: Day }
   deriving (Eq, Ord, Read, Show, Generic, Typeable, NFData)
 
 deriveJSON  defaultOptions
-  { constructorTagModifier = camelToPathPiece' 1  
+  { constructorTagModifier = camelToPathPiece' 1      -- remove lms from constructor, since the object is tagged with lms already
-  , fieldLabelModifier = camelToPathPiece' 1
+  , fieldLabelModifier     = camelToPathPiece' 2      -- just day suffices for the day field
   , omitNothingFields = True
-  , sumEncoding = TaggedObject "lmsaudit" "lmsaction"
+  , sumEncoding = TaggedObject "lms-status" "lms-result"
   } ''LmsStatus
 derivePersistFieldJSON ''LmsStatus