Browse Source
Conflicts: source/Network/Xmpp/Concurrent/Types.hs source/Network/Xmpp/Connection_.hs source/Network/Xmpp/Internal.hs source/Network/Xmpp/Pickle.hs source/Network/Xmpp/Session.hs source/Network/Xmpp/Stream.hs source/Network/Xmpp/Types.hs source/Network/Xmpp/Xep/InbandRegistration.hsmaster
Philipp Balzarek
13 years ago
29 changed files with 1148 additions and 790 deletions
|
After Width: | Height: | Size: 326 KiB |
|
After Width: | Height: | Size: 81 KiB |
@ -1,81 +0,0 @@ |
|||||||
{-# Language NoMonomorphismRestriction #-} |
|
||||||
{-# OPTIONS_HADDOCK hide #-} |
|
||||||
module Data.Conduit.Tls |
|
||||||
( tlsinit |
|
||||||
-- , conduitStdout |
|
||||||
, module TLS |
|
||||||
, module TLSExtra |
|
||||||
) |
|
||||||
where |
|
||||||
|
|
||||||
import Control.Monad |
|
||||||
import Control.Monad (liftM, when) |
|
||||||
import Control.Monad.IO.Class |
|
||||||
|
|
||||||
import Crypto.Random |
|
||||||
|
|
||||||
import qualified Data.ByteString as BS |
|
||||||
import qualified Data.ByteString.Lazy as BL |
|
||||||
import Data.Conduit |
|
||||||
import qualified Data.Conduit.Binary as CB |
|
||||||
import Data.IORef |
|
||||||
|
|
||||||
import Network.TLS as TLS |
|
||||||
import Crypto.Random.API |
|
||||||
import Network.TLS.Extra as TLSExtra |
|
||||||
|
|
||||||
import System.IO (Handle) |
|
||||||
|
|
||||||
client params gen backend = do |
|
||||||
contextNew backend params gen |
|
||||||
|
|
||||||
defaultParams = defaultParamsClient |
|
||||||
|
|
||||||
tlsinit :: (MonadIO m, MonadIO m1) => |
|
||||||
Bool |
|
||||||
-> TLSParams |
|
||||||
-> Backend |
|
||||||
-> m ( Source m1 BS.ByteString |
|
||||||
, Sink BS.ByteString m1 () |
|
||||||
, BS.ByteString -> IO () |
|
||||||
, Int -> m1 BS.ByteString |
|
||||||
, Context |
|
||||||
) |
|
||||||
tlsinit debug tlsParams backend = do |
|
||||||
when debug . liftIO $ putStrLn "TLS with debug mode enabled" |
|
||||||
gen <- liftIO $ getSystemRandomGen -- TODO: Find better random source? |
|
||||||
con <- client tlsParams gen backend |
|
||||||
handshake con |
|
||||||
let src = forever $ do |
|
||||||
dt <- liftIO $ recvData con |
|
||||||
when debug (liftIO $ putStr "in: " >> BS.putStrLn dt) |
|
||||||
yield dt |
|
||||||
let snk = do |
|
||||||
d <- await |
|
||||||
case d of |
|
||||||
Nothing -> return () |
|
||||||
Just x -> do |
|
||||||
sendData con (BL.fromChunks [x]) |
|
||||||
when debug (liftIO $ putStr "out: " >> BS.putStrLn x) |
|
||||||
snk |
|
||||||
read <- liftIO $ mkReadBuffer (recvData con) |
|
||||||
return ( src |
|
||||||
, snk |
|
||||||
, \s -> do |
|
||||||
when debug (liftIO $ BS.putStrLn s) |
|
||||||
sendData con $ BL.fromChunks [s] |
|
||||||
, liftIO . read |
|
||||||
, con |
|
||||||
) |
|
||||||
|
|
||||||
mkReadBuffer :: IO BS.ByteString -> IO (Int -> IO BS.ByteString) |
|
||||||
mkReadBuffer read = do |
|
||||||
buffer <- newIORef BS.empty |
|
||||||
let read' n = do |
|
||||||
nc <- readIORef buffer |
|
||||||
bs <- if BS.null nc then read |
|
||||||
else return nc |
|
||||||
let (result, rest) = BS.splitAt n bs |
|
||||||
writeIORef buffer rest |
|
||||||
return result |
|
||||||
return read' |
|
||||||
@ -1,57 +0,0 @@ |
|||||||
{-# LANGUAGE OverloadedStrings #-} |
|
||||||
|
|
||||||
{-# OPTIONS_HADDOCK hide #-} |
|
||||||
|
|
||||||
module Network.Xmpp.Bind where |
|
||||||
|
|
||||||
import Control.Exception |
|
||||||
|
|
||||||
import Data.Text as Text |
|
||||||
import Data.XML.Pickle |
|
||||||
import Data.XML.Types |
|
||||||
|
|
||||||
import Network.Xmpp.Connection_ |
|
||||||
import Network.Xmpp.Pickle |
|
||||||
import Network.Xmpp.Types |
|
||||||
|
|
||||||
import Control.Monad.State(modify) |
|
||||||
|
|
||||||
import Control.Concurrent.STM.TMVar |
|
||||||
|
|
||||||
import Control.Monad.Error |
|
||||||
|
|
||||||
-- Produces a `bind' element, optionally wrapping a resource. |
|
||||||
bindBody :: Maybe Text -> Element |
|
||||||
bindBody = pickleElem $ |
|
||||||
-- Pickler to produce a |
|
||||||
-- "<bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'/>" |
|
||||||
-- element, with a possible "<resource>[JID]</resource>" |
|
||||||
-- child. |
|
||||||
xpBind . 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 -> TMVar Connection -> IO (Either XmppFailure Jid) |
|
||||||
xmppBind rsrc c = runErrorT $ do |
|
||||||
answer <- ErrorT $ pushIQ' "bind" Nothing Set Nothing (bindBody rsrc) c |
|
||||||
case answer of |
|
||||||
Right IQResult{iqResultPayload = Just b} -> do |
|
||||||
let jid = unpickleElem xpJid b |
|
||||||
case jid of |
|
||||||
Right jid' -> do |
|
||||||
ErrorT $ withConnection (do |
|
||||||
modify $ \s -> s{cJid = Just jid'} |
|
||||||
return $ Right jid') c -- not pretty |
|
||||||
return jid' |
|
||||||
otherwise -> throwError XmppOtherFailure |
|
||||||
-- TODO: Log: ("Bind couldn't unpickle JID from " ++ show answer) |
|
||||||
otherwise -> throwError XmppOtherFailure |
|
||||||
where |
|
||||||
-- Extracts the character data in the `jid' element. |
|
||||||
xpJid :: PU [Node] Jid |
|
||||||
xpJid = xpBind $ xpElemNodes jidName (xpContent xpPrim) |
|
||||||
jidName = "{urn:ietf:params:xml:ns:xmpp-bind}jid" |
|
||||||
|
|
||||||
-- A `bind' element pickler. |
|
||||||
xpBind :: PU [Node] b -> PU [Node] b |
|
||||||
xpBind c = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-bind}bind" c |
|
||||||
@ -1,205 +0,0 @@ |
|||||||
{-# OPTIONS_HADDOCK hide #-} |
|
||||||
|
|
||||||
-- This module deals with JIDs, also known as XMPP addresses. For more |
|
||||||
-- information on JIDs, see RFC 6122: XMPP: Address Format. |
|
||||||
|
|
||||||
module Network.Xmpp.Jid |
|
||||||
( Jid(..) |
|
||||||
, fromText |
|
||||||
, fromStrings |
|
||||||
, isBare |
|
||||||
, isFull |
|
||||||
) where |
|
||||||
|
|
||||||
import Control.Applicative ((<$>),(<|>)) |
|
||||||
import Control.Monad(guard) |
|
||||||
|
|
||||||
import qualified Data.Attoparsec.Text as AP |
|
||||||
import Data.Maybe(fromJust) |
|
||||||
import qualified Data.Set as Set |
|
||||||
import Data.String (IsString(..)) |
|
||||||
import Data.Text (Text) |
|
||||||
import qualified Data.Text as Text |
|
||||||
import qualified Text.NamePrep as SP |
|
||||||
import qualified Text.StringPrep as SP |
|
||||||
|
|
||||||
-- | A JID is XMPP\'s native format for addressing entities in the network. It |
|
||||||
-- is somewhat similar to an e-mail address but contains three parts instead of |
|
||||||
-- two. |
|
||||||
data Jid = Jid { -- | The @localpart@ of a JID is an optional identifier placed |
|
||||||
-- before the domainpart and separated from the latter by a |
|
||||||
-- \'\@\' character. Typically a localpart uniquely identifies |
|
||||||
-- the entity requesting and using network access provided by a |
|
||||||
-- server (i.e., a local account), although it can also |
|
||||||
-- represent other kinds of entities (e.g., a chat room |
|
||||||
-- associated with a multi-user chat service). The entity |
|
||||||
-- represented by an XMPP localpart is addressed within the |
|
||||||
-- context of a specific domain (i.e., |
|
||||||
-- @localpart\@domainpart@). |
|
||||||
localpart :: !(Maybe Text) |
|
||||||
|
|
||||||
-- | The domainpart typically identifies the /home/ server to |
|
||||||
-- which clients connect for XML routing and data management |
|
||||||
-- functionality. However, it is not necessary for an XMPP |
|
||||||
-- domainpart to identify an entity that provides core XMPP |
|
||||||
-- server functionality (e.g., a domainpart can identify an |
|
||||||
-- entity such as a multi-user chat service, a |
|
||||||
-- publish-subscribe service, or a user directory). |
|
||||||
, domainpart :: !Text |
|
||||||
|
|
||||||
-- | The resourcepart of a JID is an optional identifier placed |
|
||||||
-- after the domainpart and separated from the latter by the |
|
||||||
-- \'\/\' character. A resourcepart can modify either a |
|
||||||
-- @localpart\@domainpart@ address or a mere @domainpart@ |
|
||||||
-- address. Typically a resourcepart uniquely identifies a |
|
||||||
-- specific connection (e.g., a device or location) or object |
|
||||||
-- (e.g., an occupant in a multi-user chat room) belonging to |
|
||||||
-- the entity associated with an XMPP localpart at a domain |
|
||||||
-- (i.e., @localpart\@domainpart/resourcepart@). |
|
||||||
, resourcepart :: !(Maybe Text) |
|
||||||
} deriving Eq |
|
||||||
|
|
||||||
instance Show Jid where |
|
||||||
show (Jid nd dmn res) = |
|
||||||
maybe "" ((++ "@") . Text.unpack) nd ++ Text.unpack dmn ++ |
|
||||||
maybe "" (('/' :) . Text.unpack) res |
|
||||||
|
|
||||||
instance Read Jid where |
|
||||||
readsPrec _ x = case fromText (Text.pack x) of |
|
||||||
Nothing -> [] |
|
||||||
Just j -> [(j,"")] |
|
||||||
|
|
||||||
instance IsString Jid where |
|
||||||
fromString = fromJust . fromText . Text.pack |
|
||||||
|
|
||||||
-- | Converts a Text to a JID. |
|
||||||
fromText :: Text -> Maybe Jid |
|
||||||
fromText t = do |
|
||||||
(l, d, r) <- eitherToMaybe $ AP.parseOnly jidParts t |
|
||||||
fromStrings l d r |
|
||||||
where |
|
||||||
eitherToMaybe = either (const Nothing) Just |
|
||||||
|
|
||||||
-- | Converts localpart, domainpart, and resourcepart strings to a JID. Runs the |
|
||||||
-- appropriate stringprep profiles and validates the parts. |
|
||||||
fromStrings :: Maybe Text -> Text -> Maybe Text -> Maybe Jid |
|
||||||
fromStrings l d r = do |
|
||||||
localPart <- case l of |
|
||||||
Nothing -> return Nothing |
|
||||||
Just l'-> do |
|
||||||
l'' <- SP.runStringPrep nodeprepProfile l' |
|
||||||
guard $ validPartLength l'' |
|
||||||
let prohibMap = Set.fromList nodeprepExtraProhibitedCharacters |
|
||||||
guard $ Text.all (`Set.notMember` prohibMap) l'' |
|
||||||
return $ Just l'' |
|
||||||
domainPart <- SP.runStringPrep (SP.namePrepProfile False) d |
|
||||||
guard $ validDomainPart domainPart |
|
||||||
resourcePart <- case r of |
|
||||||
Nothing -> return Nothing |
|
||||||
Just r' -> do |
|
||||||
r'' <- SP.runStringPrep resourceprepProfile r' |
|
||||||
guard $ validPartLength r'' |
|
||||||
return $ Just r'' |
|
||||||
return $ Jid localPart domainPart resourcePart |
|
||||||
where |
|
||||||
validDomainPart :: Text -> Bool |
|
||||||
validDomainPart _s = True -- TODO |
|
||||||
|
|
||||||
validPartLength :: Text -> Bool |
|
||||||
validPartLength p = Text.length p > 0 && Text.length p < 1024 |
|
||||||
|
|
||||||
-- | Returns 'True' if the JID is /bare/, and 'False' otherwise. |
|
||||||
isBare :: Jid -> Bool |
|
||||||
isBare j | resourcepart j == Nothing = True |
|
||||||
| otherwise = False |
|
||||||
|
|
||||||
-- | Returns 'True' if the JID is /full/, and 'False' otherwise. |
|
||||||
isFull :: Jid -> Bool |
|
||||||
isFull = not . isBare |
|
||||||
|
|
||||||
-- Parses an JID string and returns its three parts. It performs no validation |
|
||||||
-- or transformations. |
|
||||||
jidParts :: AP.Parser (Maybe Text, Text, Maybe Text) |
|
||||||
jidParts = do |
|
||||||
-- Read until we reach an '@', a '/', or EOF. |
|
||||||
a <- AP.takeWhile1 (AP.notInClass ['@', '/']) |
|
||||||
-- Case 1: We found an '@', and thus the localpart. At least the domainpart |
|
||||||
-- is remaining. Read the '@' and until a '/' or EOF. |
|
||||||
do |
|
||||||
b <- domainPartP |
|
||||||
-- Case 1A: We found a '/' and thus have all the JID parts. Read the '/' |
|
||||||
-- and until EOF. |
|
||||||
do |
|
||||||
c <- resourcePartP -- Parse resourcepart |
|
||||||
return (Just a, b, Just c) |
|
||||||
-- Case 1B: We have reached EOF; the JID is in the form |
|
||||||
-- localpart@domainpart. |
|
||||||
<|> do |
|
||||||
AP.endOfInput |
|
||||||
return (Just a, b, Nothing) |
|
||||||
-- Case 2: We found a '/'; the JID is in the form |
|
||||||
-- domainpart/resourcepart. |
|
||||||
<|> do |
|
||||||
b <- resourcePartP |
|
||||||
AP.endOfInput |
|
||||||
return (Nothing, a, Just b) |
|
||||||
-- Case 3: We have reached EOF; we have an JID consisting of only a |
|
||||||
-- domainpart. |
|
||||||
<|> do |
|
||||||
AP.endOfInput |
|
||||||
return (Nothing, a, Nothing) |
|
||||||
where |
|
||||||
-- Read an '@' and everything until a '/'. |
|
||||||
domainPartP :: AP.Parser Text |
|
||||||
domainPartP = do |
|
||||||
_ <- AP.char '@' |
|
||||||
AP.takeWhile1 (/= '/') |
|
||||||
-- Read everything until a '/'. |
|
||||||
resourcePartP :: AP.Parser Text |
|
||||||
resourcePartP = do |
|
||||||
_ <- AP.char '/' |
|
||||||
AP.takeText |
|
||||||
|
|
||||||
-- The `nodeprep' StringPrep profile. |
|
||||||
nodeprepProfile :: SP.StringPrepProfile |
|
||||||
nodeprepProfile = SP.Profile { SP.maps = [SP.b1, SP.b2] |
|
||||||
, SP.shouldNormalize = True |
|
||||||
, SP.prohibited = [SP.a1 |
|
||||||
, SP.c11 |
|
||||||
, SP.c12 |
|
||||||
, SP.c21 |
|
||||||
, SP.c22 |
|
||||||
, SP.c3 |
|
||||||
, SP.c4 |
|
||||||
, SP.c5 |
|
||||||
, SP.c6 |
|
||||||
, SP.c7 |
|
||||||
, SP.c8 |
|
||||||
, SP.c9 |
|
||||||
] |
|
||||||
, SP.shouldCheckBidi = True |
|
||||||
} |
|
||||||
|
|
||||||
-- These characters needs to be checked for after normalization. |
|
||||||
nodeprepExtraProhibitedCharacters :: [Char] |
|
||||||
nodeprepExtraProhibitedCharacters = ['\x22', '\x26', '\x27', '\x2F', '\x3A', |
|
||||||
'\x3C', '\x3E', '\x40'] |
|
||||||
|
|
||||||
-- The `resourceprep' StringPrep profile. |
|
||||||
resourceprepProfile :: SP.StringPrepProfile |
|
||||||
resourceprepProfile = SP.Profile { SP.maps = [SP.b1] |
|
||||||
, SP.shouldNormalize = True |
|
||||||
, SP.prohibited = [ SP.a1 |
|
||||||
, SP.c12 |
|
||||||
, SP.c21 |
|
||||||
, SP.c22 |
|
||||||
, SP.c3 |
|
||||||
, SP.c4 |
|
||||||
, SP.c5 |
|
||||||
, SP.c6 |
|
||||||
, SP.c7 |
|
||||||
, SP.c8 |
|
||||||
, SP.c9 |
|
||||||
] |
|
||||||
, SP.shouldCheckBidi = True |
|
||||||
} |
|
||||||
@ -1,36 +0,0 @@ |
|||||||
{-# LANGUAGE RecordWildCards #-} |
|
||||||
{-# OPTIONS_HADDOCK hide #-} |
|
||||||
|
|
||||||
module Network.Xmpp.Message |
|
||||||
( Message(..) |
|
||||||
, MessageError(..) |
|
||||||
, MessageType(..) |
|
||||||
, answerMessage |
|
||||||
, message |
|
||||||
) where |
|
||||||
|
|
||||||
import Data.XML.Types |
|
||||||
|
|
||||||
import Network.Xmpp.Types |
|
||||||
|
|
||||||
-- | An empty message. |
|
||||||
message :: Message |
|
||||||
message = Message { messageID = Nothing |
|
||||||
, messageFrom = Nothing |
|
||||||
, messageTo = Nothing |
|
||||||
, messageLangTag = Nothing |
|
||||||
, messageType = Normal |
|
||||||
, messagePayload = [] |
|
||||||
} |
|
||||||
|
|
||||||
-- Produce an answer message with the given payload, switching the "from" and |
|
||||||
-- "to" attributes in the original message. |
|
||||||
answerMessage :: Message -> [Element] -> Maybe Message |
|
||||||
answerMessage Message{messageFrom = Just frm, ..} payload = |
|
||||||
Just Message{ messageFrom = messageTo |
|
||||||
, messageID = Nothing |
|
||||||
, messageTo = Just frm |
|
||||||
, messagePayload = payload |
|
||||||
, .. |
|
||||||
} |
|
||||||
answerMessage _ _ = Nothing |
|
||||||
@ -1,10 +0,0 @@ |
|||||||
{-# OPTIONS_HADDOCK hide #-} |
|
||||||
|
|
||||||
module Network.Xmpp.Presence where |
|
||||||
|
|
||||||
import Data.Text(Text) |
|
||||||
import Network.Xmpp.Types |
|
||||||
|
|
||||||
-- | Add a recipient to a presence notification. |
|
||||||
presTo :: Presence -> Jid -> Presence |
|
||||||
presTo pres to = pres{presenceTo = Just to} |
|
||||||
@ -1,108 +0,0 @@ |
|||||||
{-# OPTIONS_HADDOCK hide #-} |
|
||||||
{-# LANGUAGE DeriveDataTypeable #-} |
|
||||||
{-# LANGUAGE OverloadedStrings #-} |
|
||||||
module Text.Xml.Stream.Elements where |
|
||||||
|
|
||||||
import Control.Applicative ((<$>)) |
|
||||||
import Control.Exception |
|
||||||
import Control.Monad.Trans.Class |
|
||||||
import Control.Monad.Trans.Resource as R |
|
||||||
|
|
||||||
import qualified Data.ByteString as BS |
|
||||||
import Data.Conduit as C |
|
||||||
import Data.Conduit.List as CL |
|
||||||
import qualified Data.Text as Text |
|
||||||
import qualified Data.Text.Encoding as Text |
|
||||||
import Data.Typeable |
|
||||||
import Data.XML.Types |
|
||||||
|
|
||||||
import System.IO.Unsafe(unsafePerformIO) |
|
||||||
|
|
||||||
import qualified Text.XML.Stream.Render as TXSR |
|
||||||
import Text.XML.Unresolved as TXU |
|
||||||
|
|
||||||
compressNodes :: [Node] -> [Node] |
|
||||||
compressNodes [] = [] |
|
||||||
compressNodes [x] = [x] |
|
||||||
compressNodes (NodeContent (ContentText x) : NodeContent (ContentText y) : z) = |
|
||||||
compressNodes $ NodeContent (ContentText $ x `Text.append` y) : z |
|
||||||
compressNodes (x:xs) = x : compressNodes xs |
|
||||||
|
|
||||||
streamName :: Name |
|
||||||
streamName = |
|
||||||
(Name "stream" (Just "http://etherx.jabber.org/streams") (Just "stream")) |
|
||||||
|
|
||||||
data StreamEnd = StreamEnd deriving (Typeable, Show) |
|
||||||
instance Exception StreamEnd |
|
||||||
|
|
||||||
data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable) |
|
||||||
|
|
||||||
instance Exception InvalidXmppXml |
|
||||||
|
|
||||||
parseElement txt = documentRoot $ TXU.parseText_ TXU.def txt |
|
||||||
|
|
||||||
elements :: R.MonadThrow m => C.Conduit Event m Element |
|
||||||
elements = do |
|
||||||
x <- C.await |
|
||||||
case x of |
|
||||||
Just (EventBeginElement n as) -> do |
|
||||||
goE n as >>= C.yield |
|
||||||
elements |
|
||||||
Just (EventEndElement streamName) -> lift $ R.monadThrow StreamEnd |
|
||||||
Nothing -> return () |
|
||||||
_ -> lift $ R.monadThrow $ InvalidXmppXml $ "not an element: " ++ show x |
|
||||||
where |
|
||||||
many' f = |
|
||||||
go id |
|
||||||
where |
|
||||||
go front = do |
|
||||||
x <- f |
|
||||||
case x of |
|
||||||
Left x -> return $ (x, front []) |
|
||||||
Right y -> go (front . (:) y) |
|
||||||
goE n as = do |
|
||||||
(y, ns) <- many' goN |
|
||||||
if y == Just (EventEndElement n) |
|
||||||
then return $ Element n as $ compressNodes ns |
|
||||||
else lift $ R.monadThrow $ InvalidXmppXml $ |
|
||||||
"Missing close tag: " ++ show n |
|
||||||
goN = do |
|
||||||
x <- await |
|
||||||
case x of |
|
||||||
Just (EventBeginElement n as) -> (Right . NodeElement) <$> goE n as |
|
||||||
Just (EventInstruction i) -> return $ Right $ NodeInstruction i |
|
||||||
Just (EventContent c) -> return $ Right $ NodeContent c |
|
||||||
Just (EventComment t) -> return $ Right $ NodeComment t |
|
||||||
Just (EventCDATA t) -> return $ Right $ NodeContent $ ContentText t |
|
||||||
_ -> return $ Left x |
|
||||||
|
|
||||||
|
|
||||||
openElementToEvents :: Element -> [Event] |
|
||||||
openElementToEvents (Element name as ns) = EventBeginElement name as : goN ns [] |
|
||||||
where |
|
||||||
goE (Element name' as' ns') = |
|
||||||
(EventBeginElement name' as' :) |
|
||||||
. goN ns' |
|
||||||
. (EventEndElement name' :) |
|
||||||
goN [] = id |
|
||||||
goN [x] = goN' x |
|
||||||
goN (x:xs) = goN' x . goN xs |
|
||||||
goN' (NodeElement e) = goE e |
|
||||||
goN' (NodeInstruction i) = (EventInstruction i :) |
|
||||||
goN' (NodeContent c) = (EventContent c :) |
|
||||||
goN' (NodeComment t) = (EventComment t :) |
|
||||||
|
|
||||||
elementToEvents :: Element -> [Event] |
|
||||||
elementToEvents e@(Element name _ _) = openElementToEvents e ++ [EventEndElement name] |
|
||||||
|
|
||||||
|
|
||||||
renderOpenElement :: Element -> BS.ByteString |
|
||||||
renderOpenElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO |
|
||||||
$ CL.sourceList (openElementToEvents e) $$ TXSR.renderText def =$ CL.consume |
|
||||||
|
|
||||||
renderElement :: Element -> BS.ByteString |
|
||||||
renderElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO |
|
||||||
$ CL.sourceList (elementToEvents e) $$ TXSR.renderText def =$ CL.consume |
|
||||||
|
|
||||||
ppElement :: Element -> String |
|
||||||
ppElement = Text.unpack . Text.decodeUtf8 . renderElement |
|
||||||
Loading…
Reference in new issue