chore(avs): set qu-renewal flag; tutorial add space separated

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

@@ -28,4 +28,4 @@ RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer
 AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler.
 LicenceTableChangeAvs: Im AVS ändern
 LicenceTableGrantFDrive: In FRADrive erteilen
-LicenceTableRevokeFDrive: In FRADrive entziehen
+LicenceTableRevokeFDrive: In FRADrive zum Vortag entziehen

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

@@ -28,4 +28,4 @@ RevokeUnknownLicencesFail: Not all AVS driving licences of unknown drivers could
 AvsCommunicationError: AVS interface returned an unexpected error.
 LicenceTableChangeAvs: Change in AVS
 LicenceTableGrantFDrive: Grant in FRADrive
-LicenceTableRevokeFDrive: Revoke in FRADrive
+LicenceTableRevokeFDrive: Revoke yesterday in FRADrive

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

@@ -83,7 +83,7 @@ CourseParticipantsRegisterHeading: Kursteilnehmer:innen hinzufügen
 CourseParticipantsRegisterActionAddParticipants: Personen zum Kurs anmelden
 CourseParticipantsRegisterActionAddTutorialMembers: Personen zu Kurs und Übungsgruppe anmelden
 CourseParticipantsRegisterUsersField: Zum Kurs anzumeldende Personen
-CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma getrennt angeben.
+CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma oder Leerzeichen trennen.
 CourseParticipantsRegisterTutorialOption: Kursteilnehmer:innen zu Übungsgruppe anmelden?
 CourseParticipantsRegisterTutorialField: Übungsgruppe
 CourseParticipantsRegisterTutorialFieldTip: Ist aktuell keine Übungsgruppe mit diesem Namen vorhanden, wird eine neue erstellt. Ist bereits eine Übungsgruppe mit diesem Namen vorhanden, werden die Kursteilnehmenden dieser hinzugefügt.

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

@@ -83,7 +83,7 @@ CourseParticipantsRegisterHeading: Add course participants
 CourseParticipantsRegisterActionAddParticipants: Add course participants
 CourseParticipantsRegisterActionAddTutorialMembers: Add course and tutorial participants
 CourseParticipantsRegisterUsersField: Persons to register for course
-CourseParticipantsRegisterUsersFieldTip: Please enter id card no (including dot), Fraport personnel number or email. Please separate multiple entries with commas.
+CourseParticipantsRegisterUsersFieldTip: Please enter id card no (including dot), Fraport personnel number or email. Please separate multiple entries with comma or space.
 CourseParticipantsRegisterTutorialOption: Register course participants for tutorial?
 CourseParticipantsRegisterTutorialField: Tutorial
 CourseParticipantsRegisterTutorialFieldTip: If there is no tutorial with this name, a new one will be created. If there is a tutorial with this name, the course participants will be registered for it.

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

@@ -23,7 +23,8 @@ TableQualificationFirstHeld: Erstmalig
 TableQualificationBlockedDue: Suspendiert
 TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst?
 TableQualificationNoRenewal: Storniert
-TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versand, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
+TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
+QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
 LmsUser: Inhaber
 TableLmsEmail: E-Mail
 TableLmsIdent: LMS Identifikation

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

@@ -24,6 +24,7 @@ TableQualificationBlockedDue: Suspended
 TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?
 TableQualificationNoRenewal: Canceled
 TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
+QualificationUserNoRenewal: Expires without further notification
 LmsUser: Licensee
 TableLmsEmail: Email
 TableLmsIdent: LMS Identifier

src/Audit/Types.hs

@@ -199,10 +199,11 @@ data Transaction
     }
 
   | TransactionQualificationUserEdit
-    { transactionQualificationUser :: QualificationUserId
+    { transactionQualificationUser            :: QualificationUserId
-    , transactionQualification     :: QualificationId
+    , transactionQualification                :: QualificationId
-    , transactionUser              :: UserId
+    , transactionUser                         :: UserId
-    , transactionQualificationValidUntil :: Day
+    , transactionQualificationValidUntil      :: Day
+    , transactionQualificationScheduleRenewal :: Maybe Bool -- Maybe, because some update may leave it unchanged (also avoids DB Migration)
     }
   | TransactionQualificationUserDelete
     { transactionQualificationUser :: QualificationUserId

src/Handler/Admin/Avs.hs

@@ -333,8 +333,9 @@ embedRenderMessage ''UniWorX ''LicenceTableAction id
 
 data LicenceTableActionData =  LicenceTableChangeAvsData
                             |  LicenceTableRevokeFDriveData --TODO: add { licenceTableChangeFDriveQId :: QualificationId to avoid lookup later
-                            |  LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId
+                            |  LicenceTableGrantFDriveData { licenceTableChangeFDriveQId    :: QualificationId
-                                                           , licenceTableChangeFDriveEnd :: Day
+                                                           , licenceTableChangeFDriveEnd    :: Day
+                                                           , licenceTableChangeFDriveRenew  :: Maybe Bool
                                                            }
   deriving (Eq, Ord, Read, Show, Generic)
 
@@ -423,7 +424,7 @@ getProblemAvsSynchR = do
         nups <- runDB $ do
           qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic
           selectedUsers <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
-          forM_ selectedUsers $ upsertQualificationUser qId nowaday $ pred nowaday
+          forM_ selectedUsers $ upsertQualificationUser qId nowaday (pred nowaday) Nothing
           return $ length selectedUsers
         addMessageI Success $ MsgRevokeFraDriveLicences alic nups
         redirect ProblemAvsSynchR -- must be outside runDB 
@@ -433,7 +434,7 @@ getProblemAvsSynchR = do
           uas <- selectList [UserAvsPersonId <-. Set.toList apids] []
           let uids = view _userAvsUser <$> uas
           -- addMessage Info $ text2Html $ "UIDs: " <> tshow uids -- DEBUG
-          forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd
+          forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd licenceTableChangeFDriveRenew
           (length uids,) <$> get404 licenceTableChangeFDriveQId
         addMessageI Success $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n
         redirect ProblemAvsSynchR -- must be outside runDB 
@@ -577,6 +578,7 @@ mkLicenceTable PaginationParameters{..} dbtIdent aLic apids = do
               else singletonMap LicenceTableGrantFDrive  $ LicenceTableGrantFDriveData 
                     <$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
                     <*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?!
+                    <*> aopt (convertField not not (boolField . Just $ SomeMessage MsgBoolIrrelevant)) (fslI MsgQualificationUserNoRenewal) Nothing
           ]      
       dbtParams = DBParamsForm
           { dbParamsFormMethod = POST

src/Handler/Course/ParticipantInvite.hs

@@ -143,7 +143,7 @@ postCAddUserR tid ssh csh = do
 
   ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
     today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
-    auReqUsers <- wreq (textField & cfCommaSeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
+    auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
     auReqTutorial <- optionalActionW
       ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just . CI.mk $ tshow today) ) -- TODO: use user date display setting
       ( fslI MsgCourseParticipantsRegisterTutorialOption )

src/Handler/SAP.hs

@@ -57,7 +57,7 @@ instance ToNamedRecord SapUserTableCsv where
 --   TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
 sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
 sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l 
-               , readMay persNo > Just 0       -- filter E-accounts for SAP export
+               , readMay persNo > Just (0::Int)       -- filter E-accounts for SAP export
                , let res = SapUserTableCsv
                             { csvSUTpersonalNummer = persNo
                             , csvSUTqualifikation  = sapId

src/Handler/Tutorial/Users.hs

@@ -100,7 +100,7 @@ postTUsersR tid ssh csh tutn = do
     (TutorialUserGrantQualificationData{..}, selectedUsers) -> do
       -- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
       today <- utctDay <$> liftIO getCurrentTime
-      runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil
+      runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing
       addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
       redirect $ CTutorialR tid ssh csh tutn TUsersR
     (TutorialUserSendMailData{}, selectedUsers) -> do

src/Handler/Users.hs

@@ -188,10 +188,10 @@ postUsersR = do
       acts = mconcat 
         [ singletonMap UserLdapSync      $ pure UserLdapSyncData
         , singletonMap UserAddSupervisor $ UserAddSupervisorData 
-            <$> apopt (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
+            <$> apopt (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
         , singletonMap UserSetSupervisor $ UserSetSupervisorData 
-            <$> apopt  (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
+            <$> apopt  (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
         , singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
         ]

src/Handler/Utils/Qualification.hs

@@ -11,23 +11,27 @@ module Handler.Utils.Qualification
 import Import
 
 
-upsertQualificationUser :: QualificationId -> Day -> Day -> UserId -> DB ()
+upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> UserId -> DB ()
-upsertQualificationUser  qualificationUserQualification today qualificationUserValidUntil qualificationUserUser = do   
+upsertQualificationUser  qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do   
   Entity quid _ <- upsert
     QualificationUser
-      { qualificationUserLastRefresh      = today
+      { qualificationUserFirstHeld        = qualificationUserLastRefresh
-      , qualificationUserFirstHeld        = today
       , qualificationUserBlockedDue       = Nothing
-      , qualificationUserScheduleRenewal  = True
+      , qualificationUserScheduleRenewal  = fromMaybe True mbScheduleRenewal
       , ..
       }
-    [ QualificationUserValidUntil    =. qualificationUserValidUntil
+    ( 
-    , QualificationUserLastRefresh   =. today
+      [ QualificationUserScheduleRenewal    =. scheduleRenewal              | Just scheduleRenewal <- [mbScheduleRenewal]
-    , QualificationUserBlockedDue    =. Nothing
+      ] ++
-    ]
+      [ QualificationUserValidUntil         =. qualificationUserValidUntil
+      , QualificationUserLastRefresh        =. qualificationUserLastRefresh
+      , QualificationUserBlockedDue         =. Nothing
+      ]
+    )    
   audit TransactionQualificationUserEdit
     { transactionQualificationUser        = quid
     , transactionQualification            = qualificationUserQualification
     , transactionUser                     = qualificationUserUser
     , transactionQualificationValidUntil  = qualificationUserValidUntil
+    , transactionQualificationScheduleRenewal = mbScheduleRenewal
     }

src/Utils/Form.hs

@@ -22,6 +22,7 @@ import Utils.Lens
 import Text.Blaze (Markup)
 import qualified Text.Blaze.Internal as Blaze (null)
 import qualified Data.Text as T
+import qualified Data.Char as C
 
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
@@ -849,6 +850,17 @@ cfCI = convertField CI.mk CI.original
 cfCommaSeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text)
 cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . T.splitOn ",") (T.intercalate ", " . Set.toList)
 
+cfAnySeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text)
+cfAnySeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . T.split anySeparator) (T.intercalate ", " . Set.toList)
+  where anySeparator :: Char -> Bool
+        anySeparator c = C.isSeparator c || c == ',' || c == ';'
+
+-- -- TODO: consider using package ordered-containers?
+-- cfAnySeparatedList :: (Functor m) => Field m Text -> Field m [Text]
+-- cfAnySeparatedList = guardField (not . null) . convertField (mapMaybe (assertM' (not . T.null) . T.strip) . T.split anySeparator) (T.intercalate ", ")
+--   where anySeparator :: Char -> Bool
+--         anySeparator c = C.isSeparator c || c == ',' || c == ';'
+
 isoField :: Functor m => AnIso' a b -> Field m a -> Field m b
 isoField (cloneIso -> fieldIso) = convertField (view fieldIso) (review fieldIso)