7 files changed, 29 insertions(+), 42 deletions(-)

M Network/Protocol/XMPP/Client.hs
M Network/Protocol/XMPP/Client/Authentication.hs
M Network/Protocol/XMPP/Client/Features.hs
M Network/Protocol/XMPP/Component.hs
M Network/Protocol/XMPP/Connections.hs
M Network/Protocol/XMPP/Stanza.hs
M Network/Protocol/XMPP/XML.hs

@@ 96,7 96,7 @@ bindJID jid = do
 	bindResult <- M.getStanza
 	let getJID =
 		X.elementChildren
-		>=> X.isNamed (X.Name "jid" (Just "urn:ietf:params:xml:ns:xmpp-bind") Nothing)
+		>=> X.isNamed "{urn:ietf:params:xml:ns:xmpp-bind}jid"
 		>=> X.elementNodes
 		>=> X.isContent
 		>=> return . X.contentText


@@ 126,7 126,7 @@ bindJID jid = do
 
 bindStanza :: Maybe J.Resource -> IQ
 bindStanza resource = (emptyIQ IQSet) { iqPayload = Just payload } where
-	payload = X.nselement "urn:ietf:params:xml:ns:xmpp-bind" "bind" [] requested
+	payload = X.element "{urn:ietf:params:xml:ns:xmpp-bind}bind" [] requested
 	requested = case fmap J.strResource resource of
 		Nothing -> []
 		Just x -> [X.NodeElement $ X.element "resource" []


@@ 134,7 134,7 @@ bindStanza resource = (emptyIQ IQSet) { iqPayload = Just payload } where
 
 sessionStanza :: IQ
 sessionStanza = (emptyIQ IQSet) { iqPayload = Just payload } where
-	payload = X.nselement "urn:ietf:params:xml:ns:xmpp-session" "session" [] []
+	payload = X.element "{urn:ietf:params:xml:ns:xmpp-session}session" [] []
 
 streamSupportsTLS :: [F.Feature] -> Bool
 streamSupportsTLS = any isStartTLS where


@@ 142,7 142,7 @@ streamSupportsTLS = any isStartTLS where
 	isStartTLS _                     = False
 
 xmlStartTLS :: X.Element
-xmlStartTLS = X.nselement "urn:ietf:params:xml:ns:xmpp-tls" "starttls" [] []
+xmlStartTLS = X.element "{urn:ietf:params:xml:ns:xmpp-tls}starttls" [] []
 
 void :: Monad m => m a -> m ()
 void m = m >> return ()

@@ 79,7 79,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 			SASL.setProperty SASL.PropertyHostname $ utf8 hostname
 			
 			(b64text, rc) <- SASL.step64 $ B.pack ""
-			putElement ctx $ X.nselement "urn:ietf:params:xml:ns:xmpp-sasl" "auth"
+			putElement ctx $ X.element "{urn:ietf:params:xml:ns:xmpp-sasl}auth"
 				[("mechanism", TL.pack $ B.unpack mechBytes)]
 				[X.NodeContent $ X.ContentText $ T.pack $ B.unpack b64text]
 			


@@ 94,7 94,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 saslLoop :: M.Session -> SASL.Session Result
 saslLoop ctx = do
 	elemt <- getElement ctx
-	let name = X.Name "challenge" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing
+	let name = "{urn:ietf:params:xml:ns:xmpp-sasl}challenge"
 	let getChallengeText =
 		X.isNamed name
 		>=> X.elementNodes


@@ 104,7 104,7 @@ saslLoop ctx = do
 	when (null challengeText) $ saslError "Received empty challenge"
 	
 	(b64text, rc) <- SASL.step64 . B.pack . concatMap TL.unpack $ challengeText
-	putElement ctx $ X.nselement "urn:ietf:params:xml:ns:xmpp-sasl" "response"
+	putElement ctx $ X.element "{urn:ietf:params:xml:ns:xmpp-sasl}response"
 		[] [X.NodeContent $ X.ContentText $ T.pack $ B.unpack b64text]
 	case rc of
 		SASL.Complete -> saslFinish ctx


@@ 113,7 113,7 @@ saslLoop ctx = do
 saslFinish :: M.Session -> SASL.Session Result
 saslFinish ctx = do
 	elemt <- getElement ctx
-	let name = X.Name "success" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing
+	let name = "{urn:ietf:params:xml:ns:xmpp-sasl}success"
 	let success = X.isNamed name elemt
 	return $ if null success then Failure else Success
 

@@ 64,7 64,7 @@ parseFeatureSASL e = FeatureSASL $
 	>>= return . B.pack . TL.unpack . X.contentText
 
 nameMechanism :: X.Name
-nameMechanism = X.Name "mechanism" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing
+nameMechanism = "{urn:ietf:params:xml:ns:xmpp-sasl}mechanism"
 
 nameFeatures :: X.Name
-nameFeatures = X.Name "features" (Just "http://etherx.jabber.org/streams") Nothing
+nameFeatures = "{http://etherx.jabber.org/streams}features"

@@ 67,7 67,7 @@ parseStreamID (X.BeginElement _ attrs) = sid where
 		(x:_) -> Just . X.attributeText $ x
 		_ -> Nothing
 	idAttrs = filter (matchingName . X.attributeName) attrs
-	matchingName = (== X.Name "jid" (Just "jabber:component:accept") Nothing)
+	matchingName = (== "{jabber:component:accept}jid")
 parseStreamID _ = Nothing
 
 authenticate :: T.Text -> T.Text -> M.XMPP ()


@@ 76,7 76,7 @@ authenticate streamID password = do
 	let digest = showDigest $ sha1 bytes
 	M.putElement $ X.element "handshake" [] [X.NodeContent $ X.ContentText digest]
 	result <- M.getElement
-	let nameHandshake = X.Name "handshake" (Just "jabber:component:accept") Nothing
+	let nameHandshake = "{jabber:component:accept}handshake"
 	when (null (X.isNamed nameHandshake result)) $
 		throwError M.AuthenticationFailure
 

@@ 56,4 56,4 @@ startOfStream depth event = case (depth, event) of
 	_ -> False
 
 qnameStream :: X.Name
-qnameStream = X.Name "stream" (Just "http://etherx.jabber.org/streams") Nothing
+qnameStream = "{http://etherx.jabber.org/streams}stream"

@@ 184,7 184,7 @@ emptyIQ t = IQ
 	, iqPayload = Nothing
 	}
 
-stanzaToElement' :: Stanza a => a -> T.Text -> T.Text -> X.Element
+stanzaToElement' :: Stanza a => a -> X.Name -> T.Text -> X.Element
 stanzaToElement' stanza name typeStr = X.element name attrs payloads where
 	payloads = map X.NodeElement $ stanzaPayloads stanza
 	attrs = concat


@@ 212,7 212,7 @@ elementToStanza ns elemt = do
 
 parseMessage :: X.Element -> Maybe Message
 parseMessage elemt = do
-	typeStr <- X.getattr (X.name "type") elemt
+	typeStr <- X.getattr "type" elemt
 	msgType <- case typeStr of
 		"normal"    -> Just MessageNormal
 		"chat"      -> Just MessageChat


@@ 222,14 222,14 @@ parseMessage elemt = do
 		_           -> Nothing
 	msgTo <- xmlJID "to" elemt
 	msgFrom <- xmlJID "from" elemt
-	let msgID = X.getattr (X.name "id") elemt
-	let msgLang = X.getattr (X.name "lang") elemt
+	let msgID = X.getattr "id" elemt
+	let msgLang = X.getattr "lang" elemt
 	let payloads = X.elementChildren elemt
 	return $ Message msgType msgTo msgFrom msgID msgLang payloads
 
 parsePresence :: X.Element -> Maybe Presence
 parsePresence elemt = do
-	let typeStr = maybe "" id $ X.getattr (X.name "type") elemt
+	let typeStr = maybe "" id $ X.getattr "type" elemt
 	pType <- case typeStr of
 		""             -> Just PresenceAvailable
 		"unavailable"  -> Just PresenceUnavailable


@@ 243,14 243,14 @@ parsePresence elemt = do
 		
 	msgTo <- xmlJID "to" elemt
 	msgFrom <- xmlJID "from" elemt
-	let msgID = X.getattr (X.name "id") elemt
-	let msgLang = X.getattr (X.name "lang") elemt
+	let msgID = X.getattr "id" elemt
+	let msgLang = X.getattr "lang" elemt
 	let payloads = X.elementChildren elemt
 	return $ Presence pType msgTo msgFrom msgID msgLang payloads
 
 parseIQ :: X.Element -> Maybe IQ
 parseIQ elemt = do
-	typeStr <- X.getattr (X.name "type") elemt
+	typeStr <- X.getattr "type" elemt
 	iqType <- case typeStr of
 		"get"    -> Just IQGet
 		"set"    -> Just IQSet


@@ 260,15 260,15 @@ parseIQ elemt = do
 	
 	msgTo <- xmlJID "to" elemt
 	msgFrom <- xmlJID "from" elemt
-	let msgID = X.getattr (X.name "id") elemt
-	let msgLang = X.getattr (X.name "lang") elemt
+	let msgID = X.getattr "id" elemt
+	let msgLang = X.getattr "lang" elemt
 	let payload = case X.elementChildren elemt of
 		[] -> Nothing
 		child:_ -> Just child
 	return $ IQ iqType msgTo msgFrom msgID msgLang payload
 
-xmlJID :: T.Text -> X.Element -> Maybe (Maybe JID)
-xmlJID name elemt = case X.getattr (X.name name) elemt of
+xmlJID :: X.Name -> X.Element -> Maybe (Maybe JID)
+xmlJID name elemt = case X.getattr name elemt of
 	Nothing -> Just Nothing
 	Just raw -> case parseJID raw of
 		Just jid -> Just (Just jid)

@@ 29,10 29,7 @@ module Network.Protocol.XMPP.XML
 	, Network.Protocol.XMPP.XML.attributeText
 	
 	-- * Constructors
-	, name
-	, nsname
 	, element
-	, nselement
 	
 	-- * Misc
 	, getattr


@@ 65,12 62,6 @@ contentText :: Content -> TL.Text
 contentText (ContentText t) = TL.fromStrict t
 contentText (ContentEntity e) = TL.concat ["&", TL.fromStrict e, ";"]
 
-name :: TL.Text -> Name
-name t = Name (TL.toStrict t) Nothing Nothing
-
-nsname :: TL.Text -> TL.Text -> Name
-nsname ns n = Name (TL.toStrict n) (Just (TL.toStrict ns)) Nothing
-
 escape :: TL.Text -> TL.Text
 escape = TL.concatMap escapeChar where
 	escapeChar c = case c of


@@ 85,16 76,12 @@ escapeContent :: Content -> TL.Text
 escapeContent (ContentText t) = escape (TL.fromStrict t)
 escapeContent (ContentEntity e) = TL.concat ["&", escape (TL.fromStrict e), ";"]
 
-element :: TL.Text -> [(TL.Text, TL.Text)] -> [Node] -> Element
-element elemName attrs children = Element (name elemName) attrs' children where
-	attrs' = map (uncurry mkattr) attrs
-
-nselement :: TL.Text -> TL.Text -> [(TL.Text, TL.Text)] -> [Node] -> Element
-nselement ns ln attrs children = Element (nsname ns ln) attrs' children where
+element :: Name -> [(Name, TL.Text)] -> [Node] -> Element
+element name attrs children = Element name attrs' children where
 	attrs' = map (uncurry mkattr) attrs
 
-mkattr :: TL.Text -> TL.Text -> (Name, [Content])
-mkattr n val = (name n, [ContentText (TL.toStrict val)])
+mkattr :: Name -> TL.Text -> (Name, [Content])
+mkattr n val = (n, [ContentText (TL.toStrict val)])
 
 -- A somewhat primitive serialisation function
 --