fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(mail): fix #171 by adding a route for all notifications to users and displaying them

Browse Source
This commit is contained in:
Steffen Jost 2024-08-06 17:42:27 +02:00
parent f929e03129
commit ab00a4f665
19 changed files with 269 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/categories/print/de-de-formal.msg
View File

@ -28,4 +28,5 @@ PrintLmsUser: E‑Learning Id
PrintJobs: Druckaufräge
PrintLetterType: Brieftypkürzel
MCActDummy: Platzhalter
MCActDummy: Platzhalter
CCActDummy: Platzhalter

3
messages/uniworx/categories/print/en-eu.msg
View File

@ -28,4 +28,5 @@ PrintLmsUser: E‑learning id
PrintJobs: Print jobs
PrintLetterType: Letter type shorthand
MCActDummy: Placeholder
MCActDummy: Placeholder
CCActDummy: Placeholder

3
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -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.
UserSupervisorReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
AdminUserAllNotifications: Alle Benachrichtigungen and diesen Benutzer

3
messages/uniworx/categories/user/en-eu.msg
View File

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

3
messages/uniworx/utils/navigation/menu/de-de-formal.msg
View File

@ -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

3
messages/uniworx/utils/navigation/menu/en-eu.msg
View File

@ -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

9
routes
View File

@ -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

3
src/Application.hs
View File

@ -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

5
src/Database/Esqueleto/Utils.hs
View File

@ -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"

28
src/Foundation/Navigation.hs
View File

@ -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

172
src/Handler/CommCenter.hs Normal file
View 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")

37
src/Handler/MailCenter.hs
View File

@ -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
<dt .deflist__dt>
_{MsgPrintSender}
<dd .deflist__dd>
#{r}
#{decodeMime r}
$maybe r <- getHeader "To"
<dt .deflist__dt>
_{MsgPrintRecipient}
<dd .deflist__dd>
#{r}
#{decodeMime r}
$maybe r <- getHeader "Subject"
<dt .deflist__dt>
_{MsgCommSubject}
<dd .deflist__dd>
#{r}
#{decodeMime r}
<section>
$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|
<section>
$forall p <- alt
^{part2widget p}
<hr>
|]
-}
selectAlternative :: [ContentType] -> Alternatives -> Maybe Part
selectAlternative (fmap decodeUtf8 -> prefTypes) allAlts = aux prefTypes allAlts
where
@ -240,7 +239,6 @@ disposition2widget (AttachmentDisposition n) = [whamlet|<h3>Attachment #{n}|]
disposition2widget (InlineDisposition n) = [whamlet|<h3>#{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

3
src/Handler/Profile.hs
View File

@ -46,6 +46,9 @@ import Jobs
import Foundation.Yesod.Auth (updateUserLanguage)
{-# ANN module ("HLint: ignore Functor law" :: String) #-}
data ExamOfficeSettings
= ExamOfficeSettings
{ eosettingsGetSynced :: Bool

22
src/Handler/Submission/List.hs
View File

@ -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

10
templates/adminUser.hamlet
View File

@ -8,8 +8,14 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
^{thisUserActWgt}
<section>
^{userDataWidget}
<section>
<h3>
<p>
#{iconNotificationSent}
<a href=@{CommCenterR}?comms-sorting=date-desc&comms-recipient=#{toPathPiece userDisplayName}>
_{MsgAdminUserAllNotifications}
<h3>
_{MsgAdminUserRightsHeading}
^{systemFunctionsForm}
^{rightsForm}

9
templates/comm-center.hamlet Normal file
View 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}

2
templates/i18n/profile-remarks/de-de-formal.hamlet
View File

@ -9,6 +9,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<ul>
<li>
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>
<p>
Sie können die

2
templates/i18n/profile-remarks/en-eu.hamlet
View File

@ -9,6 +9,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<ul>
<li>
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>
<p>
You can request your data be deleted by opening

3
templates/profileData.hamlet
View File

@ -209,7 +209,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<div .container>
<h2>_{MsgProfileQualifications}
<div .container>
^{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}