~singpolyma/cheogram-smtp

1a1a876a89ee8c02d2c3cdfc94535ef8ebb87470 — Stephen Paul Weber 2 years ago beb9037
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\