chore(company): assign company supervisors for new users (model:add column)
This commit is contained in:
Steffen Jost
parent
ca59adee03
commit
451dcd0a09
@ -88,7 +88,8 @@ UserGroupMember
|
||||
UserCompany
|
||||
user UserId
|
||||
company CompanyId OnDeleteCascade OnUpdateCascade
|
||||
supervisor Bool -- is this user a company supervisor?
|
||||
supervisor Bool -- should this user be made supervisor for all _new_ users associated with this company?
|
||||
supervisorReroute Bool default=true -- if supervisor is true, should this supervisor receive email for _new_ company users?
|
||||
UniqueUserCompany user company -- a user may belong to multiple companies, but to each one only once
|
||||
deriving Generic
|
||||
UserSupervisor
|
||||
|
||||
@ -182,7 +182,8 @@ upsertCampusUser upsertMode ldapData = do
|
||||
userDefaultConf <- getsYesod $ view _appUserDefaults
|
||||
|
||||
(newUser,userUpdate) <- decodeUser now userDefaultConf upsertMode ldapData
|
||||
|
||||
--TODO: newUser should be associated with a company and company supervisor through Handler.Utils.Company.upsertUserCompany, but this is called by upsertAvsUser already - conflict?
|
||||
|
||||
oldUsers <- for (userLdapPrimaryKey newUser) $ \pKey -> selectKeysList [ UserLdapPrimaryKey ==. Just pKey ] []
|
||||
|
||||
user@(Entity userId userRec) <- case oldUsers of
|
||||
|
||||
@ -12,15 +12,22 @@ import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Char as Char
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Database.Persist.Postgresql
|
||||
|
||||
-- | Ensure that the given user is linked to the given company
|
||||
upsertUserCompany :: UserId -> Maybe Text -> DB ()
|
||||
upsertUserCompany uid (Just cName) | notNull cName = do
|
||||
cid <- upsertCompany cName
|
||||
void $ upsertBy (UniqueUserCompany uid cid)
|
||||
(UserCompany uid cid False)
|
||||
[]
|
||||
upsertUserCompany uid _ = deleteWhere [ UserCompanyUser ==. uid ]
|
||||
(UserCompany uid cid False False)
|
||||
[]
|
||||
superVs <- selectList [UserCompanyCompany ==. cid, UserCompanySupervisor ==. True] []
|
||||
upsertManyWhere [ UserSupervisor super uid reroute
|
||||
| Entity{entityVal=UserCompany{userCompanyUser=super, userCompanySupervisorReroute=reroute, userCompanySupervisor=True}} <- superVs
|
||||
] [] [] []
|
||||
upsertUserCompany uid _ =
|
||||
deleteWhere [ UserCompanyUser ==. uid ] -- maybe also delete company supervisors?
|
||||
|
||||
|
||||
upsertCompany :: Text -> DB CompanyId
|
||||
upsertCompany cName =
|
||||
|
||||
@ -821,7 +821,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
return $ UserSupervisor
|
||||
E.<# E.val newUserId
|
||||
E.<&> (userSupervisor E.^. UserSupervisorUser)
|
||||
E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications)
|
||||
E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications)
|
||||
)
|
||||
(\current excluded -> [ UserSupervisorRerouteNotifications E.=. (current E.^. UserSupervisorRerouteNotifications E.||. excluded E.^. UserSupervisorRerouteNotifications) ] )
|
||||
deleteWhere [ UserSupervisorSupervisor ==. oldUserId]
|
||||
@ -847,6 +847,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
E.<# E.val newUserId
|
||||
E.<&> (userCompany E.^. UserCompanyCompany)
|
||||
E.<&> (userCompany E.^. UserCompanySupervisor)
|
||||
E.<&> (userCompany E.^. UserCompanySupervisorReroute)
|
||||
)
|
||||
(\current _excluded -> [ UserCompanySupervisor E.=. (current E.^. UserCompanySupervisor)] )
|
||||
deleteWhere [ UserCompanyUser ==. oldUserId]
|
||||
|
||||
@ -28,6 +28,8 @@ import Data.List (foldl)
|
||||
import System.Directory (getModificationTime)
|
||||
import System.FilePath.Glob (glob)
|
||||
|
||||
import Database.Persist.Postgresql
|
||||
|
||||
{- Needed for File Tests only
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
import Paths_uniworx (getDataFileName)
|
||||
@ -435,7 +437,7 @@ fillDb = do
|
||||
manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
|
||||
matUsers <- selectList [UserMatrikelnummer !=. Nothing] []
|
||||
insertMany_ [UserAvs (AvsPersonId n) uid n | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers]
|
||||
|
||||
|
||||
let tmin = -1
|
||||
tmax = 2
|
||||
trange = [tmin..tmax]
|
||||
@ -488,20 +490,33 @@ fillDb = do
|
||||
nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" 33 False Nothing
|
||||
ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing
|
||||
bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing
|
||||
void . insert' $ UserCompany jost fraportAg True
|
||||
void . insert' $ UserCompany svaupel nice True
|
||||
void . insert' $ UserCompany gkleen nice False
|
||||
void . insert' $ UserCompany gkleen fraGround False
|
||||
void . insert' $ UserCompany fhamann bpol False
|
||||
void . insert' $ UserCompany fhamann ffacil True
|
||||
void . insert' $ UserCompany fhamann nice False
|
||||
void . insert' $ UserSupervisor jost gkleen True
|
||||
void . insert' $ UserSupervisor jost svaupel False
|
||||
void . insert' $ UserSupervisor jost sbarth False
|
||||
void . insert' $ UserSupervisor jost tinaTester True
|
||||
void . insert' $ UserSupervisor svaupel gkleen False
|
||||
void . insert' $ UserSupervisor svaupel fhamann True
|
||||
void . insert' $ UserSupervisor sbarth tinaTester True
|
||||
void . insert' $ UserCompany jost fraportAg True True
|
||||
void . insert' $ UserCompany svaupel nice True False
|
||||
void . insert' $ UserCompany gkleen nice False False
|
||||
void . insert' $ UserCompany gkleen fraGround False True
|
||||
void . insert' $ UserCompany fhamann bpol False False
|
||||
void . insert' $ UserCompany fhamann ffacil True True
|
||||
void . insert' $ UserCompany fhamann nice False False
|
||||
-- void . insert' $ UserSupervisor jost gkleen True
|
||||
-- void . insert' $ UserSupervisor jost svaupel False
|
||||
-- void . insert' $ UserSupervisor jost sbarth False
|
||||
-- void . insert' $ UserSupervisor jost tinaTester True
|
||||
-- void . insert' $ UserSupervisor svaupel gkleen False
|
||||
-- void . insert' $ UserSupervisor svaupel fhamann True
|
||||
-- void . insert' $ UserSupervisor sbarth tinaTester True
|
||||
let supvs = [ UserSupervisor jost gkleen True
|
||||
, UserSupervisor jost svaupel False
|
||||
, UserSupervisor jost sbarth False
|
||||
, UserSupervisor jost tinaTester True
|
||||
, UserSupervisor svaupel gkleen False
|
||||
, UserSupervisor svaupel fhamann True
|
||||
, UserSupervisor sbarth tinaTester True
|
||||
, UserSupervisor gkleen fhamann False
|
||||
]
|
||||
upsertManyWhere supvs [] [] []
|
||||
-- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok
|
||||
-- insertMany_ supvs -- NOTE: multiple calls like this throw an error!
|
||||
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user