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

chore(lms): fix jsonb sql query for LMS dequeing

Browse Source
This commit is contained in:
Steffen Jost 2023-05-09 14:12:00 +00:00
parent 2b486e8635
commit 07aa74fbef
3 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Database/Esqueleto/Utils.hs
View File

@ -35,12 +35,12 @@ module Database.Esqueleto.Utils
, greatest, least , greatest, least
, abs , abs
, SqlProject(..) , SqlProject(..)
, (->.), (#>>.) , (->.), (->>.), (#>>.)
, fromSqlKey , fromSqlKey
, unKey , unKey
, selectCountRows, selectCountDistinct , selectCountRows, selectCountDistinct
, selectMaybe , selectMaybe
, day, interval, diffDays, diffTimes , day, day', interval, diffDays, diffTimes
, exprLift , exprLift
, explicitUnsafeCoerceSqlExprValue , explicitUnsafeCoerceSqlExprValue
, module Database.Esqueleto.Utils.TH , module Database.Esqueleto.Utils.TH
@ -504,6 +504,12 @@ infixl 8 ->.
(->.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value b) (->.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value b)
(->.) expr t = E.unsafeSqlBinOp "->" expr $ E.val t (->.) expr t = E.unsafeSqlBinOp "->" expr $ E.val t
infixl 8 ->>.
(->>.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value Text)
(->>.) expr t = E.unsafeSqlBinOp "->>" expr $ E.val t
infixl 8 #>>. infixl 8 #>>.
(#>>.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value (Maybe Text)) (#>>.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value (Maybe Text))
@ -545,6 +551,9 @@ selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day) day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day)
day = E.unsafeSqlCastAs "date" day = E.unsafeSqlCastAs "date"
day' :: E.SqlExpr (E.Value Text) -> E.SqlExpr (E.Value Day)
day' = E.unsafeSqlCastAs "date"
interval :: CalendarDiffDays -> E.SqlExpr (E.Value Day) -- E.+=. requires both types to be the same, so we use Day interval :: CalendarDiffDays -> E.SqlExpr (E.Value Day) -- E.+=. requires both types to be the same, so we use Day
-- interval _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example -- interval _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example
interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show

8
src/Handler/LMS.hs
View File

@ -78,8 +78,12 @@ postLmsAllR = do
mbBtnForm <- if not isAdmin then return Nothing else do mbBtnForm <- if not isAdmin then return Nothing else do
((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms) ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms)
case btnResult of case btnResult of
(FormSuccess BtnLmsEnqueue) -> queueJob' JobLmsQualificationsEnqueue (FormSuccess BtnLmsEnqueue) ->
(FormSuccess BtnLmsDequeue) -> queueJob' JobLmsQualificationsDequeue queueJob' JobLmsQualificationsEnqueue
>> addMessage Info "Einreihung ablaufender Qualifikationen zum LMS wird nun im Hintergund durchgeführt."
(FormSuccess BtnLmsDequeue) ->
queueJob' JobLmsQualificationsDequeue
>> addMessage Info "Benachrichtigung abgelaufener Qualifikationen und Aufräumen beendeter LMS Nutzer wird im Hintergund ausgeführt."
FormMissing -> return () FormMissing -> return ()
_other -> addMessage Warning "Kein korrekter LMS Knopf erkannt" _other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
return $ Just $ wrapForm btnWdgt def return $ Just $ wrapForm btnWdgt def

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

@ -166,7 +166,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil) E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
) E.||. ( ) E.||. (
E.isJust (quser E.^. QualificationUserBlockedDue) E.isJust (quser E.^. QualificationUserBlockedDue)
E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. ((quser E.^. QualificationUserBlockedDue) E.->. "day" :: E.SqlExpr (E.Value Day))) E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
)) ))
pure (quser E.^. QualificationUserUser) pure (quser E.^. QualificationUserUser)