chore(firm): messaging almost complete - illegal variable name splicing dispatch

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/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.

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

@@ -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
+  let decryptUserId :: CryptoUUIDUser -> Handler UserId
-      decrypt' = decrypt
+      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
+  selected <- mapM decryptUserId =<< 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)
+  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
+        usrCmpy <- E.from $ E.table @UserCompany
-        E.where_ $ usrCmpy E.^. UserCompanyUser `E.in_` E.valList chosen
+        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
+                      E.&&.  usrSpr E.^. UserSupervisorUser `E.in_` E.valList empys
-              else -- chosen employees for this company only
+              else -- selected employees for this company only
-                usr E.^. UserId E.in_ E.valList empys
+                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) ()    
+    , crJobs      = crJobsFirmCommunication mbFsh -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()    
-    , crTestJobs  = error "TODO" -- CONTINUE HERE -- :: 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 ]
     }
 
-{-
+  {- Auswahlbox für Mitteilung:
-  ??? x 
+    Wenn Firma gewählt, dann zeige:
-
+      Alle Supervisor von Leuten in X, gruppiert nach deren Firma 
-  Alle Supervisor von Leuten in X, gruppiert nach Firma 
+      Alle Teilnehmer von X 
-  Alle Teilnehmer von X 
+    Wenn keine Firma gewählt, dann zeige:
-
+      Alle Supervisor von gewählten Leuten, gruppiert nach deren Firma
-  Ansprechpartner aus X 
+      Alle gewählten Personen, gruppiert nach deren Firma
-    - Fred
-  Ansprechpartner aus Y 
-    - Otto 
-  Angestellte aus X 
-    - Fred 
-    - Meier
   -}

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)

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