~singpolyma/network-protocol-xmpp

ref: 179ec1609d4e67eb10678e77aa8bd07b4406578c network-protocol-xmpp/Network/Protocol/XMPP/JID.hs -rw-r--r-- 3.0 KiB
179ec160 — John Millikin Add functions for retrieving parts of a JID as strings. 14 years ago
                                                                                
e17933b3 John Millikin
8f95c73e John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
f5a270b3 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e677ead5 John Millikin
179ec160 John Millikin
e677ead5 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
179ec160 John Millikin
e17933b3 John Millikin
2f2cd141 John Millikin
e17933b3 John Millikin
2f2cd141 John Millikin
e17933b3 John Millikin
2f2cd141 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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
{- Copyright (C) 2009 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.JID (
	 JID(..)
	,JIDNode
	,JIDDomain
	,JIDResource
	
	,jidNodeStr
	,jidDomainStr
	,jidResourceStr
	
	,mkJIDNode
	,mkJIDDomain
	,mkJIDResource
	,mkJID
	
	,jidNode
	,jidDomain
	,jidResource
	
	,jidParse
	,jidFormat
	) where

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

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

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

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

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

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

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

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

mkJID :: String -> String -> String -> Maybe JID
mkJID nodeStr domainStr resourceStr = let
	node = mkJIDNode nodeStr
	resource = mkJIDResource resourceStr
	in do
		domain <- mkJIDDomain domainStr
		Just (JID node domain resource)

jidNode :: JID -> String
jidNode (JID x _ _) = maybe "" jidNodeStr x

jidDomain :: JID -> String
jidDomain (JID _ x _) = jidDomainStr x

jidResource :: JID -> String
jidResource (JID _ _ x) = maybe "" jidResourceStr x

-- TODO: validate input according to RFC 3920, section 3.1
jidParse :: String -> Maybe JID
jidParse s = let
	(nodeStr, postNode) = if '@' `elem` s then split s '@' else ("", s)
	(domainStr, resourceStr) = if '/' `elem` postNode then split postNode '/' else (postNode, "")
	in mkJID nodeStr domainStr resourceStr

jidFormat :: JID -> String
jidFormat (JID node (JIDDomain domain) resource) = let
	nodeStr = maybe "" (\(JIDNode s) -> s ++ "@") node
	resourceStr = maybe "" (\(JIDResource s) -> "/" ++ s) resource
	in concat [nodeStr, domain, resourceStr]

split :: (Eq a) => [a] -> a -> ([a], [a])
split xs final = let
	(before, rawAfter) = span (/= final) xs
	after = safeTail rawAfter
	in (before, after)

safeTail :: [a] -> [a]
safeTail [] = []
safeTail (_:xs) = xs