2 files changed, 93 insertions(+), 6 deletions(-)

M Email.hs
M test/EmailTest.hs

@@ 253,12 253,18 @@ emailToThread domain email pref = thread <&> \threadID ->
 	parent
 	[XML.NodeContent $ XML.ContentText $ decodeUtf8 threadID]
 	where
-	parent =
-		maybeToList $
-		fmap ((,) (s"parent") . (:[]) . XML.ContentText
-		)
-		(hush . MIME.parse (extractThreadFromRefs domain) =<< useRefs)
-	thread = fmap (s"References: "++) (fullRefs <|> msgid)
+	parent
+		| PreferInReplyTo <- pref = []
+		| otherwise =
+			maybeToList $
+			fmap ((,) (s"parent") . (:[]) . XML.ContentText)
+			parentID
+	thread
+		| PreferInReplyTo <- pref =
+			fmap encodeUtf8 parentID <|>
+			fmap (s"References: "++) (fullRefs <|> msgid)
+		| otherwise = fmap (s"References: "++) (fullRefs <|> msgid)
+	parentID = hush . MIME.parse (extractThreadFromRefs domain) =<< useRefs
 	fullRefs
 		| PreferInReplyTo <- pref = useRefs
 		| PreferMessageID <- pref = msgid

@@ 610,6 610,87 @@ unit_emailToStanzaWebXDCUpdate =
 	\\n--b2--\n\
 	\\n--b1--\n"
 
+unit_emailToStanzaWebXDCUpdateXMPPThread :: IO ()
+unit_emailToStanzaWebXDCUpdateXMPPThread =
+	show (emailToStanzaOnly (s"gateway.example.com") (s"https://e") message)
+	@?=
+	show (XMPP.emptyMessage XMPP.MessageNormal) {
+		XMPP.messageID = Just $ s"abc@example.com",
+		XMPP.messageFrom =
+			XMPP.parseJID $ s"f\\40example.com@gateway.example.com",
+		XMPP.messagePayloads = [
+			XML.Element (s"{jabber:component:accept}body") [] [
+				XML.NodeContent $ XML.ContentText $
+				s"Shared Memo: 'Memo' was changed \
+				\by tmp.h75s7@testrun.org"
+			],
+			XML.Element addressesElName [] [
+				XML.NodeElement $ XML.Element addressElName [
+					(s"type", [s"to"]),
+					(s"delivered", [s"true"]),
+					(s"jid", [toJid])
+				] []
+			],
+			XML.Element (s"{jabber:component:accept}subject") [] [
+				XML.NodeContent $ XML.ContentText $ s"subject"
+			],
+			XML.Element (s"{urn:xmpp:sid:0}origin-id") [(
+				s"id",
+				[XML.ContentText $ s"abc@example.com"]
+			)] [],
+			XML.Element (s"{jabber:component:accept}thread") [] [
+				XML.NodeContent $ XML.ContentText $
+				s"xmppthread"
+			],
+			XML.Element (s"{urn:xmpp:webxdc:0}x") [] [
+				XML.NodeElement $ XML.Element
+				(s"{urn:xmpp:webxdc:0}document") [] [
+					XML.NodeContent $ XML.ContentText $
+					s"Memo"
+				],
+				XML.NodeElement $
+				XML.Element (s"{urn:xmpp:webxdc:0}summary") [] [
+					XML.NodeContent $ XML.ContentText $
+					s"Update: tmp.h75s7@testrun.org"
+				],
+				XML.NodeElement $
+				XML.Element (s"{urn:xmpp:json:0}json") [] [
+					XML.NodeContent $ XML.ContentText $
+					s"{}"
+				]
+			]
+		]
+	}
+	where
+	Right message = MIME.parse (MIME.message MIME.mime) email
+	email = encodeUtf8 $ s"To: to@example.com\n\
+	\From: f@example.com\n\
+	\Subject: subject\n\
+	\Message-ID: <abc@example.com>\n\
+	\In-Reply-To: <123.456.xmppthread@gateway.example.com>\n\
+	\References: <abc@example.com>\n\
+	\MIME-Version: 1.0\n\
+	\Content-Type: multipart/mixed; boundary=b1\n\
+	\\n\n--b1\n\
+	\Message-ID: <whatever@localhost>\n\
+	\Content-Type: multipart/report; \
+		\report-type=status-update; boundary=b2\n\
+	\\n\n--b2\n\
+	\Content-Transfer-Encoding: quoted-printable\n\
+	\Content-Type: text/plain; charset=utf-8; format=flowed; delsp=no\n\n\
+	\A WebXDC update.\n\
+	\\n--b2\n\
+	\Content-Disposition: attachment; filename=\"status-update.json\"\n\
+	\Content-Transfer-Encoding: base64\n\
+	\Content-Type: application/json\n\n\
+	\eyJ1cGRhdGVzIjpbeyJwYXlsb2FkIjp7fSwiaW5mbyI6IlNoYXJlZCBNZW1vOiAnT\
+	\WVtbycgd2FzIGNoYW5nZWQgYnkgdG1wLmg3NXM3QHRlc3RydW4ub3JnIiwiZG9jdW\
+	\1lbnQiOiJNZW1vIiwic3VtbWFyeSI6IlVwZGF0ZTogdG1wLmg3NXM3QHRlc3RydW4\
+	\ub3JnIiwidWlkIjoibkszS09va08xMmEifV19Cg==\
+	\\n--b2--\n\
+	\\n--b1--\n"
+
+
 unit_messageToEmailChat :: IO ()
 unit_messageToEmailChat =
 	hush (fmap (MIME.renderMessage . emailMessage) (