~singpolyma/network-protocol-xmpp

ref: 8eb2c5a3e68616f93ac4249c1136079162c77f45 network-protocol-xmpp/Network/Protocol/XMPP.hs -rw-r--r-- 2.3 KiB
8eb2c5a3 — John Millikin Initial import 14 years ago 
                                                                                
8eb2c5a3 John Millikin 


























































































14 years ago


























































































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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

module Network.Protocol.XMPP (
	 JID
	,JIDNode
	,JIDDomain
	,JIDResource
	
	,jidNodeBuild
	,jidNodeValue
	,jidDomainBuild
	,jidDomainValue
	,jidResourceBuild
	,jidResourceValue
	,jidBuild
	
	,jidParse
	,jidFormat
	
	) where

-------------------------------------------------------------------------------

data JID = JID (Maybe JIDNode) JIDDomain (Maybe JIDResource)
	deriving (Eq)

instance Show JID where
	show = jidFormat

newtype JIDNode = JIDNode String
	deriving (Eq, Show)
	
newtype JIDDomain = JIDDomain String
	deriving (Eq, Show)
	
newtype JIDResource = JIDResource String
	deriving (Eq, Show)

jidNodeBuild :: String -> Maybe JIDNode
jidNodeBuild "" = Nothing
jidNodeBuild s = Just (JIDNode s) -- TODO: stringprep, validation

jidNodeValue :: JIDNode -> String
jidNodeValue (JIDNode s) = s

jidDomainBuild :: String -> Maybe JIDDomain
jidDomainBuild "" = Nothing
jidDomainBuild s = Just (JIDDomain s) -- TODO: stringprep, validation

jidDomainValue :: JIDDomain -> String
jidDomainValue (JIDDomain s) = s

jidResourceBuild :: String -> Maybe JIDResource
jidResourceBuild "" = Nothing
jidResourceBuild s = Just (JIDResource s) -- TODO: stringprep, validation

jidResourceValue :: JIDResource -> String
jidResourceValue (JIDResource s) = s

jidBuild :: String -> String -> String -> Maybe JID
jidBuild nodeStr domainStr resourceStr = case (jidDomainBuild domainStr) of
	Nothing -> Nothing
	(Just domain) -> Just (JID node domain resource)
	where
		node = jidNodeBuild nodeStr
		resource = jidResourceBuild resourceStr

-- TODO: validate input according to RFC 3920, section 3.1
jidParse :: String -> Maybe JID
jidParse s = jidBuild nodeStr domainStr resourceStr
	where
		(nodeStr, postNode) = if '@' `elem` s then split s '@' else ("", s)
		(domainStr, resourceStr) = if '/' `elem` postNode then split postNode '/' else (postNode, "")
		
jidFormat :: JID -> String
jidFormat (JID node (JIDDomain domain) resource) = concat [nodeStr, domain, resourceStr]
	where
		nodeStr = case node of
			Nothing -> ""
			Just (JIDNode s) -> s ++ "@"
		resourceStr = case resource of
			Nothing -> ""
			Just (JIDResource s) -> "/" ++ s

-------------------------------------------------------------------------------

split xs final = (before, after)
	where
		(before, rawAfter) = span (/= final) xs
		after = case rawAfter of
			[] -> []
			xs -> tail xs