~singpolyma/network-protocol-xmpp

ref: d4a781fd2c1e389fc723657f068aa9e11edc3adf network-protocol-xmpp/Network/Protocol/XMPP/Connections.hs -rw-r--r-- 2.1 KiB
d4a781fd — John Millikin Use lazy instead of strict bytestrings. 13 years ago
                                                                                
fbf0f0b1 John Millikin
57a89320 John Millikin
fbf0f0b1 John Millikin
d4a781fd John Millikin
fbf0f0b1 John Millikin
57a89320 John Millikin
fbf0f0b1 John Millikin
d4a781fd John Millikin
9ae38ff6 John Millikin
fbf0f0b1 John Millikin
d0f194da John Millikin
fbf0f0b1 John Millikin
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE OverloadedStrings #-}
module Network.Protocol.XMPP.Connections
	( Server (..)
	, xmlHeader
	, startOfStream
	, qnameStream
	) where
import Network (HostName, PortID)
import qualified Data.ByteString.Lazy as B
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import qualified Text.XML.HXT.DOM.Interface as DOM
import qualified Text.XML.LibXML.SAX as SAX

import Network.Protocol.XMPP.JID (JID, formatJID)
import Network.Protocol.XMPP.XML (qname, convertQName)

data Server = Server
	{ serverJID      :: JID
	, serverHostname :: HostName
	, serverPort     :: PortID
	}

-- 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 ns jid = B.fromChunks [encodeUtf8 header] where
	escape = T.pack . DOM.attrEscapeXml . T.unpack
	attr x = T.concat ["\"", escape x, "\""]
	header = T.concat
		[ "<?xml version='1.0'?>\n"
		, "<stream:stream xmlns=" , attr ns
		, " to=", attr (formatJID jid)
		, " version=\"1.0\""
		, " xmlns:stream=\"http://etherx.jabber.org/streams\">"
		]

startOfStream :: Integer -> SAX.Event -> Bool
startOfStream depth event = case (depth, event) of
	(1, (SAX.BeginElement elemName _)) ->
		qnameStream == convertQName elemName
	_ -> False

qnameStream :: DOM.QName
qnameStream = qname "http://etherx.jabber.org/streams" "stream"