fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

feat(course-users): export eppn to csv and json

Browse Source
This commit is contained in:
Sarah Vaupel 2022-02-08 23:08:47 +01:00 committed by Sarah Vaupel
parent 14c2f6d82d
commit 3c797039cc
3 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
models/users.model
View File

@ -17,7 +17,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create
lastAuthentication UTCTime Maybe -- last login date
created UTCTime default=now()
lastLdapSynchronisation UTCTime Maybe
ldapPrimaryKey Text Maybe
ldapPrimaryKey UserEduPersonPrincipalName Maybe
tokensIssuedAfter UTCTime Maybe -- do not accept bearer tokens issued before this time (accept all tokens if null)
matrikelnummer UserMatriculation Maybe -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...)
firstName Text -- For export in tables, pre-split firstName from displayName

18
src/Handler/Course/Users.hs
View File

@ -176,6 +176,7 @@ data UserTableCsv = UserTableCsv
, csvUserName :: UserDisplayName
, csvUserSex :: Maybe Sex
, csvUserMatriculation :: Maybe UserMatriculation
, csvUserEPPN :: Maybe UserEduPersonPrincipalName
, csvUserEmail :: UserEmail
, csvUserStudyFeatures :: UserTableStudyFeatures
, csvUserSubmissionGroup :: Maybe SubmissionGroupName
@ -194,6 +195,7 @@ instance Csv.ToNamedRecord UserTableCsv where
, "name" Csv..= csvUserName
, "sex" Csv..= csvUserSex
, "matriculation" Csv..= csvUserMatriculation
, "eduPersonPrincipalName" Csv..= csvUserEPPN
, "email" Csv..= csvUserEmail
, "study-features" Csv..= csvUserStudyFeatures
, "submission-group" Csv..= csvUserSubmissionGroup
@ -239,7 +241,7 @@ userTableCsvHeader :: Bool -> [Entity Tutorial] -> [Entity Sheet] -> UserCsvExpo
userTableCsvHeader showSex tuts sheets UserCsvExportData{..} = Csv.header $
[ "surname", "first-name", "name" ] ++
[ "sex" | showSex ] ++
[ "matriculation", "email", "study-features"] ++
[ "matriculation", "eduPersonPrincipalName", "email", "study-features"] ++
[ "tutorial" | hasEmptyRegGroup ] ++
map (encodeUtf8 . CI.foldedCase) regGroups ++
[ "exams", "registration" ] ++
@ -255,6 +257,7 @@ data UserTableJson = UserTableJson
, jsonUserName :: UserDisplayName
, jsonUserSex :: Maybe (Maybe Sex)
, jsonUserMatriculation :: Maybe UserMatriculation
, jsonUserEPPN :: Maybe UserEduPersonPrincipalName
, jsonUserEmail :: UserEmail
, jsonUserStudyFeatures :: UserTableStudyFeatures
, jsonUserSubmissionGroup :: Maybe SubmissionGroupName
@ -291,6 +294,7 @@ instance ToJSON UserTableJson where
, pure $ "name" JSON..= jsonUserName
, ("sex" JSON..=) <$> jsonUserSex
, ("matriculation" JSON..=) <$> jsonUserMatriculation
, ("eduPersonPrincipalName" JSON..=) <$> jsonUserEPPN
, pure $ "email" JSON..= jsonUserEmail
, ("study-features" JSON..=) <$> assertM' (views _Wrapped $ not . onull) jsonUserStudyFeatures
, ("submission-group" JSON..=) <$> jsonUserSubmissionGroup
@ -523,6 +527,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
<*> view (hasUser . _userDisplayName)
<*> view (hasUser . _userSex)
<*> view (hasUser . _userMatrikelnummer)
<*> view (hasUser . _userLdapPrimaryKey)
<*> view (hasUser . _userEmail)
<*> view _userStudyFeatures
<*> preview (_userSubmissionGroup . _entityVal . _submissionGroupName)
@ -550,12 +555,13 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
repUserJson = C.foldMapM $ \(E.Value uid, res) -> Map.singleton <$> encrypt uid <*> mkUserTableJson res
where
mkUserTableJson res' = flip runReaderT res' $ UserTableJson
<$> view (hasUser . _userSurname)
<*> view (hasUser . _userFirstName)
<*> view (hasUser . _userDisplayName)
<$> view (hasUser . _userSurname)
<*> view (hasUser . _userFirstName)
<*> view (hasUser . _userDisplayName)
<*> views (hasUser . _userSex) (guardOn showSex)
<*> view (hasUser . _userMatrikelnummer)
<*> view (hasUser . _userEmail)
<*> view (hasUser . _userMatrikelnummer)
<*> view (hasUser . _userLdapPrimaryKey)
<*> view (hasUser . _userEmail)
<*> view _userStudyFeatures
<*> preview (_userSubmissionGroup . _entityVal . _submissionGroupName)
<*> view _userTableRegistration

2
src/Model/Types/User.hs
View File

@ -4,7 +4,7 @@ import Import.NoModel
import Model.Types.TH.PathPiece
type UserEduPersonPrincipalName = CI Text
type UserEduPersonPrincipalName = Text
data SystemFunction