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

chore(company): add company db

Browse Source
This commit is contained in:
Steffen Jost 2022-11-16 13:46:55 +01:00
parent 88d0bf03bf
commit c04704a549
7 changed files with 66 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
models/company.model Normal file
View File

@ -0,0 +1,15 @@
-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- 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

2
models/schools.model
View File

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

8
models/users.model
View File

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

21
src/Handler/Utils/Avs.hs
View File

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

43
src/Model/Types/Common.hs
View File

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

3
src/Utils/Lens.hs
View File

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

5
test/Database/Fill.hs
View File

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