Merge branch 'master' of gitlab.uniworx.de:fradrive/fradrive

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -11,6 +11,8 @@ QualificationAuditDuration: Aufbewahrung Audit Log
 QualificationRefreshWithin: Erneurerungszeitraum
 QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E‑Learning
 QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
+QualificationExpiryNotification: Ungültigkeitsbenachrichtigung?
+QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Qualifikation ungültig wird, sofern der jeweilige Nutzer in seinen Benutzereinstellungen diese Art Benachrichtigung aktiviert hat.
 TableQualificationCountActive: Aktive
 TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
 TableQualificationCountTotal: Gesamt

messages/uniworx/categories/qualification/en-eu.msg

@@ -11,6 +11,8 @@ QualificationAuditDuration: Audit log keept
 QualificationRefreshWithin: Refresh within
 QualificationRefreshWithinTooltip: Period before expiry to send a notification or to start e‑learning
 QualificationElearningStart: Is e‑learning automatically started?
+QualificationExpiryNotification: Invalidity notification?
+QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings.
 TableQualificationCountActive: Active
 TableQualificationCountActiveTooltip: Number of currently valid qualification holders
 TableQualificationCountTotal: Total

models/lms.model

@@ -12,9 +12,8 @@ Qualification
   auditDuration       Int Maybe                 -- > 0, number of months to keep audit log and LmsUserIdents; or indefinitely  (dangerous, since LmsIdents may run out)
   refreshWithin       CalendarDiffDays Maybe    -- notify users about renewal within this number of month/days before expiry; to be used with addGregorianDurationClip
   elearningStart      Bool                      -- automatically schedule e-refresher
-  -- elearningOnly       Bool                   -- successful E-learing automatically increases validity. NO!
+  -- elearningOnly       Bool                   -- successful E-learing automatically increases validity. NO!  
-  -- refreshInvitation   StoredMarkup           -- hard-coded I18N-MSGs used instead, but displayed on qualification page NO!
+  expiryNotification  Bool default=true         -- should expiryNotification be generated for this qualification?
-  -- expiryNotification  StoredMarkup Maybe     -- configurable user-profile-notifcations are used instead NO!
   avsLicence          AvsLicence Maybe          -- if set, valid QualificationUsers are synchronized to AVS as a driving licence
   sapId               Text Maybe                -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id
   SchoolQualificationShort school shorthand            -- must be unique per school and shorthand

src/Handler/Course/ParticipantInvite.hs

@@ -32,6 +32,7 @@ import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
 import qualified Database.Esqueleto.Utils        as E
 
+import Utils.Occurrences
 
 
 type UserSearchKey = Text
@@ -316,7 +317,7 @@ upsertNewTutorial cid newTutorialName newTutorialType newFirstDay = runDB $ do
       Course{..} <- get404 cid
       term <- get404 courseTerm
       let oldFirstDay = fromMaybe moveDay $ tutorialFirstDay <|> fst (occurrencesBounds term tutorialTime)
-          newTime     = occurrencesAddBusinessDays term (oldFirstDay, moveDay) tutorialTime          
+          newTime     = normalizeOccurrences $ occurrencesAddBusinessDays term (oldFirstDay, moveDay) tutorialTime          
           dayDiff   = maybe 0 (diffDays moveDay) tutorialFirstDay
           mvTime    = fmap $ addLocalDays dayDiff
           newType0  = CI.mk . snd . Text.breakOnEnd tutorialTypeSeparator $ CI.original tutorialType

src/Handler/Qualification.hs

@@ -101,6 +101,8 @@ mkQualificationAllTable isAdmin = do
           -- , sortable Nothing (i18nCell MsgQualificationRefreshWithin)   $ foldMap textCell . view (resultAllQualification . _qualificationRefreshWithin . to formatCalendarDiffDays) -- does not work, since there is a maybe in between
           , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) 
                                                                         $ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
+          , sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip) 
+                                                                        $ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
           , sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip) 
                   $ \(view (resultAllQualification . _qualificationAvsLicence) -> licence) -> maybeCell licence $ textCell . T.singleton . licence2char
           , sortable Nothing (i18nCell MsgTableQualificationSapExport & cellTooltip MsgTableQualificationSapExportTooltip)  
@@ -115,6 +117,7 @@ mkQualificationAllTable isAdmin = do
           , singletonMap "qshort"       $ SortColumn (E.^. QualificationShorthand)
           , singletonMap "qname"        $ SortColumn (E.^. QualificationName)
           , singletonMap "qelearning"   $ SortColumn (E.^. QualificationElearningStart)
+          , singletonMap "noteexpiry"   $ SortColumn (E.^. QualificationExpiryNotification)
           ]
         dbtFilter = mconcat
           [

src/Handler/Tutorial/List.hs

@@ -74,9 +74,9 @@ getCTutorialListR tid ssh csh = do
               linkButton mempty [whamlet|_{MsgTutorialDelete}|] [BCIsButton, BCDanger] . SomeRoute $ CTutorialR tid ssh csh tutorialName TDeleteR
           ]
         dbtSorting = Map.fromList
-          [ ("type"     , SortColumn $ \tutorial -> tutorial E.^. TutorialType )
+          [ ("type"     , SortColumn          $ \tutorial -> tutorial E.^. TutorialType )
-          , ("name"     , SortColumn $ \tutorial -> tutorial E.^. TutorialName )
+          , ("name"     , SortColumn          $ \tutorial -> tutorial E.^. TutorialName )
-          , ("first-day", SortColumn $ \tutorial -> tutorial E.^. TutorialFirstDay )
+          , ("first-day", SortColumnNullsInv  $ \tutorial -> tutorial E.^. TutorialFirstDay )
           , ( "tutors"
             , SortColumn $ \tutorial -> E.subSelectMaybe . E.from $ \(tutor `E.InnerJoin` user) -> do
                 E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
@@ -91,9 +91,9 @@ getCTutorialListR tid ssh csh = do
           , ("capacity", SortColumn $ \tutorial -> tutorial E.^. TutorialCapacity )
           , ("room", SortColumn $ \tutorial -> tutorial E.^. TutorialRoom )
           , ("register-group", SortColumn $ \tutorial -> tutorial E.^. TutorialRegGroup )
-          , ("register-from", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterFrom )
+          , ("register-from"    , SortColumnNullsInv $ \tutorial -> tutorial E.^. TutorialRegisterFrom )
-          , ("register-to", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterTo )
+          , ("register-to"      , SortColumnNullsInv $ \tutorial -> tutorial E.^. TutorialRegisterTo )
-          , ("deregister-until", SortColumn $ \tutorial -> tutorial E.^. TutorialDeregisterUntil )
+          , ("deregister-until" , SortColumnNullsInv $ \tutorial -> tutorial E.^. TutorialDeregisterUntil )
           ]
         dbtFilter = Map.empty
         dbtFilterUI = const mempty

src/Handler/Utils/Occurrences.hs

@@ -64,14 +64,14 @@ occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = Occurrenc
     switchDayOfWeek os | 0 == dayDiff `mod` 7 = os
     switchDayOfWeek os@ScheduleWeekly{scheduleDayOfWeek=wday} = os{scheduleDayOfWeek= toEnum (fromIntegral dayDiff + fromEnum wday)}
 
-    newExceptions = snd $ Set.foldr advanceExceptions (dayDiff,mempty) occurrencesExceptions
+    newExceptions = snd $ Set.foldl' advanceExceptions (dayDiff,mempty) occurrencesExceptions
 
     -- we assume that instance Ord OccurrenceException is ordered chronologically
-    advanceExceptions :: OccurrenceException -> (Integer, Set OccurrenceException) -> (Integer, Set OccurrenceException)
+    advanceExceptions :: (Integer, Set OccurrenceException) -> OccurrenceException -> (Integer, Set OccurrenceException)
-    advanceExceptions ex (offset, acc) 
+    advanceExceptions (offset, acc) ex
         | ed `Set.notMember` offDays   -- skip term-holidays and weekends, unless the original day was a holiday or weekend
         , nd `Set.member`    offDays
-          = advanceExceptions ex (succ offset, acc)
+          = advanceExceptions (succ offset, acc) ex
         | otherwise
           = (offset, Set.insert (setDayOfOccurrenceException nd ex) acc)
       where 

src/Jobs/Handler/LMS.hs

@@ -98,11 +98,11 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
     act = do
       identsInUseVs <- E.select $ do
         lui <- E.from $
-          ( (E.^. LmsUserlistIdent) <$> E.from (E.table @LmsUserlist) )
+          ( (E.^. LmsUserlistIdent) <$> E.from (E.table @LmsUserlist) ) -- no filter by Qid, since LmsIdents must be unique across all 
           `E.union_`
-          ( (E.^. LmsResultIdent)   <$> E.from (E.table @LmsResult) )
+          ( (E.^. LmsResultIdent)   <$> E.from (E.table @LmsResult  ) )
           `E.union_`
-          ( (E.^. LmsUserIdent)     <$> E.from (E.table @LmsUser) )
+          ( (E.^. LmsUserIdent)     <$> E.from (E.table @LmsUser    ) )
         E.orderBy [E.asc lui]
         pure lui
       now <- liftIO getCurrentTime
@@ -150,31 +150,36 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
             `E.on` (\(quser :& luser) ->
                               luser E.^. LmsUserUser           E.==. quser   E.^. QualificationUserUser
                         E.&&. luser E.^. LmsUserQualification  E.==. quser   E.^. QualificationUserQualification)
-          E.where_ $ E.isNothing (luser E.^. LmsUserStatus)
+          E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
+              E.&&.  luser E.^. LmsUserQualification           E.==. E.val qid
+              E.&&.  E.isNothing (luser E.^. LmsUserStatus)
               E.&&.  E.isNothing (luser E.^. LmsUserEnded)
               E.&&.  E.not_ (validQualification nowaday quser)
           pure (luser E.^. LmsUserId)      
       nrExpired <- E.updateCount $ \luser -> do
         E.set luser [LmsUserStatus E.=. E.justVal (LmsExpired nowaday)]
         E.where_ $ (luser E.^. LmsUserId) `E.in_` E.valList (E.unValue <$> expiredLearners)
+             E.&&.  luser E.^. LmsUserQualification E.==. E.val qid
       $logInfoS "LMS" $ "Expired lms users " <> tshow nrExpired <> " for qualification " <> qshort
 
-      notifyInvalidDrivers <- E.select $ do 
+      when (quali ^. _qualificationExpiryNotification) $ do
-          quser <- E.from $ E.table @QualificationUser 
+        notifyInvalidDrivers <- E.select $ do 
-          E.where_ $ E.not_ (validQualification nowaday quser)              
+            quser <- E.from $ E.table @QualificationUser 
-            E.&&. ((  E.isNothing (quser E.^. QualificationUserBlockedDue)
+            E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
-                    E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
+              E.&&.  E.not_ (validQualification nowaday quser)              
-            ) E.||. (
+              E.&&. (( E.isNothing (quser E.^. QualificationUserBlockedDue)
+                      E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. quser E.^. QualificationUserValidUntil)
+              ) E.||. (
                       E.isJust    (quser E.^. QualificationUserBlockedDue)
-                    E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
+                      E.&&. (E.day (quser E.^. QualificationUserLastNotified) E.<. E.day' ((quser E.^. QualificationUserBlockedDue) E.->>. "day"))
-            ))
+              ))
-          pure (quser E.^. QualificationUserUser)      
+            pure (quser E.^. QualificationUserUser)      
-      
+        
-      forM_ notifyInvalidDrivers $ \(E.Value uid) ->
+        forM_ notifyInvalidDrivers $ \(E.Value uid) ->
-        queueDBJob JobSendNotification
+          queueDBJob JobSendNotification
-          { jRecipient    = uid
+            { jRecipient    = uid
-          , jNotification = NotificationQualificationExpired { nQualification = qid }
+            , jNotification = NotificationQualificationExpired { nQualification = qid }
-          }
+            }
 
       -- purge outdated LmsUsers
       case qualificationAuditDuration quali of

src/Utils/Print/ExpireQualification.hs

@@ -33,11 +33,11 @@ data LetterExpireQualificationF = LetterExpireQualificationF
     }
   deriving (Eq, Show)
 
--- TODO: use markdown to generate the Letter
+-- TODO: use markdown to generate the Letter -- this is no linger used, I believe
 instance MDMail LetterExpireQualificationF where 
   attachPDFLetter _ = False
   getMailSubject    l = SomeMessage $ MsgMailSubjectQualificationExpired $ leqfShort l  
-  getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = return $
+  getMailBody LetterExpireQualificationF{..} DateTimeFormatter{ format } = return $  -- TODO: can we use render Letter here?
     let expiryDate              = format SelFormatDate <$> leqfExpiry
         userDisplayName         = leqfHolderDN
         userSurname             = leqfHolderSN        
@@ -59,7 +59,11 @@ instance MDLetter LetterExpireQualificationF where
   encryptPDFfor     _ = NoPassword
   getLetterKind     _ = Din5008
   getLetterEnvelope _ = 'e'
-  getTemplate       _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")
+
+  getTemplate LetterExpireQualificationF{leqfShort="F"} 
+                = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_f_expiry.md")
+  getTemplate _ = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_generic_expiry.md")
+  
 
   letterMeta LetterExpireQualificationF{..} DateTimeFormatter{ format } lang Entity{entityKey=rcvrId, entityVal=User{userDisplayName}} = 
     let isSupervised = rcvrId /= leqfHolderID
@@ -68,11 +72,17 @@ instance MDLetter LetterExpireQualificationF where
       [ toMeta "supervisor" userDisplayName      
       ] <>
       [ toMeta "lang"           lang
+      , toMeta "licencename"    leqfName
+      , toMeta "licenceshort"   leqfShort
       , toMeta "licenceholder"  leqfHolderDN
       , mbMeta "expiry"         (format SelFormatDate <$> leqfExpiry)      
       , mbMeta "licence-url"    leqfUrl
       , toMeta "de-opening" $ bool ("Guten Tag " <> leqfHolderDN <> ",") "Sehr geehrte Damen und Herren," isSupervised
       , toMeta "en-opening" $ bool ("Dear "      <> leqfHolderDN <> ",") "Dear supervisor,"               isSupervised
+      , toMeta "de-subject" $ "Entzug \"" <> leqfShort <> "\" (" <> leqfName <> ")"
+      , toMeta "en-subject" $ case leqfShort of
+                                "F" -> "Revocation of apron driving license"
+                                _   -> "Revocation of licence \"" <> leqfShort <> "\" (" <> leqfName <> ")"
       ] 
 
   getPJId LetterExpireQualificationF{..} =

templates/letter/fraport_generic_expiry.md

@@ -0,0 +1,139 @@
+---
+### Metadaten, welche hier eingestellt werden:
+# Absender
+de-subject: Qualifikationsentzug
+en-subject: Qualification revocation
+author: Fraport AG - Fahrerausbildung (AVN-AR)
+phone: +49 69 690-30306
+email: fahrerausbildung@fraport.de
+place: Frankfurt am Main
+return-address: 
+ - 60547 Frankfurt
+de-opening: Liebe Fahrberechtigungsinhaber,
+en-opening: Dear driver,
+de-closing: |
+  Mit freundlichen Grüßen,  
+    Ihre Fraport Fahrerausbildung
+en-closing: |
+  With kind regards,  
+    Your Fraport Driver Training
+encludes:
+hyperrefoptions: hidelinks
+
+### Metadaten, welche automatisch ersetzt werden:
+date: 11.11.1111
+lang: de-de
+is-de: true
+# Emfpänger
+licenceholder: P. Rüfling
+address:
+ - E. M. Pfänger
+ - Musterfirma GmbH
+ - Musterstraße 11
+ - 12345 Musterstadt
+...
+$if(titleblock)$
+$titleblock$
+
+$endif$
+$for(header-includes)$
+$header-includes$
+        
+$endfor$
+$for(include-before)$
+$include-before$
+
+$endfor$
+
+$if(is-de)$
+
+<!-- deutsche Version des Briefes  -->
+leider ist die Fahrlizenz $licencename$
+$if(supervisor)$
+  für **$licenceholder$**
+$else$
+  Ihre
+$endif$
+ungültig geworden, z.B. weil die Ablauffrist erreicht wurde.
+
+
+Die Qualifikation „$licencename$“ ist somit 
+$if(expiry)$
+  seit $expiry$ 
+$endif$
+nicht mehr gültig.  
+
+
+$if(supervisor)$
+$if(licence-url)$
+[$licenceholder$]($licence-url$) 
+$else$
+$licenceholder$ 
+$endif$
+darf 
+$else$
+  Sie dürfen 
+$endif$
+ab sofort diese Qualifikation nicht mehr am Frankfurter Flughafens nutzen.
+
+Wenden Sie sich zur Wiedererlangung der Qualifikation bitte
+$if(supervisor)$
+an die Fahrerausbildung der Fraport AG unter:
+
+Telefon
+  
+  : [$phone$](tel:$phone$)
+
+Email
+  
+  : [$email$](mailto:$email$)
+
+$else$
+an Ihren Arbeitgeber.
+$endif$
+
+$else$ 
+<!-- englische Version des Briefes  -->
+we regret to inform you that the driving licence $licencename$ has expired for
+$if(supervisor)$
+  **$licenceholder$**.
+$else$
+  you.
+$endif$
+
+The qualification „$licencename$“ is therefore invalid
+$if(expiry)$
+  since $expiry$.
+$else$
+  now.
+$endif$ 
+
+$if(supervisor)$
+$if(licence-url)$
+[$licenceholder$]($licence-url$) 
+$else$
+$licenceholder$ 
+$endif$
+$else$
+  You
+$endif$
+may no use this qualification at Frankfurt airport, effective immediately.
+
+
+Please contact
+$if(supervisor)$
+the Fraport driving school team, if you want to book a course to regain this licence:
+
+Phone
+  
+  : [$phone$](tel:$phone$)
+
+Email
+  
+  : [$email$](mailto:$email$)
+
+$else$
+your employer to book a course for you in order to regain this licence.
+$endif$
+
+$endif$

test/Database/Fill.hs

@@ -695,9 +695,9 @@ fillDb = do
   let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
   let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
   let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
-  qid_f  <- insert' $ Qualification avn "F" "Vorfeldführerschein"  f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True  (Just AvsLicenceVorfeld)  $ Just "F4466"
+  qid_f  <- insert' $ Qualification avn "F" "Vorfeldführerschein"  f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True  True  (Just AvsLicenceVorfeld)  $ Just "F4466"
-  qid_r  <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3)  False (Just AvsLicenceRollfeld) $ Just "R2801"
+  qid_r  <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3)  False False (Just AvsLicenceRollfeld) $ Just "R2801"
-  qid_l  <- insert' $ Qualification ifi "L" "Lehrbefähigung"       l_descr Nothing   (Just 6) Nothing True Nothing Nothing
+  qid_l  <- insert' $ Qualification ifi "L" "Lehrbefähigung"       l_descr Nothing   (Just 6) Nothing True False Nothing Nothing
   void . insert' $ QualificationUser jost       qid_f (n_day    9) (n_day $   -1) (n_day $   -22) (Just $ QualificationBlocked (n_day $ -5) "LMS") True (n_day' $ -9) -- TODO: better dates!
   void . insert' $ QualificationUser jost       qid_r (n_day   99) (n_day $  -11) (n_day $  -222) Nothing True (n_day' $ -9) -- TODO: better dates!
   void . insert' $ QualificationUser jost       qid_l (n_day  999) (n_day $ -111) (n_day $ -2222) Nothing True (n_day' $ -9) -- TODO: better dates!
@@ -1027,7 +1027,7 @@ fillDb = do
         insert_ Tutorial
           { tutorialName = mkName "Vorlage"
           , tutorialCourse = c
-          , tutorialType = "Schulung"
+          , tutorialType = "Vorlage"
           , tutorialCapacity = capacity
           , tutorialRoom = Just $ case weekDay of
                 Monday -> "A380"
@@ -1045,10 +1045,15 @@ fillDb = do
                     , exceptEnd   = TimeOfDay 16  0  0
                     }
                 , ExceptOccur
-                    { exceptDay   = secondDay
+                    { exceptDay   = succ firstDay
                     , exceptStart = TimeOfDay  9  0  0
                     , exceptEnd   = TimeOfDay 16  0  0
                     }
+                , ExceptOccur
+                    { exceptDay   = secondDay
+                    , exceptStart = TimeOfDay 10  12  0
+                    , exceptEnd   = TimeOfDay 12  13  0
+                    }
                 ]
             }
           , tutorialRegGroup        = Just "schulung"