diff --git a/models/company.model b/models/company.model new file mode 100644 index 000000000..53ceecc43 --- /dev/null +++ b/models/company.model @@ -0,0 +1,15 @@ +-- SPDX-FileCopyrightText: 2022 Sarah Vaupel ,Steffen Jost +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +-- Description of companies associated with users + +Company json + name CompanyName -- == (CI Text) + shorthand CompanyShorthand -- == (CI Text) and CompanyKey :: CompanyShorthand -> CompanyId FUTURE TODO: a shorthand will become available through the AVS interface in the future + -- postAddress StoredMarkup Maybe -- + -- avsId Int -- FUTURE TODO: once this number becomes available through AVS interface; this could be the primary key + UniqueCompany name + UniqueCompanyShorthand shorthand + Primary shorthand -- newtype Key Company = CompanyKey { unSchoolKey :: CompanyShorthand } + deriving Ord Eq Show Generic diff --git a/models/schools.model b/models/schools.model index 811d95fea..60c45cbbd 100644 --- a/models/schools.model +++ b/models/schools.model @@ -6,7 +6,7 @@ -- Each school must have a unique human-readable shorthand which is used as database row key School json name (CI Text) - shorthand (CI Text) -- SchoolKey :: SchoolShorthand -> SchoolId + shorthand SchoolShorthand -- type SchoolShorthand = (CI Text) -- SchoolKey :: SchoolShorthand -> SchoolId examMinimumRegisterBeforeStart NominalDiffTime Maybe examMinimumRegisterDuration NominalDiffTime Maybe examRequireModeForRegistration Bool default=false diff --git a/models/users.model b/models/users.model index 733247d1f..080004af1 100644 --- a/models/users.model +++ b/models/users.model @@ -40,7 +40,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create sex Sex Maybe showSex Bool default=false telephone Text Maybe - mobile Text Maybe + 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 @@ -83,6 +83,12 @@ UserGroupMember UniquePrimaryUserGroupMember group primary !force UniqueUserGroupMember group user deriving Generic +UserCompany + company CompanyId + user UserId + supervisor Bool -- is this user a company supervisor? + UniqueCompanyUser company user + deriving Generic UserSupervisor supervisor UserId -- multiple supervisor per trainee possible user UserId diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index a85d185cc..c57d5cd05 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -3,13 +3,11 @@ -- SPDX-License-Identifier: AGPL-3.0-or-later module Handler.Utils.Avs - ( -- upsertAvsUser - --, checkLicences - getLicence, getLicenceDB + ( upsertAvsUser, upsertAvsUserById, upsertAvsUserByCard + , getLicence, getLicenceDB , setLicence, setLicenceAvs, setLicencesAvs , checkLicences - , lookupAvsUser, lookupAvsUsers - , upsertAvsUserById, upsertAvsUserByCard + , lookupAvsUser, lookupAvsUsers ) where import Import @@ -113,9 +111,10 @@ checkLicences = do error "CONTINUE HERE" -- TODO STUB -{- + upsertAvsUser :: Text -> Handler (Maybe UserId) -upsertAvsUser someid +upsertAvsUser _someid = error "TODO" -- TODO STUB +{- | isAvsId someid = error "TODO" | isEmail someid = error "TODO" | isNumber someid = error "TODO" @@ -145,7 +144,7 @@ upsertAvsUserById api = do case (mbuid, mbapd) of ( _ , Nothing ) -> throwM $ AvsUserUnknownByAvs api -- User not found in AVS at all, i.e. no valid card exists yet (Nothing, Just AvsDataPerson{..}) -> do -- No LDAP User, but found in AVS; create user - let firmAddress = mergeCompanyAddress <$> guessLicenceAddress avsPersonPersonCards + let firmAddress = guessLicenceAddress avsPersonPersonCards bestCard = Set.lookupMax avsPersonPersonCards fakeIdent = CI.mk $ tshow api newUsr = AdminUserForm @@ -160,7 +159,7 @@ upsertAvsUserById api = do , aufTelephone = Nothing , aufFPersonalNumber = avsPersonInternalPersonalNo , aufFDepartment = Nothing - , aufPostAddress = plaintextToStoredMarkup <$> firmAddress + , aufPostAddress = plaintextToStoredMarkup . mergeCompanyAddress <$> firmAddress , aufPrefersPostal = isJust firmAddress , aufPinPassword = getFullCardNo <$> bestCard , aufEmail = fakeIdent -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO) @@ -168,6 +167,10 @@ upsertAvsUserById api = do , aufAuth = maybe AuthKindNoLogin (const AuthKindLDAP) avsPersonInternalPersonalNo -- FUTURE TODO: if email is known, use AuthKinfPWHash for email invite, if no internal personal number is known } _ <- addNewUser newUsr -- trigger JobSynchroniseLdapUser, JobSendPasswordReset and NotificationUserAutoModeUpdate -- TODO: check if these are failsafe + -- upsertBy (UniqueCompanyName firmName) (Company firmName firmShort) [] + -- + -- <- insertBy (UserCompany firmShort uid False) + -- _newAvs = UserAvs avsPersonPersonID uid -- _newAvsCards = UserAvsCard error "TODO" -- CONTINUE HERE diff --git a/src/Model/Types/Common.hs b/src/Model/Types/Common.hs index 80ae36109..0de5be746 100644 --- a/src/Model/Types/Common.hs +++ b/src/Model/Types/Common.hs @@ -22,13 +22,13 @@ type Points = Centi type Email = Text -type UserTitle = Text -type UserFirstName = Text -type UserSurname = Text -type UserDisplayName = Text -type UserIdent = CI Text -type UserMatriculation = Text -type UserEmail = CI Email +type UserTitle = Text +type UserFirstName = Text +type UserSurname = Text +type UserDisplayName = Text +type UserIdent = CI Text +type UserMatriculation = Text +type UserEmail = CI Email type StudyDegreeName = Text type StudyDegreeShorthand = Text @@ -38,22 +38,25 @@ type StudyTermsShorthand = Text type StudyTermsKey = Int type StudySubTermsKey = Int -type SchoolName = CI Text -type SchoolShorthand = CI Text +type SchoolName = CI Text +type SchoolShorthand = CI Text -type CourseName = CI Text -type CourseShorthand = CI Text -type MaterialName = CI Text -type TutorialName = CI Text -type SheetName = CI Text -type SubmissionGroupName = CI Text +type CompanyName = CI Text +type CompanyShorthand = CI Text -type ExamName = CI Text -type ExamPartName = CI Text -type ExamOccurrenceName = CI Text +type CourseName = CI Text +type CourseShorthand = CI Text +type MaterialName = CI Text +type TutorialName = CI Text +type SheetName = CI Text +type SubmissionGroupName = CI Text -type AllocationName = CI Text -type AllocationShorthand = CI Text +type ExamName = CI Text +type ExamPartName = CI Text +type ExamOccurrenceName = CI Text + +type AllocationName = CI Text +type AllocationShorthand = CI Text type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index b5bdb62e9..0001b4dc3 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -56,6 +56,9 @@ _nullable = prism' toNullable fromNullable _SchoolId :: Iso' SchoolId SchoolShorthand _SchoolId = iso unSchoolKey SchoolKey +_CompanyId :: Iso' CompanyId CompanyShorthand +_CompanyId = iso unCompanyKey CompanyKey + _TermId :: Iso' TermId TermIdentifier _TermId = iso unTermKey TermKey diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index b8ed53f86..0ae3e1db5 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -478,6 +478,11 @@ fillDb = do I am aware that violations in the form plagiarism or collaboration with third parties will lead to expulsion from the course. |] } + _fraportAg <- insert' $ Company "Fraport AG" "Fraport" + _fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH" "FraGround" + _nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" + _ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" + _bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True avn <- insert' $ School "Fahrerausbildung" "FA" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True