diff --git a/messages/uniworx/categories/jobs_handler/de-de-formal.msg b/messages/uniworx/categories/jobs_handler/de-de-formal.msg index 94fae99d1..dcb48a3fa 100644 --- a/messages/uniworx/categories/jobs_handler/de-de-formal.msg +++ b/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. diff --git a/messages/uniworx/categories/jobs_handler/en-eu.msg b/messages/uniworx/categories/jobs_handler/en-eu.msg index 3367e7a7a..e18244502 100644 --- a/messages/uniworx/categories/jobs_handler/en-eu.msg +++ b/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. diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 373cfc0e6..b306bfdfc 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index c46f047da..c8c18365f 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/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 diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg index 13bae27f0..c02cbe1fb 100644 --- a/messages/uniworx/utils/utils/de-de-formal.msg +++ b/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. diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg index 27a7eecad..1135dbade 100644 --- a/messages/uniworx/utils/utils/en-eu.msg +++ b/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. diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index e53e6b3ae..0c8cbd1a2 100644 --- a/src/Foundation/Navigation.hs +++ b/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 diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index b6eb43e95..5087e68c1 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -771,7 +771,7 @@ postFirmSupersR fsh = do getFirmCommR, postFirmCommR :: CompanyShorthand -> Handler Html getFirmCommR = postFirmCommR -postFirmCommR fsh = handleFirmCommR (SomeRoute FirmUsersR) (Just fsh) +postFirmCommR fsh = handleFirmCommR (SomeRoute $ FirmUsersR fsh) (Just fsh) getFirmsCommR, postFirmsCommR :: Handler Html @@ -781,29 +781,36 @@ postFirmsCommR = handleFirmCommR (SomeRoute FirmAllR) Nothing handleFirmCommR :: SomeRoute UniWorX -> Maybe CompanyShorthand -> Handler Html handleFirmCommR ultDest mbFsh = do - let decrypt' :: CryptoUUIDUser -> Handler UserId - decrypt' = decrypt + let decryptUserId :: CryptoUUIDUser -> Handler UserId + decryptUserId = decrypt mbCid = CompanyKey <$> mbFsh - -- queryEmpys :: CompanyId -> Handler [UserId] + {- + 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 ) + -} - chosen <- mapM decrypt =<< lookupGlobalGetParams GetRecipient -- retrieve selected users - empys <- maybe (return chosen) queryEmpys mbCid -- get all employees or stick with selected users, if no company was pre-selected (to limit choices) + 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 <- runDB $ E.select $ do + cmpys <- E.unValue <<$>> runDB (E.select $ do cmpy <- E.from $ E.table @Company E.where_ $ E.exists $ do - usrCmpy <- E.table @UserCompany - E.where_ $ usrCmpy E.^. UserCompanyUser `E.in_` E.valList chosen + 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) @@ -811,35 +818,30 @@ handleFirmCommR ultDest mbFsh = do E.&&. (if sORe then -- supervisors only E.exists $ do - usrSpr <- E.table @UserSupervisor + 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 -- chosen employees for this company only - usr E.^. UserId E.in_ E.valList empys - ) + 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 = error "TODO" -- CONTINUE HERE -- :: Communication -> ConduitT () Job (YesodDB UniWorX) () - , crTestJobs = error "TODO" -- CONTINUE HERE -- :: Communication -> ConduitT () Job (YesodDB UniWorX) () + , 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 ] } -{- - ??? x - - Alle Supervisor von Leuten in X, gruppiert nach Firma - Alle Teilnehmer von X - - Ansprechpartner aus X - - Fred - Ansprechpartner aus Y - - Otto - Angestellte aus X - - Fred - - Meier + {- 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 -} diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs index 3ec2dd854..91e66d4b8 100644 --- a/src/Handler/Utils/Communication.hs +++ b/src/Handler/Utils/Communication.hs @@ -8,6 +8,7 @@ module Handler.Utils.Communication , Communication(..) , commR , crJobsCourseCommunication, crTestJobsCourseCommunication + , crJobsFirmCommunication, crTestFirmCommunication -- * Re-Exports , Job(..) ) where @@ -108,6 +109,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 @@ -133,7 +156,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) diff --git a/src/Jobs/Handler/SendCourseCommunication.hs b/src/Jobs/Handler/SendCourseCommunication.hs index a8a629f60..fa4fbcb69 100644 --- a/src/Jobs/Handler/SendCourseCommunication.hs +++ b/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) $ diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index a0717099a..6c665adb4 100644 --- a/src/Jobs/Types.hs +++ b/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