chore(firm): messaging almost complete - illegal variable name splicing dispatch
This commit is contained in:
parent
631d157688
commit
a98c3190e0
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -136,6 +136,7 @@ MenuLmsReport: Ergebnisse E‑Learning
|
||||
MenuFirms: Firmen
|
||||
MenuFirmUsers: Angehörige
|
||||
MenuFirmSupervisors: Ansprechpartner
|
||||
MenuFirmsComm: Mitteilung
|
||||
|
||||
MenuSap: SAP Schnittstelle
|
||||
|
||||
|
||||
@ -137,6 +137,7 @@ MenuLmsReport: E‑learning Results
|
||||
MenuFirms: Companies
|
||||
MenuFirmUsers: Associates
|
||||
MenuFirmSupervisors: Supervisors
|
||||
MenuFirmsComm: Messaging
|
||||
|
||||
MenuSap: SAP Interface
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
-}
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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) $
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user