diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 65e8291f1..c50120e92 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -16,7 +16,9 @@ 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 \ No newline at end of file +FilterFirmPostalAddress: Postalische Firmenadresse vorhanden +FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig +FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh} \ No newline at end of file diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 68e4add9b..3e24de5c5 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -19,4 +19,6 @@ 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 \ No newline at end of file +FilterFirmPostalAddress: Postal company addresse known +FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh} +FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users \ No newline at end of file diff --git a/routes b/routes index 9c895eae7..931c52909 100644 --- a/routes +++ b/routes @@ -116,7 +116,7 @@ /firms FirmAllR GET POST !supervisor /firms/comm FirmsCommR GET POST /firm/#CompanyShorthand FirmR GET POST -/firm/#CompanyShorthand/comm FirmCommR GET POST +/firm/#CompanyShorthand/comm FirmCommR GET POST /firm/#CompanyShorthand/users FirmUsersR GET POST !supervisor /firm/#CompanyShorthand/supers FirmSupersR GET POST !supervisor diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 5087e68c1..9e6cdd55e 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -366,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 - (FirmAllActNotifyData , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " companies. TODO" - (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset " <> tshow (length fids) <> " companies. TODO" + formResult firmRes $ \case + (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") @@ -742,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 @@ -834,7 +843,7 @@ handleFirmCommR ultDest mbFsh = do , 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 ] + [(RGFirmEmployees $ unCompanyKey acid, queryCmpy False acid) | acid <- cmpys, maybe True (acid ==) mbCid] } {- Auswahlbox für Mitteilung: diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs index 91e66d4b8..893b22d14 100644 --- a/src/Handler/Utils/Communication.hs +++ b/src/Handler/Utils/Communication.hs @@ -28,6 +28,7 @@ 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 diff --git a/templates/widgets/communication/recipientLayout.hamlet b/templates/widgets/communication/recipientLayout.hamlet index 7b7f188d1..9dc2beea0 100644 --- a/templates/widgets/communication/recipientLayout.hamlet +++ b/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