fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lms: add pin passwords to user records

Browse Source
This commit is contained in:
Steffen Jost 2022-09-01 16:16:56 +02:00
parent 3eedff2b9f
commit 83b8e765c6
8 changed files with 25 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -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

1
messages/uniworx/categories/user/en-eu.msg
View File

@ -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

2
models/users.model
View File

@ -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

1
src/Foundation/Yesod/Auth.hs
View File

@ -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
, ..
}

10
src/Handler/LMS/Fake.hs
View File

@ -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)

5
src/Handler/Users/Add.hs
View File

@ -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
}

8
test/Database/Fill.hs
View File

@ -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

1
test/User.hs
View File

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