~singpolyma/cheogram-smtp: Render JID as "name" in email

4 files changed, 17 insertions(+), 15 deletions(-)

M Email.hs
M gateway.hs
M incoming-email.hs
M test/EmailTest.hs

M Email.hs => Email.hs +5 -5

@@ 80,7 80,7 @@ jidToLocalpart jid = encodeUtf8 $ fromString $
 	bareStr = textToString $ bareTxt jid
 
 jidToMailbox :: XMPP.JID -> MIME.Domain -> MIME.Mailbox
-jidToMailbox jid domain = MIME.Mailbox Nothing $
+jidToMailbox jid domain = MIME.Mailbox (Just $ bareTxt jid) $
 	MIME.AddrSpec (jidToLocalpart jid) domain
 
 emailToStanza ::


@@ 111,7 111,7 @@ emailToStanza toJid email =
 	Just subject = MIME.decodeEncodedWords MIME.defaultCharsets <$>
 		firstOf (MIME.headers . MIME.header (s"subject")) email
 	Just fromMailbox@(MIME.Mailbox fn _) =
-		headZ =<< firstOf MIME.headerFrom email
+		headZ =<< firstOf (MIME.headerFrom MIME.defaultCharsets) email
 
 
 defaultSubject :: XMPP.Message -> Maybe Text


@@ 133,11 133,11 @@ messageToEmail fromDomain now message@XMPP.Message {
 		XMPP.messageFrom = Just from,
 		XMPP.messageTo = Just (XMPP.JID (Just toNode) _ _)
 	} | Just bodyTxt <- getBody message,
-	    Right toAddress <- MIME.parse MIME.address unescapedToNode =
+	    Right toAddress <- MIME.parse (MIME.address MIME.defaultCharsets) unescapedToNode =
 		Just (fromMailbox,
 			typeHeaders message $
-			set MIME.headerTo [toAddress] $
-			set MIME.headerFrom [fromMailbox] $
+			set (MIME.headerTo MIME.defaultCharsets) [toAddress] $
+			set (MIME.headerFrom MIME.defaultCharsets) [fromMailbox] $
 			set (MIME.headers . at (s"Jabber-ID")) jidHeader $
 			set (MIME.headers . at (s"Subject")) subjectHeader $
 			set MIME.headerDate (Just dateHeader) $

M gateway.hs => gateway.hs +2 -1

@@ 101,7 101,8 @@ main :: IO ()
 main = do
 	(componentJidTxt:host:portTxt:secret:trustedJidsTxt) <- getArgs
 	let Right (MIME.Mailbox _ (MIME.AddrSpec _ emailDomain)) =
-		MIME.parse MIME.mailbox (s"boop@" ++ encodeUtf8 componentJidTxt)
+		MIME.parse (MIME.mailbox MIME.defaultCharsets)
+		(s"boop@" ++ encodeUtf8 componentJidTxt)
 	let Just componentJid = XMPP.parseJID componentJidTxt
 	let Just trustedJids = mapM XMPP.parseJID trustedJidsTxt
 	let port = PortNumber $ read portTxt

M incoming-email.hs => incoming-email.hs +2 -2

@@ 34,8 34,8 @@ main = do
 	let Just rpcJid = XMPP.parseJID rpcJidStr
 
 	let Just recipientJids = forM envelopeTos $ \envelopeTo ->
-		XMPP.parseJID =<< mailboxNode <$>
-			hush (MIME.parse MIME.mailbox $ encodeUtf8 envelopeTo)
+		(XMPP.parseJID =<<) $ fmap mailboxNode $ hush $
+			MIME.parse (MIME.mailbox MIME.defaultCharsets) (encodeUtf8 envelopeTo)
 
 	input <- LByteString.getContents
 	let Right email = MIME.parse messageOptionalMboxFrom input

M test/EmailTest.hs => test/EmailTest.hs +8 -7

@@ 34,7 34,7 @@ unit_mailboxToJID =
 	@?=
 	XMPP.parseJID (s"boop\\40example.com@gateway.example.com")
 	where
-	Right mailbox = MIME.parse MIME.mailbox
+	Right mailbox = MIME.parse (MIME.mailbox MIME.defaultCharsets)
 		(encodeUtf8 $ s"\"Joe\" <boop@example.com>")
 
 unit_emailToStanzaSimple :: IO ()


@@ 107,10 107,11 @@ unit_messageToEmailChat =
 	email = s"MIME-Version: 1.0\r\n\
 	\Chat-Version: 1.0\r\n\
 	\To: t@example.com\r\n\
-	\From: =E4=B8=96=40example=2Ecom@gateway.example.com\r\n\
+	\From: =?utf-8?Q?=E4=B8=96@example.com?=\r\n\
+	\ <=E4=B8=96=40example=2Ecom@gateway.example.com>\r\n\
 	\Jabber-ID: =?utf-8?B?5LiWQGV4YW1wbGUuY29t?=\r\n\
 	\Subject: =?utf-8?B?Q2hhdDog5LiW55WMCi4K?=\r\n\
-	\date: Mon, 01 Jan 1990 00:00:00 +0000\r\n\
+	\Date: Mon, 01 Jan 1990 00:00:00 +0000\r\n\
 	\Content-Transfer-Encoding: base64\r\n\
 	\Content-Disposition: inline\r\n\
 	\Content-Type: text/plain; charset=utf-8\r\n\


@@ 143,10 144,10 @@ unit_messageToEmailWithSubject =
 	Just date = parseXMPPTime (s"1990-01-01T00:00:00Z")
 	email = s"MIME-Version: 1.0\r\n\
 	\To: t@example.com\r\n\
-	\From: f=40example=2Ecom@gateway.example.com\r\n\
+	\From: \"f@example.com\" <f=40example=2Ecom@gateway.example.com>\r\n\
 	\Jabber-ID: f@example.com\r\n\
 	\Subject: =?utf-8?B?5LiW55WM?=\r\n\
-	\date: Mon, 01 Jan 1990 00:00:00 +0000\r\n\
+	\Date: Mon, 01 Jan 1990 00:00:00 +0000\r\n\
 	\Content-Transfer-Encoding: base64\r\n\
 	\Content-Disposition: inline\r\n\
 	\Content-Type: text/plain; charset=utf-8\r\n\


@@ 184,9 185,9 @@ unit_messageToEmailWithDelay =
 	Just date = parseXMPPTime (s"1990-01-01T00:00:00Z")
 	email = s"MIME-Version: 1.0\r\n\
 	\To: t@example.com\r\n\
-	\From: f=40example=2Ecom@gateway.example.com\r\n\
+	\From: \"f@example.com\" <f=40example=2Ecom@gateway.example.com>\r\n\
 	\Jabber-ID: f@example.com\r\n\
-	\date: Sun, 22 Feb 2009 00:10:00 +0000\r\n\
+	\Date: Sun, 22 Feb 2009 00:10:00 +0000\r\n\
 	\Content-Transfer-Encoding: base64\r\n\
 	\Content-Disposition: inline\r\n\
 	\Content-Type: text/plain; charset=utf-8\r\n\