diff --git a/src/Network/XMPP/Bind.hs b/src/Network/XMPP/Bind.hs index b371883..99e741b 100644 --- a/src/Network/XMPP/Bind.hs +++ b/src/Network/XMPP/Bind.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} --- TODO: Allow the client to retry the bind with another resource +{-# OPTIONS_HADDOCK hide #-} module Network.XMPP.Bind where @@ -13,35 +13,28 @@ import Network.XMPP.Types import Network.XMPP.Pickle import Network.XMPP.Monad - --- A `bind' element. - -bindP :: PU [Node] b -> PU [Node] b -bindP c = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-bind}bind" c - - --- If the (optional resource) parameter is a `Just' value, a --- `resource' child element will be added to the `bind' element. - +-- Produces a `bind' element, optionally wrapping a resource. bindBody :: Maybe Text -> Element -bindBody rsrc = (pickleElem - (bindP . xpOption $ xpElemNodes "resource" (xpContent xpId)) - rsrc - ) - --- Extracts the character data in the `jid' element. - -jidP :: PU [Node] JID -jidP = bindP $ xpElemNodes "jid" (xpContent xpPrim) - - --- Sends a (synchronous) IQ set request for a (`Just') given or --- server-generated resource and extract the JID from the non-error --- response. +bindBody = pickleElem $ + -- Pickler to produce a + -- "" + -- element, with a possible "[JID]" + -- child. + bindP . xpOption $ xpElemNodes "resource" (xpContent xpId) + +-- Sends a (synchronous) IQ set request for a (`Just') given or server-generated +-- resource and extract the JID from the non-error response. xmppBind :: Maybe Text -> XMPPConMonad Text xmppBind rsrc = do - answer <- xmppSendIQ' "bind" Nothing Set Nothing (bindBody rsrc) - let (Right IQResult{iqResultPayload = Just b}) = answer -- TODO: Error handling - let Right (JID _n _d (Just r)) = unpickleElem jidP b - return r - + answer <- xmppSendIQ' "bind" Nothing Set Nothing (bindBody rsrc) + let Right IQResult{iqResultPayload = Just b} = answer -- TODO: Error handling + let Right (JID _n _d (Just r)) = unpickleElem jidP b + return r + where + -- Extracts the character data in the `jid' element. + jidP :: PU [Node] JID + jidP = bindP $ xpElemNodes "jid" (xpContent xpPrim) + +-- A `bind' element pickler. +bindP :: PU [Node] b -> PU [Node] b +bindP c = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-bind}bind" c \ No newline at end of file