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
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module XMPPTypes where
import Network.Socket (Socket,SockAddr(..))
import System.IO (Handle)
import Control.Concurrent.STM (TChan)
import Data.ByteString.Lazy.Char8 as L (ByteString,unpack,pack)
import Text.Show.ByteString as L
import Data.Binary.Builder as B
import Data.Binary.Put
import Control.DeepSeq
import ByteStringOperators
class XMPPSession session where
data XMPPClass session
newSession :: XMPPClass session -> Socket -> Handle -> IO session
setResource :: session -> ByteString -> IO ()
getJID :: session -> IO JID
closeSession :: session -> IO ()
subscribe :: session -> Maybe JID -> IO (TChan Presence)
announcePresence :: session -> Presence -> IO ()
class XMPPConfig config where
getBuddies :: config -> ByteString -> IO [ByteString]
getSubscribers :: config -> ByteString -> IO [ByteString]
-- | Jabber ID (JID) datatype
data JID = JID { name :: Maybe ByteString
, peer :: Peer
, resource :: Maybe ByteString
}
deriving (Eq,Ord)
data JabberShow = Offline
| Away
| Available
deriving (Prelude.Show,Enum,Ord,Eq,Read)
data Presence = Presence JID JabberShow
deriving Prelude.Show
data Peer = LocalHost | RemotePeer SockAddr
deriving (Eq,Prelude.Show)
instance Ord Peer where
LocalHost <= _
= True
RemotePeer (SockAddrUnix a) <= RemotePeer (SockAddrUnix b)
= a <= b
RemotePeer (SockAddrUnix _) <= _
= True
RemotePeer (SockAddrInet aport a) <= RemotePeer (SockAddrInet bport b)
= (a,aport) <= (b,bport)
RemotePeer (SockAddrInet aport a) <= _
= True
RemotePeer (SockAddrInet6 aport aflow a ascope) <= RemotePeer (SockAddrInet6 bport bflow b bscope)
= (a,aport,ascope,aflow) <= (b,bport,bscope,bflow)
a <= b = False
instance L.Show JID where
showp (JID n s r ) = putBuilder . B.fromLazyByteString $ n <$++> "@" <?++> showPeer s <++?> "/" <++$> r
instance Prelude.Show JID where
show jid = L.unpack $ L.show jid
instance NFData JID where
rnf v@(JID n s r) = n `seq` s `seq` r `seq` ()
jid user host rsrc = JID (Just user) host (Just rsrc)
showPeer :: Peer -> ByteString
showPeer LocalHost = "localhost"
showPeer (RemotePeer addr@(SockAddrInet _ _)) = pack $ stripColon (Prelude.show addr)
where stripColon s = pre where (pre,port) = break (==':') s
showPeer (RemotePeer addr@(SockAddrInet6 _ _ _ _)) = pack $ stripColon (Prelude.show addr)
where stripColon s = if null bracket then pre else pre ++ "]"
where
(pre,bracket) = break (==']') s
|
