~singpolyma/cheogram-smtp

3e373490efc8206f383e27a062892a6e7838a72f — Stephen Paul Weber 1 year, 6 months ago 8473d07
Update to latest purebred-email
3 files changed, 20 insertions(+), 16 deletions(-)

M Email.hs
M cheogram-smtp.cabal
M test/EmailTest.hs
M Email.hs => Email.hs +13 -9
@@ 6,7 6,7 @@ import Data.Char                                 (isAscii, isAlphaNum)
import Data.Functor                              ((<&>), ($>))
import Control.Error
	(headZ, lastZ, justZ, hush, exceptT)
import Data.Time.Clock                           (UTCTime)
import Data.Time                                 (UTCTime, utcToZonedTime, utc)
import Data.Time.Format                          (formatTime, defaultTimeLocale)
import Control.Exception                         (ErrorCall(..))
import Control.Lens (


@@ 24,7 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.IMF.Syntax                 as MIME
import qualified Data.XML.Types                  as XML
import qualified Network.Protocol.XMPP           as XMPP
import qualified Network.URI                     as URI


@@ 239,11 239,13 @@ emailToSubject = fmap (mkElement (s"{jabber:component:accept}subject")) .: go
bytesToCid :: ByteString -> CID.CID
bytesToCid = CID.newCidV1 CID.Raw . Hash.hashWith Hash.SHA512

addressMailboxes :: MIME.Address -> [MIME.Mailbox]
addressMailboxes (MIME.Single mailbox) = [mailbox]
addressMailboxes (MIME.Group _ mailboxes) = mailboxes

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 (Address addr) =
	justZ . mailboxToJID domain =<< addressMailboxes addr
addressJids domain (AddressLax addr) =
	justZ $ XMPP.parseJID $ escapeJid addr ++ s"@" ++ domain



@@ 299,7 301,8 @@ emailToStanza domain attachmentUrl email = (
		) fn
	Just textBody = firstOf plainTextBody email
	Just fromMailbox@(MIME.Mailbox fn _) =
		headZ =<< firstOf (MIME.headerFrom MIME.defaultCharsets) email
		headZ $ addressMailboxes =<<
		join (toListOf (MIME.headerFrom MIME.defaultCharsets) email)
	addresses = XML.Element
		(s"{http://jabber.org/protocol/address}addresses") [] $
		map (XML.NodeElement . addressEl "to") to ++


@@ 392,12 395,13 @@ messageToEmail fromDomain now message@XMPP.Message {
	mid = mkMessageID fromDomain now message
	refs = mkReferences message
	jidHeader = Just $ MIME.encodeEncodedWords (bareTxt from)
	dateHeader = fromMaybe now $ parseXMPPTime =<<
	dateHeader = utcToZonedTime utc $ fromMaybe now $ parseXMPPTime =<<
		XML.attributeText (s"stamp") =<<
		child (s"{urn:xmpp:delay}delay") message
	subjectHeader = MIME.encodeEncodedWords <$>
		(getSubject message <|> defaultSubject message)
	setFrom = set (MIME.headerFrom MIME.defaultCharsets) [fromMailbox]
	setFrom = set (MIME.headerFrom MIME.defaultCharsets)
		[MIME.Single fromMailbox]
	fromMailbox@(MIME.Mailbox _ fromAddrSpec) = jidToMailbox from fromDomain
	parsedToNode =
		MIME.parse (MIME.mailbox MIME.defaultCharsets) unescapedToNode

M cheogram-smtp.cabal => cheogram-smtp.cabal +1 -1
@@ 28,7 28,7 @@ common defs
                       network               >= 2.6.3 && < 2.7,
                       network-protocol-xmpp >=0.4 && <0.5,
                       network-uri           >=2.6 && <2.7,
                       purebred-email        >=0.4.1 && <0.5,
                       purebred-email        >=0.6 && <0.7,
                       stm                   >=2.4 && <2.6,
                       stm-containers        >= 1.1.0 && < 1.2,
                       stm-delay             >=0.1 && <0.2,

M test/EmailTest.hs => test/EmailTest.hs +6 -6
@@ 472,7 472,7 @@ unit_messageToEmailChat =
	\Content-Disposition: inline\r\n\
	\Content-Type: text/plain; charset=utf-8\r\n\
	\\r\n\
	\5LiW55WMCi4K\r\n"
	\5LiW55WMCi4K"
	message = (XMPP.emptyMessage XMPP.MessageChat) {
		XMPP.messageTo =
			XMPP.parseJID $ s"t\\40example.com@gateway.example.com",


@@ 510,7 510,7 @@ unit_messageToEmailWithSubject =
	\Content-Disposition: inline\r\n\
	\Content-Type: text/plain; charset=utf-8\r\n\
	\\r\n\
	\5LiW55WMCi4K\r\n"
	\5LiW55WMCi4K"
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messageID = Just $ s"123",
		XMPP.messageTo =


@@ 553,7 553,7 @@ unit_messageToEmailWithDelay =
	\Content-Disposition: inline\r\n\
	\Content-Type: text/plain; charset=utf-8\r\n\
	\\r\n\
	\5LiW55WMCi4K\r\n"
	\5LiW55WMCi4K"
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messageTo =
			XMPP.parseJID $ s"t\\40example.com@gateway.example.com",


@@ 591,7 591,7 @@ unit_messageToEmailWithThread =
	\Content-Disposition: inline\r\n\
	\Content-Type: text/plain; charset=utf-8\r\n\
	\\r\n\
	\5LiW55WMCi4K\r\n"
	\5LiW55WMCi4K"
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messageTo =
			XMPP.parseJID $ s"t\\40example.com@gateway.example.com",


@@ 629,7 629,7 @@ unit_messageToEmailWithCheoThread =
	\Content-Disposition: inline\r\n\
	\Content-Type: text/plain; charset=utf-8\r\n\
	\\r\n\
	\5LiW55WMCi4K\r\n"
	\5LiW55WMCi4K"
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messageTo =
			XMPP.parseJID $ s"t\\40example.com@gateway.example.com",


@@ 670,7 670,7 @@ unit_messageToEmailWithDeepCheoThread =
	\Content-Disposition: inline\r\n\
	\Content-Type: text/plain; charset=utf-8\r\n\
	\\r\n\
	\5LiW55WMCi4K\r\n"
	\5LiW55WMCi4K"
	message = (XMPP.emptyMessage XMPP.MessageNormal) {
		XMPP.messageTo =
			XMPP.parseJID $ s"t\\40example.com@gateway.example.com",