~singpolyma/network-protocol-xmpp: Use strict text and bytestrings for everything.

10 files changed, 142 insertions(+), 166 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/Handle.hs
M Network/Protocol/XMPP/JID.hs
M Network/Protocol/XMPP/Monad.hs
M Network/Protocol/XMPP/Stanza.hs
M Network/Protocol/XMPP/XML.hs

M Network/Protocol/XMPP/Client.hs => Network/Protocol/XMPP/Client.hs +4 -4

@@ 24,7 24,7 @@ import           Control.Monad ((>=>))
 import           Control.Monad.Error (throwError)
 import           Control.Monad.Trans (liftIO)
 import           Data.ByteString (ByteString)
-import qualified Data.Text.Lazy as T
+import           Data.Text (Text)
 import           Network (connectTo)
 import qualified System.IO as IO
 


@@ 40,8 40,8 @@ import           Network.Protocol.XMPP.Stanza
 
 runClient :: C.Server
           -> J.JID -- ^ Client JID
-          -> T.Text -- ^ Username
-          -> T.Text -- ^ Password
+          -> Text -- ^ Username
+          -> Text -- ^ Password
           -> M.XMPP a
           -> IO (Either M.Error a)
 runClient server jid username password xmpp = do


@@ 130,7 130,7 @@ bindStanza resource = (emptyIQ IQSet) { iqPayload = Just payload } where
 	requested = case fmap J.strResource resource of
 		Nothing -> []
 		Just x -> [X.NodeElement $ X.element "resource" []
-			[X.NodeContent $ X.ContentText (T.toStrict x)]]
+			[X.NodeContent $ X.ContentText x]]
 
 sessionStanza :: IQ
 sessionStanza = (emptyIQ IQSet) { iqPayload = Just payload } where

M Network/Protocol/XMPP/Client/Authentication.hs => Network/Protocol/XMPP/Client/Authentication.hs +16 -17

@@ 26,9 26,9 @@ import           Control.Monad (when, (>=>))
 import           Control.Monad.IO.Class (MonadIO, liftIO)
 import qualified Control.Monad.Error as E
 import qualified Data.ByteString.Char8 as B
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import qualified Data.Text.Lazy as TL
+import qualified Data.Text
+import           Data.Text (Text)
+import           Data.Text.Encoding (encodeUtf8)
 import           Data.Typeable (Typeable)
 import qualified Network.Protocol.SASL.GNU as SASL
 


@@ 39,7 39,7 @@ import           Network.Protocol.XMPP.JID (JID, formatJID, jidResource)
 data Result = Success | Failure
 	deriving (Show, Eq)
 
-data AuthException = XmppError M.Error | SaslError TL.Text
+data AuthException = XmppError M.Error | SaslError Text
 	deriving (Typeable, Show)
 
 instance Exc.Exception AuthException


@@ 47,14 47,13 @@ instance Exc.Exception AuthException
 authenticate :: [B.ByteString] -- ^ Mechanisms
              -> JID -- ^ User JID
              -> JID -- ^ Server JID
-             -> TL.Text -- ^ Username
-             -> TL.Text -- ^ Password
+             -> Text -- ^ Username
+             -> Text -- ^ Password
              -> M.XMPP ()
 authenticate xmppMechanisms userJID serverJID username password = xmpp where
 	mechanisms = map SASL.Mechanism xmppMechanisms
 	authz = formatJID $ userJID { jidResource = Nothing }
 	hostname = formatJID serverJID
-	utf8 = TE.encodeUtf8 . T.concat . TL.toChunks
 	
 	xmpp = do
 		ctx <- M.getSession


@@ 72,16 71,16 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 	authSasl ctx mechanism = do
 		let (SASL.Mechanism mechBytes) = mechanism
 		sessionResult <- SASL.runClient mechanism $ do
-			SASL.setProperty SASL.PropertyAuthzID $ utf8 authz
-			SASL.setProperty SASL.PropertyAuthID $ utf8 username
-			SASL.setProperty SASL.PropertyPassword $ utf8 password
+			SASL.setProperty SASL.PropertyAuthzID $ encodeUtf8 authz
+			SASL.setProperty SASL.PropertyAuthID $ encodeUtf8 username
+			SASL.setProperty SASL.PropertyPassword $ encodeUtf8 password
 			SASL.setProperty SASL.PropertyService $ B.pack "xmpp"
-			SASL.setProperty SASL.PropertyHostname $ utf8 hostname
+			SASL.setProperty SASL.PropertyHostname $ encodeUtf8 hostname
 			
 			(b64text, rc) <- SASL.step64 $ B.pack ""
 			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]
+				[("mechanism", Data.Text.pack $ B.unpack mechBytes)]
+				[X.NodeContent $ X.ContentText $ Data.Text.pack $ B.unpack b64text]
 			
 			case rc of
 				SASL.Complete -> saslFinish ctx


@@ 89,7 88,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
 			
 		case sessionResult of
 			Right x -> return x
-			Left err -> saslError $ TL.pack $ show err
+			Left err -> saslError $ Data.Text.pack $ show err
 
 saslLoop :: M.Session -> SASL.Session Result
 saslLoop ctx = do


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


@@ 131,5 130,5 @@ getElement ctx = liftIO $ do
 		Left err -> Exc.throwIO $ XmppError err
 		Right x -> return x
 
-saslError :: MonadIO m => TL.Text -> m a
+saslError :: MonadIO m => Text -> m a
 saslError = liftIO . Exc.throwIO . SaslError

M Network/Protocol/XMPP/Client/Features.hs => Network/Protocol/XMPP/Client/Features.hs +5 -4

@@ 22,13 22,14 @@ module Network.Protocol.XMPP.Client.Features
 	) where
 
 import           Control.Arrow ((&&&))
-import qualified Data.ByteString.Char8 as B
-import qualified Data.Text.Lazy as TL
+import qualified Data.ByteString.Char8
+import           Data.ByteString (ByteString)
+import qualified Data.Text
 import qualified Network.Protocol.XMPP.XML as X
 
 data Feature =
 	  FeatureStartTLS Bool
-	| FeatureSASL [B.ByteString]
+	| FeatureSASL [ByteString]
 	| FeatureRegister
 	| FeatureBind
 	| FeatureSession


@@ 61,7 62,7 @@ parseFeatureSASL e = FeatureSASL $
 	>>= X.isNamed nameMechanism
 	>>= X.elementNodes
 	>>= X.isContent
-	>>= return . B.pack . TL.unpack . X.contentText
+	>>= return . Data.ByteString.Char8.pack . Data.Text.unpack . X.contentText
 
 nameMechanism :: X.Name
 nameMechanism = "{urn:ietf:params:xml:ns:xmpp-sasl}mechanism"

M Network/Protocol/XMPP/Component.hs => Network/Protocol/XMPP/Component.hs +15 -19

@@ 24,11 24,11 @@ import           Control.Monad (when)
 import           Control.Monad.Error (throwError)
 import           Data.Bits (shiftR, (.&.))
 import           Data.Char (intToDigit)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString
+import           Data.ByteString (ByteString)
 import qualified Data.Text
-import qualified Data.Text.Lazy as T
-import qualified Data.Text.Lazy.Encoding as TE
+import           Data.Text (Text)
+import           Data.Text.Encoding (encodeUtf8)
 import           Network (connectTo)
 import           Network.Protocol.SASL.GNU (sha1)
 import qualified System.IO as IO


@@ 40,7 40,7 @@ import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.JID (JID)
 
 runComponent :: C.Server
-             -> T.Text -- ^ Server secret
+             -> Text -- ^ Server secret
              -> M.XMPP a
              -> IO (Either M.Error a)
 runComponent server password xmpp = do


@@ 53,7 53,7 @@ runComponent server password xmpp = do
 		authenticate streamID password
 		xmpp
 
-beginStream :: JID -> M.XMPP T.Text
+beginStream :: JID -> M.XMPP Text
 beginStream jid = do
 	M.putBytes $ C.xmlHeader "jabber:component:accept" jid
 	events <- M.readEvents C.startOfStream


@@ 61,16 61,13 @@ beginStream jid = do
 		Nothing -> throwError M.NoComponentStreamID
 		Just x -> return x
 
-parseStreamID :: X.SaxEvent -> Maybe T.Text
-parseStreamID (X.BeginElement _ attrs) = sid where
-	sid = case idAttrs of
-		(x:_) -> Just . X.attributeText $ x
-		_ -> Nothing
-	idAttrs = filter (matchingName . X.attributeName) attrs
-	matchingName = (== "{jabber:component:accept}jid")
+parseStreamID :: X.SaxEvent -> Maybe Text
+parseStreamID (X.BeginElement name attrs) = X.attributeText
+	"{jabber:component:accept}jid"
+	(X.Element name attrs [])
 parseStreamID _ = Nothing
 
-authenticate :: T.Text -> T.Text -> M.XMPP ()
+authenticate :: Text -> Text -> M.XMPP ()
 authenticate streamID password = do
 	let bytes = buildSecret streamID password
 	let digest = showDigest $ sha1 bytes


@@ 80,11 77,10 @@ authenticate streamID password = do
 	when (null (X.isNamed nameHandshake result)) $
 		throwError M.AuthenticationFailure
 
-buildSecret :: T.Text -> T.Text -> B.ByteString
-buildSecret sid password = B.concat . BL.toChunks $ bytes where
-	bytes = TE.encodeUtf8 $ X.escape $ T.append sid password
+buildSecret :: Text -> Text -> ByteString
+buildSecret sid password = encodeUtf8 (X.escape (Data.Text.append sid password))
 
-showDigest :: B.ByteString -> Data.Text.Text
-showDigest = Data.Text.pack . concatMap wordToHex . B.unpack where
+showDigest :: ByteString -> Text
+showDigest = Data.Text.pack . concatMap wordToHex . Data.ByteString.unpack where
 	wordToHex x = [hexDig $ shiftR x 4, hexDig $ x .&. 0xF]
 	hexDig = intToDigit . fromIntegral

M Network/Protocol/XMPP/Connections.hs => Network/Protocol/XMPP/Connections.hs +7 -6

@@ 23,9 23,10 @@ module Network.Protocol.XMPP.Connections
 	) where
 
 import           Network (HostName, PortID)
-import qualified Data.ByteString.Lazy as B
-import qualified Data.Text.Lazy as T
-import           Data.Text.Lazy.Encoding (encodeUtf8)
+import           Data.ByteString (ByteString)
+import qualified Data.Text
+import           Data.Text (Text)
+import           Data.Text.Encoding (encodeUtf8)
 
 import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.JID (JID, formatJID)


@@ 39,10 40,10 @@ data Server = Server
 -- Since only the opening tag should be written, normal XML
 -- serialization cannot be used. Be careful to escape any embedded
 -- attributes.
-xmlHeader :: T.Text -> JID -> B.ByteString
+xmlHeader :: Text -> JID -> ByteString
 xmlHeader ns jid = encodeUtf8 header where
-	attr x = T.concat ["\"", X.escape x, "\""]
-	header = T.concat
+	attr x = Data.Text.concat ["\"", X.escape x, "\""]
+	header = Data.Text.concat
 		[ "<?xml version='1.0'?>\n"
 		, "<stream:stream xmlns=" , attr ns
 		, " to=", attr (formatJID jid)

M Network/Protocol/XMPP/Handle.hs => Network/Protocol/XMPP/Handle.hs +17 -12

@@ 25,8 25,11 @@ module Network.Protocol.XMPP.Handle
 import           Control.Monad (when)
 import qualified Control.Monad.Error as E
 import           Control.Monad.Trans (liftIO)
-import qualified Data.ByteString.Lazy as B
-import qualified Data.Text.Lazy as T
+import qualified Data.ByteString
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy
+import qualified Data.Text
+import           Data.Text (Text)
 import qualified System.IO as IO
 import qualified Network.Protocol.TLS.GNU as TLS
 import           Network.Protocol.XMPP.ErrorT


@@ 35,17 38,17 @@ data Handle =
 	  PlainHandle IO.Handle
 	| SecureHandle IO.Handle TLS.Session
 
-liftTLS :: TLS.Session -> TLS.TLS a -> ErrorT T.Text IO a
+liftTLS :: TLS.Session -> TLS.TLS a -> ErrorT Text IO a
 liftTLS s = liftTLS' . TLS.runTLS s
 
-liftTLS' :: IO (Either TLS.Error a) -> ErrorT T.Text IO a
+liftTLS' :: IO (Either TLS.Error a) -> ErrorT Text IO a
 liftTLS' io = do
 	eitherX <- liftIO io
 	case eitherX of
-		Left err -> E.throwError $ T.pack $ show err
+		Left err -> E.throwError $ Data.Text.pack $ show err
 		Right x -> return x
 
-startTLS :: Handle -> ErrorT T.Text IO Handle
+startTLS :: Handle -> ErrorT Text IO Handle
 startTLS (SecureHandle _ _) = E.throwError "Can't start TLS on a secure handle"
 startTLS (PlainHandle h) = liftTLS' $ TLS.runClient (TLS.handleTransport h) $ do
 	TLS.setPriority [TLS.X509]


@@ 53,14 56,16 @@ startTLS (PlainHandle h) = liftTLS' $ TLS.runClient (TLS.handleTransport h) $ do
 	TLS.handshake
 	SecureHandle h `fmap` TLS.getSession
 
-hPutBytes :: Handle -> B.ByteString -> ErrorT T.Text IO ()
-hPutBytes (PlainHandle h)  = liftIO . B.hPut h
-hPutBytes (SecureHandle _ s) = liftTLS s . TLS.putBytes
+hPutBytes :: Handle -> ByteString -> ErrorT Text IO ()
+hPutBytes (PlainHandle h)  = liftIO . Data.ByteString.hPut h
+hPutBytes (SecureHandle _ s) = liftTLS s . TLS.putBytes . toLazy where
+	toLazy bytes = Data.ByteString.Lazy.fromChunks [bytes]
 
-hGetBytes :: Handle -> Integer -> ErrorT T.Text IO B.ByteString
-hGetBytes (PlainHandle h) n = liftIO $  B.hGet h $ fromInteger n
+hGetBytes :: Handle -> Integer -> ErrorT Text IO ByteString
+hGetBytes (PlainHandle h) n = liftIO $ Data.ByteString.hGet h $ fromInteger n
 hGetBytes (SecureHandle h s) n = liftTLS s $ do
 	pending <- TLS.checkPending
 	let wait = IO.hWaitForInput h (- 1) >> return ()
 	when (pending == 0) (liftIO wait)
-	TLS.getBytes n
+	lazy <- TLS.getBytes n
+	return (Data.ByteString.concat (Data.ByteString.Lazy.toChunks lazy))

M Network/Protocol/XMPP/JID.hs => Network/Protocol/XMPP/JID.hs +14 -14

@@ 27,8 27,8 @@ module Network.Protocol.XMPP.JID
 	, formatJID
 	) where
 
-import qualified Data.Text.Lazy as TL
-import           Data.Text.Lazy (Text)
+import qualified Data.Text
+import           Data.Text (Text)
 import qualified Data.Text.IDN.StringPrep as SP
 import           Data.String (IsString, fromString)
 


@@ 74,14 74,14 @@ instance IsString JID where
 parseJID :: Text -> Maybe JID
 parseJID str = maybeJID where
 	(node, postNode) = case textSpanBy (/= '@') str of
-		(x, y) -> if TL.null y
+		(x, y) -> if Data.Text.null y
 			then ("", x)
-			else (x, TL.drop 1 y)
+			else (x, Data.Text.drop 1 y)
 	(domain, resource) = case textSpanBy (/= '/') postNode of
-		(x, y) -> if TL.null y
+		(x, y) -> if Data.Text.null y
 			then (x, "")
-			else (x, TL.drop 1 y)
-	nullable x f = if TL.null x then Just Nothing else fmap Just $ f x
+			else (x, Data.Text.drop 1 y)
+	nullable x f = if Data.Text.null x then Just Nothing else fmap Just $ f x
 	maybeJID = do
 		preppedNode <- nullable node $ stringprepM SP.xmppNode
 		preppedDomain <- stringprepM SP.nameprep domain


@@ 90,9 90,9 @@ parseJID str = maybeJID where
 			(fmap Node preppedNode)
 			(Domain preppedDomain)
 			(fmap Resource preppedResource)
-	stringprepM p x = case SP.stringprep p SP.defaultFlags (TL.toStrict x) of
+	stringprepM p x = case SP.stringprep p SP.defaultFlags x of
 		Left _ -> Nothing
-		Right y -> Just (TL.fromStrict y)
+		Right y -> Just y
 
 parseJID_ :: Text -> JID
 parseJID_ text = case parseJID text of


@@ 101,9 101,9 @@ parseJID_ text = case parseJID text of
 
 formatJID :: JID -> Text
 formatJID (JID node (Domain domain) resource) = formatted where
-	formatted = TL.concat [node', domain, resource']
-	node' = maybe "" (\(Node x) -> TL.append x "@") node
-	resource' = maybe "" (\(Resource x) -> TL.append "/" x) resource
+	formatted = Data.Text.concat [node', domain, resource']
+	node' = maybe "" (\(Node x) -> Data.Text.append x "@") node
+	resource' = maybe "" (\(Resource x) -> Data.Text.append "/" x) resource
 
 -- Similar to 'comparing'
 equaling :: Eq a => (b -> a) -> b -> b -> Bool


@@ 112,7 112,7 @@ equaling f x y = f x == f y
 -- multi-version 'text' compatibility
 textSpanBy :: (Char -> Bool) -> Text -> (Text, Text)
 #if MIN_VERSION_text(0,11,0)
-textSpanBy = TL.span
+textSpanBy = Data.Text.span
 #else
-textSpanBy = TL.spanBy
+textSpanBy = Data.Text.spanBy
 #endif

M Network/Protocol/XMPP/Monad.hs => Network/Protocol/XMPP/Monad.hs +6 -5

@@ 43,9 43,10 @@ import           Control.Monad.Fix (MonadFix, mfix)
 import           Control.Monad.Trans (MonadIO, liftIO)
 import qualified Control.Monad.Error as E
 import qualified Control.Monad.Reader as R
-import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.Text.Lazy (Text)
-import           Data.Text.Lazy.Encoding (encodeUtf8)
+import qualified Data.ByteString
+import           Data.ByteString (ByteString)
+import           Data.Text (Text)
+import           Data.Text.Encoding (encodeUtf8)
 
 import           Network.Protocol.XMPP.ErrorT
 import qualified Network.Protocol.XMPP.Handle as H


@@ 145,7 146,7 @@ liftTLS io = do
 		Left err -> E.throwError $ TransportError err
 		Right x -> return x
 
-putBytes :: B.ByteString -> XMPP ()
+putBytes :: ByteString -> XMPP ()
 putBytes bytes = do
 	h <- getHandle
 	liftTLS $ H.hPutBytes h bytes


@@ 163,7 164,7 @@ readEvents done = xmpp where
 		let nextEvents = do
 			-- TODO: read in larger increments
 			bytes <- liftTLS $ H.hGetBytes h 1
-			let eof = B.length bytes == 0
+			let eof = Data.ByteString.length bytes == 0
 			parsed <- liftIO $ X.parse p bytes eof
 			case parsed of
 				Left err -> E.throwError $ TransportError err

M Network/Protocol/XMPP/Stanza.hs => Network/Protocol/XMPP/Stanza.hs +23 -22

@@ 34,15 34,16 @@ module Network.Protocol.XMPP.Stanza
 	) where
 
 import           Control.Monad (when)
-import qualified Data.Text.Lazy as T
+import qualified Data.Text
+import           Data.Text (Text)
 import qualified Network.Protocol.XMPP.XML as X
 import           Network.Protocol.XMPP.JID (JID, parseJID, formatJID)
 
 class Stanza a where
 	stanzaTo        :: a -> Maybe JID
 	stanzaFrom      :: a -> Maybe JID
-	stanzaID        :: a -> Maybe T.Text
-	stanzaLang      :: a -> Maybe T.Text
+	stanzaID        :: a -> Maybe Text
+	stanzaLang      :: a -> Maybe Text
 	stanzaPayloads  :: a -> [X.Element]
 	stanzaToElement :: a -> X.Element
 


@@ 56,8 57,8 @@ data Message = Message
 	{ messageType     :: MessageType
 	, messageTo       :: Maybe JID
 	, messageFrom     :: Maybe JID
-	, messageID       :: Maybe T.Text
-	, messageLang     :: Maybe T.Text
+	, messageID       :: Maybe Text
+	, messageLang     :: Maybe Text
 	, messagePayloads :: [X.Element]
 	}
 	deriving (Show)


@@ 98,8 99,8 @@ data Presence = Presence
 	{ presenceType     :: PresenceType
 	, presenceTo       :: Maybe JID
 	, presenceFrom     :: Maybe JID
-	, presenceID       :: Maybe T.Text
-	, presenceLang     :: Maybe T.Text
+	, presenceID       :: Maybe Text
+	, presenceLang     :: Maybe Text
 	, presencePayloads :: [X.Element]
 	}
 	deriving (Show)


@@ 146,8 147,8 @@ data IQ = IQ
 	{ iqType    :: IQType
 	, iqTo      :: Maybe JID
 	, iqFrom    :: Maybe JID
-	, iqID      :: Maybe T.Text
-	, iqLang    :: Maybe T.Text
+	, iqID      :: Maybe Text
+	, iqLang    :: Maybe Text
 	, iqPayload :: Maybe X.Element
 	}
 	deriving (Show)


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


@@ 192,13 193,13 @@ stanzaToElement' stanza name typeStr = X.element name attrs payloads where
 		, mattr "from" $ fmap formatJID . stanzaFrom
 		, mattr "id" stanzaID
 		, mattr "xml:lang" stanzaLang
-		, if T.null typeStr then [] else [("type", typeStr)]
+		, if Data.Text.null typeStr then [] else [("type", typeStr)]
 		]
 	mattr label f = case f stanza of
 		Nothing -> []
 		Just text -> [(label, text)]
 
-elementToStanza :: T.Text -> X.Element -> Maybe ReceivedStanza
+elementToStanza :: Text -> X.Element -> Maybe ReceivedStanza
 elementToStanza ns elemt = do
 	let elemNS = X.nameNamespace . X.elementName $ elemt
 	when (elemNS /= Just ns) Nothing


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


@@ 222,14 223,14 @@ parseMessage elemt = do
 		_           -> Nothing
 	msgTo <- xmlJID "to" elemt
 	msgFrom <- xmlJID "from" elemt
-	let msgID = X.getattr "id" elemt
-	let msgLang = X.getattr "lang" elemt
+	let msgID = X.attributeText "id" elemt
+	let msgLang = X.attributeText "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 "type" elemt
+	let typeStr = maybe "" id $ X.attributeText "type" elemt
 	pType <- case typeStr of
 		""             -> Just PresenceAvailable
 		"unavailable"  -> Just PresenceUnavailable


@@ 243,14 244,14 @@ parsePresence elemt = do
 		
 	msgTo <- xmlJID "to" elemt
 	msgFrom <- xmlJID "from" elemt
-	let msgID = X.getattr "id" elemt
-	let msgLang = X.getattr "lang" elemt
+	let msgID = X.attributeText "id" elemt
+	let msgLang = X.attributeText "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 "type" elemt
+	typeStr <- X.attributeText "type" elemt
 	iqType <- case typeStr of
 		"get"    -> Just IQGet
 		"set"    -> Just IQSet


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

M Network/Protocol/XMPP/XML.hs => Network/Protocol/XMPP/XML.hs +35 -63

@@ 16,23 16,12 @@
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 module Network.Protocol.XMPP.XML
-	( Element(..)
-	, Node(..)
-	, Content(..)
-	, Name(Name)
-	, Network.Protocol.XMPP.XML.nameNamespace
-	, Network.Protocol.XMPP.XML.nameLocalName
-	, isNamed
-	, elementChildren
-	, isContent
-	, attributeName
-	, Network.Protocol.XMPP.XML.attributeText
+	( module Data.XML.Types
 	
 	-- * Constructors
 	, element
 	
 	-- * Misc
-	, getattr
 	, contentText
 	, escape
 	, serialiseElement


@@ 48,78 37,61 @@ module Network.Protocol.XMPP.XML
 	) where
 
 import           Control.Monad (when)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Text.Lazy as TL
-import           Data.XML.Types as X
+import           Data.ByteString (ByteString)
+import qualified Data.Text
+import           Data.Text (Text)
+import           Data.XML.Types
 import           Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import qualified Text.XML.LibXML.SAX as SAX
 
-getattr :: Name -> Element -> Maybe TL.Text
-getattr n e = fmap TL.fromStrict (X.attributeText n e)
+contentText :: Content -> Text
+contentText (ContentText t) = t
+contentText (ContentEntity e) = Data.Text.concat ["&", e, ";"]
 
-contentText :: Content -> TL.Text
-contentText (ContentText t) = TL.fromStrict t
-contentText (ContentEntity e) = TL.concat ["&", TL.fromStrict e, ";"]
-
-escape :: TL.Text -> TL.Text
-escape = TL.concatMap escapeChar where
+escape :: Text -> Text
+escape = Data.Text.concatMap escapeChar where
 	escapeChar c = case c of
 		'&' -> "&amp;"
 		'<' -> "&lt;"
 		'>' -> "&gt;"
 		'"' -> "&quot;"
 		'\'' -> "&apos;"
-		_ -> TL.singleton c
+		_ -> Data.Text.singleton c
 
-escapeContent :: Content -> TL.Text
-escapeContent (ContentText t) = escape (TL.fromStrict t)
-escapeContent (ContentEntity e) = TL.concat ["&", escape (TL.fromStrict e), ";"]
+escapeContent :: Content -> Text
+escapeContent (ContentText t) = escape t
+escapeContent (ContentEntity e) = Data.Text.concat ["&", escape e, ";"]
 
-element :: Name -> [(Name, TL.Text)] -> [Node] -> Element
+element :: Name -> [(Name, Text)] -> [Node] -> Element
 element name attrs children = Element name attrs' children where
 	attrs' = map (uncurry mkattr) attrs
 
-mkattr :: Name -> TL.Text -> (Name, [Content])
-mkattr n val = (n, [ContentText (TL.toStrict val)])
+mkattr :: Name -> Text -> (Name, [Content])
+mkattr n val = (n, [ContentText val])
 
 -- A somewhat primitive serialisation function
 --
 -- TODO: better namespace / prefix handling
-serialiseElement :: Element -> TL.Text
+serialiseElement :: Element -> Text
 serialiseElement e = text where
-	text = TL.concat ["<", eName, " ", attrs, ">", contents, "</", eName, ">"]
+	text = Data.Text.concat ["<", eName, " ", attrs, ">", contents, "</", eName, ">"]
 	eName = formatName $ elementName e
-	formatName = escape . TL.fromStrict . X.nameLocalName
-	attrs = TL.intercalate " " $ map attr $ elementAttributes e ++ nsattr
-	attr (n, c) = TL.concat $ [formatName n, "=\""] ++ map escapeContent c ++ ["\""]
-	nsattr = case X.nameNamespace $ elementName e of
+	formatName = escape . nameLocalName
+	attrs = Data.Text.intercalate " " $ map attr $ elementAttributes e ++ nsattr
+	attr (n, c) = Data.Text.concat $ [formatName n, "=\""] ++ map escapeContent c ++ ["\""]
+	nsattr = case nameNamespace $ elementName e of
 		Nothing -> []
-		Just ns -> [mkattr "xmlns" (TL.fromStrict ns)]
-	contents = TL.concat $ map serialiseNode $ elementNodes e
+		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 _) = ""
 	serialiseNode (NodeInstruction _) = ""
 
--- lazy wrappers around strict xml-types; avoids having to break the API just
--- to use xml-types 0.3
-nameNamespace :: Name -> Maybe TL.Text
-nameNamespace = fmap TL.fromStrict . X.nameNamespace
-
-nameLocalName :: Name -> TL.Text
-nameLocalName = TL.fromStrict . X.nameLocalName
-
-attributeName :: (Name, [Content]) -> Name
-attributeName = fst
-
-attributeText :: (Name, [Content]) -> TL.Text
-attributeText = TL.concat . map contentText . snd
-
 -- quick-and-dirty imitation of libxml-sax-0.4 API; later, this should
 -- probably be rewritten to use ST and discard the list parsing
-data Parser = Parser (SAX.Parser IO) (IORef (Either TL.Text [SaxEvent]))
+data Parser = Parser (SAX.Parser IO) (IORef (Either Text [SaxEvent]))
 
 newParser :: IO Parser
 newParser = do


@@ 135,17 107,17 @@ newParser = do
 	
 	SAX.setCallback p SAX.parsedBeginElement (\name' attrs -> addEvent $ BeginElement name' attrs)
 	SAX.setCallback p SAX.parsedEndElement (\name' -> addEvent $ EndElement name')
-	SAX.setCallback p SAX.parsedCharacters (\txt -> addEvent $ Characters $ TL.fromStrict txt)
-	SAX.setCallback p SAX.parsedComment (\txt -> addEvent $ Comment $ TL.fromStrict txt)
+	SAX.setCallback p SAX.parsedCharacters (\txt -> addEvent $ Characters txt)
+	SAX.setCallback p SAX.parsedComment (\txt -> addEvent $ Comment txt)
 	SAX.setCallback p SAX.parsedInstruction (\i -> addEvent $ ProcessingInstruction i)
-	SAX.setCallback p SAX.reportError (\err -> writeIORef ref (Left $ TL.fromStrict err) >> return False)
+	SAX.setCallback p SAX.reportError (\err -> writeIORef ref (Left err) >> return False)
 	
 	return $ Parser p ref
 
-parse :: Parser -> BL.ByteString -> Bool -> IO (Either TL.Text [SaxEvent])
+parse :: Parser -> ByteString -> Bool -> IO (Either Text [SaxEvent])
 parse (Parser p ref) bytes finish = do
 	writeIORef ref (Right [])
-	SAX.parseBytes p (B.concat (BL.toChunks bytes))
+	SAX.parseBytes p bytes
 	when finish $ SAX.parseComplete p
 	eitherEvents <- readIORef ref
 	return $ case eitherEvents of


@@ 155,8 127,8 @@ parse (Parser p ref) bytes finish = do
 data SaxEvent
 	= BeginElement Name [(Name, [Content])]
 	| EndElement Name
-	| Characters TL.Text
-	| Comment TL.Text
+	| Characters Text
+	| Comment Text
 	| ProcessingInstruction Instruction
 
 readEvents :: Monad m


@@ 182,7 154,7 @@ readEvents done nextEvents = readEvents' 0 [] where
 			then (True, depth', reverse acc')
 			else step es depth' acc'
 
--- | Convert a list of events to a single 'X.Element'. If the events do not
+-- | Convert a list of events to a single 'Element'. If the events do not
 -- contain at least one valid element, 'Nothing' will be returned instead.
 eventsToElement :: [SaxEvent] -> Maybe Element
 eventsToElement es = case eventsToNodes es >>= isElement of


@@ 216,7 188,7 @@ blockToNodes (begin:rest) = nodes where
 	end = last rest
 	nodes = case (begin, end) of
 		(BeginElement name' attrs, EndElement _) -> [node name' attrs]
-		(Characters t, _) -> [NodeContent (ContentText (TL.toStrict t))]
+		(Characters t, _) -> [NodeContent (ContentText t)]
 		_ -> []
 	
 	node n as = NodeElement $ Element n as $ eventsToNodes $ init rest