8 files changed, 57 insertions(+), 57 deletions(-)

M examples/echo.hs
M lib/Network/Protocol/XMPP.hs
M lib/Network/Protocol/XMPP/Client.hs
M lib/Network/Protocol/XMPP/Client/Authentication.hs
M lib/Network/Protocol/XMPP/JID.hs
M lib/Network/Protocol/XMPP/Monad.hs
M lib/Network/Protocol/XMPP/Stanza.hs
M lib/Network/Protocol/XMPP/XML.hs

@@ 58,7 58,7 @@ runEcho hostname user password = do
 		, serverJID = JID Nothing (jidDomain jid) Nothing
 		, serverPort = PortNumber 5222
 		}
-	
+
 	-- 'runClient' and 'runComponent' open a connection to the remote server and
 	-- establish an XMPP session.
 	-- 


@@ 77,16 77,16 @@ runEcho hostname user password = do
 		-- When running a client session, most servers require the user to
 		-- "bind" their JID before sending any stanzas.
 		boundJID <- bindJID jid
-		
+
 		-- Some servers will close the XMPP connection after some period
 		-- of inactivity. For this example, we'll simply send a "ping" every
 		-- 60 seconds
 		getSession >>= liftIO . forkIO . sendPings 60
-		
+
 		-- 'XMPP' is an instance of 'MonadIO', so any IO may be performed
 		-- within.
 		liftIO $ putStrLn $ "Server bound our session to: " ++ show boundJID
-		
+
 		-- This is a simple loop which will echo received messages back to the
 		-- sender; additionally, it prints *all* received stanzas to the console.
 		forever $ do


@@ 100,7 100,7 @@ runEcho hostname user password = do
 					then putStanza (subscribe msg)
 					else return ()
 				_ -> return ()
-	
+
 	-- If 'runClient' terminated due to an XMPP error, propagate it as an exception.
 	-- In non-example code, you might want to show this error to the user.
 	case res of


@@ 113,12 113,12 @@ echo :: Message -> Message
 echo msg = Message
 	{ messageType = MessageNormal
 	, messageTo = messageFrom msg
-	
+
 	-- Note: Conforming XMPP servers populate the "from" attribute on
 	-- stanzas, to prevent clients from spoofing it. Therefore, the
 	-- 'messageFrom' field's value is irrelevant when sending stanzas.
 	, messageFrom = Nothing
-	
+
 	, messageID = Nothing
 	, messageLang = Nothing
 	, messagePayloads = messagePayloads msg

@@ 14,20 14,20 @@
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 module Network.Protocol.XMPP
-	( 
+	(
 	-- * JIDs
 	  JID (..)
 	, Node
 	, Domain
 	, Resource
-	
+
 	, strNode
 	, strDomain
 	, strResource
-	
+
 	, parseJID
 	, formatJID
-	
+
 	-- * Stanzas
 	, Stanza
 		( stanzaTo


@@ 36,7 36,7 @@ module Network.Protocol.XMPP
 		, stanzaLang
 		, stanzaPayloads
 		)
-	
+
 	, ReceivedStanza (..)
 	, Message (..)
 	, Presence (..)


@@ 44,11 44,11 @@ module Network.Protocol.XMPP
 	, MessageType (..)
 	, PresenceType (..)
 	, IQType (..)
-	
+
 	, emptyMessage
 	, emptyPresence
 	, emptyIQ
-	
+
 	-- * The XMPP monad
 	, XMPP
 	, Server (..)


@@ 58,7 58,7 @@ module Network.Protocol.XMPP
 	, putStanza
 	, getStanza
 	, bindJID
-	
+
 	-- ** Resuming sessions
 	, Session
 	, getSession

@@ 50,7 50,7 @@ runClient server jid username password xmpp = do
 	rawHandle <- connectTo host port
 	IO.hSetBuffering rawHandle IO.NoBuffering
 	let handle = H.PlainHandle rawHandle
-	
+
 	-- Open the initial stream and authenticate
 	M.startXMPP handle "jabber:client" $ do
 		features <- newStream sjid


@@ 100,28 100,28 @@ bindJID jid = do
 		>=> X.elementNodes
 		>=> X.isContent
 		>=> return . X.contentText
-	
+
 	let maybeJID = do
 		iq <- case bindResult of
 			ReceivedIQ x -> Just x
 			_ -> Nothing
 		payload <- iqPayload iq
-		
+
 		case getJID payload of
 			[] -> Nothing
 			(str:_) -> J.parseJID str
-	
+
 	returnedJID <- case maybeJID of
 		Just x -> return x
 		Nothing -> throwError (M.InvalidBindResult bindResult)
-	
+
 	-- Session
 	M.putStanza sessionStanza
 	void M.getStanza
-	
+
 	M.putStanza (emptyPresence PresenceAvailable)
 	void M.getStanza
-	
+
 	return returnedJID
 
 bindStanza :: Maybe J.Resource -> IQ

@@ 53,7 53,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 	mechanisms = map SASL.Mechanism xmppMechanisms
 	authz = formatJID (userJID { jidResource = Nothing })
 	hostname = formatJID serverJID
-	
+
 	xmpp = do
 		ctx <- M.getSession
 		res <- liftIO . Exc.try . SASL.runSASL $ do


@@ 66,7 66,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 			Right (Failure e) -> E.throwError (M.AuthenticationFailure e)
 			Left (XmppError err) -> E.throwError err
 			Left (SaslError err) -> E.throwError (M.AuthenticationError err)
-	
+
 	authSasl ctx mechanism = do
 		let (SASL.Mechanism mechBytes) = mechanism
 		sessionResult <- SASL.runClient mechanism $ do


@@ 75,16 75,16 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 			SASL.setProperty SASL.PropertyPassword (encodeUtf8 password)
 			SASL.setProperty SASL.PropertyService "xmpp"
 			SASL.setProperty SASL.PropertyHostname (encodeUtf8 hostname)
-			
+
 			(b64text, rc) <- SASL.step64 ""
 			putElement ctx $ X.element "{urn:ietf:params:xml:ns:xmpp-sasl}auth"
 				[("mechanism", Data.Text.pack (Data.ByteString.Char8.unpack mechBytes))]
 				[X.NodeContent (X.ContentText (Data.Text.pack (Data.ByteString.Char8.unpack b64text)))]
-			
+
 			case rc of
 				SASL.Complete -> saslFinish ctx
 				SASL.NeedsMore -> saslLoop ctx
-			
+
 		case sessionResult of
 			Right x -> return x
 			Left err -> saslError (show err)


@@ 106,7 106,7 @@ saslLoop ctx = do
 			case rc of
 				SASL.Complete -> saslFinish ctx
 				SASL.NeedsMore -> saslLoop ctx
-		
+
 		-- The server has authenticated this client, but the client-side
 		-- SASL protocol wants more data from the server.
 		n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}success" -> do


@@ 115,10 115,10 @@ saslLoop ctx = do
 			case rc of
 				SASL.Complete -> return Success
 				SASL.NeedsMore -> saslError "Server didn't provide enough SASL data."
-		
+
 		-- The server has rejected this client's credentials.
 		n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}failure" -> return (Failure e)
-		
+
 		_ -> saslError ("Server sent unexpected element during authentication.")
 
 saslFinish :: M.Session -> SASL.Session Result

@@ 21,7 21,7 @@ module Network.Protocol.XMPP.JID
 	, Node (..)
 	, Domain (..)
 	, Resource (..)
-	
+
 	, parseJID
 	, parseJID_
 	, formatJID

@@ 23,15 23,15 @@ module Network.Protocol.XMPP.Monad
 	, runXMPP
 	, startXMPP
 	, restartXMPP
-	
+
 	, getHandle
 	, getSession
 	, sessionIsSecure
-	
+
 	, readEvents
 	, getElement
 	, getStanza
-	
+
 	, putBytes
 	, putElement
 	, putStanza


@@ 62,20 62,20 @@ data Error
 	-- provided. It may contain additional information about why
 	-- authentication failed.
 	= AuthenticationFailure X.Element
-	
+
 	-- | There was an error while authenticating with the remote host.
 	| AuthenticationError Text
-	
+
 	-- | An unrecognized or malformed 'S.Stanza' was received from the remote
 	-- host.
 	| InvalidStanza X.Element
-	
+
 	-- | The remote host sent an invalid reply to a resource bind request.
 	| InvalidBindResult S.ReceivedStanza
-	
+
 	-- | There was an error with the underlying transport.
 	| TransportError Text
-	
+
 	-- | The remote host did not send a stream ID when accepting a component
 	-- connection.
 	| NoComponentStreamID


@@ 189,7 189,7 @@ getElement = xmpp where
 		case X.eventsToElement events of
 			Just x -> return x
 			Nothing -> E.throwError (TransportError "getElement: invalid event list")
-	
+
 	endOfTree 0 (X.EventEndElement _) = True
 	endOfTree _ _ = False
 

@@ 17,7 17,7 @@
 
 module Network.Protocol.XMPP.Stanza
 	( Stanza (..)
-	
+
 	, ReceivedStanza (..)
 	, Message (..)
 	, Presence (..)


@@ 25,11 25,11 @@ module Network.Protocol.XMPP.Stanza
 	, MessageType (..)
 	, PresenceType (..)
 	, IQType (..)
-	
+
 	, emptyMessage
 	, emptyPresence
 	, emptyIQ
-	
+
 	, elementToStanza
 	) where
 


@@ 204,7 204,7 @@ elementToStanza :: Text -> X.Element -> Maybe ReceivedStanza
 elementToStanza ns elemt = do
 	let elemNS = X.nameNamespace (X.elementName elemt)
 	when (elemNS /= Just ns) Nothing
-	
+
 	let elemName = X.nameLocalName (X.elementName elemt)
 	case elemName of
 		"message" -> ReceivedMessage `fmap` parseMessage elemt


@@ 241,7 241,7 @@ parsePresence elemt = do
 		"probe"        -> Just PresenceProbe
 		"error"        -> Just PresenceError
 		_              -> Nothing
-		
+
 	msgTo <- xmlJID "to" elemt
 	msgFrom <- xmlJID "from" elemt
 	let msgID = X.attributeText "id" elemt


@@ 258,7 258,7 @@ parseIQ elemt = do
 		"result" -> Just IQResult
 		"error"  -> Just IQError
 		_        -> Nothing
-	
+
 	msgTo <- xmlJID "to" elemt
 	msgFrom <- xmlJID "from" elemt
 	let msgID = X.attributeText "id" elemt

@@ 17,22 17,22 @@
 
 module Network.Protocol.XMPP.XML
 	( module Data.XML.Types
-	
+
 	-- * Constructors
 	, element
-	
+
 	-- * Misc
 	, contentText
 	, escape
 	, serialiseElement
 	, readEvents
-	
+
 	-- * libxml-sax-0.4 API imitation
 	, Parser
 	, newParser
 	, parse
 	, eventsToElement
-	
+
 	) where
 
 import           Control.Monad (when)


@@ 82,7 82,7 @@ serialiseElement e = text where
 		Nothing -> []
 		Just ns -> [mkattr "xmlns" ns]
 	contents = Data.Text.concat (map serialiseNode (elementNodes e))
-	
+
 	serialiseNode (NodeElement e') = serialiseElement e'
 	serialiseNode (NodeContent c) = escape (contentText c)
 	serialiseNode (NodeComment _) = ""


@@ 96,21 96,21 @@ newParser :: IO Parser
 newParser = do
 	ref <- newIORef (Right [])
 	p <- SAX.newParserIO Nothing
-	
+
 	let addEvent e = do
 		x <- readIORef ref
 		case x of
 			Left _ -> return ()
 			Right es -> writeIORef ref (Right (e:es))
 		return True
-	
+
 	SAX.setCallback p SAX.parsedBeginElement (\name attrs -> addEvent (EventBeginElement name attrs))
 	SAX.setCallback p SAX.parsedEndElement (addEvent . EventEndElement)
 	SAX.setCallback p SAX.parsedCharacters (addEvent . EventContent . ContentText)
 	SAX.setCallback p SAX.parsedComment (addEvent . EventComment)
 	SAX.setCallback p SAX.parsedInstruction (addEvent . EventInstruction)
 	SAX.setCallback p SAX.reportError (\err -> writeIORef ref (Left err) >> return False)
-	
+
 	return (Parser p ref)
 
 parse :: Parser -> ByteString -> Bool -> IO (Either Text [Event])


@@ 134,7 134,7 @@ readEvents done nextEvents = readEvents' 0 [] where
 		if done'
 			then return acc'
 			else readEvents' depth' acc'
-	
+
 	step [] depth acc = (False, depth, acc)
 	step (e:es) depth acc = let
 		depth' = depth + case e of


@@ 162,7 162,7 @@ eventsToNodes = concatMap blockToNodes . splitBlocks
 splitBlocks :: [Event] -> [[Event]]
 splitBlocks es = ret where
 	(_, _, ret) = foldl splitBlocks' (0, [], []) es
-	
+
 	splitBlocks' (depth, accum, allAccum) e = split where
 		split = if depth' == 0
 			then (depth', [], allAccum ++ [accum'])


@@ 182,5 182,5 @@ blockToNodes (begin:rest) = nodes where
 		(EventBeginElement name attrs, EventEndElement _) -> [node name attrs]
 		(EventContent c, _) -> [NodeContent c]
 		_ -> []
-	
+
 	node n as = NodeElement (Element n as (eventsToNodes (init rest)))