@@ 24,6 24,7 @@ import qualified Data.Attoparsec.ByteString.Lazy as Atto
import qualified Data.MIME as MIME
import qualified Data.MIME.Charset as MIME
import qualified Data.MIME.EncodedWord as MIME
+import qualified Data.RFC5322.Internal as MIME -- TODO
import qualified Data.XML.Types as XML
import qualified Network.Protocol.XMPP as XMPP
import qualified Network.URI as URI
@@ 73,6 74,16 @@ messageID =
messageOptionalMboxFrom :: Atto.Parser MIME.MIMEMessage
messageOptionalMboxFrom = Atto.option () mboxFrom *> MIME.message MIME.mime
+data AddressLax = Address MIME.Address | AddressLax Text
+
+addressLax :: MIME.CharsetLookup -> Atto.Parser AddressLax
+addressLax charsets =
+ (Address <$> MIME.address charsets) <|>
+ (AddressLax . decodeUtf8 <$> MIME.localPart)
+
+addressLaxList :: MIME.CharsetLookup -> Atto.Parser [AddressLax]
+addressLaxList charsets = addressLax charsets `Atto.sepBy` Atto.satisfy (==0x2C)
+
isTextPlain :: MIME.WireEntity -> Bool
isTextPlain = MIME.matchContentType (s"text") (Just $ s"plain") .
view MIME.contentType
@@ 228,6 239,22 @@ emailToSubject = fmap (mkElement (s"{jabber:component:accept}subject")) .: go
bytesToCid :: ByteString -> CID.CID
bytesToCid = CID.newCidV1 CID.Raw . Hash.hashWith Hash.SHA512
+addressJids :: Text -> AddressLax -> [XMPP.JID]
+addressJids domain (Address (MIME.Single mailbox)) =
+ justZ $ mailboxToJID domain mailbox
+addressJids domain (Address (MIME.Group _ mailboxes)) =
+ justZ . mailboxToJID domain =<< mailboxes
+addressJids domain (AddressLax addr) =
+ justZ $ XMPP.parseJID $ escapeJid addr ++ s"@" ++ domain
+
+addressEl :: String -> XMPP.JID -> XML.Element
+addressEl typ jid =
+ XML.Element (s"{http://jabber.org/protocol/address}address") [
+ (s"type", [fromString typ]),
+ (s"delivered", [s"true"]),
+ (s"jid", [XML.ContentText $ XMPP.formatJID jid])
+ ] []
+
emailToStanza ::
Text
-> Text
@@ 238,7 265,8 @@ emailToStanza domain attachmentUrl email = (
XMPP.messageFrom = mailboxToJID domain fromMailbox,
XMPP.messagePayloads = [
XML.Element (s"{jabber:component:accept}body")
- [] [XML.NodeContent $ XML.ContentText textBody]
+ [] [XML.NodeContent $ XML.ContentText textBody],
+ addresses
] ++ subject ++ nick ++ mid ++ attachmentsOOB ++
maybeToList (emailToThread domain email)
},
@@ 272,6 300,16 @@ emailToStanza domain attachmentUrl email = (
Just textBody = firstOf plainTextBody email
Just fromMailbox@(MIME.Mailbox fn _) =
headZ =<< firstOf (MIME.headerFrom MIME.defaultCharsets) email
+ addresses = XML.Element
+ (s"{http://jabber.org/protocol/address}addresses") [] $
+ map (XML.NodeElement . addressEl "to") to ++
+ map (XML.NodeElement . addressEl "cc") cc
+ to = addressJids domain =<< join . justZ . hush .
+ MIME.parse (addressLaxList MIME.defaultCharsets) =<<
+ toListOf (MIME.headers . MIME.header (s"to")) email
+ cc = addressJids domain =<< join . justZ . hush .
+ MIME.parse (addressLaxList MIME.defaultCharsets) =<<
+ toListOf (MIME.headers . MIME.header (s"cc")) email
defaultSubject :: XMPP.Message -> Maybe Text
defaultSubject message@XMPP.Message { XMPP.messageType = XMPP.MessageChat } =
@@ 15,6 15,18 @@ import Util
import Email
import TestInstances ()
+addressesElName :: XML.Name
+addressesElName = s"{http://jabber.org/protocol/address}addresses"
+
+addressElName :: XML.Name
+addressElName = s"{http://jabber.org/protocol/address}address"
+
+toJid :: XML.Content
+toJid = s"to\\40example.com@gateway.example.com"
+
+ccJid :: XML.Content
+ccJid = s"cc\\40example.com@gateway.example.com"
+
mailboxFromLocal :: Text -> MIME.Mailbox
mailboxFromLocal local = MIME.Mailbox Nothing $
MIME.AddrSpec (encodeUtf8 local) (MIME.DomainLiteral mempty)
@@ 51,6 63,23 @@ unit_emailToStanzaSimple =
XML.Element (s"{jabber:component:accept}body") [] [
XML.NodeContent $ XML.ContentText $ s"Hello\n"
],
+ XML.Element addressesElName [] [
+ XML.NodeElement $ XML.Element addressElName [
+ (s"type", [s"to"]),
+ (s"delivered", [s"true"]),
+ (s"jid", [toJid])
+ ] [],
+ XML.NodeElement $ XML.Element addressElName [
+ (s"type", [s"cc"]),
+ (s"delivered", [s"true"]),
+ (s"jid", [s"g@gateway.example.com"])
+ ] [],
+ XML.NodeElement $ XML.Element addressElName [
+ (s"type", [s"cc"]),
+ (s"delivered", [s"true"]),
+ (s"jid", [ccJid])
+ ] []
+ ],
XML.Element (s"{jabber:component:accept}subject") [] [
XML.NodeContent $ XML.ContentText $ s"subject"
],
@@ 72,6 101,7 @@ unit_emailToStanzaSimple =
Right message = MIME.parse (MIME.message MIME.mime) email
email = encodeUtf8 $ s"To: to@example.com\n\
\From: Human <f@example.com>\n\
+ \Cc: g, cc@example.com\n\
\Subject: subject\n\
\Message-ID: <boop-id@ids.example.com>\n\
\\n\
@@ 88,6 118,13 @@ unit_emailToStanzaChat =
XML.Element (s"{jabber:component:accept}body") [] [
XML.NodeContent $ XML.ContentText $ s"Hello\n"
],
+ 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"
]
@@ 112,6 149,13 @@ unit_emailToStanzaChatFakeSubject =
XMPP.messagePayloads = [
XML.Element (s"{jabber:component:accept}body") [] [
XML.NodeContent $ XML.ContentText $ s"Hello\n"
+ ],
+ XML.Element addressesElName [] [
+ XML.NodeElement $ XML.Element addressElName [
+ (s"type", [s"to"]),
+ (s"delivered", [s"true"]),
+ (s"jid", [toJid])
+ ] []
]
]
}
@@ 134,6 178,13 @@ unit_emailToStanzaChatReFakeSubject =
XMPP.messagePayloads = [
XML.Element (s"{jabber:component:accept}body") [] [
XML.NodeContent $ XML.ContentText $ s"Hello\n"
+ ],
+ XML.Element addressesElName [] [
+ XML.NodeElement $ XML.Element addressElName [
+ (s"type", [s"to"]),
+ (s"delivered", [s"true"]),
+ (s"jid", [toJid])
+ ] []
]
]
}
@@ 156,6 207,13 @@ unit_emailToStanzUTF8Subject =
XMPP.messagePayloads = [
XML.Element (s"{jabber:component:accept}body") []
[XML.NodeContent $ XML.ContentText $s"Hello\n"],
+ 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"δΈη"]
]
@@ 179,6 237,13 @@ unit_emailToStanzaReply =
XML.Element (s"{jabber:component:accept}body") [] [
XML.NodeContent $ XML.ContentText $ s"Hello\n"
],
+ 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"
],
@@ 218,6 283,13 @@ unit_emailToStanzaReplyNulThread =
XML.Element (s"{jabber:component:accept}body") [] [
XML.NodeContent $ XML.ContentText $ s"Hello\n"
],
+ 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"
],
@@ 254,6 326,13 @@ unit_emailToStanzaDeepReply =
XML.Element (s"{jabber:component:accept}body") [] [
XML.NodeContent $ XML.ContentText $ s"Hello\n"
],
+ 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"
],
@@ 314,6 393,13 @@ unit_emailToStanzaDeepInReplyTo =
XML.Element (s"{jabber:component:accept}body") [] [
XML.NodeContent $ XML.ContentText $ s"Hello\n"
],
+ 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"
],