Merge branch 'fradrive/company' into test

CHANGELOG.md

@@ -2,7 +2,12 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
-## [27.4.48](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.47...t27.4.48) (2023-11-03)
+## [27.4.48](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.47...v27.4.48) (2023-11-07)
+
+
+### Bug Fixes
+
+* **lms:** mark as ended only if not seen for at least one day ([8165892](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/8165892b2e4f945780bb8420cfc4eed50fdd294d))
 
 ## [27.4.47](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.46...v27.4.47) (2023-11-03)
 

messages/uniworx/categories/firm/de-de-formal.msg

@@ -13,8 +13,12 @@ FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
 FirmSuperActNotify: Mitteilung versenden
 FirmSuperActRMSuperDef: Standard Firmenansprechpartner entfernen
 FirmSuperActRMSuperAll: Als aktiven Ansprechpartner komplett entfernen
+FirmsNotification: Firmen Benachrichtigung versenden
+FirmNotification fsh@CompanyShorthand: Benachrichtigung an #{fsh} versenden
 FilterSupervisor: Hat aktiven Ansprechpartner
-FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der #{fsh} angehört
+FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh} der angehört
 FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört
 FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
-FilterFirmPostalAddress: Postalische Firmenadresse vorhanden
+FilterFirmPostalAddress: Postalische Firmenadresse vorhanden
+FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
+FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}

messages/uniworx/categories/firm/en-eu.msg

@@ -13,8 +13,12 @@ FirmUserActMkSuper: Mark as company supervisor
 FirmSuperActNotify: Send message
 FirmSuperActRMSuperDef: Remove as default supervisor
 FirmSuperActRMSuperAll: Remove all active supervisions for this company
+FirmsNotification: Send company notification
+FirmNotification fsh: Send notification to company #{fsh}
 FilterSupervisor: Has active supervisor
 FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh}
 FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
 FilterForeignSupervisor: Has company-external supervisors
-FilterFirmPostalAddress: Postal company addresse known
+FilterFirmPostalAddress: Postal company addresse known
+FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
+FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users

messages/uniworx/categories/jobs_handler/de-de-formal.msg

@@ -15,7 +15,6 @@ ResetPassword: FRADrive-Passwort ändern bzw. setzen
 MailSubjectChangeUserDisplayEmail: E-Mail-Adresse in FRADrive verwenden
 MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer/Die oben genannte Benutzerin möchte „#{displayEmail}“ als E-Mail-Adresse in FRADrive verwenden. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte!
 MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail-Adresse in FRADrive verwenden
-CommCourseSubject: Kursartmitteilung
 InvitationAcceptDecline: Einladung annehmen/ablehnen
 InvitationFromTip displayName@Text: Sie erhalten diese Einladung, weil #{displayName} ihren Versand in FRADrive ausgelöst hat.
 InvitationFromTipAnonymous: Sie erhalten diese Einladung, weil ein nicht eingeloggter Benutzer/eine nichteingeloggte Benutzerin ihren Versand in FRADrive ausgelöst hat.

messages/uniworx/categories/jobs_handler/en-eu.msg

@@ -15,7 +15,6 @@ ResetPassword: Reselt FRADrive password
 MailSubjectChangeUserDisplayEmail: Set email address in FRADrive
 MailIntroChangeUserDisplayEmail displayEmail: The user mentioned above wants to set “#{displayEmail}” as their own email address. If you have not caused this email to be sent, please ignore it!
 MailTitleChangeUserDisplayEmail displayName: #{displayName} wants to set this email address as their own in FRADrive
-CommCourseSubject: Course type message
 InvitationAcceptDecline: Accept/Decline invitation
 InvitationFromTip displayName: You are receiving this invitation because #{displayName} has caused it to be sent from within FRADrive.
 InvitationFromTipAnonymous: You are receiving this invitiation because an user who didn't log in has caused it to be send from within FRADrive.

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -136,6 +136,7 @@ MenuLmsReport: Ergebnisse E‑Learning
 MenuFirms: Firmen
 MenuFirmUsers: Angehörige
 MenuFirmSupervisors: Ansprechpartner
+MenuFirmsComm: Mitteilung
 
 MenuSap: SAP Schnittstelle
 

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -137,6 +137,7 @@ MenuLmsReport: E‑learning Results
 MenuFirms: Companies
 MenuFirmUsers: Associates
 MenuFirmSupervisors: Supervisors
+MenuFirmsComm: Messaging
 
 MenuSap: SAP Interface 
 

messages/uniworx/utils/table_column/en-eu.msg

@@ -83,7 +83,7 @@ TableCompanyNos: Company numbers
 TableCompanyUser: Associate
 TableCompanyNrUsers: Associates
 TableCompanyNrSupers: Supervisors
-TableCompanyNrEmpSupervised: Supervsied employees 
+TableCompanyNrEmpSupervised: Supervised employees 
 TableCompanyNrEmpRerouted: Employees having reroute
 TableCompanyNrEmpRerPost: Employees having postal reroute
 TableCompanyNrSupersActive: Associates having supervisors

messages/uniworx/utils/utils/de-de-formal.msg

@@ -13,6 +13,7 @@ RGCourseUnacceptedApplicants: Nicht akzeptierte Bewerber:innen
 RecipientToggleAll: Alle/Keine
 CommCourseTestSubject customSubject@Text !ident-ok: [TEST] #{customSubject}
 UtilCommCourseSubject: Kursartmitteilung
+UtilCommFirmSubject: Firmenmitteilung
 CommRecipients: Empfänger:innen
 CommRecipientsTip: Sie selbst erhalten immer eine Kopie der Nachricht
 CommRecipientsList: Die an Sie selbst verschickte Kopie der Nachricht wird, zu Archivierungszwecken, eine vollständige Liste aller Empfänger:innen enthalten. Die Empfängerliste wird im CSV-Format an die E-Mail angehängt. Andere Empfänger:innen erhalten die Liste nicht. Bitte entfernen Sie dementsprechend den Anhang bevor Sie die E-Mail weiterleiten oder anderweitig mit Dritten teilen.

messages/uniworx/utils/utils/en-eu.msg

@@ -13,6 +13,7 @@ RGCourseUnacceptedApplicants: Applicants not accepted
 RecipientToggleAll: All/None
 CommCourseTestSubject customSubject: [TEST] #{customSubject}
 UtilCommCourseSubject: Course type message
+UtilCommFirmSubject: Company message 
 CommRecipients: Recipients
 CommRecipientsTip: You always receive a copy of the message
 CommRecipientsList: For archival purposes the copy of the message sent to you will contain a complete list of all recipients. The list of recipients will be attached to the email in CSV-format. Other recipients do not receive the list. Thus, please remove the attachment before you forward the email or otherwise share it with third parties.

models/lms.model

@@ -184,4 +184,5 @@ LmsReportLog
   result            LmsState        -- (0|1|2) 0=LmsFailed[too many tries], 1=LmsOpen, 2=LmsPassed[success]
   lock              Bool            -- (0|1)
   timestamp         UTCTime         default=now()  
+  missing           Bool            default=false
   deriving Generic

routes

@@ -113,8 +113,10 @@
 /for/#CryptoUUIDUser/user         ForProfileR       GET POST    !supervisor !self
 /for/#CryptoUUIDUser/user/profile ForProfileDataR   GET         !supervisor !self
 
-/firm                           FirmAllR            GET POST		!supervisor
+/firms                          FirmAllR            GET POST		!supervisor
+/firms/comm    									FirmsCommR          GET POST
 /firm/#CompanyShorthand         FirmR               GET POST
+/firm/#CompanyShorthand/comm    FirmCommR						GET POST
 /firm/#CompanyShorthand/users   FirmUsersR          GET POST    !supervisor
 /firm/#CompanyShorthand/supers  FirmSupersR         GET POST    !supervisor
 

src/Foundation/Navigation.hs

@@ -124,9 +124,11 @@ breadcrumb ProblemAvsSynchR     = i18nCrumb MsgProblemsAvsSynchHeading    $ Just
 breadcrumb ProblemAvsErrorR     = i18nCrumb MsgProblemsAvsErrorHeading    $ Just ProblemAvsSynchR
 
 breadcrumb FirmAllR         = i18nCrumb MsgMenuFirms              Nothing
+breadcrumb FirmsCommR       = i18nCrumb MsgMenuFirmsComm        $ Just   FirmAllR
 breadcrumb FirmR{}          = i18nCrumb MsgMenuAdminHeading     $ Just   FirmAllR  -- TODO: change heading or remove
 breadcrumb FirmUsersR{}     = i18nCrumb MsgMenuFirmUsers        $ Just   FirmAllR
 breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors  $ Just $ FirmUsersR fsh
+breadcrumb (FirmCommR   fsh)= i18nCrumb MsgMenuFirmsComm        $ Just $ FirmUsersR fsh                       
 
 breadcrumb PrintCenterR     = i18nCrumb MsgMenuApc              Nothing
 breadcrumb PrintSendR       = i18nCrumb MsgMenuPrintSend      $ Just PrintCenterR

src/Handler/Firm.hs

@@ -11,6 +11,8 @@ module Handler.Firm
   , getFirmR      , postFirmR
   , getFirmUsersR , postFirmUsersR
   , getFirmSupersR, postFirmSupersR
+  , getFirmCommR  , postFirmCommR
+  , getFirmsCommR,  postFirmsCommR
   )
   where
 
@@ -18,6 +20,7 @@ import Import
 
 -- import Jobs
 import Handler.Utils
+import Handler.Utils.Communication
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
@@ -272,11 +275,11 @@ mkFirmAllTable isAdmin uid = do
           , singletonMap "avsnr"          $ SortColumn (E.^. CompanyAvsId)
           , singletonMap "postal-pref"    $ SortColumn (E.^. CompanyPrefersPostal)
           , singletonMap "users"          $ SortColumn firmCountUsers
-          , singletonMap "supervisors"    $ SortColumn firmCountSupervisors
+          , singletonMap "supervisors"    $ SortColumn firmHasSupervisors
           -- , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised
           -- , singletonMap "emp-rerouted"   $ SortColumn firmCountEmployeeRerouted
           -- , singletonMap "emp-rer-post"   $ SortColumn firmCountEmployeeRerPost
-          , singletonMap "reroute-def"    $ SortColumn firmCountDefaultReroutes
+          , singletonMap "reroute-def"    $ SortColumn firmHasDefaultReroutes
           -- , singletonMap "foreigners"     $ SortColumn firmCountForeignSupervisors
           -- , singletonMap "reroute-act"    $ SortColumn firmCountActiveReroutes
           -- , singletonMap "reroute-all"    $ SortColumn firmCountActiveReroutes'
@@ -363,9 +366,15 @@ postFirmAllR = do
   uid <- requireAuthId
   isAdmin <- hasReadAccessTo AdminR
   (firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
-  formResult firmRes $ \case
+  formResult firmRes $ \case    
-    (FirmAllActNotifyData          , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " companies. TODO"
+    (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset "  <> tshow (length fids) <> " companies. TODO"    
-    (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset "  <> tshow (length fids) <> " companies. TODO"
+    (FirmAllActNotifyData          , fids) -> do
+      usrs <- runDB $ E.select $ E.distinct $ do
+        (usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
+        E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList (Set.toList fids)
+        return $ usr E.^. UserId
+      cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
+      redirect (FirmsCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
   siteLayoutMsg MsgMenuFirms $ do
     setTitleI MsgMenuFirms
     $(i18nWidgetFile "firm-all")
@@ -494,8 +503,10 @@ mkFirmUserTable isAdmin cid = do
                   Just True   -> E.exists    checkSuper
                   Just False  -> E.notExists checkSuper
           ]
+        -- superField = selectField $ ????
         dbtFilterUI mPrev = mconcat
           [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
+          , prismAForm (singletonFilter "supervisor-is"          . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTableTerm)
           , prismAForm (singletonFilter "has-supervisor"         . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor)
           , prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh)
           , prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh)
@@ -541,7 +552,7 @@ getFirmUsersR, postFirmUsersR :: CompanyShorthand -> Handler Html
 getFirmUsersR  = postFirmUsersR
 postFirmUsersR fsh = do
   isAdmin <- hasReadAccessTo AdminR
-  let fshId = CompanyKey fsh
+  let cid = CompanyKey fsh
   ((    Entity{entityVal=Company{..}}
       , E.Value nrCompanyUsers
       , E.Value nrCompanySupervisors
@@ -551,10 +562,10 @@ postFirmUsersR fsh = do
       , E.Value nrCompanyEmployeeRerPost
       , E.Value nrCompanyDefaultReroutes
       , E.Value nrCompanyActiveReroutes
-   )  , (fusrRes, fusrTable)) <- runDB $ (,)
+   )  , (fusrRes, fusrTable)) <- runDB $ (,) 
       <$> fromMaybeM notFound (E.selectOne $ do
           cmpy <- E.from $ E.table @Company
-          E.where_ $ cmpy E.^. CompanyId E.==. E.val fshId
+          E.where_ $ cmpy E.^. CompanyId E.==. E.val cid
           return  ( cmpy
                   , cmpy & firmCountUsers
                   , cmpy & firmCountSupervisors
@@ -565,11 +576,18 @@ postFirmUsersR fsh = do
                   , cmpy & firmCountDefaultReroutes
                   , cmpy & firmCountActiveReroutes
                   ))
-      <*> mkFirmUserTable isAdmin fshId
+      -- superVs <- E.select $ do 
+      --     usr <- E.from $ E.table @User
+      --     E.where_ $ E.exists $ firmQuerySupervisedBy cmpyId Nothing usr
+      --     return usr
+      <*> mkFirmUserTable isAdmin cid      
 
-  formResult fusrRes $ \case
+  formResult fusrRes $ \case    
-    (FirmUserActNotifyData , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " employees. TODO"
     (FirmUserActMkSuperData, fids) -> addMessage Info $ text2Html $ "Make "  <> tshow (length fids) <> " employees to supervisors. TODO"
+    (FirmUserActNotifyData , fids) -> do 
+      cuids <- traverse encrypt $ Set.toList fids :: Handler [CryptoUUIDUser]
+      redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
+
   siteLayout (citext2widget companyName) $ do
     setTitle $ toHtml $ CI.original companyShorthand <> " (" <> tshow companyAvsId <> ")"
     $(widgetFile "firm-users")
@@ -597,7 +615,7 @@ type SuperCompanyTableExpr = E.SqlExpr (Entity User)
 querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User)
 querySuperUser = id
 
-type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64)
+type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64, [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)])
 
 resultSuperUser :: Lens' SuperCompanyTableData (Entity User)
 resultSuperUser = _dbrOutput . _1 
@@ -608,12 +626,27 @@ resultSuperCompanySupervised = _dbrOutput . _2 . _unValue
 resultSuperCompanyReroutes :: Lens' SuperCompanyTableData Word64
 resultSuperCompanyReroutes = _dbrOutput . _3 . _unValue
 
+resultSuperCompanies :: Lens' SuperCompanyTableData [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)]
+resultSuperCompanies = _dbrOutput . _4
+
+
 instance HasEntity SuperCompanyTableData User where 
   hasEntity = resultSuperUser
 
 instance HasUser SuperCompanyTableData where 
   hasUser = resultSuperUser . _entityVal
 
+firmQuerySupervisedBy :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlQuery ()
+firmQuerySupervisedBy cid mbFltr usr = do
+    (usrSpr :& usrCmp) <- E.from $  E.table @UserSupervisor
+                      `E.innerJoin` E.table @UserCompany
+                      `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
+    let basecond = usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
+            E.&&.  usrCmp E.^. UserCompanyCompany       E.==. E.val cid
+    E.where_ $ maybe basecond ((basecond E.&&.).($ usrSpr)) mbFltr
+
+firmCountForSupervisor :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlExpr (E.Value Word64)
+firmCountForSupervisor = ((E.subSelectCount .) .) . firmQuerySupervisedBy
 
 mkFirmSuperTable :: Bool -> CompanyId -> DB (FormResult (FirmSuperActionData, Set UserId), Widget)
 mkFirmSuperTable isAdmin cid = do
@@ -621,34 +654,31 @@ mkFirmSuperTable isAdmin cid = do
     -- fsh = unCompanyKey cid
     resultDBTable = DBTable{..}
       where
-        dbtSQLQuery = \usr -> do
+        dbtSQLQuery = \usr -> do          
-          -- refactor this
+          E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr
-          let subs = do 
+          return ( usr
-                      (usrSpr :& usrCmp) <- E.from $  E.table @UserSupervisor 
+                 , usr & firmCountForSupervisor cid Nothing
-                                        `E.innerJoin` E.table @UserCompany 
+                 , usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
-                                        `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
+                 )
-                      E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
-                          E.&&.  usrCmp E.^. UserCompanyCompany       E.==. E.val cid
-              subs' = do 
-                      (usrSpr :& usrCmp) <- E.from $  E.table @UserSupervisor 
-                                        `E.innerJoin` E.table @UserCompany 
-                                        `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
-                      E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
-                          E.&&.  usrCmp E.^. UserCompanyCompany       E.==. E.val cid
-                          E.&&.  usrSpr E.^. UserSupervisorRerouteNotifications
-          E.where_ $ E.exists subs
-          return (usr, E.subSelectCount subs, E.subSelectCount subs')
         dbtRowKey = querySuperUser >>> (E.^. UserId)
-        dbtProj = dbtProjId
+        dbtProj = dbtProjSimple $ \(usr, supervised, rerouted) -> do
+            cmps <- E.select $ do 
+              (cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
+              E.where_ $ usrCmp E.^. UserCompanyUser E.==. E.val (entityKey usr)
+              E.orderBy [E.asc $ cmp E.^. CompanyName]
+              return (cmp E.^. CompanyName, cmp E.^. CompanyShorthand, usrCmp E.^. UserCompanySupervisor)
+            return (usr, supervised, rerouted, cmps)
         dbtColonnade = formColonnade $ mconcat
           [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey))
           , colUserNameModalHdr MsgTableSupervisor ForProfileDataR
           , sortable (Just "matriculation")   (i18nCell MsgTableMatrikelNr)              $ \(view   resultSuperUser                         -> entUsr) -> cellHasMatrikelnummerLinked entUsr
+          , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultSuperCompanies -> cmps) ->
+              intercalate semicolonCell [companyCell cmpShort cmpName isSuper | (E.Value cmpName, E.Value cmpShort, E.Value isSuper) <- cmps]
           , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber)        $ \(view $ resultSuperUser . _userCompanyPersonalNumber -> t) -> foldMap textCell t
           , sortable (Just "postal-pref")     (i18nCell MsgPrefersPostal)                $ \(view $ resultSuperUser . _userPrefersPostal         -> b) -> iconFixedCell $ iconLetterOrEmail b
           , colUserEmail
-          , sortable Nothing (i18nCell MsgTableCompanyNrEmpSupervised)  $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "supervised") (i18nCell MsgTableCompanyNrEmpSupervised)  $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
-          , sortable Nothing (i18nCell MsgTableCompanyNrEmpRerouted  )  $ \(view resultSuperCompanyReroutes   -> nr) -> wgtCell $ word2widget nr
+          , sortable (Just "rerouted")   (i18nCell MsgTableCompanyNrEmpRerouted  )  $ \(view resultSuperCompanyReroutes   -> nr) -> wgtCell $ word2widget nr
           ]
         dbtSorting = mconcat
           [ single $ sortUserNameLink querySuperUser
@@ -656,6 +686,14 @@ mkFirmSuperTable isAdmin cid = do
           , singletonMap "matriculation"    $ SortColumn $ querySuperUser        >>> (E.^. UserMatrikelnummer)
           , singletonMap "personal-number"  $ SortColumn $ querySuperUser        >>> (E.^. UserCompanyPersonalNumber)
           , singletonMap "postal-pref"      $ SortColumn $ querySuperUser        >>> (E.^. UserPrefersPostal)
+          , singletonMap "supervised"       $ SortColumn $ querySuperUser        >>> firmCountForSupervisor cid Nothing
+          , singletonMap "rerouted"         $ SortColumn $ querySuperUser        >>> firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
+          , singletonMap "user-company"     $ SortColumn (\row -> E.subSelect $ do
+              (cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
+              E.where_ $ usrCmp E.^. UserCompanyUser E.==. querySuperUser row E.^. UserId
+              E.orderBy [E.asc $ cmp E.^. CompanyName]
+              return (cmp E.^. CompanyName)
+            )
           ]
         dbtFilter = mconcat
           [ single $ fltrUserNameEmail querySuperUser
@@ -710,9 +748,12 @@ postFirmSupersR fsh = do
     <*> mkFirmSuperTable isAdmin fshId
 
   formResult fsprRes $ \case
-    (FirmSuperActNotifyData    , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " supervisors. TODO"
     (FirmSuperActRMSuperDefData, fids) -> addMessage Info $ text2Html $ "Remove "  <> tshow (length fids) <> " default supervisors. TODO"
     (FirmSuperActRMSuperAllData, fids) -> addMessage Info $ text2Html $ "Make "  <> tshow (length fids) <> " default and active supervisors. TODO"
+    (FirmSuperActNotifyData    , fids) -> do 
+      cuids <- traverse encrypt $ Set.toList fids :: Handler [CryptoUUIDUser]
+      redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
+
 
   siteLayout (citext2widget fsh) $ do
     setTitle $ citext2Html fsh
@@ -735,3 +776,81 @@ postFirmSupersR fsh = do
       <section>
         ^{fsprTable}
     |]
+
+
+getFirmCommR,  postFirmCommR :: CompanyShorthand -> Handler Html
+getFirmCommR = postFirmCommR
+postFirmCommR fsh = handleFirmCommR (SomeRoute $ FirmUsersR fsh) (Just fsh)
+
+
+getFirmsCommR,  postFirmsCommR :: Handler Html
+getFirmsCommR = postFirmsCommR
+postFirmsCommR = handleFirmCommR (SomeRoute FirmAllR) Nothing
+
+
+handleFirmCommR :: SomeRoute UniWorX -> Maybe CompanyShorthand -> Handler Html
+handleFirmCommR ultDest mbFsh = do
+  let decryptUserId :: CryptoUUIDUser -> Handler UserId
+      decryptUserId = decrypt
+
+      mbCid = CompanyKey <$> mbFsh  
+
+      {-
+      queryEmpys :: CompanyId -> Handler [UserId]
+      queryEmpys cid = E.unValue <<$>> runDB (E.select $ do
+          (emp :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
+          E.where_ $ uc E.^. UserCompanyCompany E.==. E.val cid
+          return $ emp E.^. UserId
+        )
+      -}
+
+  selected <- mapM decryptUserId =<< lookupGlobalGetParams GetRecipient   -- retrieve selected users
+  empys <- ifMaybeM mbCid selected (\cid ->  -- get all employees or stick with selected users, if no company was pre-selected (to limit choices)
+    E.unValue <<$>> runDB (E.select $ do    
+      (emp :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
+      E.where_ $ uc E.^. UserCompanyCompany E.==. E.val cid
+      return $ emp E.^. UserId
+    ))
+  
+  cmpys <- E.unValue <<$>> runDB (E.select $ do
+      cmpy <- E.from $ E.table @Company
+      E.where_ $ E.exists $ do 
+        usrCmpy <- E.from $ E.table @UserCompany
+        E.where_ $ usrCmpy E.^. UserCompanyUser `E.in_` E.valList selected
+            E.&&.  usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
+      return $ cmpy E.^.CompanyId
+    )
+  let queryCmpy :: Bool -> CompanyId -> E.SqlQuery (E.SqlExpr (Entity User))
+      queryCmpy sORe acid = do 
+        (usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
+        E.where_ $ uc E.^. UserCompanyCompany E.==. E.val acid
+            E.&&. (if sORe 
+              then -- supervisors only
+                E.exists $ do 
+                  usrSpr <- E.from $ E.table @UserSupervisor 
+                  E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId 
+                      E.&&.  usrSpr E.^. UserSupervisorUser `E.in_` E.valList empys
+              else -- selected employees for this company only
+                usr E.^. UserId `E.in_` E.valList empys
+            )
+        return usr 
+
+  commR CommunicationRoute
+    { crHeading   = SomeMessage $ maybe MsgFirmsNotification MsgFirmNotification mbFsh
+    , crUltDest   = ultDest
+    , crJobs      = crJobsFirmCommunication mbFsh -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()    
+    , crTestJobs  = crTestFirmCommunication mbFsh -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()    
+    , crRecipientAuth = Nothing -- :: Maybe (UserId -> DB AuthResult) -- an optional filter passed to guardAuthResult 
+    , crRecipients = -- :: [(RecipientGroup, SqlQuery (SqlExpr (Entity User)))]
+      [(RGFirmSupervisor $ unCompanyKey acid, queryCmpy True  acid)  | acid <- cmpys ] <>
+      [(RGFirmEmployees  $ unCompanyKey acid, queryCmpy False acid)  | acid <- cmpys, maybe True (acid ==) mbCid]
+    }
+
+  {- Auswahlbox für Mitteilung:
+    Wenn Firma gewählt, dann zeige:
+      Alle Supervisor von Leuten in X, gruppiert nach deren Firma 
+      Alle Teilnehmer von X 
+    Wenn keine Firma gewählt, dann zeige:
+      Alle Supervisor von gewählten Leuten, gruppiert nach deren Firma
+      Alle gewählten Personen, gruppiert nach deren Firma
+  -}

src/Handler/Utils/Communication.hs

@@ -8,6 +8,7 @@ module Handler.Utils.Communication
   , Communication(..)
   , commR
   , crJobsCourseCommunication, crTestJobsCourseCommunication
+  , crJobsFirmCommunication, crTestFirmCommunication
   -- * Re-Exports
   , Job(..)
   ) where
@@ -27,9 +28,11 @@ import qualified Data.Conduit.Combinators as C
 
 
 data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors | RGCourseTutors | RGCourseParticipantsInTutorial | RGCourseUnacceptedApplicants
+  -- WARNING: no RenderMessage instance, but a pattern match in templates/widgets/communication/recipientLayout.hamlet that needs to be extended
                     | RGTutorialParticipants CryptoUUIDTutorial
                     | RGExamRegistered CryptoUUIDExam
                     | RGSheetSubmittor CryptoUUIDSheet
+                    | RGFirmSupervisor CompanyShorthand | RGFirmEmployees CompanyShorthand
   deriving (Eq, Ord, Read, Show, Generic)
 
 instance LowerBounded RecipientGroup where
@@ -107,6 +110,28 @@ crTestJobsCourseCommunication jCourse comm = do
   crJobsCourseCommunication jCourse comm' .| C.filter ((== Right jSender) . jRecipientEmail)
 
 
+crJobsFirmCommunication :: Maybe CompanyShorthand -> Communication -> ConduitT () Job (YesodDB UniWorX) ()
+crJobsFirmCommunication jCompany Communication{..} = do
+  jSender <- requireAuthId
+  let jMailContent = cContent
+      allRecipients = Set.toList $ Set.insert (Right jSender) cRecipients
+  jMailObjectUUID <- liftIO getRandom
+  jAllRecipientAddresses <- lift . fmap Set.fromList . forM allRecipients $ \case
+    Left email -> return . Address Nothing $ CI.original email
+    Right rid  -> userAddress <$> getJust rid
+  forM_ allRecipients $ \jRecipientEmail ->
+    yield JobSendFirmCommunication{..}
+
+crTestFirmCommunication :: Maybe CompanyShorthand -> Communication -> ConduitT () Job (YesodDB UniWorX) ()
+crTestFirmCommunication jCompany comm = do
+  jSender <- requireAuthId
+  MsgRenderer mr <- getMsgRenderer
+  let comm' = comm & _cContent . _ccSubject %~ Just . mr . MsgCommCourseTestSubject . fromMaybe (mr MsgUtilCommFirmSubject)
+  crJobsFirmCommunication jCompany comm' .| C.filter ((== Right jSender) . jRecipientEmail)
+
+
+
+
 commR :: CommunicationRoute -> Handler Html
 commR CommunicationRoute{..} =  do
   cUser <- maybeAuth
@@ -132,7 +157,7 @@ commR CommunicationRoute{..} =  do
   let
     lookupUser :: UserId -> User
     lookupUser lId
-      = entityVal . unsafeHead . filter ((== lId) . entityKey) $ concat (view _2 <$> suggestedRecipients) ++ chosenRecipients
+      = entityVal . unsafeHead . filter ((== lId) . entityKey) $ concatMap (view _2) suggestedRecipients ++ chosenRecipients
 
   let chosenRecipients' = Map.fromList $
         [ ( (BoundedPosition $ RecipientGroup g, pos)

src/Handler/Utils/Table/Cells.hs

@@ -29,6 +29,9 @@ type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with Wit
 spacerCell :: IsDBTable m a => DBCell m a
 spacerCell = cell [whamlet| |]
 
+semicolonCell :: IsDBTable m a => DBCell m a
+semicolonCell = cell [whamlet|; |]
+
 tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
 tellCell = flip mappend . writerCell . tell
 

src/Jobs/Handler/LMS.hs

@@ -164,7 +164,7 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
             maybeM (pure Nothing) (E.insertUniqueEntity . mkLmsUser lpw) (randomLMSIdentBut qprefix identsInUse)
             -- runMaybeT $ do
             --   lid <- MaybeT $ randomLMSIdentBu qprefix identsInUse
-            --   MaybeT $ E.insertUniqueEntity $ mkLmsUser lpw lid                            
+            --   MaybeT $ E.insertUniqueEntity $ mkLmsUser lpw lid
       inserted <- untilJustMaxM maxLmsUserIdentRetries startLmsUser
       case inserted of
         Nothing  -> do
@@ -187,7 +187,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
       quali <- getJust qid -- may throw an error, aborting the job
       let qshort = CI.original $ qualificationShorthand quali
       $logInfoS "LMS" $ "Processing e-learning results for qualification " <> qshort
-      now <- liftIO getCurrentTime      
+      now <- liftIO getCurrentTime
       -- end users that expired by doing nothing
       expiredUsers <- E.select $ do
           (quser :& luser) <- E.from $
@@ -201,9 +201,10 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
               -- E.&&.  E.isNothing (luser E.^. LmsUserStatus)
               -- E.&&.  E.isNothing (luser E.^. LmsUserEnded)
               E.&&.  E.not_ (validQualification now quser)
-          pure (quser E.^. QualificationUserUser, luser E.?. LmsUserId)
+          pure (luser E.?. LmsUserId, quser E.^. QualificationUserUser)
-      nrBlocked <- qualificationUserBlocking qid (E.unValue . fst <$> expiredUsers) False (Just now) (Right QualificationBlockExpired) True -- essential that blocks occur only once
+      nrBlocked <- qualificationUserBlocking qid (E.unValue . snd <$> expiredUsers) False (Just now) (Right QualificationBlockExpired) True -- essential that blocks occur only once
-      let expiredLearners = [luid | (_, E.Value (Just luid)) <- expiredUsers]
+      let expiredLearners = [ luid | (E.Value (Just luid), _) <- expiredUsers ]
+      -- let expiredLearners = catMaybes (E.unValue . fst <$> expiredUsers)
       nrExpired <- E.updateCount $ \luser -> do
         E.set luser [LmsUserStatus E.=. E.justVal LmsExpired, LmsUserStatusDay E.=. E.justVal now]
         E.where_ $ E.isNothing (luser E.^. LmsUserStatus)
@@ -213,7 +214,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
 
       when (quali ^. _qualificationExpiryNotification) $ do -- notifies expired and previously lms-failed drivers
         notifyInvalidDrivers <- E.select $ do
-            (quser :& qblock) <- E.from $ 
+            (quser :& qblock) <- E.from $
               E.table @QualificationUser
               `E.leftJoin` E.table @QualificationUserBlock
               `E.on` (\(quser :& qblock) -> qblock E.?. QualificationUserBlockQualificationUser E.?=. quser E.^. QualificationUserId
@@ -266,7 +267,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
     act = whenM (exists [LmsReportQualification ==. qid]) $ do -- executing twice must be prohibited due to assertion that ALL learners are always sent (D fails otherwise)
       now <- liftIO getCurrentTime
       -- DEBUG 2rows; remove later
-      totalrows <- count [LmsReportQualification ==. qid]      
+      totalrows <- count [LmsReportQualification ==. qid]
       $logInfoS "LMS" $ "Report processing " <> tshow totalrows <> " rows for qualification " <> tshow qid
       when (totalrows > 0) $ do
         let -- locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now  -- no longer necessary, since LMS reports dates only
@@ -292,7 +293,7 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
                 E.&&.  lreport E.^. LmsReportQualification  E.==. E.val qid
                 E.&&. E.isNothing (luser E.^. LmsUserEnded) -- ignore all closed learners
                 E.&&. lrFltr luser lreport
-              return (luser, lreport)          
+              return (luser, lreport)
         -- A) reset status for learners that had their tries just resetted as indicated by LmsOpen
         E.update $ \luser -> do
           E.set luser [ LmsUserStatus     E.=. E.nothing
@@ -315,13 +316,13 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
           in luserQry luserFltrNew (const $ const E.true) >>= mapM_ notifyNewLearner
         -- C) block qualifications for failed learners by calling qualificationUserBlocking [uids] (includes audit), notified during expiry
         let lrFltrBlock luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsFailed
-            procBlock (Entity luid luser, Entity _ lreport) = do 
+            procBlock (Entity luid luser, Entity _ lreport) = do
                 let repDay = lmsReportDate lreport <|> Just now
                 ok_block <- qualificationUserBlocking qid [lmsUserUser luser] False (lmsReportDate lreport) (Right $ QualificationBlockFailedELearningBy $ lmsUserIdent luser) True -- only valid qualifications are blocked; transcribes to audit log
                 update luid [LmsUserStatus =. Just LmsBlocked, LmsUserStatusDay =. repDay]
                 return $ Sum ok_block
-          in lrepQry lrFltrBlock 
+          in lrepQry lrFltrBlock
-                >>= foldMapM procBlock 
+                >>= foldMapM procBlock
                 >>= \s -> $logInfoS "LMS" $ "Report processing: " <> tshow (getSum s) <> " status set to blocked for qualification " <> tshow qid -- debug, remove later
         -- D) renew qualifications for all successfull learners
         let lrFltrSuccess luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsPassed
@@ -329,14 +330,14 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
                 let repDay = lmsReportDate lreport <|> Just now
                     reason = Just $ Right $ QualificationRenewELearningBy $ lmsUserIdent luser
                 -- LMS WORKAROUND 2: [supposedly fixed now] sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
-                -- let reason_undo = Left $ "LMS Workaround undoing: " <> qualificationBlockedReasonText QualificationBlockFailedELearning                  
+                -- let reason_undo = Left $ "LMS Workaround undoing: " <> qualificationBlockedReasonText QualificationBlockFailedELearning
                 -- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log
                 -- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|])
-                -- END LMS WORKAROUND 2                
+                -- END LMS WORKAROUND 2
                 ok_renew <- renewValidQualificationUsers qid reason repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log
                 update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay]
                 return $ Sum ok_renew
-          in lrepQry lrFltrSuccess 
+          in lrepQry lrFltrSuccess
                 >>= foldMapM procRenew
                 >>= \s -> $logInfoS "LMS" $ "Report processing: " <> tshow (getSum s) <> " renewed and status set to success for qualification " <> tshow qid -- debug, remove later
         -- E) mark all previuosly reported, but now unreported users as ended (LMS deleted them as expected)
@@ -379,8 +380,8 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
           >>= \nr -> $logInfoS "LMS" $ "Report processing marked " <> tshow nr <> " rows as unlocked and received for qualification " <> tshow qid -- debug, remove later
         updateReceivedLocked True
           >>= \nr -> $logInfoS "LMS" $ "Report processing marked " <> tshow nr <> " rows as locked and received for qualification " <> tshow qid -- debug, remove later
-        -- G) Truncate LmsReport for qid, after updating log        
+        -- G) Truncate LmsReport for qid, after updating log
-        E.insertSelect $ do 
+        E.insertSelect $ do
           lreport <- E.from $ E.table @LmsReport
           let samelog = E.subSelect $ do
                   lrl <- E.from $ E.table @LmsReportLog
@@ -388,7 +389,8 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
                       E.&&.  lrl E.^. LmsReportLogIdent         E.==. lreport E.^. LmsReportIdent
                   E.orderBy [E.desc $ lrl E.^. LmsReportLogTimestamp]
                   return $ lreport E.^. LmsReportResult E.==. lrl E.^. LmsReportLogResult
-                    E.&&.  lreport E.^. LmsReportLock   E.==. lrl E.^. LmsReportLogLock                          
+                    E.&&.  lreport E.^. LmsReportLock   E.==. lrl E.^. LmsReportLogLock
+                    E.&&.  E.not_ (lrl E.^. LmsReportLogMissing)
           E.where_ $ lreport E.^. LmsReportQualification E.==. E.val qid
               E.&&. E.not_ (E.isTrue samelog)
           return (LmsReportLog
@@ -397,7 +399,31 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
             E.<&> (lreport E.^. LmsReportDate         )
             E.<&> (lreport E.^. LmsReportResult       )
             E.<&> (lreport E.^. LmsReportLock         )
-            E.<&> (lreport E.^. LmsReportTimestamp    ))
+            E.<&> (lreport E.^. LmsReportTimestamp    )
+            E.<&> E.false)
+        E.insertSelect $ do
+          lrl <- E.from $ E.table @LmsReportLog
+          E.where_ $ E.not_ (lrl E.^. LmsReportLogMissing)
+                E.&&. lrl E.^. LmsReportLogQualification            E.==. E.val qid
+                E.&&. E.notExists (do
+                  lreport <- E.from $ E.table @LmsReport
+                  E.where_ $ lreport E.^. LmsReportQualification    E.==. E.val qid
+                      E.&&.  lreport E.^. LmsReportIdent            E.==. lrl E.^. LmsReportLogIdent
+                )
+                E.&&. E.notExists (do
+                  lrl_old <- E.from $ E.table @LmsReportLog
+                  E.where_ $ lrl_old E.^. LmsReportLogQualification E.==. E.val qid
+                    E.&&.    lrl_old E.^. LmsReportLogIdent         E.==. lrl E.^. LmsReportLogIdent
+                    E.&&.    lrl_old E.^. LmsReportLogTimestamp     E.>.  lrl E.^. LmsReportLogTimestamp
+                  )
+          return (LmsReportLog
+            E.<#  (lrl E.^. LmsReportLogQualification)
+            E.<&> (lrl E.^. LmsReportLogIdent        )
+            E.<&> E.nothing
+            E.<&> (lrl E.^. LmsReportLogResult       )
+            E.<&> (lrl E.^. LmsReportLogLock         )
+            E.<&> E.val now
+            E.<&> E.true)
         repProc <- deleteWhereCount [LmsReportQualification ==. qid]
         $logInfoS "LMS" [st|Processed #{tshow repProc} e-learning status reports for qualification #{tshow qid}.|]
 
@@ -489,7 +515,7 @@ dispatchJobLmsUserlist qid = JobHandlerAtomic act
           | otherwise -> return ()                     -- users likely not yet started
 
         (Entity luid luser, Just (Entity _lulid lulist)) -> do
-          let lReceived = lmsUserlistTimestamp lulist              
+          let lReceived = lmsUserlistTimestamp lulist
           update luid [LmsUserReceived =. Just lReceived] -- LmsUserNotified is only updated upon sending notifications
 
           when (isNothing $ lmsUserNotified luser) $ do -- notify users that lms is available

src/Jobs/Handler/SendCourseCommunication.hs

@@ -4,6 +4,7 @@
 
 module Jobs.Handler.SendCourseCommunication
   ( dispatchJobSendCourseCommunication
+  , dispatchJobSendFirmCommunication
   ) where
 
 import Import
@@ -37,7 +38,35 @@ dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCours
     _mailFrom .= userAddressFrom sender
     addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|]
     addMailHeader "Auto-Submitted" "no"
-    setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage ccSubject
+    setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgUtilCommCourseSubject) SomeMessage ccSubject
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseCommunication.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+    forM_ ccAttachments $ addPart' . toMailPart
+    when (jRecipientEmail == Right jSender) $
+      addPart' $ do
+        partIsAttachmentCsv MsgCommAllRecipients
+        toMailPart (MsgCommAllRecipientsSheet, toDefaultOrderedCsvRendered jAllRecipientAddresses)
+
+
+dispatchJobSendFirmCommunication :: Either UserEmail UserId
+                                   -> Set Address
+                                   -> Maybe CompanyShorthand
+                                   -> UserId
+                                   -> UUID
+                                   -> CommunicationContent
+                                   -> JobHandler UniWorX
+dispatchJobSendFirmCommunication jRecipientEmail jAllRecipientAddresses _jCompany jSender jMailObjectUUID CommunicationContent{..} = JobHandlerException $ do
+  -- (sender,mbComp) <- runDB $ (,)
+  --   <$> getJust jSender
+  --   <*> ifMaybeM jCompany Nothing get
+  sender <- runDB $ getJust jSender    
+  either (\email -> mailT def . (assign _mailTo (pure . Address Nothing $ CI.original email) *>)) userMailT jRecipientEmail $ do
+    MsgRenderer mr <- getMailMsgRenderer
+
+    void $ setMailObjectUUID jMailObjectUUID
+    _mailFrom .= userAddressFrom sender
+    addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|]
+    addMailHeader "Auto-Submitted" "no"
+    setSubjectI $ maybe (SomeMessage MsgUtilCommFirmSubject) SomeMessage ccSubject
     addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseCommunication.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
     forM_ ccAttachments $ addPart' . toMailPart
     when (jRecipientEmail == Right jSender) $

src/Jobs/Types.hs

@@ -74,6 +74,13 @@ data Job
                                , jMailObjectUUID :: UUID
                                , jMailContent :: CommunicationContent
                                }
+  | JobSendFirmCommunication   { jRecipientEmail :: Either UserEmail UserId
+                               , jAllRecipientAddresses :: Set Address
+                               , jCompany :: Maybe CompanyShorthand
+                               , jSender :: UserId
+                               , jMailObjectUUID :: UUID
+                               , jMailContent :: CommunicationContent
+                               }
   | JobInvitation { jInviter :: Maybe UserId
                   , jInvitee :: UserEmail
                   , jInvitationUrl :: Text

src/Model/Migration/Definitions.hs

@@ -139,7 +139,8 @@ migrateManual = do
     , ("idx_qualification_user_block_unblock","CREATE INDEX idx_qualification_user_block_unblock ON \"qualification_user_block\" (\"unblock\")")
     , ("idx_qualification_user_block_from"   ,"CREATE INDEX idx_qualification_user_block_from ON \"qualification_user_block\" (\"from\")")    
     , ("idx_print_job_apc_ident"             ,"CREATE INDEX idx_print_job_apc_ident ON \"print_job\" (\"apc_ident\")")
-    , ("idx_user_avs_card_person_id"         ,"CREATE INDEX idx_user_avs_card_person_id ON \"user_avs_card\" (\"person_id\")")    
+    , ("idx_user_avs_card_person_id"         ,"CREATE INDEX idx_user_avs_card_person_id ON \"user_avs_card\" (\"person_id\")")
+    , ("idx_lms_report_log_q_ident_time"     ,"CREATE INDEX idx_lms_report_log_q_ident_time ON \"lms_report_log\" (\"qualification\",\"ident\",\"timestamp\")")
     ]
   where
     addIndex :: Text -> Sql -> Migration

templates/firm-users.hamlet

@@ -23,8 +23,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         <tr .table__row .table__row--head>
           <th .table__th>_{MsgTableCompanyNrSupersDefault}
           <th .table__th>_{MsgTableCompanyNrRerouteDefault}
-          <th .table__th>_{MsgPrefersPostal}
+          <th .table__th colspan=2>_{MsgPrefersPostal}           
-          <th .table__th>          
         <tr .table__row>         
           <td .table__td>#{nrCompanySupervisors}
           <td .table__td>#{nrCompanyDefaultReroutes}

templates/widgets/communication/recipientLayout.hamlet

@@ -31,6 +31,10 @@ $if not (null activeCategories)
               ^{rgSheetSubmittorCaption sid}
             $of RecipientGroup RGCourseUnacceptedApplicants
               _{MsgRGCourseUnacceptedApplicants}
+            $of RecipientGroup (RGFirmSupervisor fsh)
+              _{MsgFirmSupervisorOf fsh}
+            $of RecipientGroup (RGFirmEmployees  fsh)
+              _{MsgFirmEmployeeOf fsh}
 
         $if hasContent category
           <fieldset .recipient-category__fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{checkedIdent category}>