diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 523db3d2d..535db4979 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -153,6 +153,7 @@ MenuCommCenter: Benachrichtigungen MenuMailCenter: E‑Mails MenuMailHtml !ident-ok: Html MenuMailPlain !ident-ok: Text +MenuMailAttachment: Anhang MenuApiDocs: API-Dokumentation (Englisch) MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger) diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 0dd276ff8..d316e7812 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -153,6 +153,7 @@ MenuCommCenter: Notifications MenuMailCenter: Email MenuMailHtml: Html MenuMailPlain: Text +MenuMailAttachment: Attachment MenuApiDocs: API documentation MenuSwagger: OpenAPI 2.0 (Swagger) diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg index 84478dbb9..166aa413a 100644 --- a/messages/uniworx/utils/utils/de-de-formal.msg +++ b/messages/uniworx/utils/utils/de-de-formal.msg @@ -83,6 +83,7 @@ MultiUserFieldInvitationExplanationAlways: Es wird an alle Adressen, die Sie hie AmbiguousEmail: E-Mail-Adresse nicht eindeutig InvalidEmailAddress: E-Mail-Adresse ist ungültig InvalidEmailAddressWith e@Text: E-Mail-Adresse #{show e} ist ungültig +MailFileAttachment: Dateianhang UtilExamResultGrade: Note UtilExamResultPass: Bestanden/Nicht Bestanden UtilExamResultNoShow: Nicht erschienen diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg index 5a30b858b..7c417bb4c 100644 --- a/messages/uniworx/utils/utils/en-eu.msg +++ b/messages/uniworx/utils/utils/en-eu.msg @@ -83,6 +83,7 @@ MultiUserFieldInvitationExplanationAlways: An invitation will be sent via email AmbiguousEmail: Email address is ambiguous InvalidEmailAddress: Email address is invalid InvalidEmailAddressWith e: Email asdress #{show e} is invalid +MailFileAttachment: Attached file UtilExamResultGrade: Grade UtilExamResultPass: Passed/Failed UtilExamResultNoShow: Not present diff --git a/routes b/routes index 21518dfa5..905e9f817 100644 --- a/routes +++ b/routes @@ -82,6 +82,7 @@ /comm/email MailCenterR GET POST /comm/email/html/#CryptoUUIDSentMail MailHtmlR GET /comm/email/plain/#CryptoUUIDSentMail MailPlainR GET +/comm/email/attachment/#CryptoUUIDSentMail/#Text MailAttachmentR GET /print PrintCenterR GET POST !system-printer /print/acknowledge/#Day/#Int/#Int PrintAckR GET POST !system-printer diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 6c33958e3..52e0566f0 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -134,6 +134,7 @@ breadcrumb CommCenterR = i18nCrumb MsgMenuCommCenter Nothing breadcrumb MailCenterR = i18nCrumb MsgMenuMailCenter $ Just CommCenterR breadcrumb MailHtmlR{} = i18nCrumb MsgMenuMailHtml $ Just MailCenterR breadcrumb MailPlainR{} = i18nCrumb MsgMenuMailPlain $ Just MailCenterR +breadcrumb (MailAttachmentR mid _) = i18nCrumb MsgMenuMailAttachment $ Just $ MailHtmlR mid breadcrumb PrintCenterR = i18nCrumb MsgMenuApc $ Just CommCenterR breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR diff --git a/src/Handler/MailCenter.hs b/src/Handler/MailCenter.hs index 021860b76..55a91bf1d 100644 --- a/src/Handler/MailCenter.hs +++ b/src/Handler/MailCenter.hs @@ -8,6 +8,7 @@ module Handler.MailCenter ( getMailCenterR, postMailCenterR , getMailHtmlR , getMailPlainR + , getMailAttachmentR ) where import Import @@ -163,6 +164,27 @@ postMailCenterR = do $(widgetFile "mail-center") +typePDF :: ContentType +typePDF = "application/pdf" + +getMailAttachmentR :: CryptoUUIDSentMail -> Text -> Handler TypedContent +getMailAttachmentR cusm attdisp = do + smid <- decrypt cusm + (sm,cn) <- runDBRead $ do + sm <- get404 smid + cn <- get404 $ sm ^. _sentMailContentRef + return (sm,cn) + let mcontent = getMailContent (sentMailContentContent cn) + getAttm alts = case selectAlternative [typePDF] alts of + (Just Part{partContent=PartContent (LB.toStrict -> pc), partDisposition=AttachmentDisposition t}) -- partType=pt, + | t == attdisp + -> Just pc + _ -> Nothing + attm = firstJust getAttm mcontent + case attm of + (Just pc) -> sendByteStringAsFile (T.unpack attdisp) pc $ sm ^. _sentMailSentAt + _ -> notFound + getMailHtmlR :: CryptoUUIDSentMail -> Handler Html getMailHtmlR = handleMailShow (SomeMessages [SomeMessage MsgUtilEMail, SomeMessage MsgMenuMailHtml]) [typeHtml,typePlain] @@ -216,8 +238,7 @@ handleMailShow hdr prefTypes cusm = do
$forall mc <- mcontent $maybe pt <- selectAlternative prefTypes mc -

- ^{part2widget pt} + ^{part2widget cusm pt} |] -- Include for Debugging: --

@@ -238,23 +259,22 @@ selectAlternative (fmap decodeUtf8 -> prefTypes) allAlts = aux prefTypes allAlts aux _ [] = Nothing disposition2widget :: Disposition -> Widget -disposition2widget (AttachmentDisposition n) = [whamlet|

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

#{n}|] +disposition2widget (AttachmentDisposition _) = [whamlet|

_{MsgMailFileAttachment}|] +disposition2widget (InlineDisposition n) = [whamlet|

_{MsgMenuMailAttachment} #{n}|] disposition2widget DefaultDisposition = mempty -part2widget :: Part -> Widget -part2widget Part{partContent=NestedParts ps} = +part2widget :: CryptoUUIDSentMail -> Part -> Widget +part2widget cusm Part{partContent=NestedParts ps} = [whamlet| -
$forall p <- ps -

- ^{part2widget p} + ^{part2widget cusm p} |] -part2widget Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partDisposition=dispo} = +part2widget cusm Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partDisposition=dispo} = [whamlet|

^{disposition2widget dispo} ^{showBody} + ^{showPass} |] where showBody @@ -263,8 +283,25 @@ part2widget Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partD | pt == decodeUtf8 typeJson = let jw :: Aeson.Value -> Widget = jsonWidget in either str2widget jw $ Aeson.eitherDecodeStrict' pc - | otherwise = [whamlet|part2widget cannot decode parts of type #{pt} yet.|] - + | pt == decodeUtf8 typePDF + , AttachmentDisposition t <- dispo + = [whamlet|#{t}|] + | otherwise = [whamlet|FRADrive cannot decode email parts of type #{pt} yet.|] + showPass + | pt == decodeUtf8 typePlain + , Just name <- listBracket ("Inhaber","Gültig") $ T.words (decodeUtf8 pc) + = let sdn = T.filter (/= '*') (T.unwords $ dropWhile (":"==) name) in + liftHandler (runDBRead $ getByFilter [UserDisplayName ==. sdn]) >>= \case + Nothing -> mempty -- DEBUG: [whamlet|

Not found: #{sdn}|] + Just Entity{entityVal = User{userPinPassword=mbpw}} -> + [whamlet| +
+ $maybe pw <- mbpw + _{MsgAdminUserPinPassword}: #{pw} + $nothing + _{MsgAdminUserNoPassword} + |] + | otherwise = mempty ------------------------------ -- Decode MIME Encoded Word diff --git a/src/Utils.hs b/src/Utils.hs index ceac5a618..201fd54de 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -813,6 +813,19 @@ checkAsc :: Ord a => [a] -> Bool checkAsc (x:r@(y:_)) = x<=y && checkAsc r checkAsc _ = True +-- return a part of a list between two given elements, if it exists +listBracket :: Eq a => (a,a) -> [a] -> Maybe [a] +listBracket _ [] = Nothing +listBracket b@(s,e) (h:t) + | s == h = listUntil [] t + | otherwise = listBracket b t + where + listUntil _ [] = Nothing + listUntil l1 (h1:t1) + | e == h1 = Just $ reverse l1 + | otherwise = listUntil (h1:l1) t1 + + ---------- -- Sets -- ---------- diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 268c56c97..6991103cf 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -113,10 +113,10 @@ fillDb = do , userMobile = Nothing , userCompanyPersonalNumber = Just "00000" , userCompanyDepartment = Nothing - , userPinPassword = Nothing + , userPinPassword = Just "1234.5" , userPostAddress = Just $ markdownToStoredMarkup ("Büro 127 \nMathematisches Institut der Ludwig-Maximilians-Universität München \nTheresienstr. 39 \nD-80333 München"::Text) , userPostLastUpdate = Nothing - , userPrefersPostal = True + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } @@ -202,7 +202,7 @@ fillDb = do , userPinPassword = Nothing , userPostAddress = Nothing , userPostLastUpdate = Nothing - , userPrefersPostal = True + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } @@ -220,7 +220,7 @@ fillDb = do , userTitle = Nothing , userMaxFavourites = 7 , userTheme = ThemeAberdeenReds - , userDateTimeFormat = userDefaultDateTimeFormat + , userDateTimeFormat = userDefaultDateTimeFormatprefersPo , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat @@ -766,7 +766,7 @@ fillDb = do void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) True (n_day' $ -9) -- TODO: better dates! void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) True (n_day' $ -9) -- TODO: better dates! void . insert' $ QualificationUser jost qid_rp (n_day 999) (n_day $ -111) (n_day $ -2222) True (n_day' $ -9) -- TODO: better dates! - qfkleen <- insert' $ QualificationUser gkleen qid_f (n_day 33) (n_day $ -4) (n_day $ -20) True (n_day' $ -9) + qfkleen <- insert' $ QualificationUser gkleen qid_f (n_day 10) (n_day $ -40) (n_day $ -120) True (n_day' $ -20) void . insert $ QualificationUserBlock qfkleen False (n_day' 1) "Future block" (Just svaupel) void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8) False (n_day' $ -1) qfvaupel <- insert' $ QualificationUser svaupel qid_f (n_day 2) (n_day $ -1) (n_day $ -2) True (n_day' $ -9)