chore(mail): add decoder for MIME encoded word

src/Handler/MailCenter.hs

@@ -24,32 +24,22 @@ 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 Numeric (readHex)
 import qualified Data.Text as T
--- import qualified Data.Text.Lazy as LT
--- import qualified Data.Text.Lazy.Encoding as LT
+import qualified Data.Text.Encoding as TE
+import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as LB
 
--- import Data.Char as C
 
--- import qualified Data.Text.Encoding as TE
--- import qualified Data.ByteString.Char8 as BS
+import Handler.Utils
+
 
--- import Data.Bits
--- import Data.Word
 
 -- avoids repetition of local definitions
 single :: (k,a) -> Map k a
@@ -106,7 +96,7 @@ mkMCTable = do
       , sortable Nothing (i18nCell MsgCommSubject) $ \(view resultMail -> Entity k v) ->
           let subject = v ^? _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject"
               linkWgt = maybe (msg2widget MsgUtilEMail) text2widget subject
-          in anchorCellM (MailHtmlR <$> encrypt k) linkWgt
+          in anchorCellM (MailPlainR <$> encrypt k) linkWgt
       -- , sortable Nothing (i18nCell MsgCommContent)    $ \(view $ resultMail . _entityKey -> k) -> anchorCellM (MailHtmlR <$> encrypt k) (text2widget "html")
       -- , sortable Nothing (i18nCell MsgCommSubject) $ \(preview $ resultMail . _entityVal . _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject" -> h) -> cellMaybe textCell h
       ]
@@ -202,19 +192,24 @@ handleMailShow hdr prefTypes cusm = do
               ^{userIdWidget usr}
           $maybe r <- getHeader "To"
             <dt .deflist__dt>
-              _{MsgPrintRecipient}
+              To
             <dd .deflist__dd>
-              #{decodeMime r}
+              #{decodeEncodedWord r}
+          $maybe r <- getHeader "Cc"
+            <dt .deflist__dt>
+              Cc
+            <dd .deflist__dd>
+              #{decodeEncodedWord r}
           $maybe r <- getHeader "From"
             <dt .deflist__dt>
-              _{MsgPrintSender}
+              From
             <dd .deflist__dd>
-              #{decodeMime r}
+              #{decodeEncodedWord r}
           $maybe r <- getHeader "Subject"
             <dt .deflist__dt>
               _{MsgCommSubject}
             <dd .deflist__dd>
-              #{decodeMime r}
+              #{decodeEncodedWord r}
 
       <section>
         $forall mc <- mcontent
@@ -222,6 +217,7 @@ handleMailShow hdr prefTypes cusm = do
             <p>
               ^{part2widget pt}
     |]
+    -- Include for Debugging:
     -- ^{jsonWidget (sm ^. _sentMailHeaders)}
     -- ^{jsonWidget (sentMailContentContent cn)}
 
@@ -265,10 +261,47 @@ part2widget Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partD
       | otherwise = [whamlet|part2widget cannot decode parts of type #{pt} yet.|]
 
 
+------------------------------
+-- Decode MIME Encoded Word
+
 -- | 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 t
- | Just r <- T.stripPrefix "=?utf-8?Q?" t
-   = T.replace "_" " " $ T.replace "?=" "" r  -- TODO: this only works in plain cases without special characters; e.g. umlauts are not handled correctly
- | otherwise
-   = t
+decodeEncodedWord :: Text -> Text
+decodeEncodedWord tinp
+  | (pl, T.drop 2 -> cf) <- T.breakOn "=?" tinp
+  , (cw, T.drop 2 -> rm) <- T.breakOn "?=" cf
+  , notNull cw
+    = pl <> decodeEncodedWordHeader cw <> decodeEncodedWord rm
+  | otherwise
+    = tinp
+
+decodeEncodedWordHeader :: Text -> Text
+decodeEncodedWordHeader tinp
+  | [enc, bin, cw] <- T.splitOn "?" tinp
+  , "utf-8" == T.toLower enc
+  , "Q"     == T.toUpper bin      -- Quoted Printable Text
+    = decEncWrdUtf8Q cw
+  -- TODO: add more decoders for other possible encodings here, but "=?utf-8?Q?..?=" is the only one used by Network.Mail.Mime at the moment
+  | otherwise
+    = tinp
+
+decEncWrdUtf8Q :: Text -> Text
+decEncWrdUtf8Q tinp
+  | Right ok <- TE.decodeUtf8' $ decWds tinp
+    = ok
+  | otherwise
+    = tinp
+  where
+    decWds :: Text -> S.ByteString
+    decWds t
+      | (h:tl) <- T.splitOn "=" t
+        = mconcat $ TE.encodeUtf8 h : map deco tl
+      | otherwise
+        = TE.encodeUtf8 t
+
+    deco :: Text -> S.ByteString
+    deco w
+      | (c,r) <- T.splitAt 2 w
+      , [(v,"")] <- readHex $ T.unpack c
+        = S.cons v $ TE.encodeUtf8 r
+      | otherwise
+        = TE.encodeUtf8 w

test/Database/Fill.hs

@@ -127,7 +127,7 @@ fillDb = do
     , userTokensIssuedAfter = Nothing
     , userMatrikelnummer = Nothing
     , userEmail  = "AVSNO:123456"
-    , userDisplayEmail = ""
+    , userDisplayEmail = "felix.hamann@campus.lmu.de"
     , userDisplayName = "Felix Hamann"
     , userSurname = "Hamann"
     , userFirstName = "Felix"