{-# 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
import SocketLike

class XMPPSession session where
    data XMPPClass session
    newSession   :: SocketLike sock => XMPPClass session -> sock -> 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