~singpolyma/network-protocol-xmpp

ref: 3f30f380adb4c6eedf3c919590359c9746f5d8b3 network-protocol-xmpp/lib/Network/Protocol/XMPP/Client/Features.hs -rw-r--r-- 2.4 KiB
3f30f380Stephen Paul Weber Call TLS.getBytes again on EAGAIN 2 years ago
                                                                                
6ac34f1c John Millikin
915f7dba John Millikin
bd216cc4 John Millikin
915f7dba John Millikin
6ac34f1c John Millikin
1eb63b40 John Millikin
fa4477d2 John Millikin
915f7dba John Millikin
1eb63b40 John Millikin
915f7dba John Millikin
fa4477d2 John Millikin
915f7dba John Millikin
fa4477d2 John Millikin
32f143cc John Millikin
915f7dba John Millikin
fa4477d2 John Millikin
fa4477d2 John Millikin
915f7dba John Millikin
fa4477d2 John Millikin
915f7dba John Millikin
fa4477d2 John Millikin
915f7dba John Millikin
fa4477d2 John Millikin
fa4477d2 John Millikin
43e263d7 John Millikin
fa4477d2 John Millikin
43693c9c John Millikin
915f7dba John Millikin
fa4477d2 John Millikin
915f7dba John Millikin
fa4477d2 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
62
63
64
65
66
67
68
69
70
-- Copyright (C) 2010-2011 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/>.

module Network.Protocol.XMPP.Client.Features
	( Feature (..)
	, parseFeatures
	, parseFeature
	) where

import           Control.Arrow ((&&&))
import qualified Data.ByteString.Char8
import           Data.ByteString (ByteString)
import qualified Data.Text
import qualified Network.Protocol.XMPP.XML as X
import           Network.Protocol.XMPP.String (s)

data Feature =
	  FeatureStartTLS Bool
	| FeatureSASL [ByteString]
	| FeatureRegister
	| FeatureBind
	| FeatureSession
	| FeatureUnknown X.Element
	deriving (Show, Eq)

parseFeatures :: X.Element -> [Feature]
parseFeatures e =
	parseFeature <$>
	(X.isNamed nameFeatures e >>= X.elementChildren)

parseFeature :: X.Element -> Feature
parseFeature elemt = feature where
	unpackName = (maybe "" Data.Text.unpack . X.nameNamespace) &&&
		(Data.Text.unpack . X.nameLocalName)
	feature = case unpackName (X.elementName elemt) of
		("urn:ietf:params:xml:ns:xmpp-tls", "starttls") -> parseFeatureTLS elemt
		("urn:ietf:params:xml:ns:xmpp-sasl", "mechanisms") -> parseFeatureSASL elemt
		("http://jabber.org/features/iq-register", "register") -> FeatureRegister
		("urn:ietf:params:xml:ns:xmpp-bind", "bind") -> FeatureBind
		("urn:ietf:params:xml:ns:xmpp-session", "session") -> FeatureSession
		_ -> FeatureUnknown elemt

parseFeatureTLS :: X.Element -> Feature
parseFeatureTLS _ = FeatureStartTLS True -- TODO: detect whether or not required

parseFeatureSASL :: X.Element -> Feature
parseFeatureSASL e = FeatureSASL $
	fmap (Data.ByteString.Char8.pack . Data.Text.unpack . X.contentText) $
	X.elementChildren e
	>>= X.isNamed nameMechanism
	>>= X.elementNodes
	>>= X.isContent

nameMechanism :: X.Name
nameMechanism = s"{urn:ietf:params:xml:ns:xmpp-sasl}mechanism"

nameFeatures :: X.Name
nameFeatures = s"{http://etherx.jabber.org/streams}features"