Browse Source

continued rewrite; formatting, documentation, jidP where-local

master
Jon Kristensen 14 years ago
parent
commit
90950791d0
  1. 45
      src/Network/XMPP/Bind.hs

45
src/Network/XMPP/Bind.hs

@ -1,6 +1,6 @@ @@ -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 @@ -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
-- "<bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'/>"
-- element, with a possible "<resource>[JID]</resource>"
-- 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 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
Loading…
Cancel
Save