chore(users): add birthday field

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

@@ -134,6 +134,7 @@ CourseUserSheets: Übungsblätter
 CsvColumnUserName: Voller Name des/der Teilnehmers/Teilnehmerin
 CsvColumnUserMatriculation: Matrikelnummer des/der Teilnehmers/Teilnehmerin
 CsvColumnUserSex: Geschlecht
+CsvColumnUserBirthday: Geburtstag
 CsvColumnUserEmail: E-Mail-Adresse des/der Teilnehmers/Teilnehmerin
 CsvColumnUserCourseStudyFeatures: Alle relevanten Studiendaten des/der Teilnehmers/Teilnehmerin als Semikolon (;) separierte Liste
 CsvColumnUserRegistration: Zeitpunkt der Anmeldung zum Kurs (ISO 8601)

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

@@ -134,6 +134,7 @@ CourseUserSheets: Exercise sheets
 CsvColumnUserName: Participant's full name
 CsvColumnUserMatriculation: Participant's matriculation
 CsvColumnUserSex: Participant's sex
+CsvColumnUserBirthday: Birthday
 CsvColumnUserEmail: Participant's email address
 CsvColumnUserCourseStudyFeatures: All relevant features of study for the participant, separated by semicolon (;)
 CsvColumnUserRegistration: Time of participant's enrollment (ISO 8601)

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

@@ -13,6 +13,7 @@ AdminUserAuth: Authentifizierung
 AdminUserAuthTooltip: Abhängig von der Auswahl werden neue Benutzer über ihr neues FRADrive Konto benachrichtigt.
 AdminUserMatriculation: Matrikelnummer
 AdminUserSex: Geschlecht
+AdminUserBirthday: Geburtsdatum
 AdminUserTelephone: Telefonnummer
 AdminUserMobile: Mobiltelefonnummer
 AdminUserFPersonalNumber: Personalnummer (nur Fraport AG)

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

@@ -13,6 +13,7 @@ AdminUserAuth: Authentication
 AdminUserAuthTooltip: New users may be notified about their FRADrive account depending on this choice.
 AdminUserMatriculation: Matriculation
 AdminUserSex: Sex
+AdminUserBirthday: Date of Birth
 AdminUserTelephone: Phone
 AdminUserMobile: Mobile
 AdminUserFPersonalNumber: Personnel number (Fraport AG only)

messages/uniworx/utils/table_column/de-de-formal.msg

@@ -18,6 +18,7 @@ TableSubmissionGroup: Feste Abgabegruppe
 TableNoSubmissionGroup: Keine feste Abgabegruppe
 TableMatrikelNr: Matrikelnummer
 TableSex: Geschlecht
+TableBirthday: Geburtsdatum
 TableSchool: Institut
 TableCourse: Kurs
 TableCourseMembers: Teilnehmer:innen

messages/uniworx/utils/table_column/en-eu.msg

@@ -18,6 +18,7 @@ TableSubmissionGroup: Registered submission group
 TableNoSubmissionGroup: No registered submission group
 TableMatrikelNr: Matriculation
 TableSex: Sex
+TableBirthday: Birthday
 TableSchool: Department
 TableCourse: Course
 TableCourseMembers: Participants

models/users.model

@@ -37,7 +37,8 @@ User json    -- Each Uni2work user has a corresponding row in this table; create
     notificationSettings NotificationSettings  "default='{}'::jsonb"   -- Bit-array for which events email notifications are requested by user; user-defined
     warningDays    NominalDiffTime default=1209600 -- timedistance to pending deadlines for homepage infos
     csvOptions     CsvOptions "default='{}'::jsonb"
-    sex            Sex Maybe
+    sex            Sex Maybe  -- currently ignored
+    birthday       Day Maybe  -- for better identification
     showSex        Bool default=false
     telephone      Text Maybe            
     mobile         Text Maybe

src/Foundation/Yesod/Auth.hs

@@ -278,6 +278,7 @@ decodeUser now UserDefaultConf{..} upsertMode ldapData = do
         , userWarningDays             = userDefaultWarningDays
         , userShowSex                 = userDefaultShowSex
         , userSex                     = Nothing
+        , userBirthday                = Nothing
         , userExamOfficeGetSynced     = userDefaultExamOfficeGetSynced
         , userExamOfficeGetLabels     = userDefaultExamOfficeGetLabels
         , userNotificationSettings    = def

src/Handler/Admin/Avs.hs

@@ -19,7 +19,7 @@ import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Set  as Set
 import qualified Data.Map as Map
-import Database.Persist.Sql (updateWhereCount)
+-- import Database.Persist.Sql (updateWhereCount)
 
 import Handler.Utils
 import Handler.Utils.Avs
@@ -390,11 +390,13 @@ getProblemAvsSynchR = do
         addMessageI mkind $ MsgAvsSetLicences aLic oks no_req                  
         redirect ProblemAvsSynchR -- reload to update all tables
 
-      procRes alic (LicenceTableRevokeFDriveData, selectedUsers) = do 
+      procRes alic (LicenceTableRevokeFDriveData, apids) = do 
-        runDB $ do
+        nups <- runDB $ do
           qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic
+          selectedUsers <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
           forM_ selectedUsers $ upsertQualificationUser qId nowaday $ pred nowaday
-        addMessageI Success $ MsgRevokeFraDriveLicences alic oks              
+          return $ length selectedUsers
+        addMessageI Success $ MsgRevokeFraDriveLicences alic nups
         redirect ProblemAvsSynchR -- must be outside runDB 
 
       procRes _alic (LicenceTableGrantFDriveData{..}, apids ) = do

src/Handler/Course/Users.hs

@@ -185,6 +185,7 @@ data UserTableCsv = UserTableCsv
   , csvUserFirstName :: UserFirstName
   , csvUserName :: UserDisplayName
   , csvUserSex :: Maybe Sex
+  , csvUserBirthday :: Maybe Day
   , csvUserMatriculation :: Maybe UserMatriculation
   , csvUserEPPN :: Maybe UserEduPersonPrincipalName
   , csvUserEmail :: UserEmail
@@ -204,6 +205,7 @@ instance Csv.ToNamedRecord UserTableCsv where
     , "first-name" Csv..= csvUserFirstName
     , "name" Csv..= csvUserName
     , "sex" Csv..= csvUserSex
+    , "birthday" Csv..= csvUserBirthday
     , "matriculation" Csv..= csvUserMatriculation
     , "eduPersonPrincipalName" Csv..= csvUserEPPN
     , "email" Csv..= csvUserEmail
@@ -228,6 +230,7 @@ instance CsvColumnsExplained UserTableCsv where
     , single "first-name"          MsgCsvColumnUserFirstName
     , single "name"                MsgCsvColumnUserName
     , single "sex"                 MsgCsvColumnUserSex
+    , single "birthday"            MsgCsvColumnUserBirthday
     , single "matriculation"       MsgCsvColumnUserMatriculation
     , single "email"               MsgCsvColumnUserEmail
     , single "submission-group"    MsgCsvColumnUserSubmissionGroup
@@ -538,6 +541,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                   <*> view (hasUser . _userFirstName)
                   <*> view (hasUser . _userDisplayName)
                   <*> view (hasUser . _userSex)
+                  <*> view (hasUser . _userBirthday)
                   <*> view (hasUser . _userMatrikelnummer)
                   <*> view (hasUser . _userLdapPrimaryKey)
                   <*> view (hasUser . _userEmail)

src/Handler/LMS/Fake.hs

@@ -105,6 +105,7 @@ fakeQualificationUsers (Entity qid Qualification{qualificationRefreshWithin}) (u
               userNotificationSettings = def
               userCsvOptions = def
               userSex = Nothing
+              userBirthday = Nothing
               userShowSex = userDefaultShowSex
               userTelephone = Nothing
               userMobile = Nothing

src/Handler/Users/Add.hs

@@ -23,6 +23,7 @@ data AdminUserForm = AdminUserForm
   , aufDisplayEmail :: UserEmail
   , aufMatriculation :: Maybe UserMatriculation
   , aufSex :: Maybe Sex
+  , aufBirthday :: Maybe Day
   , aufMobile    :: Maybe Text 
   , aufTelephone :: Maybe Text   
   , aufFPersonalNumber :: Maybe Text 
@@ -64,6 +65,7 @@ adminUserForm template = renderAForm FormStandard
   <*> areq (emailField & cfCI)          (fslI MsgAdminUserDisplayEmail) (aufDisplayEmail <$> template)
   <*> aopt (textField & cfStrip)        (fslI MsgAdminUserMatriculation) (aufMatriculation <$> template)
   <*> aopt (selectField optionsFinite)  (fslI MsgAdminUserSex) (aufSex <$> template)
+  <*> aopt dayField                     (fslI MsgAdminUserBirthday) (aufBirthday <$> template)
   <*> aopt (textField & cfStrip)        (fslI MsgAdminUserMobile) (aufMobile <$> template)
   <*> aopt (textField & cfStrip)        (fslI MsgAdminUserTelephone) (aufTelephone <$> template)  
   <*> aopt (textField & cfStrip)        (fslI MsgAdminUserFPersonalNumber) (aufFPersonalNumber <$> template)
@@ -115,6 +117,7 @@ addNewUser' notifyUsr AdminUserForm{..} = do
       , userSurname                 = aufSurname
       , userTitle                   = aufTitle
       , userSex                     = aufSex
+      , userBirthday                = aufBirthday
       , userMobile                  = aufMobile
       , userTelephone               = aufTelephone
       , userCompanyPersonalNumber   = aufFPersonalNumber

src/Handler/Utils/Avs.hs

@@ -370,6 +370,7 @@ upsertAvsUserById api = do
             , aufDisplayEmail = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
             , aufMatriculation = Nothing
             , aufSex = Nothing
+            , aufBirthday = Nothing
             , aufMobile = Nothing
             , aufTelephone = Nothing
             , aufFPersonalNumber = avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo

templates/profileData.hamlet

@@ -29,6 +29,16 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
           _{MsgTableMatrikelNr}
         <dd .deflist__dd>
           #{matnr}
+      $maybe sex <- userSex 
+        <dt .deflist__dt>
+          _{MsgTableSex}
+        <dd .deflist__dd>
+          _{sex}
+      $maybe bday <- userBirthday
+        <dt .deflist__dt>
+          _{MsgTableBirthday}
+        <dd .deflist__dd>
+          ^{formatTimeW SelFormatDate bday}      
       <dt .deflist__dt>
         _{MsgPrefersPostal}
       <dd .deflist__dd>

test/Database/Fill.hs

@@ -97,6 +97,7 @@ fillDb = do
     , userLdapPrimaryKey = Nothing
     , userCsvOptions = def { csvFormat = csvPreset # CsvPresetRFC }
     , userSex = Just SexMale
+    , userBirthday = Nothing
     , userShowSex = userDefaultShowSex
     , userTelephone = Nothing
     , userMobile = Nothing
@@ -136,6 +137,7 @@ fillDb = do
     , userCsvOptions = def { csvFormat = csvPreset # CsvPresetExcel }
     , userSex = Just SexMale
     , userShowSex = userDefaultShowSex
+    , userBirthday = Nothing
     , userMobile = Nothing
     , userTelephone = Nothing
     , userCompanyPersonalNumber = Nothing
@@ -178,6 +180,7 @@ fillDb = do
     , userLastLdapSynchronisation = Nothing
     , userLdapPrimaryKey = Nothing
     , userSex = Just SexMale
+    , userBirthday = Just $ n_day $ 35 * (-365)
     , userCsvOptions = def
     , userShowSex = userDefaultShowSex
     , userTelephone = Just "+49 69 690-71706"
@@ -217,6 +220,7 @@ fillDb = do
     , userLdapPrimaryKey = Nothing
     , userCsvOptions = def
     , userSex = Just SexMale
+    , userBirthday = Just $ n_day $ 27 * (-365)
     , userShowSex = userDefaultShowSex
     , userTelephone = Nothing
     , userMobile = Nothing
@@ -255,6 +259,7 @@ fillDb = do
     , userLdapPrimaryKey = Nothing
     , userCsvOptions = def
     , userSex = Just SexNotApplicable
+    , userBirthday = Just $ n_day 3
     , userShowSex = userDefaultShowSex
     , userTelephone = Nothing
     , userMobile = Nothing
@@ -293,6 +298,7 @@ fillDb = do
     , userLdapPrimaryKey = Nothing
     , userCsvOptions = def
     , userSex = Just SexFemale
+    , userBirthday = Nothing
     , userShowSex = userDefaultShowSex
     , userTelephone = Nothing
     , userMobile = Nothing
@@ -331,6 +337,7 @@ fillDb = do
     , userLdapPrimaryKey = Nothing
     , userCsvOptions = def
     , userSex = Just SexMale
+    , userBirthday = Nothing
     , userShowSex = userDefaultShowSex
     , userTelephone = Nothing
     , userMobile = Nothing
@@ -399,6 +406,7 @@ fillDb = do
       , userLdapPrimaryKey = Nothing
       , userCsvOptions = def
       , userSex = Nothing
+      , userBirthday = Nothing
       , userShowSex = userDefaultShowSex
       , userTelephone = Nothing
       , userMobile = Nothing