~singpolyma/cheogram-smtp

5d17364400cd2e0476817a0dc70f17503df1fec8 — Stephen Paul Weber 2 years ago bffd1d9
Set JID from on vCard request
1 files changed, 9 insertions(+), 5 deletions(-)

M gateway.hs
M gateway.hs => gateway.hs +9 -5
@@ 90,24 90,28 @@ addVCardData vcard =
fetchAndAddVCardData ::
	   (XMPP.IQ -> XMPP.XMPP (STM (Maybe XMPP.IQ)))
	-> MIME.MIMEMessage
	-> Maybe XMPP.JID
	-> XMPP.JID
	-> XMPP.XMPP MIME.MIMEMessage
fetchAndAddVCardData sendIQ email jid =
fetchAndAddVCardData sendIQ email from to =
	(`addVCardData` email) .  maybe emptyVCard parseVCard <$>
	(atomicUIO =<< sendIQ (vcardRequest jid))
	(atomicUIO =<< sendIQ (vcardRequest to) { XMPP.iqFrom = from })

messageHandler ::
	   MIME.Domain
	-> (XMPP.IQ -> XMPP.XMPP (STM (Maybe XMPP.IQ)))
	-> XMPP.Message
	-> XMPP.XMPP ()
messageHandler fromDomain sendIQ message = do
messageHandler fromDomain sendIQ message@XMPP.Message {
	XMPP.messageFrom = from,
	XMPP.messageTo = to
} = do
	now <- liftIO getCurrentTime
	either XMPP.putStanza sendEmail =<< traverseOf (_Right . emailMessage')
		(\msg ->
			maybe (return msg)
			(fetchAndAddVCardData sendIQ msg)
			(XMPP.messageFrom message)
			(fetchAndAddVCardData sendIQ msg to)
			from
		)
		(messageToEmail fromDomain now message)