chore(mail): fix #179 reorder attachments and guess PDF pin password in Text display
This commit is contained in:
parent
2a27a1efa6
commit
cbadef0a73
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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|
|
||||
<section>
|
||||
<dl .deflist>
|
||||
@ -236,9 +237,8 @@ handleMailShow hdr prefTypes cusm = do
|
||||
#{decodeEncodedWord r}
|
||||
|
||||
<section>
|
||||
$forall mc <- mcontent
|
||||
$maybe pt <- selectAlternative prefTypes mc
|
||||
^{part2widget cusm pt}
|
||||
$forall pt <- mparts
|
||||
^{part2widget cusm pt}
|
||||
|]
|
||||
-- Include for Debugging:
|
||||
-- <section>
|
||||
@ -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|<h3>_{MsgMailFileAttachment}|]
|
||||
disposition2widget (InlineDisposition n) = [whamlet|<h3>_{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|<h2>Not found: #{sdn}|]
|
||||
Just Entity{entityVal = User{userPinPassword=mbpw}} ->
|
||||
Just Entity{entityVal = u@User{userPinPassword=mbpw}} ->
|
||||
[whamlet|
|
||||
<section>
|
||||
$maybe pw <- mbpw
|
||||
_{MsgAdminUserPinPassword}: #{pw}
|
||||
<details>
|
||||
<summary>
|
||||
_{MsgAdminUserPinPassword}
|
||||
<p>
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>
|
||||
^{userWidget u}
|
||||
<dd .deflist__dd>
|
||||
<b>
|
||||
#{pw}
|
||||
<p>
|
||||
_{MsgAdminUserPinPassNotIncluded}
|
||||
$nothing
|
||||
_{MsgAdminUserNoPassword}
|
||||
_{MsgAdminUserNoPassword}
|
||||
|]
|
||||
| otherwise = mempty
|
||||
|
||||
|
||||
@ -220,7 +220,7 @@ fillDb = do
|
||||
, userTitle = Nothing
|
||||
, userMaxFavourites = 7
|
||||
, userTheme = ThemeAberdeenReds
|
||||
, userDateTimeFormat = userDefaultDateTimeFormatprefersPo
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
||||
, userDateFormat = userDefaultDateFormat
|
||||
, userTimeFormat = userDefaultTimeFormat
|
||||
|
||||
Reference in New Issue
Block a user