chore(company): assign company supervisors for new users (model:add column)

models/users.model

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

src/Foundation/Yesod/Auth.hs

@@ -182,6 +182,7 @@ 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 ] []
 

src/Handler/Utils/Company.hs

@@ -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) 
+                  (UserCompany uid cid False False) 
                   []
-upsertUserCompany uid _ = deleteWhere [ UserCompanyUser ==. uid ] 
+  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 = 

src/Handler/Utils/Users.hs

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

test/Database/Fill.hs

@@ -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)
@@ -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 jost    fraportAg    True   True 
-  void . insert' $ UserCompany svaupel nice         True
+  void . insert' $ UserCompany svaupel nice         True   False 
-  void . insert' $ UserCompany gkleen  nice         False
+  void . insert' $ UserCompany gkleen  nice         False  False 
-  void . insert' $ UserCompany gkleen  fraGround    False
+  void . insert' $ UserCompany gkleen  fraGround    False  True 
-  void . insert' $ UserCompany fhamann bpol         False
+  void . insert' $ UserCompany fhamann bpol         False  False 
-  void . insert' $ UserCompany fhamann ffacil       True
+  void . insert' $ UserCompany fhamann ffacil       True   True 
-  void . insert' $ UserCompany fhamann nice         False
+  void . insert' $ UserCompany fhamann nice         False  False
-  void . insert' $ UserSupervisor jost gkleen       True
+  -- void . insert' $ UserSupervisor jost gkleen       True
-  void . insert' $ UserSupervisor jost svaupel      False
+  -- void . insert' $ UserSupervisor jost svaupel      False
-  void . insert' $ UserSupervisor jost sbarth       False
+  -- void . insert' $ UserSupervisor jost sbarth       False
-  void . insert' $ UserSupervisor jost tinaTester   True
+  -- void . insert' $ UserSupervisor jost tinaTester   True
-  void . insert' $ UserSupervisor svaupel gkleen    False
+  -- void . insert' $ UserSupervisor svaupel gkleen    False
-  void . insert' $ UserSupervisor svaupel fhamann   True
+  -- void . insert' $ UserSupervisor svaupel fhamann   True
-  void . insert' $ UserSupervisor sbarth tinaTester 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