From fdd2da240500f6ad212316bd896af19af009cb06 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 27 Sep 2022 18:31:24 +0200 Subject: [PATCH] chore(lpr+avs): show print ack-date for lms letter invites; refactor avs codes --- .../uniworx/categories/print/de-de-formal.msg | 3 +- messages/uniworx/categories/print/en-eu.msg | 3 +- models/print.model | 5 ++- src/CryptoID.hs | 12 ++++++ src/Foundation/Navigation.hs | 1 + src/Handler/LMS.hs | 38 ++++++++++++++----- src/Handler/PrintCenter.hs | 22 +++++++++-- src/Handler/Utils/Table/Cells.hs | 4 ++ .../Handler/SendNotification/Qualification.hs | 2 +- src/Model/Types/Avs.hs | 6 +-- src/Utils/Icon.hs | 3 ++ src/Utils/Print.hs | 26 +++---------- templates/profileData.hamlet | 2 +- test/Database/Fill.hs | 24 ++++++------ 14 files changed, 97 insertions(+), 54 deletions(-) diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index e1d1cb4e1..ace249f67 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -11,4 +11,5 @@ PrintSender !ident-ok: Sender PrintCourse: Kurse PrintQualification: Qualifikation PrintPDF !ident-ok: PDF -PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden \ No newline at end of file +PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden +PrintLmsUser: E-Lernen Benachrichtigung? \ No newline at end of file diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index 87e0bbb47..fe24d8edb 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -11,4 +11,5 @@ PrintSender: Sender PrintCourse: Course PrintQualification: Qualification PrintPDF: PDF -PrintManualRenewal: Manual sending of an apron driving licence renewal letter \ No newline at end of file +PrintManualRenewal: Manual sending of an apron driving licence renewal letter +PrintLmsUser: E-learning notification? \ No newline at end of file diff --git a/models/print.model b/models/print.model index 6f5ff28c9..9bb1cd8d1 100644 --- a/models/print.model +++ b/models/print.model @@ -4,8 +4,9 @@ PrintJob file ByteString -- stores plain pdf; otherwise use FileContentReference Maybe created UTCTime acknowledged UTCTime Maybe - recipient UserId Maybe -- optional as some letters may contain just an address - sender UserId Maybe -- senders and associations are optional + recipient UserId Maybe OnDeleteCascade OnUpdateCascade -- optional as some letters may contain just an address + sender UserId Maybe -- senders and associations are optional course CourseId Maybe OnDeleteCascade OnUpdateCascade qualification QualificationId Maybe OnDeleteCascade OnUpdateCascade + lmsUser LmsUserId Maybe OnDeleteCascade OnUpdateCascade -- allows tracking if recipient has been notified deriving Generic \ No newline at end of file diff --git a/src/CryptoID.hs b/src/CryptoID.hs index 377c26691..8c9892ba7 100644 --- a/src/CryptoID.hs +++ b/src/CryptoID.hs @@ -106,6 +106,18 @@ instance {-# OVERLAPS #-} PathPiece (E.CryptoID "PrintJob" (CI FilePath)) where return . CryptoID . CI.mk $ map CI.original piece' toPathPiece = Text.pack . ("uwl" <>) . CI.foldedCase . ciphertext +-- TODO: DELETE THIS AGAIN, NO LONGER NEEDD: +-- this is a hack needed for a hiddenField; better use JSON instance?! +instance PathPiece [E.CryptoID "PrintJob" UUID] where + toPathPiece = Text.intercalate ";;;" . toPathMultiPiece + fromPathPiece = fromPathMultiPiece . Text.splitOn ";;;" + +{- +instance PathPiece [E.CryptoID "PrintJob" (CI FilePath)] where + toPathPiece = Text.decodeUtf8Lenient . encode + fromPathPiece = decode . Text.encodeUtf8 +-} + instance {-# OVERLAPS #-} ToJSON (E.CryptoID "PrintJob" (CI FilePath)) where toJSON = String . toPathPiece instance {-# OVERLAPS #-} ToJSONKey (E.CryptoID "PrintJob" (CI FilePath)) where diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 78b787084..c28dd2688 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -2521,6 +2521,7 @@ pageActions PrintCenterR = do Ex.groupBy pjDay Ex.orderBy [ Ex.asc pjDay ] pure (pjDay, Ex.countRows) + -- TODO: add hash of prinjobs to route to avoid an outdated acknowledgement! let toDayAck (Ex.unValue -> d, Ex.unValue -> n::Int) = do dtxt <- formatTime SelFormatDate d let msg = "#" <> tshow n <> ", " <> dtxt diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index dc926f280..5689c9a01 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -248,17 +248,22 @@ instance CsvColumnsExplained LmsTableCsv where type LmsTableExpr = ( E.SqlExpr (Entity QualificationUser) `E.InnerJoin` E.SqlExpr (Entity User) ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser)) + `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity PrintJob)) + queryQualUser :: LmsTableExpr -> E.SqlExpr (Entity QualificationUser) -queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 2 1) +queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1) queryUser :: LmsTableExpr -> E.SqlExpr (Entity User) -queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 2 1) +queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1) queryLmsUser :: LmsTableExpr -> E.SqlExpr (Maybe (Entity LmsUser)) -queryLmsUser = $(sqlLOJproj 2 2) +queryLmsUser = $(sqlLOJproj 3 2) -type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser)) +queryPrintJob :: LmsTableExpr -> E.SqlExpr (Maybe (Entity PrintJob)) +queryPrintJob = $(sqlLOJproj 3 3) + +type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity PrintJob)) resultQualUser :: Lens' LmsTableData (Entity QualificationUser) resultQualUser = _dbrOutput . _1 @@ -269,6 +274,9 @@ resultUser = _dbrOutput . _2 resultLmsUser :: Traversal' LmsTableData (Entity LmsUser) resultLmsUser = _dbrOutput . _3 . _Just +resultPrintJob :: Traversal' LmsTableData (Entity PrintJob) +resultPrintJob = _dbrOutput . _4 . _Just + instance HasEntity LmsTableData User where hasEntity = resultUser @@ -304,13 +312,15 @@ isRenewPinAct LmsActRenewPinData = True lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser) , E.SqlExpr (Entity User) , E.SqlExpr (Maybe (Entity LmsUser)) + , E.SqlExpr (Maybe (Entity PrintJob)) ) -lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do - E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser +lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` printJob) = do + E.on $ lmsUser E.?. LmsUserId E.=?. printJob E.?. PrintJobLmsUser E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause + E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification - return (qualUser, user, lmsUser) + return (qualUser, user, lmsUser, printJob) mkLmsTable :: forall h p cols act act'. @@ -350,7 +360,8 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do , single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted)) , single ("lms-datepin" , SortColumn $ queryLmsUser >>> (E.?. LmsUserDatePin)) , single ("lms-received", SortColumn $ queryLmsUser >>> (E.?. LmsUserReceived)) - , single ("lms-notified", SortColumn $ queryLmsUser >>> (E.?. LmsUserNotified)) + --, single ("lms-notified", SortColumn $ queryLmsUser >>> (E.?. LmsUserNotified)) + , single ("lms-notified", SortColumn $ \row -> E.coalesce [queryPrintJob row E.?. PrintJobAcknowledged, queryLmsUser row E.?. LmsUserNotified]) , single ("lms-ended" , SortColumn $ queryLmsUser >>> (E.?. LmsUserEnded)) ] dbtFilter = mconcat @@ -465,7 +476,16 @@ postLmsR sid qsh = do , sortable (Just "lms-started") (i18nLms MsgTableLmsStarted) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d , sortable (Just "lms-datepin") (i18nLms MsgTableLmsDatePin) $ \(preview $ resultLmsUser . _entityVal . _lmsUserDatePin -> d) -> foldMap dateTimeCell d , sortable (Just "lms-received") (i18nLms MsgTableLmsReceived) $ \(preview $ resultLmsUser . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell $ join d - , sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \(preview $ resultLmsUser . _entityVal . _lmsUserNotified -> d) -> foldMap dateTimeCell $ join d + --, sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \(preview $ resultLmsUser . _entityVal . _lmsUserNotified -> d) -> foldMap dateTimeCell $ join d + , sortable (Just "lms-notified") (i18nLms MsgTableLmsNotified) $ \row -> + let notifyDate = row ^? resultLmsUser . _entityVal . _lmsUserNotified + letterSent = isJust (row ^? resultPrintJob . _entityKey) + letterDate = row ^? resultPrintJob . _entityVal . _printJobAcknowledged + cIcon = iconFixedCell $ iconLetterOrEmail letterSent + cDate = if letterSent + then foldMap dateTimeCell (join letterDate) + else foldMap dateTimeCell (join notifyDate) + in cIcon <> spacerCell <> cDate , sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d ] where diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index b1ffb2dae..fa0890783 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -199,6 +199,7 @@ mkPJTable = do , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell , sortable (Just "pj-qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell + , sortable (Just "pj-lmsid") (i18nCell MsgPrintLmsUser) $ \( view $ resultPrintJob . _entityVal . _printJobLmsUser -> q) -> ifIconCell (isJust q) IconMenuLms ] dbtSorting = mconcat [ single ("pj-name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName)) @@ -209,6 +210,7 @@ mkPJTable = do , single ("pj-sender" , sortUserNameBareM querySender ) , single ("pj-course" , SortColumn $ queryCourse >>> (E.?. CourseName)) , single ("pj-qualification", SortColumn $ queryQualification >>> (E.?. QualificationName)) + , single ("pj-lmsid" , SortColumn $ queryPrintJob >>> (E.isJust . (E.^. PrintJobLmsUser))) ] dbtFilter = mconcat [ single ("pj-name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName)) @@ -305,7 +307,7 @@ postPrintSendR = do -- liftIO $ LBS.writeFile "/tmp/generated.pdf" bs -- DEBUGGING ONLY -- addMessage Warning "PDF momentan nur gespeicher unter /tmp/generated.pdf" uID <- maybeAuthId - runDB (sendLetter "Test-Brief" bs (mbRecipient, uID) Nothing Nothing) >>= \case -- calls lpr + runDB (sendLetter "Test-Brief" bs (mbRecipient, uID) Nothing Nothing Nothing) >>= \case -- calls lpr Left err -> do let msg = "PDF printing failed with error: " <> err $logErrorS "LPR" msg @@ -354,14 +356,26 @@ getPrintDownloadR cupj = do getPrintAcknowR, postPrintAcknowR :: Day -> Handler Html getPrintAcknowR = postPrintAcknowR postPrintAcknowR ackDay = do - -- TODO: besser mit cryptoids als hiddenfield in Form hineinhängen arbeiten und an den Post Request hängen?! - ((ackRes, ackWgt), ackEnctype) <- runFormPost (identifyForm FIDPrintAcknowledge buttonForm :: Form ButtonConfirm) + dayJobs <- runDB $ Ex.select $ do + pj <- Ex.from $ Ex.table @PrintJob + let pjDay = E.day $ pj Ex.^. PrintJobCreated + Ex.where_ $ Ex.isNothing (pj Ex.^. PrintJobAcknowledged) + E.&&. (pjDay Ex.==. Ex.val ackDay) + return $ pj Ex.^. PrintJobId + let encPJ :: PrintJobId -> Handler CryptoUUIDPrintJob + encPJ = encrypt + pjHash = hash (Ex.unValue <$> dayJobs) + _encJobs <- mapM (encPJ . Ex.unValue) dayJobs + let hiddenPJs = areq hiddenField "ack-pjs" $ Just pjHash + --_mkAckForm :: Form ([PrintJobId], ButtonConfirm) + --_mkAckForm = withButtonForm' [BtnConfirm] hiddenPJs + ((ackRes, ackWgt), ackEnctype) <- runFormPost . identifyForm FIDPrintAcknowledge . withButtonForm' [BtnConfirm] $ renderAForm FormStandard hiddenPJs let ackForm = wrapForm ackWgt def { formAction = Just $ SomeRoute $ PrintAcknowR ackDay , formEncoding = ackEnctype , formSubmit = FormNoSubmit } - formResult ackRes $ \BtnConfirm -> do + formResult ackRes $ \(_pjIds, BtnConfirm) -> do now <- liftIO getCurrentTime num <- runDB $ E.updateCount $ \pj -> do diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 31a157e9b..d977e4de2 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -91,6 +91,10 @@ ifIconCell False = const iconSpacerCell addIconFixedWidth :: IsDBTable m a => DBCell m a -> DBCell m a addIconFixedWidth = addCellClass ("icon-fixed-width" :: Text) +-- | Can be used directly with type Markup as delivered by most functions from Utils.Icon +iconFixedCell :: (IsDBTable m a, ToWidget UniWorX wgt) => wgt -> DBCell m a +iconFixedCell = addIconFixedWidth . cell . toWidget + iconSpacerCell :: IsDBTable m a => DBCell m a iconSpacerCell = mempty & addIconFixedWidth diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 3e446ae76..c4491cdf7 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -101,7 +101,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do notifyOk <- pdfRenewal pdfMeta >>= \case Right pdf | userPrefersLetter recipient -> -- userPrefersLetter is false if both userEmail and userPostAddress are null let printSender = Nothing - in runDB (sendLetter printJobName pdf (Just jRecipient, printSender) Nothing (Just nQualification)) >>= \case + in runDB (sendLetter printJobName pdf (Just jRecipient, printSender) Nothing (Just nQualification) (Just luid)) >>= \case Left err -> do let msg = "Notify " <> tshow encRecipient <> ": PDF printing to send letter failed with error " <> cropText err $logErrorS "LMS" msg diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index 1cebc7a16..e718e14b2 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -475,12 +475,12 @@ mergeByPersonId = Set.foldr aux Map.empty in AvsDataPerson { avsPersonFirstName = pickBy' Text.length avsPersonFirstName , avsPersonLastName = pickBy' Text.length avsPersonLastName - , avsPersonInternalPersonalNo = pickBy' (Text.length . (fromMaybe mempty)) avsPersonInternalPersonalNo + , avsPersonInternalPersonalNo = pickBy' (Text.length . fromMaybe mempty) avsPersonInternalPersonalNo , avsPersonPersonNo = pickBy' id avsPersonPersonNo , avsPersonPersonID = api -- keys must be identical due to call with insertWithKey , avsPersonPersonCards = (Set.union `on` avsPersonPersonCards) pa pb } pickBy :: Ord b => (a -> b) -> a -> a -> a - pickBy f x y | (f x) >= (f y) = x - | otherwise = y + pickBy f x y | f x >= f y = x + | otherwise = y diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index b9d3420a8..cd2959e1b 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -295,6 +295,9 @@ iconExamRegister :: Bool -> Markup iconExamRegister True = icon IconExamRegisterTrue iconExamRegister False = icon IconExamRegisterFalse +iconLetterOrEmail :: Bool -> Markup +iconLetterOrEmail True = icon IconPrintCenter +iconLetterOrEmail False = icon IconAt ---------------- -- For documentation on how to avoid these unneccessary functions diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 1bf9088b4..b54155756 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -264,8 +264,8 @@ pdfRenewal' meta = do -- PrintJobs -- --------------- -sendLetter :: Text -> LBS.ByteString -> (Maybe UserId, Maybe UserId) -> Maybe CourseId -> Maybe QualificationId -> DB (Either Text (Text, FilePath)) -sendLetter printJobName pdf (printJobRecipient, printJobSender) printJobCourse printJobQualification = do +sendLetter :: Text -> LBS.ByteString -> (Maybe UserId, Maybe UserId) -> Maybe CourseId -> Maybe QualificationId -> Maybe LmsUserId -> DB (Either Text (Text, FilePath)) +sendLetter printJobName pdf (printJobRecipient, printJobSender) printJobCourse printJobQualification printJobLmsUser = do recipient <- join <$> mapM get printJobRecipient sender <- join <$> mapM get printJobSender course <- join <$> mapM get printJobCourse @@ -288,30 +288,16 @@ sendLetter printJobName pdf (printJobRecipient, printJobSender) printJobCourse p return $ Right (ok, printJobFilename) {- -sendLetter' :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB PureFile -sendLetter' printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do - recipient <- join <$> mapM get printJobRecipient - sender <- join <$> mapM get printJobSender - course <- join <$> mapM get printJobCourse - quali <- join <$> mapM get printJobQualification - let nameRecipient = userDisplayName <$> recipient - nameSender = userDisplayName <$> sender - nameCourse = CI.original . courseShorthand <$> course - nameQuali = CI.original . qualificationShorthand <$> quali - let printJobAcknowledged = Nothing - jobFullName = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) - printJobFilename = jobFullName <> ".pdf" - -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code - printJobFile = LBS.toStrict pdf - lprPDF jobFullName pdf - printJobCreated <- liftIO getCurrentTime - insert_ PrintJob {..} +sendLetter' :: _ -> DB PureFile +sendLetter' _ = do + ... return $ File { fileTitle = printJobFilename , fileModified = printJobCreated , fileContent = Just $ yield printJobFile } -} + ----------------------------- -- Typed Process Utilities -- ----------------------------- diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index 9ca6dba55..248b792ce 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -22,7 +22,7 @@ $newline never
_{MsgPrefersPostal}
- #{icon (bool IconAt IconPrintCenter userPrefersPostal)} + #{iconLetterOrEmail userPrefersPostal}
_{MsgAdminUserPostAddress}
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index c14088475..0143369a8 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -522,19 +522,19 @@ fillDb = do void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now - void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing now Nothing Nothing Nothing - void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just $ LmsSuccess $ n_day 1) now (Just now) Nothing Nothing - void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just $ LmsBlocked $ utctDay now) now (Just now) Nothing Nothing - void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just $ LmsSuccess $ n_day (-2)) now Nothing (Just $ n_day' (-1)) Nothing - void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) now (Just $ n_day' (-2)) (Just $ n_day' (-2)) (Just $ n_day' (-1)) + lujost <- insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing now Nothing Nothing Nothing + luvaupel <- insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just $ LmsSuccess $ n_day 1) now (Just now) Nothing Nothing + void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just $ LmsBlocked $ utctDay now) now (Just now) Nothing Nothing + lutina <- insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just $ LmsSuccess $ n_day (-2)) now (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing + void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) now (Just $ n_day' (-2)) (Just $ n_day' (-2)) (Just $ n_day' (-1)) - void . insert $ PrintJob "TestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) - void . insert $ PrintJob "TestJob2" "job2" "No Text herein." (n_day' (-1)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_f) - void . insert $ PrintJob "TestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing - void . insert $ PrintJob "TestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing - void . insert $ PrintJob "TestJob5" "job5" "No Text herein." (n_day' (-4)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) - void . insert $ PrintJob "TestJob6" "job6" "No Text herein." (n_day' (-4)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) - void . insert $ PrintJob "TestJob7" "job7" "No Text herein." (n_day' (-4)) Nothing (Just svaupel) Nothing Nothing Nothing + void . insert $ PrintJob "TestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing + void . insert $ PrintJob "TestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just lujost) + void . insert $ PrintJob "TestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing + void . insert $ PrintJob "TestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing Nothing + void . insert $ PrintJob "TestJob5" "job5" "No Text herein." (n_day' (-4)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) (Just lutina) + void . insert $ PrintJob "TestJob6" "job6" "No Text herein." (n_day' (-4)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing + void . insert $ PrintJob "TestJob7" "job7" "No Text herein." (n_day' (-4)) (Just $ n_day' (-2)) (Just svaupel) Nothing Nothing Nothing (Just luvaupel) let