~singpolyma/cheogram-smtp

f692a1cef26edfce6f2231dabfc8457b9393f961 — Stephen Paul Weber 2 years ago 9efc45d
Generate IDs for IQs before sending
2 files changed, 12 insertions(+), 2 deletions(-)

M IQManager.hs
M incoming-email.hs
M IQManager.hs => IQManager.hs +12 -1
@@ 10,6 10,8 @@ import Control.Concurrent.STM.Delay    (newDelay, waitDelay)
import UnexceptionalIO.Trans           (Unexceptional)
import qualified Data.Map.Strict       as Map
import qualified Network.Protocol.XMPP as XMPP
import qualified Data.UUID             as UUID
import qualified Data.UUID.V4          as UUID

import Util



@@ 18,13 20,22 @@ type ResponseMap = Map.Map (Maybe Text) (TMVar XMPP.IQ)
iqSendTimeoutMicroseconds :: Int
iqSendTimeoutMicroseconds = 5000000

iqDefaultID :: (Unexceptional m) => XMPP.IQ -> m XMPP.IQ
iqDefaultID iq@XMPP.IQ { XMPP.iqID = Just _ } = return iq
iqDefaultID iq = do
	uuid <- fromIO_ UUID.nextRandom
	return $ iq {
			XMPP.iqID = Just $ UUID.toText uuid
		}

iqSenderUnexceptional :: (Unexceptional m) =>
	   TVar ResponseMap
	-> XMPP.IQ
	-> m (STM (Maybe XMPP.IQ))
iqSenderUnexceptional responseMapVar iqToSend = do
iqSenderUnexceptional responseMapVar iq = do
	timeout <- fromIO_ $ newDelay iqSendTimeoutMicroseconds
	iqResponseVar <- atomicUIO newEmptyTMVar
	iqToSend <- iqDefaultID iq
	atomicUIO $ modifyTVar' responseMapVar $
			Map.insert (XMPP.iqID iqToSend) iqResponseVar
	return (

M incoming-email.hs => incoming-email.hs +0 -1
@@ 47,7 47,6 @@ main = do

	let messageIQs = messages <&> \message -> (XMPP.emptyIQ XMPP.IQSet) {
			XMPP.iqTo = XMPP.parseJID domain,
			XMPP.iqID = bareTxt <$> XMPP.messageTo message,
			XMPP.iqPayload = Just $ XMPP.stanzaToElement message
		}