diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index 3cc18f0ee..f14def9d8 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -28,4 +28,5 @@ PrintLmsUser: E‑Learning Id PrintJobs: Druckaufräge PrintLetterType: Brieftypkürzel -MCActDummy: Platzhalter \ No newline at end of file +MCActDummy: Platzhalter +CCActDummy: Platzhalter \ No newline at end of file diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index 2b491983e..d757cf2cf 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -28,4 +28,5 @@ PrintLmsUser: E‑learning id PrintJobs: Print jobs PrintLetterType: Letter type shorthand -MCActDummy: Placeholder \ No newline at end of file +MCActDummy: Placeholder +CCActDummy: Placeholder \ No newline at end of file diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index f550dd4b2..b2ab14351 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -114,4 +114,5 @@ UsersRemoveSubordinates usr@Int: Alle Ansprechpartnerbeziehungen für #{tshow us UserCompanyReason: Begründung der Firmenassoziation UserCompanyReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern. UserSupervisorReason: Begründung Ansprechpartner -UserSupervisorReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern. \ No newline at end of file +UserSupervisorReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern. +AdminUserAllNotifications: Alle Benachrichtigungen and diesen Benutzer \ No newline at end of file diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg index 6e4624edc..265344219 100644 --- a/messages/uniworx/categories/user/en-eu.msg +++ b/messages/uniworx/categories/user/en-eu.msg @@ -114,4 +114,5 @@ UsersRemoveSubordinates usr: Removed all subordinates for #{pluralENsN usr "prev UserCompanyReason: Reason for company association UserCompanyReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes. UserSupervisorReason: Reason for supervision -UserSupervisorReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes. \ No newline at end of file +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 \ No newline at end of file diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 9eae9e201..523db3d2d 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -143,12 +143,13 @@ MenuSap: SAP Schnittstelle MenuAvs: AVS Schnittstelle MenuAvsSynchError: AVS Problemübersicht MenuLdap: LDAP Schnittstelle -MenuApc: Druckerei +MenuApc: Druck MenuPrintSend: Manueller Briefversand MenuPrintDownload: Brief herunterladen MenuPrintLog: LPR Schnittstelle MenuPrintAck: Druckbestätigung +MenuCommCenter: Benachrichtigungen MenuMailCenter: E‑Mails MenuMailHtml !ident-ok: Html MenuMailPlain !ident-ok: Text diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 79438c351..0dd276ff8 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -143,12 +143,13 @@ MenuSap: SAP Interface MenuAvs: AVS Interface MenuAvsSynchError: AVS Problem Overview MenuLdap: LDAP Interface -MenuApc: Printing +MenuApc: Print MenuPrintSend: Send Letter MenuPrintDownload: Download Letter MenuPrintLog: LPR Interface MenuPrintAck: Acknowledge Printing +MenuCommCenter: Notifications MenuMailCenter: Email MenuMailHtml: Html MenuMailPlain: Text diff --git a/routes b/routes index 10627db43..1030745a2 100644 --- a/routes +++ b/routes @@ -77,6 +77,11 @@ /admin/problems/avs ProblemAvsSynchR GET POST /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/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer /print/acknowledge/direct PrintAckDirectR GET POST !system-printer @@ -84,10 +89,6 @@ /print/download/#CryptoUUIDPrintJob PrintDownloadR 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/interface/+Texts HealthInterfaceR GET !free /instance InstanceR GET !free diff --git a/src/Application.hs b/src/Application.hs index 30f6d9469..12e0cf9c3 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -157,8 +157,9 @@ import Handler.Upload import Handler.Qualification import Handler.LMS import Handler.SAP -import Handler.PrintCenter +import Handler.CommCenter import Handler.MailCenter +import Handler.PrintCenter import Handler.ApiDocs import Handler.Swagger import Handler.Firm diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 1ce50b833..6a59f0241 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -48,7 +48,7 @@ module Database.Esqueleto.Utils , subSelectCountDistinct , selectCountRows, selectCountDistinct , selectMaybe - , str2text + , str2text, str2text' , num2text --, text2num , day, day', dayMaybe, interval, diffDays, diffTimes , 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.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 num2text :: Num n => E.SqlExpr (E.Value n) -> E.SqlExpr (E.Value Text) num2text = E.unsafeSqlCastAs "text" diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 154c65e8c..5c3fe16c5 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -129,17 +129,18 @@ breadcrumb FirmUsersR{} = i18nCrumb MsgMenuFirmUsers $ Just FirmAll breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors $ 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 PrintDownloadR{} = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR breadcrumb PrintAckR{} = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -- never displayed breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintAck $ 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 (SchoolR ssh sRoute) = case sRoute of SchoolEditR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do @@ -2478,12 +2479,19 @@ pageActions PrintCenterR = do , navForceActive = False } } - emailCenter = NavPageActionPrimary - { navLink = defNavLink MsgMenuMailCenter MailCenterR - , navChildren = [] - } 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 [ NavPageActionPrimary diff --git a/src/Handler/CommCenter.hs b/src/Handler/CommCenter.hs new file mode 100644 index 000000000..6cfb16eb0 --- /dev/null +++ b/src/Handler/CommCenter.hs @@ -0,0 +1,172 @@ +-- SPDX-FileCopyrightText: 2024 Steffen Jost +-- +-- 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") + diff --git a/src/Handler/MailCenter.hs b/src/Handler/MailCenter.hs index f638341f0..251f84108 100644 --- a/src/Handler/MailCenter.hs +++ b/src/Handler/MailCenter.hs @@ -2,6 +2,9 @@ -- -- 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.MailCenter @@ -44,7 +47,14 @@ import Text.Blaze.Html (preEscapedToHtml) -- import qualified Data.Text.Lazy.Encoding as LT 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 single :: (k,a) -> Map k a @@ -96,7 +106,7 @@ mkMCTable = do dbtProj = dbtProjId dbtColonnade = mconcat [ 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 Nothing (i18nCell MsgCommSubject) $ \(view resultMail -> Entity k v) -> 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))) ] 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 "subject" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgCommSubject & setTooltip MsgTableFilterCommaPlusShort) ] @@ -192,17 +202,17 @@ handleMailShow prefTypes cusm = do
_{MsgPrintSender}
- #{r} + #{decodeMime r} $maybe r <- getHeader "To"
_{MsgPrintRecipient}
- #{r} + #{decodeMime r} $maybe r <- getHeader "Subject"
_{MsgCommSubject}
- #{r} + #{decodeMime r}
$forall mc <- mcontent @@ -214,17 +224,6 @@ handleMailShow prefTypes cusm = do -- ^{jsonWidget (sentMailContentContent cn)} -{- -alternative2widget :: Alternatives -> Widget -alternative2widget alt = -- show all parts for now TODO: select only best representation for each - [whamlet| -
- $forall p <- alt - ^{part2widget p} -
- |] --} - selectAlternative :: [ContentType] -> Alternatives -> Maybe Part selectAlternative (fmap decodeUtf8 -> prefTypes) allAlts = aux prefTypes allAlts where @@ -240,7 +239,6 @@ disposition2widget (AttachmentDisposition n) = [whamlet|

Attachment #{n}|] disposition2widget (InlineDisposition n) = [whamlet|

#{n}|] disposition2widget DefaultDisposition = mempty - part2widget :: Part -> Widget part2widget Part{partContent=NestedParts ps} = [whamlet| @@ -265,3 +263,8 @@ part2widget Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partD let jw :: Aeson.Value -> Widget = jsonWidget in either str2widget jw $ Aeson.eitherDecodeStrict' pc | 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 \ No newline at end of file diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 9bddff59c..69ee99847 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -46,6 +46,9 @@ import Jobs import Foundation.Yesod.Auth (updateUserLanguage) +{-# ANN module ("HLint: ignore Functor law" :: String) #-} + + data ExamOfficeSettings = ExamOfficeSettings { eosettingsGetSynced :: Bool diff --git a/src/Handler/Submission/List.hs b/src/Handler/Submission/List.hs index 4590b9f48..26476896f 100644 --- a/src/Handler/Submission/List.hs +++ b/src/Handler/Submission/List.hs @@ -48,14 +48,14 @@ import Data.List (genericLength) import qualified Data.Csv as Csv - +{-# ANN module ("HLint: ignore Functor law" :: String) #-} data CorrectionTableFilterProj = CorrectionTableFilterProj { corrProjFilterSubmission :: Maybe (Set [CI Char]) , corrProjFilterPseudonym :: Maybe (Set [CI Char]) , corrProjFilterAuthorshipStatementState :: Last AuthorshipStatementSubmissionState } - + instance Default CorrectionTableFilterProj where def = CorrectionTableFilterProj { corrProjFilterSubmission = Nothing @@ -64,7 +64,7 @@ instance Default CorrectionTableFilterProj where } makeLenses_ ''CorrectionTableFilterProj - + type CorrectionTableExpr = ( E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) @@ -135,7 +135,7 @@ resultSubmittors = _dbrOutput . _6 . itraversed resultUserUser :: Lens' CorrectionTableUserData User resultUserUser = _1 - + resultUserPseudonym :: Traversal' CorrectionTableUserData Pseudonym resultUserPseudonym = _2 . _Just @@ -207,7 +207,7 @@ instance Csv.ToNamedRecord CorrectionTableCsv where , "rating-points" Csv..= csvCorrectionRatingPoints , "rating-comment" Csv..= csvCorrectionRatingComment ] - where + where mkEmpty = \case [Nothing] -> [] x -> x @@ -269,7 +269,7 @@ data CorrectionTableCsvQualification = CorrectionTableCsvNoQualification | CorrectionTableCsvQualifySheet | CorrectionTableCsvQualifyCourse - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) deriving anyclass (Universe, Finite) correctionTableCsvHeader :: Bool -- ^ @showCorrector@ @@ -402,7 +402,7 @@ colSubmissionLink = sortable (Just "submission") (i18nCell MsgTableSubmission) $ colSelect :: forall act h epId. (Semigroup act, Monoid act, Headedness h, Ord epId) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary epId)) colSelect = dbSelect (_1 . applying _2) id $ views resultCryptoID return - + colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \x -> let tid = x ^. resultCourseTerm @@ -457,7 +457,7 @@ colRating' l = sortable (Just "rating") (i18nCell MsgTableRating) $ \x -> ] colAssigned :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \x -> maybeCell (x ^? resultSubmission . _entityVal . _submissionRatingAssigned . _Just) dateTimeCell +colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \x -> maybeCell (x ^? resultSubmission . _entityVal . _submissionRatingAssigned . _Just) dateTimeCell colRated :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colRated = sortable (Just "ratingtime") (i18nCell MsgTableRatingTime) $ \x -> maybeCell (x ^? resultSubmission . _entityVal . _submissionRatingTime . _Just) dateTimeCell @@ -515,7 +515,7 @@ colAuthorshipStatementState = sortable (Just "as-state") (i18nCell MsgSubmission csh = x ^. resultCourseShorthand shn = x ^. resultSheet . _entityVal . _sheetName cID = x ^. resultCryptoID - + asRoute = CSubmissionR tid ssh csh shn cID SubAuthorshipStatementsR in maybeCell (guardOnM (x ^. resultNonAnonymousAccess) $ x ^. resultASState) (\s -> heatC s $ anchorCell asRoute (i18n s :: Widget)) @@ -537,7 +537,7 @@ filterUIIsRated = flip (prismAForm $ singletonFilter "israted" . maybePrism _Pat filterUISubmission :: DBFilterUI filterUISubmission = flip (prismAForm $ singletonFilter "submission") $ aopt (lift `hoistField` textField) (fslI MsgTableSubmission) - + filterUIPseudonym :: DBFilterUI filterUIPseudonym = flip (prismAForm $ singletonFilter "pseudonym") $ aopt (lift `hoistField` textField) (fslI MsgSubmissionPseudonym) @@ -809,7 +809,7 @@ correctionsR whereClause displayColumns dbtFilterUI csvSettings psValidator acti fmap toTypedContent . defaultLayout $ do setTitleI MsgCourseCorrectionsTitle $(widgetFile "corrections") - + correctionsR' :: CorrectionTableWhere -> _ -> _ -> Maybe CorrectionTableCsvSettings -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler (Widget, SheetTypeSummary SqlBackendKey) correctionsR' whereClause displayColumns dbtFilterUI csvSettings psValidator actions = do currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler diff --git a/templates/adminUser.hamlet b/templates/adminUser.hamlet index dca82f0ff..7eed92fc1 100644 --- a/templates/adminUser.hamlet +++ b/templates/adminUser.hamlet @@ -8,8 +8,14 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later ^{thisUserActWgt}
^{userDataWidget} -
-

+ +

+ #{iconNotificationSent} + + _{MsgAdminUserAllNotifications} + + +

_{MsgAdminUserRightsHeading} ^{systemFunctionsForm} ^{rightsForm} diff --git a/templates/comm-center.hamlet b/templates/comm-center.hamlet new file mode 100644 index 000000000..cc6f5e72f --- /dev/null +++ b/templates/comm-center.hamlet @@ -0,0 +1,9 @@ +$newline never + +$# SPDX-FileCopyrightText: 2024 Steffen Jost +$# +$# SPDX-License-Identifier: AGPL-3.0-or-later + +
+

+ ^{ccTable} diff --git a/templates/i18n/profile-remarks/de-de-formal.hamlet b/templates/i18n/profile-remarks/de-de-formal.hamlet index f851d9b81..443df86aa 100644 --- a/templates/i18n/profile-remarks/de-de-formal.hamlet +++ b/templates/i18n/profile-remarks/de-de-formal.hamlet @@ -9,6 +9,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

  • Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrektur von Übungen, Kursleiterschaft, Raumbuchungen, etc. +
  • + Nicht aufgeführt sind die an diesen Benutzer versendeten Benachrichtigungen per E-Mail oder Briefpost.

  • Sie können die diff --git a/templates/i18n/profile-remarks/en-eu.hamlet b/templates/i18n/profile-remarks/en-eu.hamlet index 7858e784c..ee749f36c 100644 --- a/templates/i18n/profile-remarks/en-eu.hamlet +++ b/templates/i18n/profile-remarks/en-eu.hamlet @@ -9,6 +9,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

    • Timestamps with user information (e.g. editing of corrections, submission groups, rooms, ...) are not shown here. +
    • + Sent notifications by email or letter are not shown here.

    • You can request your data be deleted by opening diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index 60827a7db..363bb0739 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -209,7 +209,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

      _{MsgProfileQualifications}
      - ^{qualificationsTable} + ^{qualificationsTable} ^{maybeTable MsgProfileCourses ownedCoursesTable} @@ -221,5 +221,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later ^{maybeTable' MsgTableCorrector Nothing (Just (msg2widget MsgProfileCorrectorRemark <> simpleLinkI MsgProfileCorrections CorrectionsR)) correctionsTable} - ^{profileRemarks}