fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: minor code cleaning

Browse Source
This commit is contained in:
Steffen Jost 2023-10-06 15:07:34 +00:00
parent e3b6a7e4c6
commit be527ada32
2 changed files with 9 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Jobs/Handler/LMS.hs
View File

@ -197,14 +197,13 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
luser E.?. LmsUserUser E.?=. quser E.^. QualificationUserUser luser E.?. LmsUserUser E.?=. quser E.^. QualificationUserUser
E.&&. luser E.?. LmsUserQualification E.?=. quser E.^. QualificationUserQualification) E.&&. luser E.?. LmsUserQualification E.?=. quser E.^. QualificationUserQualification)
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
-- E.&&. luser E.?. LmsUserQualification E.?=. E.val qid -- E.&&. luser E.?. LmsUserQualification E.?=. E.val qid
-- E.&&. E.isNothing (luser E.^. LmsUserStatus) -- E.&&. E.isNothing (luser E.^. LmsUserStatus)
-- E.&&. E.isNothing (luser E.^. LmsUserEnded) -- E.&&. E.isNothing (luser E.^. LmsUserEnded)
E.&&. E.not_ (validQualification now quser) E.&&. E.not_ (validQualification now quser)
pure (luser E.?. LmsUserId, quser E.^. QualificationUserUser) pure (quser E.^. QualificationUserUser, luser E.?. LmsUserId)
nrBlocked <- qualificationUserBlocking qid (E.unValue . snd <$> expiredUsers) False (Just now) (Right QualificationBlockExpired) True -- essential that blocks occur only once nrBlocked <- qualificationUserBlocking qid (E.unValue . fst <$> expiredUsers) False (Just now) (Right QualificationBlockExpired) True -- essential that blocks occur only once
let expiredLearners = [ luid | (E.Value (Just luid), _) <- expiredUsers ] let expiredLearners = [luid | (_, E.Value (Just luid)) <- expiredUsers]
-- let expiredLearners = catMaybes (E.unValue . fst <$> expiredUsers)
nrExpired <- E.updateCount $ \luser -> do nrExpired <- E.updateCount $ \luser -> do
E.set luser [LmsUserStatus E.=. E.justVal LmsExpired, LmsUserStatusDay E.=. E.justVal now] E.set luser [LmsUserStatus E.=. E.justVal LmsExpired, LmsUserStatusDay E.=. E.justVal now]
E.where_ $ E.isNothing (luser E.^. LmsUserStatus) E.where_ $ E.isNothing (luser E.^. LmsUserStatus)

10
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -60,7 +60,7 @@ dispatchNotificationQualificationExpired nQualification jRecipient = do
let expDay = maybe qualificationUserValidUntil (min qualificationUserValidUntil . utctDay . qualificationUserBlockFrom) block let expDay = maybe qualificationUserValidUntil (min qualificationUserValidUntil . utctDay . qualificationUserBlockFrom) block
qname = CI.original qualificationName qname = CI.original qualificationName
qshort = CI.original qualificationShorthand qshort = CI.original qualificationShorthand
letter = LetterExpireQualification letter = LetterExpireQualification
{ leqHolderCFN = encRecShort { leqHolderCFN = encRecShort
, leqHolderID = jRecipient , leqHolderID = jRecipient
, leqHolderDN = userDisplayName , leqHolderDN = userDisplayName
@ -72,14 +72,14 @@ dispatchNotificationQualificationExpired nQualification jRecipient = do
, leqSchool = qualificationSchool , leqSchool = qualificationSchool
, leqUrl = pure . urender $ ForProfileDataR encRecipient , leqUrl = pure . urender $ ForProfileDataR encRecipient
} }
if expDay > utctDay qualificationUserLastNotified if expDay > utctDay qualificationUserLastNotified
then do then do
notifyOk <- sendEmailOrLetter jRecipient letter notifyOk <- sendEmailOrLetter jRecipient letter
if notifyOk if notifyOk
then do then do
runDB $ update quId [QualificationUserLastNotified =. now] runDB $ update quId [QualificationUserLastNotified =. now]
$logInfoS "LMS" $ "Notified " <> tshow encRecipient <> " about expired qualification " <> qname $logInfoS "LMS" $ "Notified " <> tshow encRecipient <> " about expired qualification " <> qname
else else
$logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> qname $logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> qname
else $logErrorS "LMS" $ "Suppressed repeated notification " <> tshow encRecipient <> " about expired qualification " <> qname else $logErrorS "LMS" $ "Suppressed repeated notification " <> tshow encRecipient <> " about expired qualification " <> qname
_ -> $logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> tshow nQualification _ -> $logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> tshow nQualification
@ -89,7 +89,7 @@ dispatchNotificationQualificationExpired nQualification jRecipient = do
dispatchNotificationQualificationRenewal :: QualificationId -> Bool -> UserId -> Handler () dispatchNotificationQualificationRenewal :: QualificationId -> Bool -> UserId -> Handler ()
dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = do dispatchNotificationQualificationRenewal nQualification nReminder jRecipient = do
encRecipient :: CryptoUUIDUser <- encrypt jRecipient encRecipient :: CryptoUUIDUser <- encrypt jRecipient
query <- runDB $ (,,,) query <- runDB $ (,,,)
<$> get jRecipient <$> get jRecipient
<*> get nQualification <*> get nQualification
<*> getBy (UniqueQualificationUser nQualification jRecipient) <*> getBy (UniqueQualificationUser nQualification jRecipient)