Started conduits-based XMPP module (will replace XMPPServer)

1 files changed, 84 insertions, 0 deletions

diff --git a/Presence/XMPPTypes.hs b/Presence/XMPPTypes.hs
new file mode 100644
index 00000000..eb5d349e
--- /dev/null
+++ b/Presence/XMPPTypes.hs
@@ -0,0 +1,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
+
+