From cbadef0a73213bdf24bc338754b8e5330d04e68b Mon Sep 17 00:00:00 2001 From: Steffen Date: Thu, 5 Sep 2024 16:28:20 +0200 Subject: [PATCH] chore(mail): fix #179 reorder attachments and guess PDF pin password in Text display --- .../uniworx/categories/user/de-de-formal.msg | 1 + messages/uniworx/categories/user/en-eu.msg | 1 + src/Handler/MailCenter.hs | 40 +++++++++++++++---- test/Database/Fill.hs | 2 +- 4 files changed, 36 insertions(+), 8 deletions(-) diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index 2f5b7b4bb..737e627bf 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -22,6 +22,7 @@ AdminUserPostAddress: Postalische Anschrift AdminUserPrefersPostal: Briefe anstatt Email bevorzugt AdminUserPinPassword: Passwort zur Verschlüsselung von PDF Anhängen in Emails AdminUserNoPassword: Kein Passwort gesetzt +AdminUserPinPassNotIncluded: Hinweis: Das Passwort wird hier zur Bequemlichkeit zusätzlich angezeigt und ist selbstverständlich nicht im originalem Inhalt enthalten. AdminUserAssimilate: Diesen Benutzer assimilieren von UserAdded: Benutzer erfolgreich angelegt UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg index e4ec93fff..67ae441d8 100644 --- a/messages/uniworx/categories/user/en-eu.msg +++ b/messages/uniworx/categories/user/en-eu.msg @@ -22,6 +22,7 @@ AdminUserPostAddress: Postal Address AdminUserPrefersPostal: Prefers postal letters over email AdminUserPinPassword: Password used for PDF attachments to emails AdminUserNoPassword: No password set +AdminUserPinPassNotIncluded: Note: the password is shown here only for convenience, but is not contained in the original content, of course. AdminUserAssimilate: Assimilate user by another user UserAdded: Successfully added user UserCollision: Could not create user due to uniqueness constraint diff --git a/src/Handler/MailCenter.hs b/src/Handler/MailCenter.hs index 55a91bf1d..f84cf4ec7 100644 --- a/src/Handler/MailCenter.hs +++ b/src/Handler/MailCenter.hs @@ -202,6 +202,7 @@ handleMailShow hdr prefTypes cusm = do setTitleI hdr let mcontent = getMailContent (sentMailContentContent cn) getHeader h = preview (_mailHeader' h) (sm ^. _sentMailHeaders . _mailHeaders') + mparts = reorderParts $ mapMaybe (selectAlternative prefTypes) mcontent [whamlet|
@@ -236,9 +237,8 @@ handleMailShow hdr prefTypes cusm = do #{decodeEncodedWord r}
- $forall mc <- mcontent - $maybe pt <- selectAlternative prefTypes mc - ^{part2widget cusm pt} + $forall pt <- mparts + ^{part2widget cusm pt} |] -- Include for Debugging: --
@@ -258,6 +258,19 @@ selectAlternative (fmap decodeUtf8 -> prefTypes) allAlts = aux prefTypes allAlts aux [] (pt:_) = Just pt aux _ [] = Nothing +reorderParts :: [Part] -> [Part] +reorderParts = sortBy pOrder + where + pOrder Part{partDisposition=d1} Part{partDisposition=d2} = dispoOrder d1 d2 + + dispoOrder DefaultDisposition DefaultDisposition = EQ + dispoOrder DefaultDisposition _ = LT + dispoOrder _ DefaultDisposition = GT + dispoOrder (InlineDisposition t1) (InlineDisposition t2) = compare t1 t2 + dispoOrder (InlineDisposition _) _ = LT + dispoOrder _ (InlineDisposition _) = GT + dispoOrder (AttachmentDisposition t1) (AttachmentDisposition t2) = compare t1 t2 + disposition2widget :: Disposition -> Widget disposition2widget (AttachmentDisposition _) = [whamlet|

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

_{MsgMenuMailAttachment} #{n}|] @@ -289,17 +302,30 @@ part2widget cusm Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, | 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 cw = T.words $ decodeUtf8 pc + , Just name <- listBracket ("Inhaber","Gültig") cw -- heursitic for dirving licence renewal letters only; improve + <|> listBracket ("Licensee","Valid") cw = 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}} -> + Just Entity{entityVal = u@User{userPinPassword=mbpw}} -> [whamlet|
$maybe pw <- mbpw - _{MsgAdminUserPinPassword}: #{pw} +
+ + _{MsgAdminUserPinPassword} +

+

+
+ ^{userWidget u} +
+ + #{pw} +

+ _{MsgAdminUserPinPassNotIncluded} $nothing - _{MsgAdminUserNoPassword} + _{MsgAdminUserNoPassword} |] | otherwise = mempty diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 6991103cf..6827257e6 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -220,7 +220,7 @@ fillDb = do , userTitle = Nothing , userMaxFavourites = 7 , userTheme = ThemeAberdeenReds - , userDateTimeFormat = userDefaultDateTimeFormatprefersPo + , userDateTimeFormat = userDefaultDateTimeFormat , userMaxFavouriteTerms = userDefaultMaxFavouriteTerms , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat