{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE TypeFamilies        #-}
module XMPPTypes where

import Network.Socket 
    ( Socket
    , Family(..)
    , SockAddr(..)
    , getAddrInfo
    , addrCanonName
    , addrAddress
    , defaultHints
    , AddrInfo(..)
    , AddrInfoFlag(..)
    )
import Network.BSD (getHostName)
import System.IO (Handle)
import Control.Concurrent.STM (TChan)
import Data.ByteString.Lazy.Char8 as L  
    ( ByteString
    , unpack
    , pack 
    , splitWith
    , uncons
    , takeWhile
    )
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

is_remote (RemotePeer _) = True
is_remote _              = False

parseHostNameJID :: ByteString -> IO JID
parseHostNameJID jid = do
    let (name,peer_string,rsc) = splitJID jid
        hints = Just $ defaultHints { addrFlags = [ AI_CANONNAME ] }
    peer <- do
        if peer_string=="localhost"
          then return LocalHost
          else do
            -- putStrLn $ "getAddrInfo 3 " ++ Prelude.show ( Just (unpack peer_string))
            info <- getAddrInfo hints (Just (unpack peer_string)) Nothing -- (Just "xmpp-server")
            let info0 = head info
                cname = addrCanonName info0
            if cname==Just "localhost"
              then return LocalHost
              else do
                self <- getHostName
                return $ if Just self==cname
                          then LocalHost 
                          else RemotePeer (addrAddress info0)
    return $ JID name peer rsc

splitJID :: ByteString -> (Maybe ByteString,ByteString,Maybe ByteString)
splitJID bjid = 
    let xs = L.splitWith (=='@') bjid
        ys = L.splitWith (=='/') (last xs)
        server = head ys
        name
            = case xs of
                (n:s:_) -> Just n
                (s:_)   -> Nothing
        rsrc = case ys of
                (s:_:_) -> Just $ last ys
                _       -> Nothing
    in (name,server,rsrc)

strip_brackets s = 
    case L.uncons s of
      Just ('[',t) -> L.takeWhile (/=']') t
      _            -> s


parseAddressJID :: ByteString -> IO JID
parseAddressJID jid = do
    let (name,peer_string,rsc) = splitJID jid
        hints = Just $ defaultHints { addrFlags = [ {- AI_NUMERICHOST, -} AI_CANONNAME ] }
        peer_string' = unpack . strip_brackets $ peer_string
    peer <- do
        -- putStrLn $ "getAddrInfo 2 " ++ Prelude.show ( Just (unpack peer_string))
        info <- getAddrInfo hints (Just peer_string') Nothing -- (Just "xmpp-server")
        let info0 = head info
        return . RemotePeer . addrAddress $ info0
    return $ JID name peer rsc

peerAddr :: Peer -> SockAddr
peerAddr (RemotePeer addr) = addr
-- peerAddr LocalHost = throw exception

socketFamily (SockAddrInet _ _)      = AF_INET
socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6
socketFamily (SockAddrUnix _)        = AF_UNIX