chore(company): add company db

models/company.model

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

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

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

src/Handler/Utils/Avs.hs

@@ -3,13 +3,11 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 module Handler.Utils.Avs
-  ( -- upsertAvsUser
+  ( upsertAvsUser, upsertAvsUserById, upsertAvsUserByCard
-  --, checkLicences
+  , getLicence, getLicenceDB
-    getLicence, getLicenceDB
   , setLicence, setLicenceAvs, setLicencesAvs
   , checkLicences
-  , lookupAvsUser, lookupAvsUsers
+  , lookupAvsUser, lookupAvsUsers  
-  , upsertAvsUserById, upsertAvsUserByCard
   ) 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    

src/Model/Types/Common.hs

@@ -22,13 +22,13 @@ type Points = Centi
 
 type Email = Text
 
-type UserTitle         = Text
+type UserTitle            = Text
-type UserFirstName     = Text
+type UserFirstName        = Text
-type UserSurname       = Text
+type UserSurname          = Text
-type UserDisplayName   = Text
+type UserDisplayName      = Text
-type UserIdent         = CI Text
+type UserIdent            = CI Text
-type UserMatriculation = Text
+type UserMatriculation    = Text
-type UserEmail         = CI Email
+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 SchoolName           = CI Text
-type SchoolShorthand = CI Text
+type SchoolShorthand      = CI Text
 
-type CourseName          = CI Text
+type CompanyName          = CI Text
-type CourseShorthand     = CI Text
+type CompanyShorthand     = CI Text 
-type MaterialName        = CI Text
-type TutorialName        = CI Text
-type SheetName           = CI Text
-type SubmissionGroupName = CI Text
 
-type ExamName           = CI Text
+type CourseName           = CI Text
-type ExamPartName       = CI Text
+type CourseShorthand      = CI Text
-type ExamOccurrenceName = CI Text
+type MaterialName         = CI Text
+type TutorialName         = CI Text
+type SheetName            = CI Text
+type SubmissionGroupName  = CI Text
 
-type AllocationName      = CI Text
+type ExamName             = CI Text
-type AllocationShorthand = 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
 

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
 

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