chore(lms): add primary lms job handler for kickoff of all qualifications
This commit is contained in:
parent
49ccb35035
commit
f1021d4e10
@ -1,7 +1,8 @@
|
|||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
module Jobs.Handler.LMS
|
module Jobs.Handler.LMS
|
||||||
( dispatchJobLmsEnqueue, dispatchJobLmsEnqueueUser
|
( dispatchJobLmsQualifications
|
||||||
|
, dispatchJobLmsEnqueue, dispatchJobLmsEnqueueUser
|
||||||
, dispatchJobLmsDequeue
|
, dispatchJobLmsDequeue
|
||||||
, dispatchJobLmsResults
|
, dispatchJobLmsResults
|
||||||
, dispatchJobLmsUserlist
|
, dispatchJobLmsUserlist
|
||||||
@ -20,9 +21,25 @@ import qualified Database.Esqueleto.Utils as E
|
|||||||
import Handler.Utils.LMS (randomLMSIdent, randomLMSpw, maxLmsUserIdentRetries)
|
import Handler.Utils.LMS (randomLMSIdent, randomLMSpw, maxLmsUserIdentRetries)
|
||||||
|
|
||||||
|
|
||||||
|
dispatchJobLmsQualifications :: JobHandler UniWorX
|
||||||
|
dispatchJobLmsQualifications = JobHandlerAtomic act
|
||||||
|
where
|
||||||
|
act :: YesodJobDB UniWorX ()
|
||||||
|
act = do
|
||||||
|
qids <- E.select $ do
|
||||||
|
q <- E.from $ E.table @Qualification
|
||||||
|
E.where_ $ q E.^. QualificationElearningStart
|
||||||
|
E.&&. E.isJust (q E.^. QualificationRefreshWithin)
|
||||||
|
pure $ q E.^. QualificationId
|
||||||
|
forM_ qids $ \(E.unValue -> qid) -> do
|
||||||
|
$logInfoS "lms" $ "Start e-learning for qualification " <> tshow qid <> "."
|
||||||
|
queueDBJob $ JobLmsEnqueue qid
|
||||||
|
|
||||||
|
|
||||||
dispatchJobLmsEnqueue :: QualificationId -> JobHandler UniWorX
|
dispatchJobLmsEnqueue :: QualificationId -> JobHandler UniWorX
|
||||||
dispatchJobLmsEnqueue qid = JobHandlerAtomic act
|
dispatchJobLmsEnqueue qid = JobHandlerAtomic act
|
||||||
where
|
where
|
||||||
|
-- TODO: get rid of QualificationId Parameter and use a join instead? Fails since addGregorianDurationClip cannot be performed within DB
|
||||||
-- act :: YesodJobDB UniWorX ()
|
-- act :: YesodJobDB UniWorX ()
|
||||||
act = do
|
act = do
|
||||||
quali <- getJust qid -- may throw an error, aborting the job
|
quali <- getJust qid -- may throw an error, aborting the job
|
||||||
@ -63,10 +80,10 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
|
|||||||
, lmsUserEnded = Nothing
|
, lmsUserEnded = Nothing
|
||||||
}
|
}
|
||||||
-- startLmsUser :: YesodJobDB UniWorX (Maybe (Entity LmsUser))
|
-- startLmsUser :: YesodJobDB UniWorX (Maybe (Entity LmsUser))
|
||||||
startLmsUser = insertUniqueEntity =<< (mkLmsUser <$> randomLMSIdent <*> randomLMSpw)
|
startLmsUser = E.insertUniqueEntity =<< (mkLmsUser <$> randomLMSIdent <*> randomLMSpw)
|
||||||
inserted <- untilJustMaxM maxLmsUserIdentRetries startLmsUser
|
inserted <- untilJustMaxM maxLmsUserIdentRetries startLmsUser
|
||||||
case inserted of
|
case inserted of
|
||||||
Nothing -> $logErrorS "lms" "Inserting fresh LmsIdent failed!"
|
Nothing -> $logErrorS "LMS" "Generating and inserting fresh LmsIdent failed!"
|
||||||
(Just _) -> error "continue here by notifying user by email or mail"
|
(Just _) -> error "continue here by notifying user by email or mail"
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -105,6 +105,7 @@ data Job
|
|||||||
, jEpoch
|
, jEpoch
|
||||||
, jIteration :: Natural
|
, jIteration :: Natural
|
||||||
}
|
}
|
||||||
|
| JobLmsQualifications
|
||||||
| JobLmsEnqueue { jQualification :: QualificationId }
|
| JobLmsEnqueue { jQualification :: QualificationId }
|
||||||
| JobLmsEnqueueUser { jQualification :: QualificationId, jUser :: UserId }
|
| JobLmsEnqueueUser { jQualification :: QualificationId, jUser :: UserId }
|
||||||
| JobLmsDequeue { jQualification :: QualificationId }
|
| JobLmsDequeue { jQualification :: QualificationId }
|
||||||
|
|||||||
@ -71,7 +71,7 @@ shortened = iso shorten expand
|
|||||||
-- Handler.Utils.Widget.tidFromText
|
-- Handler.Utils.Widget.tidFromText
|
||||||
-- MsgTermPlaceHolder
|
-- MsgTermPlaceHolder
|
||||||
termToText :: TermIdentifier -> Text
|
termToText :: TermIdentifier -> Text
|
||||||
termToText TermIdentifier{..} = Text.pack . show $ year -- ^. shortened
|
termToText TermIdentifier{..} = tshow year -- ^. shortened
|
||||||
|
|
||||||
termFromText :: Text -> Either Text TermIdentifier
|
termFromText :: Text -> Either Text TermIdentifier
|
||||||
termFromText t
|
termFromText t
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user