lms: add pin passwords to user records

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

@@ -14,6 +14,7 @@ AdminUserFPersonalNumber: Personalnummer (nur Fraport AG)
 AdminUserFDepartment: Abteilung
 AdminUserPostAddress: Postalische Anschrift
 AdminUserPrefersPostal: Briefe anstatt Email bevorzugt
+AdminUserPinPassword: Passwort zur Verschlüsselung von PDF Anhängen in Emails
 AdminUserAssimilate: Benutzer assimilieren
 UserAdded: Benutzer erfolgreich angelegt
 UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden

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

@@ -14,6 +14,7 @@ AdminUserFPersonalNumber: Personalnumber (Fraport AG only)
 AdminUserFDepartment: Department
 AdminUserPostAddress: Postal Address
 AdminUserPrefersPostal: Prefers postal letters over email
+AdminUserPinPassword: Password used for all PDF attachments to emails
 AdminUserAssimilate: Assimilate user
 UserAdded: Successfully added user
 UserCollision: Could not create user due to uniqueness constraint

models/users.model

@@ -39,7 +39,7 @@ User json    -- Each Uni2work user has a corresponding row in this table; create
     mobile         Text Maybe                   
     companyPersonalNumber Text Maybe -- Company will become a new table, but if company=fraport, some information is received via LDAP 
     companyDepartment     Text Maybe -- thus we store such information for ease of reference directly, if available 
-    -- pinPassword           Text Maybe -- used to encrypt pins within emails
+    pinPassword           Text Maybe -- used to encrypt pins within emails
     postAddress           StoredMarkup Maybe 
     prefersPostal         Bool default=false    -- user prefers letters by post instead of email
     examOfficeGetSynced   Bool default=true     -- whether synced status should be displayed for exam results by default

src/Foundation/Yesod/Auth.hs

@@ -247,6 +247,7 @@ upsertCampusUser upsertMode ldapData = do
       , userDisplayEmail            = userEmail
       , userMatrikelnummer          = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO      
       , userPostAddress             = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO
+      , userPinPassword             = Nothing -- must be derived via AVS
       , userPrefersPostal           = False
       , ..
       }

src/Handler/LMS/Fake.hs

@@ -34,7 +34,7 @@ postLmsFakeR sid qsh = do
   siteLayout "Testnutzer generieren" $ do
     setTitle $ toHtml $ "Testnutzer generieren " <> qName
     toWidget [whamlet|
-        Hier können neu zufällige Testbenutzer mit ablaufenden Qualifikationen generiert werden.
+        Hier können zufällige Testbenutzer mit ablaufenden Qualifikationen generiert werden.
 
         ^{fakeForm}
       |]
@@ -89,6 +89,7 @@ fakeQualificationUsers qid (usersPerDay, dfrom, dto) = do
               userCompanyPersonalNumber = Nothing
               userCompanyDepartment = Nothing
               userPostAddress = postalAddress
+              userPinPassword = Just "tomatenmarmelade"
           in User{..}
 
     valid <- forM (zip expiryOffsets $ drop dropNames names) $ \(expOffset, user) -> do
@@ -99,7 +100,12 @@ fakeQualificationUsers qid (usersPerDay, dfrom, dto) = do
           qualificationUserValidUntil    = addDays expOffset dfrom
           qualificationUserFirstHeld     = addGregorianMonthsClip (-24) qualificationUserValidUntil
           qualificationUserLastRefresh   = qualificationUserFirstHeld
-      ok <- insertUnique QualificationUser{..}
+      -- upsert QualificationUser{..} [ QualificationUserValidUntil  =. qualificationUserValidUntil
+      --                                , QualificationUserLastRefresh =. qualificationUserLastRefresh
+      --                              ]
+      -- return 1
+      -- We do not overwrite any existing qualifications, just to be on the save side:
+      ok <- insertUnique QualificationUser{..}      
       return $ maybe 0 (const 1) ok
     return (sum valid, length expiryOffsets)
 

src/Handler/Users/Add.hs

@@ -25,6 +25,7 @@ data AdminUserForm = AdminUserForm
   , aufFDepartment     :: Maybe Text 
   , aufPostAddress     :: Maybe StoredMarkup
   , aufPrefersPostal   :: Bool
+  , aufPinPassword     :: Maybe Text
   , aufEmail :: UserEmail
   , aufIdent :: UserIdent
   , aufAuth :: AuthenticationKind  
@@ -61,10 +62,11 @@ adminUserForm template = renderAForm FormStandard
   <*> aopt (textField & cfStrip)        (fslI MsgAdminUserFDepartment)     (aufFDepartment <$> template)
   <*> aopt htmlField                    (fslI MsgAdminUserPostAddress)     (aufPostAddress   <$> template) 
   <*> areq checkBoxField                (fslI MsgAdminUserPrefersPostal)   (aufPrefersPostal <$> template)
+  <*> aopt (textField & cfStrip)        (fslI MsgAdminUserPinPassword)     (aufPinPassword <$> template)
   <*> areq (emailField & cfCI)          (fslI MsgAdminUserEmail) (aufEmail <$> template)
   <*> areq (textField & cfStrip & cfCI) (fslI MsgAdminUserIdent) (aufIdent <$> template)
   <*> areq (selectField optionsFinite)  (fslI MsgAdminUserAuth) (aufAuth <$> template <|> Just AuthKindLDAP)
-
+  
 
 getAdminUserAddR, postAdminUserAddR :: Handler Html
 getAdminUserAddR = postAdminUserAddR
@@ -110,6 +112,7 @@ postAdminUserAddR = do
         , userCompanyDepartment       = aufFDepartment    
         , userPostAddress             = aufPostAddress
         , userPrefersPostal           = aufPrefersPostal
+        , userPinPassword             = aufPinPassword
         , userMatrikelnummer          = aufMatriculation
         , userAuthentication          = mkAuthMode aufAuth
         }

test/Database/Fill.hs

@@ -111,6 +111,7 @@ fillDb = do
     , userMobile = Nothing 
     , userCompanyPersonalNumber = Nothing 
     , userCompanyDepartment = Nothing
+    , userPinPassword = Nothing
     , userPostAddress = Nothing
     , userPrefersPostal = False
     , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
@@ -148,6 +149,7 @@ fillDb = do
     , userTelephone = Nothing     
     , userCompanyPersonalNumber = Nothing 
     , userCompanyDepartment = Nothing
+    , userPinPassword = Nothing
     , userPostAddress = Nothing
     , userPrefersPostal = False
     , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
@@ -191,6 +193,7 @@ fillDb = do
     , userMobile = Just "0173 69 99 646"
     , userCompanyPersonalNumber = Just "57138"
     , userCompanyDepartment = Just "AVN-AR2"
+    , userPinPassword = Nothing
     , userPostAddress = Nothing
     , userPrefersPostal = False
     , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
@@ -228,6 +231,7 @@ fillDb = do
     , userMobile = Nothing 
     , userCompanyPersonalNumber = Nothing 
     , userCompanyDepartment = Nothing
+    , userPinPassword = Nothing
     , userPostAddress = Nothing
     , userPrefersPostal = False
     , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
@@ -265,6 +269,7 @@ fillDb = do
     , userMobile = Nothing 
     , userCompanyPersonalNumber = Nothing 
     , userCompanyDepartment = Nothing
+    , userPinPassword = Nothing
     , userPostAddress = Nothing
     , userPrefersPostal = False
     , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
@@ -302,6 +307,7 @@ fillDb = do
     , userMobile = Nothing 
     , userCompanyPersonalNumber = Nothing 
     , userCompanyDepartment = Nothing
+    , userPinPassword = Nothing
     , userPostAddress = Nothing
     , userPrefersPostal = False
     , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced
@@ -339,6 +345,7 @@ fillDb = do
     , userMobile = Nothing 
     , userCompanyPersonalNumber = Nothing 
     , userCompanyDepartment = Nothing
+    , userPinPassword = Nothing
     , userPostAddress = Nothing
     , userPrefersPostal = False
     , userExamOfficeGetSynced = False
@@ -406,6 +413,7 @@ fillDb = do
       , userMobile = Nothing 
       , userCompanyPersonalNumber = Nothing 
       , userCompanyDepartment = Nothing
+      , userPinPassword = Nothing
       , userPostAddress = Nothing
       , userPrefersPostal = False
       , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced

test/User.hs

@@ -49,5 +49,6 @@ fakeUser adjUser = adjUser User{..}
     userTelephone = Nothing     
     userCompanyPersonalNumber = Nothing 
     userCompanyDepartment = Nothing
+    userPinPassword = Nothing
     userPostAddress = Nothing
     userPrefersPostal = False