chore(mail): fix #171 by adding a route for all notifications to users and displaying them
This commit is contained in:
parent
f929e03129
commit
ab00a4f665
@ -29,3 +29,4 @@ PrintJobs: Druckaufräge
|
|||||||
PrintLetterType: Brieftypkürzel
|
PrintLetterType: Brieftypkürzel
|
||||||
|
|
||||||
MCActDummy: Platzhalter
|
MCActDummy: Platzhalter
|
||||||
|
CCActDummy: Platzhalter
|
||||||
@ -29,3 +29,4 @@ PrintJobs: Print jobs
|
|||||||
PrintLetterType: Letter type shorthand
|
PrintLetterType: Letter type shorthand
|
||||||
|
|
||||||
MCActDummy: Placeholder
|
MCActDummy: Placeholder
|
||||||
|
CCActDummy: Placeholder
|
||||||
@ -115,3 +115,4 @@ UserCompanyReason: Begründung der Firmenassoziation
|
|||||||
UserCompanyReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
|
UserCompanyReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
|
||||||
UserSupervisorReason: Begründung Ansprechpartner
|
UserSupervisorReason: Begründung Ansprechpartner
|
||||||
UserSupervisorReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
|
UserSupervisorReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
|
||||||
|
AdminUserAllNotifications: Alle Benachrichtigungen and diesen Benutzer
|
||||||
@ -115,3 +115,4 @@ UserCompanyReason: Reason for company association
|
|||||||
UserCompanyReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.
|
UserCompanyReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.
|
||||||
UserSupervisorReason: Reason for supervision
|
UserSupervisorReason: Reason for supervision
|
||||||
UserSupervisorReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.
|
UserSupervisorReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.
|
||||||
|
AdminUserAllNotifications: All notification sent to this user
|
||||||
@ -143,12 +143,13 @@ MenuSap: SAP Schnittstelle
|
|||||||
MenuAvs: AVS Schnittstelle
|
MenuAvs: AVS Schnittstelle
|
||||||
MenuAvsSynchError: AVS Problemübersicht
|
MenuAvsSynchError: AVS Problemübersicht
|
||||||
MenuLdap: LDAP Schnittstelle
|
MenuLdap: LDAP Schnittstelle
|
||||||
MenuApc: Druckerei
|
MenuApc: Druck
|
||||||
MenuPrintSend: Manueller Briefversand
|
MenuPrintSend: Manueller Briefversand
|
||||||
MenuPrintDownload: Brief herunterladen
|
MenuPrintDownload: Brief herunterladen
|
||||||
MenuPrintLog: LPR Schnittstelle
|
MenuPrintLog: LPR Schnittstelle
|
||||||
MenuPrintAck: Druckbestätigung
|
MenuPrintAck: Druckbestätigung
|
||||||
|
|
||||||
|
MenuCommCenter: Benachrichtigungen
|
||||||
MenuMailCenter: E‑Mails
|
MenuMailCenter: E‑Mails
|
||||||
MenuMailHtml !ident-ok: Html
|
MenuMailHtml !ident-ok: Html
|
||||||
MenuMailPlain !ident-ok: Text
|
MenuMailPlain !ident-ok: Text
|
||||||
|
|||||||
@ -143,12 +143,13 @@ MenuSap: SAP Interface
|
|||||||
MenuAvs: AVS Interface
|
MenuAvs: AVS Interface
|
||||||
MenuAvsSynchError: AVS Problem Overview
|
MenuAvsSynchError: AVS Problem Overview
|
||||||
MenuLdap: LDAP Interface
|
MenuLdap: LDAP Interface
|
||||||
MenuApc: Printing
|
MenuApc: Print
|
||||||
MenuPrintSend: Send Letter
|
MenuPrintSend: Send Letter
|
||||||
MenuPrintDownload: Download Letter
|
MenuPrintDownload: Download Letter
|
||||||
MenuPrintLog: LPR Interface
|
MenuPrintLog: LPR Interface
|
||||||
MenuPrintAck: Acknowledge Printing
|
MenuPrintAck: Acknowledge Printing
|
||||||
|
|
||||||
|
MenuCommCenter: Notifications
|
||||||
MenuMailCenter: Email
|
MenuMailCenter: Email
|
||||||
MenuMailHtml: Html
|
MenuMailHtml: Html
|
||||||
MenuMailPlain: Text
|
MenuMailPlain: Text
|
||||||
|
|||||||
9
routes
9
routes
@ -77,6 +77,11 @@
|
|||||||
/admin/problems/avs ProblemAvsSynchR GET POST
|
/admin/problems/avs ProblemAvsSynchR GET POST
|
||||||
/admin/problems/avs/errors ProblemAvsErrorR GET
|
/admin/problems/avs/errors ProblemAvsErrorR GET
|
||||||
|
|
||||||
|
/comm CommCenterR GET
|
||||||
|
/comm/email MailCenterR GET POST
|
||||||
|
/comm/email/html/#CryptoUUIDSentMail MailHtmlR GET
|
||||||
|
/comm/email/plain/#CryptoUUIDSentMail MailPlainR GET
|
||||||
|
|
||||||
/print PrintCenterR GET POST !system-printer
|
/print PrintCenterR GET POST !system-printer
|
||||||
/print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer
|
/print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer
|
||||||
/print/acknowledge/direct PrintAckDirectR GET POST !system-printer
|
/print/acknowledge/direct PrintAckDirectR GET POST !system-printer
|
||||||
@ -84,10 +89,6 @@
|
|||||||
/print/download/#CryptoUUIDPrintJob PrintDownloadR GET !system-printer
|
/print/download/#CryptoUUIDPrintJob PrintDownloadR GET !system-printer
|
||||||
/print/log PrintLogR GET !system-printer
|
/print/log PrintLogR GET !system-printer
|
||||||
|
|
||||||
/mail MailCenterR GET POST
|
|
||||||
/mail/html/#CryptoUUIDSentMail MailHtmlR GET
|
|
||||||
/mail/plain/#CryptoUUIDSentMail MailPlainR GET
|
|
||||||
|
|
||||||
/health HealthR GET !free
|
/health HealthR GET !free
|
||||||
/health/interface/+Texts HealthInterfaceR GET !free
|
/health/interface/+Texts HealthInterfaceR GET !free
|
||||||
/instance InstanceR GET !free
|
/instance InstanceR GET !free
|
||||||
|
|||||||
@ -157,8 +157,9 @@ import Handler.Upload
|
|||||||
import Handler.Qualification
|
import Handler.Qualification
|
||||||
import Handler.LMS
|
import Handler.LMS
|
||||||
import Handler.SAP
|
import Handler.SAP
|
||||||
import Handler.PrintCenter
|
import Handler.CommCenter
|
||||||
import Handler.MailCenter
|
import Handler.MailCenter
|
||||||
|
import Handler.PrintCenter
|
||||||
import Handler.ApiDocs
|
import Handler.ApiDocs
|
||||||
import Handler.Swagger
|
import Handler.Swagger
|
||||||
import Handler.Firm
|
import Handler.Firm
|
||||||
|
|||||||
@ -48,7 +48,7 @@ module Database.Esqueleto.Utils
|
|||||||
, subSelectCountDistinct
|
, subSelectCountDistinct
|
||||||
, selectCountRows, selectCountDistinct
|
, selectCountRows, selectCountDistinct
|
||||||
, selectMaybe
|
, selectMaybe
|
||||||
, str2text
|
, str2text, str2text'
|
||||||
, num2text --, text2num
|
, num2text --, text2num
|
||||||
, day, day', dayMaybe, interval, diffDays, diffTimes
|
, day, day', dayMaybe, interval, diffDays, diffTimes
|
||||||
, exprLift
|
, exprLift
|
||||||
@ -712,6 +712,9 @@ selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
|
|||||||
str2text :: E.SqlString a => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Text)
|
str2text :: E.SqlString a => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Text)
|
||||||
str2text = E.unsafeSqlCastAs "text"
|
str2text = E.unsafeSqlCastAs "text"
|
||||||
|
|
||||||
|
str2text' :: E.SqlString a => E.SqlExpr (E.Value (Maybe a)) -> E.SqlExpr (E.Value (Maybe Text))
|
||||||
|
str2text' = E.unsafeSqlCastAs "text"
|
||||||
|
|
||||||
-- | cast numeric type to text, which is safe and allows for an inefficient but safe comparison of numbers stored as text and numbers
|
-- | cast numeric type to text, which is safe and allows for an inefficient but safe comparison of numbers stored as text and numbers
|
||||||
num2text :: Num n => E.SqlExpr (E.Value n) -> E.SqlExpr (E.Value Text)
|
num2text :: Num n => E.SqlExpr (E.Value n) -> E.SqlExpr (E.Value Text)
|
||||||
num2text = E.unsafeSqlCastAs "text"
|
num2text = E.unsafeSqlCastAs "text"
|
||||||
|
|||||||
@ -129,17 +129,18 @@ breadcrumb FirmUsersR{} = i18nCrumb MsgMenuFirmUsers $ Just FirmAll
|
|||||||
breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors $ Just $ FirmUsersR fsh
|
breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors $ Just $ FirmUsersR fsh
|
||||||
breadcrumb (FirmCommR fsh)= i18nCrumb MsgMenuFirmsComm $ Just $ FirmUsersR fsh
|
breadcrumb (FirmCommR fsh)= i18nCrumb MsgMenuFirmsComm $ Just $ FirmUsersR fsh
|
||||||
|
|
||||||
breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing
|
breadcrumb CommCenterR = i18nCrumb MsgMenuCommCenter Nothing
|
||||||
|
breadcrumb MailCenterR = i18nCrumb MsgMenuMailCenter $ Just CommCenterR
|
||||||
|
breadcrumb MailHtmlR{} = i18nCrumb MsgMenuMailHtml $ Just MailCenterR
|
||||||
|
breadcrumb MailPlainR{} = i18nCrumb MsgMenuMailPlain $ Just MailCenterR
|
||||||
|
|
||||||
|
breadcrumb PrintCenterR = i18nCrumb MsgMenuApc $ Just CommCenterR
|
||||||
breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR
|
breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR
|
||||||
breadcrumb PrintDownloadR{} = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR
|
breadcrumb PrintDownloadR{} = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR
|
||||||
breadcrumb PrintAckR{} = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed
|
breadcrumb PrintAckR{} = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed
|
||||||
breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintAck $ Just PrintCenterR
|
breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintAck $ Just PrintCenterR
|
||||||
breadcrumb PrintLogR = i18nCrumb MsgMenuPrintLog $ Just PrintCenterR
|
breadcrumb PrintLogR = i18nCrumb MsgMenuPrintLog $ Just PrintCenterR
|
||||||
|
|
||||||
breadcrumb MailCenterR = i18nCrumb MsgMenuMailCenter Nothing
|
|
||||||
breadcrumb MailHtmlR{} = i18nCrumb MsgMenuMailHtml $ Just MailCenterR
|
|
||||||
breadcrumb MailPlainR{} = i18nCrumb MsgMenuMailPlain $ Just MailCenterR
|
|
||||||
|
|
||||||
breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR
|
breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR
|
||||||
breadcrumb (SchoolR ssh sRoute) = case sRoute of
|
breadcrumb (SchoolR ssh sRoute) = case sRoute of
|
||||||
SchoolEditR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
|
SchoolEditR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
|
||||||
@ -2478,12 +2479,19 @@ pageActions PrintCenterR = do
|
|||||||
, navForceActive = False
|
, navForceActive = False
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
emailCenter = NavPageActionPrimary
|
|
||||||
{ navLink = defNavLink MsgMenuMailCenter MailCenterR
|
|
||||||
, navChildren = []
|
|
||||||
}
|
|
||||||
dayLinks <- mapM toDayAck $ Map.toAscList dayMap
|
dayLinks <- mapM toDayAck $ Map.toAscList dayMap
|
||||||
return $ emailCenter : manualSend : printLog : printAck : take 9 dayLinks
|
return $ manualSend : printLog : printAck : take 9 dayLinks
|
||||||
|
|
||||||
|
pageActions CommCenterR = return
|
||||||
|
[ NavPageActionPrimary
|
||||||
|
{ navLink = defNavLink MsgMenuMailCenter MailCenterR
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
, NavPageActionPrimary
|
||||||
|
{ navLink = defNavLink MsgMenuApc PrintCenterR
|
||||||
|
, navChildren = []
|
||||||
|
}
|
||||||
|
]
|
||||||
|
|
||||||
pageActions (MailHtmlR smid) = return
|
pageActions (MailHtmlR smid) = return
|
||||||
[ NavPageActionPrimary
|
[ NavPageActionPrimary
|
||||||
|
|||||||
172
src/Handler/CommCenter.hs
Normal file
172
src/Handler/CommCenter.hs
Normal file
@ -0,0 +1,172 @@
|
|||||||
|
-- SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
|
||||||
|
--
|
||||||
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
|
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
|
||||||
|
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||||
|
-- TODO: remove these above
|
||||||
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
|
||||||
|
module Handler.CommCenter
|
||||||
|
( getCommCenterR
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
-- import qualified Data.Aeson as Aeson
|
||||||
|
-- import qualified Data.Text as Text
|
||||||
|
|
||||||
|
-- import Database.Persist.Sql (updateWhereCount)
|
||||||
|
-- import Database.Esqueleto.Experimental ((:&)(..))
|
||||||
|
import qualified Database.Esqueleto.Legacy as EL (on) -- only `on` and `from` are different, needed for dbTable using Esqueleto.Legacy
|
||||||
|
import qualified Database.Esqueleto.Experimental as E
|
||||||
|
import qualified Database.Esqueleto.Utils as E
|
||||||
|
import Database.Esqueleto.Utils.TH
|
||||||
|
|
||||||
|
-- import Utils.Print
|
||||||
|
|
||||||
|
import Handler.Utils
|
||||||
|
-- import Handler.Utils.Csv
|
||||||
|
-- import qualified Data.Csv as Csv
|
||||||
|
-- import qualified Data.CaseInsensitive as CI
|
||||||
|
|
||||||
|
-- import Jobs.Queue
|
||||||
|
import qualified Data.Aeson as Aeson
|
||||||
|
|
||||||
|
import Text.Blaze.Html (preEscapedToHtml)
|
||||||
|
-- import Text.Blaze.Html5 as H (html, body, pre, p, h1)
|
||||||
|
-- import Text.Blaze.Html.Renderer.String (renderHtml)
|
||||||
|
-- import Data.Text (Text)
|
||||||
|
|
||||||
|
|
||||||
|
import Data.Text.Lens (packed)
|
||||||
|
-- import qualified Data.Text.Lazy as LT
|
||||||
|
-- import qualified Data.Text.Lazy.Encoding as LT
|
||||||
|
import qualified Data.ByteString.Lazy as LB
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- avoids repetition of local definitions
|
||||||
|
single :: (k,a) -> Map k a
|
||||||
|
single = uncurry Map.singleton
|
||||||
|
|
||||||
|
|
||||||
|
data CCTableAction = CCActDummy -- just a dummy, since we don't now yet which actions we will be needing
|
||||||
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||||
|
|
||||||
|
instance Universe CCTableAction
|
||||||
|
instance Finite CCTableAction
|
||||||
|
nullaryPathPiece ''CCTableAction $ camelToPathPiece' 2
|
||||||
|
embedRenderMessage ''UniWorX ''CCTableAction id
|
||||||
|
|
||||||
|
data CCTableActionData = CCActDummyData
|
||||||
|
deriving (Eq, Ord, Read, Show, Generic)
|
||||||
|
|
||||||
|
|
||||||
|
-- SJ: I don't know how to use E.unionAll_ with dbTable, so we simulate it by a FullOuterJoin with constant False ON-clause instead
|
||||||
|
type CCTableExpr =
|
||||||
|
( (E.SqlExpr (Maybe (Entity User)) `E.InnerJoin` E.SqlExpr (Maybe (Entity SentMail)))
|
||||||
|
`E.FullOuterJoin` (E.SqlExpr (Maybe (Entity User)) `E.InnerJoin` E.SqlExpr (Maybe (Entity PrintJob)))
|
||||||
|
)
|
||||||
|
|
||||||
|
queryRecipientMail :: CCTableExpr -> E.SqlExpr (Maybe (Entity User))
|
||||||
|
queryRecipientMail = $(sqlIJproj 2 1) . $(sqlFOJproj 2 1)
|
||||||
|
|
||||||
|
queryMail :: CCTableExpr -> E.SqlExpr (Maybe (Entity SentMail))
|
||||||
|
queryMail = $(sqlIJproj 2 2) . $(sqlFOJproj 2 1)
|
||||||
|
|
||||||
|
queryRecipientPrint :: CCTableExpr -> E.SqlExpr (Maybe (Entity User))
|
||||||
|
queryRecipientPrint = $(sqlIJproj 2 1) . $(sqlFOJproj 2 2)
|
||||||
|
|
||||||
|
queryPrint :: CCTableExpr -> E.SqlExpr (Maybe (Entity PrintJob))
|
||||||
|
queryPrint = $(sqlIJproj 2 2) . $(sqlFOJproj 2 2)
|
||||||
|
|
||||||
|
type CCTableData = DBRow (Maybe (Entity User), Maybe (Entity SentMail), Maybe (Entity User), Maybe (Entity PrintJob))
|
||||||
|
|
||||||
|
resultRecipientMail :: Traversal' CCTableData (Entity User)
|
||||||
|
resultRecipientMail = _dbrOutput . _1 . _Just
|
||||||
|
|
||||||
|
resultMail :: Traversal' CCTableData (Entity SentMail)
|
||||||
|
resultMail = _dbrOutput . _2 . _Just
|
||||||
|
|
||||||
|
resultRecipientPrint :: Traversal' CCTableData (Entity User)
|
||||||
|
resultRecipientPrint = _dbrOutput . _3 . _Just
|
||||||
|
|
||||||
|
resultPrint :: Traversal' CCTableData (Entity PrintJob)
|
||||||
|
resultPrint = _dbrOutput . _4 . _Just
|
||||||
|
|
||||||
|
|
||||||
|
mkCCTable :: DB (Any, Widget)
|
||||||
|
mkCCTable = do
|
||||||
|
let
|
||||||
|
dbtSQLQuery :: CCTableExpr -> E.SqlQuery (E.SqlExpr (Maybe (Entity User)), E.SqlExpr (Maybe (Entity SentMail)), E.SqlExpr (Maybe (Entity User)), E.SqlExpr (Maybe (Entity PrintJob)))
|
||||||
|
dbtSQLQuery ((recipientMail `E.InnerJoin` mail) `E.FullOuterJoin` (recipientPrint `E.InnerJoin` printJob)) = do
|
||||||
|
EL.on $ recipientMail E.?. UserId E.==. E.joinV (mail E.?. SentMailRecipient)
|
||||||
|
EL.on $ recipientPrint E.?. UserId E.==. E.joinV (printJob E.?. PrintJobRecipient)
|
||||||
|
-- EL.on $ recipientMail E.?. UserId E.==. recipientPrint E.?. UserId E.&&. E.false -- simulating E.unionAll_ by a constant false full outer join, since it is unclear how dbTable could handle E.unionAll_
|
||||||
|
EL.on E.false -- simulating E.unionAll_ by a constant false full outer join, since it is unclear how dbTable could handle E.unionAll_
|
||||||
|
-- E.where_ $ E.isJust (recipientMail E.?. UserId) E.||. E.isJust (recipientPrint E.?. UserId) -- not needed
|
||||||
|
-- return (E.coalesce[recipientMail, recipientPrint], mail, print) -- coalesce only works on values, not entities
|
||||||
|
return (recipientMail, mail, recipientPrint, printJob)
|
||||||
|
-- dbtRowKey = (,) <$> views (to queryMail) (E.?. SentMailId) <*> views (to queryPrint) (E.?. PrintJobId)
|
||||||
|
dbtRowKey ((_recipientMail `E.InnerJoin` mail) `E.FullOuterJoin` (_recipientPrint `E.InnerJoin` printJob)) = (mail E.?. SentMailId, printJob E.?. PrintJobId)
|
||||||
|
|
||||||
|
dbtProj = dbtProjId
|
||||||
|
dbtColonnade = dbColonnade $ mconcat -- prefer print over email in the impossible case that both are Just
|
||||||
|
[ sortable (Just "date") (i18nCell MsgPrintJobCreated) $ \row ->
|
||||||
|
let tprint = row ^? resultPrint . _entityVal . _printJobCreated
|
||||||
|
tmail = row ^? resultMail . _entityVal . _sentMailSentAt
|
||||||
|
in maybeCell (tprint <|> tmail) dateTimeCell
|
||||||
|
, sortable (Just "recipient") (i18nCell MsgPrintRecipient) $ \row ->
|
||||||
|
let uprint = row ^? resultRecipientPrint
|
||||||
|
umail = row ^? resultRecipientMail
|
||||||
|
in maybeCell (uprint <|> umail) $ cellHasUserLink AdminUserR
|
||||||
|
, sortable Nothing (i18nCell MsgCommBody) $ \row -> if
|
||||||
|
| (Just k) <- row ^? resultPrint . _entityKey
|
||||||
|
-> anchorCellM (PrintDownloadR <$> encrypt k) $ toWgt (iconLetterOrEmail True ) <> text2widget "-link"
|
||||||
|
| (Just k) <- row ^? resultMail . _entityKey
|
||||||
|
-> anchorCellM (MailHtmlR <$> encrypt k) $ toWgt (iconLetterOrEmail False) <> text2widget "-link"
|
||||||
|
| otherwise
|
||||||
|
-> mempty
|
||||||
|
, sortable Nothing (i18nCell MsgCommSubject) $ \row ->
|
||||||
|
let tsubject = row ^? resultPrint . _entityVal . _printJobFilename . packed
|
||||||
|
msubject = row ^? resultMail . _entityVal . _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject"
|
||||||
|
in maybeCell (tsubject <|> msubject) textCell
|
||||||
|
]
|
||||||
|
dbtSorting = mconcat
|
||||||
|
[ singletonMap "date" $ SortColumn $ \row -> E.coalesce [queryPrint row E.?. PrintJobCreated, queryMail row E.?. SentMailSentAt]
|
||||||
|
, singletonMap "recipient" $ SortColumns $ \row ->
|
||||||
|
[ SomeExprValue $ E.coalesce [queryRecipientPrint row E.?. UserSurname , queryRecipientMail row E.?. UserSurname ]
|
||||||
|
, SomeExprValue $ E.coalesce [queryRecipientPrint row E.?. UserDisplayName, queryRecipientMail row E.?. UserDisplayName]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
dbtFilter = mconcat
|
||||||
|
[ single ("recipient" , FilterColumn . E.mkContainsFilterWithCommaPlus Just
|
||||||
|
$ \row -> E.coalesce [queryRecipientPrint row E.?. UserDisplayName, queryRecipientMail row E.?. UserDisplayName])
|
||||||
|
, single ("subject" , FilterColumn . E.mkContainsFilterWithCommaPlus Just
|
||||||
|
$ \row -> E.coalesce [E.str2text' $ queryPrint row E.?. PrintJobFilename
|
||||||
|
,E.str2text' $ queryMail row E.?. SentMailHeaders ])
|
||||||
|
]
|
||||||
|
dbtFilterUI mPrev = mconcat
|
||||||
|
[ prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlus)
|
||||||
|
, prismAForm (singletonFilter "subject" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgCommSubject & setTooltip MsgTableFilterCommaPlusShort)
|
||||||
|
]
|
||||||
|
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
|
||||||
|
dbtIdent :: Text
|
||||||
|
dbtIdent = "comms"
|
||||||
|
dbtCsvEncode = noCsvEncode
|
||||||
|
dbtCsvDecode = Nothing
|
||||||
|
dbtExtraReps = []
|
||||||
|
dbtParams = def
|
||||||
|
psValidator = def & defaultSorting [SortDescBy "date"]
|
||||||
|
dbTable psValidator DBTable{..}
|
||||||
|
|
||||||
|
getCommCenterR :: Handler Html
|
||||||
|
getCommCenterR = do
|
||||||
|
(_, ccTable) <- runDB mkCCTable
|
||||||
|
siteLayoutMsg MsgMenuMailCenter $ do
|
||||||
|
setTitleI MsgMenuMailCenter
|
||||||
|
$(widgetFile "comm-center")
|
||||||
|
|
||||||
@ -2,6 +2,9 @@
|
|||||||
--
|
--
|
||||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
|
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
|
||||||
|
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||||
|
-- TODO: remove these above
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
|
||||||
module Handler.MailCenter
|
module Handler.MailCenter
|
||||||
@ -44,7 +47,14 @@ import Text.Blaze.Html (preEscapedToHtml)
|
|||||||
-- import qualified Data.Text.Lazy.Encoding as LT
|
-- import qualified Data.Text.Lazy.Encoding as LT
|
||||||
import qualified Data.ByteString.Lazy as LB
|
import qualified Data.ByteString.Lazy as LB
|
||||||
|
|
||||||
|
import Data.Char as C
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
-- import qualified Data.Text.Encoding as TE
|
||||||
|
-- import qualified Data.ByteString.Char8 as BS
|
||||||
|
|
||||||
|
import Data.Bits
|
||||||
|
-- import Data.Word
|
||||||
|
|
||||||
-- avoids repetition of local definitions
|
-- avoids repetition of local definitions
|
||||||
single :: (k,a) -> Map k a
|
single :: (k,a) -> Map k a
|
||||||
@ -96,7 +106,7 @@ mkMCTable = do
|
|||||||
dbtProj = dbtProjId
|
dbtProj = dbtProjId
|
||||||
dbtColonnade = mconcat
|
dbtColonnade = mconcat
|
||||||
[ dbSelect (applying _2) id (return . view (resultMail . _entityKey))
|
[ dbSelect (applying _2) id (return . view (resultMail . _entityKey))
|
||||||
, sortable (Just "sent") (i18nCell MsgPrintJobCreated) $ \( view $ resultMail . _entityVal . _sentMailSentAt -> t) -> dateTimeCell t -- TODO: msg
|
, sortable (Just "sent") (i18nCell MsgPrintJobCreated) $ \( view $ resultMail . _entityVal . _sentMailSentAt -> t) -> dateTimeCell t
|
||||||
, sortable (Just "recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR
|
, sortable (Just "recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR
|
||||||
, sortable Nothing (i18nCell MsgCommSubject) $ \(view resultMail -> Entity k v) ->
|
, sortable Nothing (i18nCell MsgCommSubject) $ \(view resultMail -> Entity k v) ->
|
||||||
let subject = v ^? _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject"
|
let subject = v ^? _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject"
|
||||||
@ -115,7 +125,7 @@ mkMCTable = do
|
|||||||
, single ("subject" , FilterColumn . E.mkContainsFilter $ views (to queryMail) (E.str2text . (E.^. SentMailHeaders)))
|
, single ("subject" , FilterColumn . E.mkContainsFilter $ views (to queryMail) (E.str2text . (E.^. SentMailHeaders)))
|
||||||
]
|
]
|
||||||
dbtFilterUI mPrev = mconcat
|
dbtFilterUI mPrev = mconcat
|
||||||
[ prismAForm (singletonFilter "sent" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift dayField) (fslI MsgPrintJobCreated) -- TODO: msg
|
[ prismAForm (singletonFilter "sent" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift dayField) (fslI MsgPrintJobCreated)
|
||||||
, prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlus)
|
, prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlus)
|
||||||
, prismAForm (singletonFilter "subject" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgCommSubject & setTooltip MsgTableFilterCommaPlusShort)
|
, prismAForm (singletonFilter "subject" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgCommSubject & setTooltip MsgTableFilterCommaPlusShort)
|
||||||
]
|
]
|
||||||
@ -192,17 +202,17 @@ handleMailShow prefTypes cusm = do
|
|||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
_{MsgPrintSender}
|
_{MsgPrintSender}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
#{r}
|
#{decodeMime r}
|
||||||
$maybe r <- getHeader "To"
|
$maybe r <- getHeader "To"
|
||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
_{MsgPrintRecipient}
|
_{MsgPrintRecipient}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
#{r}
|
#{decodeMime r}
|
||||||
$maybe r <- getHeader "Subject"
|
$maybe r <- getHeader "Subject"
|
||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
_{MsgCommSubject}
|
_{MsgCommSubject}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
#{r}
|
#{decodeMime r}
|
||||||
|
|
||||||
<section>
|
<section>
|
||||||
$forall mc <- mcontent
|
$forall mc <- mcontent
|
||||||
@ -214,17 +224,6 @@ handleMailShow prefTypes cusm = do
|
|||||||
-- ^{jsonWidget (sentMailContentContent cn)}
|
-- ^{jsonWidget (sentMailContentContent cn)}
|
||||||
|
|
||||||
|
|
||||||
{-
|
|
||||||
alternative2widget :: Alternatives -> Widget
|
|
||||||
alternative2widget alt = -- show all parts for now TODO: select only best representation for each
|
|
||||||
[whamlet|
|
|
||||||
<section>
|
|
||||||
$forall p <- alt
|
|
||||||
^{part2widget p}
|
|
||||||
<hr>
|
|
||||||
|]
|
|
||||||
-}
|
|
||||||
|
|
||||||
selectAlternative :: [ContentType] -> Alternatives -> Maybe Part
|
selectAlternative :: [ContentType] -> Alternatives -> Maybe Part
|
||||||
selectAlternative (fmap decodeUtf8 -> prefTypes) allAlts = aux prefTypes allAlts
|
selectAlternative (fmap decodeUtf8 -> prefTypes) allAlts = aux prefTypes allAlts
|
||||||
where
|
where
|
||||||
@ -240,7 +239,6 @@ disposition2widget (AttachmentDisposition n) = [whamlet|<h3>Attachment #{n}|]
|
|||||||
disposition2widget (InlineDisposition n) = [whamlet|<h3>#{n}|]
|
disposition2widget (InlineDisposition n) = [whamlet|<h3>#{n}|]
|
||||||
disposition2widget DefaultDisposition = mempty
|
disposition2widget DefaultDisposition = mempty
|
||||||
|
|
||||||
|
|
||||||
part2widget :: Part -> Widget
|
part2widget :: Part -> Widget
|
||||||
part2widget Part{partContent=NestedParts ps} =
|
part2widget Part{partContent=NestedParts ps} =
|
||||||
[whamlet|
|
[whamlet|
|
||||||
@ -265,3 +263,8 @@ part2widget Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partD
|
|||||||
let jw :: Aeson.Value -> Widget = jsonWidget
|
let jw :: Aeson.Value -> Widget = jsonWidget
|
||||||
in either str2widget jw $ Aeson.eitherDecodeStrict' pc
|
in either str2widget jw $ Aeson.eitherDecodeStrict' pc
|
||||||
| otherwise = [whamlet|part2widget cannot decode parts of type #{pt} yet.|]
|
| otherwise = [whamlet|part2widget cannot decode parts of type #{pt} yet.|]
|
||||||
|
|
||||||
|
|
||||||
|
-- | decode the MIME encoded-word format, which is used in email headers to encode non-ASCII text. This format is specified in RFC 2047.
|
||||||
|
decodeMime :: Text -> Text
|
||||||
|
decodeMime = id -- TODO
|
||||||
@ -46,6 +46,9 @@ import Jobs
|
|||||||
import Foundation.Yesod.Auth (updateUserLanguage)
|
import Foundation.Yesod.Auth (updateUserLanguage)
|
||||||
|
|
||||||
|
|
||||||
|
{-# ANN module ("HLint: ignore Functor law" :: String) #-}
|
||||||
|
|
||||||
|
|
||||||
data ExamOfficeSettings
|
data ExamOfficeSettings
|
||||||
= ExamOfficeSettings
|
= ExamOfficeSettings
|
||||||
{ eosettingsGetSynced :: Bool
|
{ eosettingsGetSynced :: Bool
|
||||||
|
|||||||
@ -48,7 +48,7 @@ import Data.List (genericLength)
|
|||||||
|
|
||||||
import qualified Data.Csv as Csv
|
import qualified Data.Csv as Csv
|
||||||
|
|
||||||
|
{-# ANN module ("HLint: ignore Functor law" :: String) #-}
|
||||||
|
|
||||||
data CorrectionTableFilterProj = CorrectionTableFilterProj
|
data CorrectionTableFilterProj = CorrectionTableFilterProj
|
||||||
{ corrProjFilterSubmission :: Maybe (Set [CI Char])
|
{ corrProjFilterSubmission :: Maybe (Set [CI Char])
|
||||||
|
|||||||
@ -8,8 +8,14 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
|||||||
^{thisUserActWgt}
|
^{thisUserActWgt}
|
||||||
<section>
|
<section>
|
||||||
^{userDataWidget}
|
^{userDataWidget}
|
||||||
<section>
|
|
||||||
<h3>
|
<p>
|
||||||
|
#{iconNotificationSent}
|
||||||
|
<a href=@{CommCenterR}?comms-sorting=date-desc&comms-recipient=#{toPathPiece userDisplayName}>
|
||||||
|
_{MsgAdminUserAllNotifications}
|
||||||
|
|
||||||
|
|
||||||
|
<h3>
|
||||||
_{MsgAdminUserRightsHeading}
|
_{MsgAdminUserRightsHeading}
|
||||||
^{systemFunctionsForm}
|
^{systemFunctionsForm}
|
||||||
^{rightsForm}
|
^{rightsForm}
|
||||||
|
|||||||
9
templates/comm-center.hamlet
Normal file
9
templates/comm-center.hamlet
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
$newline never
|
||||||
|
|
||||||
|
$# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
|
||||||
|
$#
|
||||||
|
$# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
|
<section>
|
||||||
|
<p>
|
||||||
|
^{ccTable}
|
||||||
@ -9,6 +9,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
|||||||
<ul>
|
<ul>
|
||||||
<li>
|
<li>
|
||||||
Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrektur von Übungen, Kursleiterschaft, Raumbuchungen, etc.
|
Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrektur von Übungen, Kursleiterschaft, Raumbuchungen, etc.
|
||||||
|
<li>
|
||||||
|
Nicht aufgeführt sind die an diesen Benutzer versendeten Benachrichtigungen per E-Mail oder Briefpost.
|
||||||
<li>
|
<li>
|
||||||
<p>
|
<p>
|
||||||
Sie können die
|
Sie können die
|
||||||
|
|||||||
@ -9,6 +9,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
|||||||
<ul>
|
<ul>
|
||||||
<li>
|
<li>
|
||||||
Timestamps with user information (e.g. editing of corrections, submission groups, rooms, ...) are not shown here.
|
Timestamps with user information (e.g. editing of corrections, submission groups, rooms, ...) are not shown here.
|
||||||
|
<li>
|
||||||
|
Sent notifications by email or letter are not shown here.
|
||||||
<li>
|
<li>
|
||||||
<p>
|
<p>
|
||||||
You can request your data be deleted by opening
|
You can request your data be deleted by opening
|
||||||
|
|||||||
@ -221,5 +221,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
|||||||
|
|
||||||
^{maybeTable' MsgTableCorrector Nothing (Just (msg2widget MsgProfileCorrectorRemark <> simpleLinkI MsgProfileCorrections CorrectionsR)) correctionsTable}
|
^{maybeTable' MsgTableCorrector Nothing (Just (msg2widget MsgProfileCorrectorRemark <> simpleLinkI MsgProfileCorrections CorrectionsR)) correctionsTable}
|
||||||
|
|
||||||
|
|
||||||
^{profileRemarks}
|
^{profileRemarks}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user