~singpolyma/network-protocol-xmpp

ce476c6f9fd7e87266da1a689d4b3bb6f620de87 — John Millikin 12 years ago b031335
Allow IQ payloads to be empty.
2 files changed, 16 insertions(+), 11 deletions(-)

M Network/Protocol/XMPP/Client.hs
M Network/Protocol/XMPP/Stanza.hs
M Network/Protocol/XMPP/Client.hs => Network/Protocol/XMPP/Client.hs +7 -5
@@ 100,8 100,9 @@ bindJID jid = do
		iq <- case bindResult of
			ReceivedIQ x -> Just x
			_ -> Nothing
		payload <- iqPayload iq
		
		case A.runLA jidArrow (iqPayload iq) of
		case A.runLA jidArrow payload of
			[] -> Nothing
			(str:_) -> J.parseJID (T.pack str)
	


@@ 119,7 120,7 @@ bindJID jid = do
	return returnedJID

bindStanza :: Maybe J.Resource -> IQ
bindStanza resource = emptyIQ IQSet payload where
bindStanza resource = (emptyIQ IQSet) { iqPayload = Just payload } where
	payload = element ("", "bind")
		[("", "xmlns", "urn:ietf:params:xml:ns:xmpp-bind")]
		requested


@@ 130,9 131,10 @@ bindStanza resource = emptyIQ IQSet payload where
			[XN.mkText (T.unpack x)]]

sessionStanza :: IQ
sessionStanza = emptyIQ IQSet $ element ("", "session")
	[("", "xmlns", "urn:ietf:params:xml:ns:xmpp-session")]
	[]
sessionStanza = (emptyIQ IQSet) { iqPayload = Just payload } where
	payload = element ("", "session")
		[("", "xmlns", "urn:ietf:params:xml:ns:xmpp-session")]
		[]

streamSupportsTLS :: [F.Feature] -> Bool
streamSupportsTLS = any isStartTLS where

M Network/Protocol/XMPP/Stanza.hs => Network/Protocol/XMPP/Stanza.hs +9 -6
@@ 149,7 149,7 @@ data IQ = IQ
	, iqFrom    :: Maybe JID
	, iqID      :: Maybe T.Text
	, iqLang    :: Maybe T.Text
	, iqPayload :: XmlTree
	, iqPayload :: Maybe XmlTree
	}
	deriving (Show)



@@ 158,7 158,9 @@ instance Stanza IQ where
	stanzaFrom = iqFrom
	stanzaID = iqID
	stanzaLang = iqLang
	stanzaPayloads iq = [iqPayload iq]
	stanzaPayloads iq = case iqPayload iq of
		Just tree -> [tree]
		Nothing -> []
	stanzaToTree x = stanzaToTree' x "iq" typeStr where
		typeStr = case iqType x of
			IQGet -> "get"


@@ 173,14 175,14 @@ data IQType
	| IQError
	deriving (Show, Eq)

emptyIQ :: IQType -> XmlTree -> IQ
emptyIQ t tree = IQ
emptyIQ :: IQType -> IQ
emptyIQ t = IQ
	{ iqType = t
	, iqTo = Nothing
	, iqFrom = Nothing
	, iqID = Nothing
	, iqLang = Nothing
	, iqPayload = tree
	, iqPayload = Nothing
	}

stanzaToTree' :: Stanza a => a -> String -> String -> XmlTree


@@ 257,11 259,12 @@ parseIQ t = do
		"result" -> Just IQResult
		"error"  -> Just IQError
		_        -> Nothing
	
	msgTo <- xmlJID "to" t
	msgFrom <- xmlJID "from" t
	let msgID = T.pack `fmap` runMA (A.getAttrValue "id") t
	let msgLang = T.pack `fmap` runMA (A.getAttrValue "lang") t
	payload <- runMA (A.getChildren >>> A.isElem) t
	let payload = runMA (A.getChildren >>> A.isElem) t
	return $ IQ iqType msgTo msgFrom msgID msgLang payload

xmlJID :: String -> XmlTree -> Maybe (Maybe JID)