From 07aa74fbef3a7503c44523f591237900091a41e7 Mon Sep 17 00:00:00 2001
From: Steffen Jost <S.Jost@Fraport.de>
Date: Tue, 9 May 2023 14:12:00 +0000
Subject: [PATCH] chore(lms): fix jsonb sql query for LMS dequeing

---
 src/Database/Esqueleto/Utils.hs | 13 +++++++++++--
 src/Handler/LMS.hs              |  8 ++++++--
 src/Jobs/Handler/LMS.hs         |  2 +-
 3 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 30f779bf1..7064697e4 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -35,12 +35,12 @@ module Database.Esqueleto.Utils
   , greatest, least
   , abs
   , SqlProject(..)
-  , (->.), (#>>.)
+  , (->.), (->>.), (#>>.)
   , fromSqlKey
   , unKey
   , selectCountRows, selectCountDistinct
   , selectMaybe
-  , day, interval, diffDays, diffTimes
+  , day, day', interval, diffDays, diffTimes
   , exprLift
   , explicitUnsafeCoerceSqlExprValue
   , module Database.Esqueleto.Utils.TH
@@ -504,6 +504,12 @@ infixl 8 ->.
 (->.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value b)
 (->.) 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 #>>.
 
 (#>>.) :: 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.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 _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example 
 interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show
diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index 1499ebb1d..6f1fe038a 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -78,8 +78,12 @@ postLmsAllR = do
   mbBtnForm <- if not isAdmin then return Nothing else do
     ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms)
     case btnResult of
-      (FormSuccess BtnLmsEnqueue) -> queueJob' JobLmsQualificationsEnqueue
-      (FormSuccess BtnLmsDequeue) -> queueJob' JobLmsQualificationsDequeue
+      (FormSuccess BtnLmsEnqueue) -> 
+        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 ()
       _other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
     return $ Just $ wrapForm btnWdgt def
diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs
index eb92356ac..f78fdebd5 100644
--- a/src/Jobs/Handler/LMS.hs
+++ b/src/Jobs/Handler/LMS.hs
@@ -166,7 +166,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
                     E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
             ) E.||. (
                       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)