{-

Copyright © 2010-2011 Jon Kristensen.

This file is part of Pontarius XMPP.

Pontarius XMPP is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.

Pontarius XMPP 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 Lesser General Public License for more
details.

You should have received a copy of the GNU Lesser General Public License along
with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.

-}

-- TODO: Better functions and events for stanzas, IncomingIQ, OutgoingIQ, etc. (ClientSession, ClientStanza)

-- TODO: IO function to do everything related to the handle, instead of just connecting.

-- TODO: Enumerate in the same thread? Enumerate one element at the time, non-blocking?

-- I believe we need to use the MultiParamTypeClasses extension to be able to
-- work with arbitrary client states (solving the problem that the ClientState
-- type class is solving). However, I would be happy if someone proved me wrong.

{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module:      $Header$
-- Description: XMPP client session management module
-- Copyright:   Copyright © 2010-2011 Jon Kristensen
-- License:     LGPL-3
--
-- Maintainer:  info@pontarius.org
-- Stability:   unstable
-- Portability: portable
--
-- This module provides the functions used by XMPP clients to manage their XMPP
-- sessions.
--
-- Working with Pontarius XMPP is mostly done asynchronously with callbacks;
-- Pontarius XMPP "owns" the XMPP thread and carries the client state with it. A
-- client consists of a list of client handlers to handle XMPP events. This is
-- all set up through a @Session@ object, which a client can create by calling
-- the (blocking) function @createSession@.
--
-- The Pontarius XMPP functions operate in an arbitrary MonadIO monad.
-- Typically, clients will use the IO monad.
--
-- For more information, see the Pontarius XMPP Manual.

module Network.XMPP.Session ( ClientHandler (..)
                            , ClientState (..)
                            , ConnectResult (..)
                            , Session
                            , TerminationReason
                            , OpenStreamResult (..)
                            , SecureWithTLSResult (..)
                            , AuthenticateResult (..)
                            , sendPresence
                            , sendIQ
                            , sendMessage
                            , connect
                            , openStream
                            , secureWithTLS
                            , authenticate
                            , session
                            , injectAction
                            , getID ) where

import Network.XMPP.Address
import Network.XMPP.SASL
import Network.XMPP.Stanza
import Network.XMPP.Stream
import Network.XMPP.TLS
import Network.XMPP.Types
import Network.XMPP.Utilities

import qualified Control.Exception as CE
import qualified Control.Exception.Base as CEB -- ?
import qualified Control.Monad.Error as CME
import qualified Control.Monad.State as CMS
import qualified Network as N

-------------

import Control.Concurrent.MVar

import Codec.Binary.UTF8.String
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.State hiding (State)
import Data.Enumerator (($$), Iteratee, continue, joinI,
                        run, run_, yield)
import Data.Enumerator.Binary (enumHandle, enumFile)
import Data.Maybe
import Data.String
import Data.XML.Types
import GHC.IO.Handle (Handle, hPutStr, hFlush, hSetBuffering, hWaitForInput)
import Network.TLS
import Network.TLS.Cipher
import System.IO (BufferMode, BufferMode(NoBuffering))
import Text.XML.Enumerator.Parse (parseBytes, decodeEntities)
import Text.XML.Enumerator.Document (fromEvents)
import qualified Codec.Binary.Base64.String as CBBS
import qualified Data.ByteString as DB
import qualified Data.ByteString.Lazy as DBL (ByteString, append, pack, fromChunks, toChunks, null)
import qualified Data.ByteString.Lazy.Char8 as DBLC (append, pack, unpack)
import qualified Data.Enumerator as E
import qualified Data.Enumerator.List as EL
import qualified Data.List as DL
import qualified Data.Text as DT
import qualified Data.Text.Lazy as DTL



-- =============================================================================
--  EXPORTED TYPES AND FUNCTIONS
-- =============================================================================


-- | The @Session@ object is used by clients when interacting with Pontarius
--   XMPP. It holds information needed by Pontarius XMPP; its content is not
--   accessible from the client.

data Session s m = Session { sessionChannel :: Chan (InternalEvent s m)
                           , sessionIDGenerator :: IDGenerator }


-- | A client typically needs one or more @ClientHandler@ objects to interact
--   with Pontarius XMPP. Each client handler may provide four callback
--   functions; the first three callbacks deals with received stanzas, and the
--   last one is used when the session is terminated.
--
--   These stanza functions takes the current client state and an object
--   containing the details of the stanza in question. The boolean returned
--   along with the possibly updated state signals whether or not the message
--   should be blocked to client handlerss further down the stack. For example,
--   an XEP-0030: Service Discovery handler may choose to hide disco\#info
--   requests to handlers above it in the stack.
--
--   The 'sessionTerminated' callback function takes a 'TerminationReason' value
--   along with the state and will be sent to all client handlers.

data MonadIO m => ClientHandler s m =
  ClientHandler { messageReceived :: Maybe (Message -> StateT s m Bool)
                , presenceReceived :: Maybe (Presence -> StateT s m Bool)
                , iqReceived :: Maybe (IQ -> StateT s m Bool)
                , sessionTerminated :: Maybe (TerminationReason ->
                                              StateT s m ()) }


-- | @TerminationReason@ contains information on why the XMPP session was
--   terminated.

data TerminationReason = WhateverReason -- TODO


-- | Creates an XMPP session. Blocks the current thread. The first parameter,
--   @s@, is an arbitrary state that is defined by the client. This is the
--   initial state, and it will be passed to the client (handlers) as XMPP
--   events are emitted. The second parameter is the list of @ClientHandler@s;
--   this is a way to provide a "layered" system of XMPP event handlers. For
--   example, a client may have a dedicated handler to manage messages,
--   implement a spam protection system, etc. Messages are piped through these
--   handlers one by one, and any handler may block the message from being sent
--   to the next handler(s) above in the stack. The third argument is a callback
--   function that will be called when the session has been initialized, and
--   this function should be used by the client to store the Session object in
--   its state.

-- Creates the internal event channel, injects the Pontarius XMPP session object
-- into the ClientState object, runs the "session created" client callback (in
-- the new state context), and stores the updated client state in s''. Finally,
-- we launch the (main) state loop of Pontarius XMPP.

session :: (MonadIO m, ClientState s m) => s -> [ClientHandler s m] ->
           (CMS.StateT s m ()) -> m ()

session s h c = do
  threadID <- liftIO $ newEmptyMVar
  chan <- liftIO $ newChan
  idGenerator <- liftIO $ idGenerator "" -- TODO: Prefix
  ((), clientState) <- runStateT c (putSession s $ session_ chan idGenerator)
  (result, _) <- runStateT (stateLoop chan)
                 (defaultState chan threadID h clientState idGenerator)
  case result of
    Just (CE.SomeException e) -> do
      liftIO $ putStrLn "Got an exception!"
      threadID' <- liftIO $ tryTakeMVar threadID
      case threadID' of
        Nothing -> do
          liftIO $ putStrLn "No thread ID to kill"
        Just t -> do
          liftIO $ putStrLn "Killing thread"
          liftIO $ killThread t
      CE.throw e
    Nothing ->
      return ()
  where
    -- session :: Chan (InternalEvent m s) -> Session m s -- TODO
    session_ c i = Session { sessionChannel = c, sessionIDGenerator = i }


defaultState :: (MonadIO m, ClientState s m) => Chan (InternalEvent s m) -> MVar ThreadId ->
                [ClientHandler s m] -> s -> IDGenerator -> State s m

defaultState c t h s i = State { stateClientHandlers = h
                               , stateClientState = s
                               , stateChannel = c
                               , stateConnectionState = Disconnected
                               , stateStreamState = PreStream
                               , stateTLSState = NoTLS
                               , stateOpenStreamCallback = Nothing
                               , stateSecureWithTLSCallback = Nothing
                               , stateAuthenticateCallback = Nothing
                               , stateAuthenticationState = NoAuthentication
                               , stateResource = Nothing
                               , stateShouldExit = False
                               , stateThreadID = t
                               , statePresenceCallbacks = []
                               , stateMessageCallbacks = []
                               , stateIQCallbacks = []
                               , stateTimeoutStanzaIDs = []
                               , stateIDGenerator = i } -- TODO: Prefix


connect :: MonadIO m => Session s m -> HostName -> PortNumber ->
           Maybe (Certificate, (Certificate -> Bool)) ->
           Maybe (UserName, Password, Maybe Resource) ->
           (ConnectResult -> StateT s m ()) -> StateT s m ()

connect s h p t a c = openStream s h p connect'
  where
    connect' r = case r of
      OpenStreamSuccess _ _ -> case t of -- TODO: Check for TLS support?
        Just (certificate, certificateValidator) ->
          secureWithTLS s certificate certificateValidator connect''
        Nothing -> connect'' (SecureWithTLSSuccess 1.0 "") -- TODO
      OpenStreamFailure -> c ConnectOpenStreamFailure
    connect'' r = case r of
      SecureWithTLSSuccess _ _ -> case a of
        Just (userName, password, resource) ->
          authenticate s userName password resource connect'''
        Nothing -> connect''' (AuthenticateSuccess 1.0 "" "todo") -- TODO
      SecureWithTLSFailure -> c ConnectSecureWithTLSFailure
    connect''' r = case r of
      AuthenticateSuccess streamProperties streamFeatures resource ->
        c (ConnectSuccess streamProperties streamFeatures (Just resource))
      AuthenticateFailure -> c ConnectAuthenticateFailure


openStream :: MonadIO m => Session s m -> HostName -> PortNumber ->
              (OpenStreamResult -> StateT s m ()) -> StateT s m ()

openStream s h p c = CMS.get >>=
                     (\ state -> lift $ liftIO $ writeChan (sessionChannel s)
                                 (IEC (CEOpenStream h p c)))


secureWithTLS :: MonadIO m => Session s m -> Certificate ->
                 (Certificate -> Bool) ->
                 (SecureWithTLSResult -> StateT s m ()) -> StateT s m ()

secureWithTLS s c a c_ = CMS.get >>=
                         (\ state -> lift $ liftIO $
                                     writeChan (sessionChannel s)
                                     (IEC (CESecureWithTLS c a c_)))


-- |

authenticate :: MonadIO m => Session s m -> UserName -> Password ->
                Maybe Resource -> (AuthenticateResult -> StateT s m ()) ->
                StateT s m ()

authenticate s u p r c = CMS.get >>=
                         (\ state -> lift $ liftIO $
                                     writeChan (sessionChannel s)
                                     (IEC (CEAuthenticate u p r c)))


sendMessage :: MonadIO m => Session s m -> Message -> Maybe (Message -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m ()
sendMessage se m c t st = CMS.get >>=
                  (\ state -> lift $ liftIO $
                              writeChan (sessionChannel se)
                              (IEC (CEMessage m c t st)))

sendPresence :: MonadIO m => Session s m -> Presence -> Maybe (Presence -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m ()
sendPresence se p c t st = CMS.get >>=
                   (\ state -> lift $ liftIO $
                               writeChan (sessionChannel se)
                               (IEC (CEPresence p c t st)))

sendIQ :: MonadIO m => Session s m -> IQ -> Maybe (IQ -> StateT s m Bool) -> Maybe (Timeout, StateT s m ()) -> Maybe (StreamError -> StateT s m ()) -> StateT s m ()
sendIQ se i c t st = CMS.get >>=
               (\ state -> lift $ liftIO $
                           writeChan (sessionChannel se)
                           (IEC (CEIQ i c t st)))

injectAction :: MonadIO m => Session s m -> Maybe (StateT s m Bool) -> StateT s m () -> StateT s m ()
injectAction s p a = CMS.get >>=
               (\ state -> lift $ liftIO $
                           writeChan (sessionChannel s)
                           (IEC (CEAction p a)))

getID :: MonadIO m => Session s m -> StateT s m String
getID s = CMS.get >>= \ state -> lift $ liftIO $ nextID (sessionIDGenerator s) >>= \ id -> return id

-- xmppDisconnect :: MonadIO m => Session s m -> Maybe (s -> (Bool, s)) -> m ()
-- xmppDisconnect s c = xmppDisconnect s c

class ClientState s m where
  putSession :: s -> Session s m -> s


-- =============================================================================
--  INTERNAL TYPES AND FUNCTIONS
-- =============================================================================


type OpenStreamCallback s m = Maybe (OpenStreamResult -> CMS.StateT s m ())

type SecureWithTLSCallback s m = Maybe (SecureWithTLSResult -> CMS.StateT s m ())

type AuthenticateCallback s m = Maybe (AuthenticateResult -> CMS.StateT s m ())


isConnected :: ConnectionState -> Bool
isConnected Disconnected = True
isConnected (Connected _ _) = True

data MonadIO m => State s m =
  State { stateClientHandlers :: [ClientHandler s m]
        , stateClientState :: s
        , stateChannel :: Chan (InternalEvent s m)
        , stateConnectionState :: ConnectionState -- s m
        , stateTLSState :: TLSState
        , stateStreamState :: StreamState
        , stateOpenStreamCallback :: OpenStreamCallback s m
        , stateSecureWithTLSCallback :: SecureWithTLSCallback s m
        , stateAuthenticateCallback :: AuthenticateCallback s m
        , stateAuthenticationState :: AuthenticationState
        , stateResource :: Maybe Resource
        , stateShouldExit :: Bool
        , stateThreadID :: MVar ThreadId
        , statePresenceCallbacks :: [(StanzaID, (Presence -> StateT s m Bool))]
        , stateMessageCallbacks :: [(StanzaID, (Message -> StateT s m Bool))]
        , stateIQCallbacks :: [(StanzaID, (IQ -> StateT s m Bool))]
        , stateTimeoutStanzaIDs :: [StanzaID]
        , stateIDGenerator :: IDGenerator
        }


-- Repeatedly reads internal events from the channel and processes them. This is
-- the main loop of the XMPP session process.

-- The main loop of the XMPP library runs in the following monads:
--
-- m, m => MonadIO (from the client)
-- StateT
-- ErrorT

-- TODO: Will >> carry the updated state?
-- TODO: Should InternalState be in both places?

stateLoop :: (MonadIO m, ClientState s m) => Chan (InternalEvent s m) ->
             StateT (State s m) m (Maybe CE.SomeException)

stateLoop c = do
  event <- lift $ liftIO $ readChan c
  lift $ liftIO $ putStrLn $ "Processing event " ++ (show event) ++ "."
  result <- (processEvent event)
  state <- get
  case result of
    Nothing -> do
      case stateShouldExit state of
        True ->
          return $ Nothing
        False ->
          stateLoop c
    Just e ->
      return $ Just e


-- Process an InternalEvent and performs the necessary IO and updates the state
-- accordingly.

processEvent :: (MonadIO m, ClientState s m) => (InternalEvent s m) ->
                (StateT (State s m) m) (Maybe CE.SomeException)

processEvent e = get >>= \ state ->
  let handleOrTLSCtx = case stateTLSState state of
        PostHandshake tlsCtx ->
          Right tlsCtx
        _ ->
          let Connected _ handle = stateConnectionState state in Left handle
  in case e of

  -- ---------------------------------------------------------------------------
  --  CLIENT EVENTS
  -- ---------------------------------------------------------------------------
  --
  IEC (CEOpenStream hostName portNumber callback) -> do

    CEB.assert (stateConnectionState state == Disconnected) (return ())

    let portNumber' = fromIntegral portNumber

    connectResult <- liftIO $ CE.try $ N.connectTo hostName
                     (N.PortNumber portNumber')

    case connectResult of
      Right handle -> do
        put $ state { stateConnectionState = Connected (ServerAddress hostName portNumber') handle
                    , stateStreamState = PreStream
                    , stateOpenStreamCallback = Just callback }
        lift $ liftIO $ hSetBuffering handle NoBuffering
        lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++ hostName ++
          "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.or" ++
          "g/streams' version='1.0'>") (Left handle)
        threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Left handle)
        lift $ liftIO $ putMVar (stateThreadID state) threadID
        return Nothing
      Left e -> do
        let clientState = stateClientState state
        ((), clientState') <- lift $ runStateT (callback OpenStreamFailure) clientState
        put $ state { stateShouldExit = True }
        return $ Just e

  IEC (CESecureWithTLS certificate verifyCertificate callback) -> do
    -- CEB.assert (not $ isTLSSecured (stateStreamState state)) (return ())
    let Connected _ handle = stateConnectionState state
    lift $ liftIO $ send "<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>" (Left handle)
    put $ state { stateStreamState = PreStream
                , stateSecureWithTLSCallback = Just callback }
    return Nothing

-- TODO: Save callback in state.
  IEC (CEAuthenticate userName password resource callback) -> do
    -- CEB.assert (or [ stateConnectionState state == Connected
    --                , stateConnectionState state == TLSSecured ]) (return ())
    -- CEB.assert (stateHandle state /= Nothing) (return ())
    put $ state { stateAuthenticationState = AuthenticatingPreChallenge1 userName password resource
                , stateAuthenticateCallback = Just callback }
    lift $ liftIO $ send "<auth xmlns='urn:ietf:params:xml:ns:xmpp-sasl' mechanism='DIGEST-MD5'/>" handleOrTLSCtx
    return Nothing

  IEE (EnumeratorXML (XEBeginStream stream)) -> do
    put $ state { stateStreamState = PreFeatures (1.0) }
    return Nothing

  IEE (EnumeratorXML (XEFeatures features)) -> do
    let PreFeatures streamProperties = stateStreamState state
    case stateTLSState state of
      NoTLS -> let callback = fromJust $ stateOpenStreamCallback state in do
        ((), clientState) <- lift $ runStateT (callback $ OpenStreamSuccess streamProperties "TODO") (stateClientState state)
        put $ state { stateClientState = clientState
                    , stateStreamState = PostFeatures streamProperties "TODO" }
        return Nothing
      _ -> case stateAuthenticationState state of
        AuthenticatedUnbound _ resource -> do -- TODO: resource
          case resource of
            Nothing -> do
              lift $ liftIO $ send ("<iq type=\"set\" id=\"bind_1\"><bind xmlns=\"urn:ietf:param" ++ "s:xml:ns:xmpp-bind\"></bind></iq>") handleOrTLSCtx
              return ()
            _ -> do
              lift $ liftIO $ send ("<iq type=\"set\" id=\"bind_1\"><bind xmlns=\"urn:ietf:param" ++ "s:xml:ns:xmpp-bind\"><resource>" ++ fromJust resource ++ "</resource></bind></iq>") handleOrTLSCtx
              return ()
          id <- liftIO $ nextID $ stateIDGenerator state
          lift $ liftIO $ send ("<iq type=\"set\" id=\"" ++ id ++ "\"><session xmlns=\"urn:ietf:params:xml:ns:xmpp-session\"/>" ++ "</iq>") handleOrTLSCtx

          -- TODO: Execute callback on iq result

          let callback = fromJust $ stateAuthenticateCallback state in do -- TODO: streamProperties "TODO" after success
            ((), clientState) <- lift $ runStateT (callback $ AuthenticateSuccess streamProperties "TODO" "todo") (stateClientState state) -- get proper resource value when moving to iq result
            put $ state { stateClientState = clientState
                        , stateStreamState = PostFeatures streamProperties "TODO" }
          state' <- get
          return Nothing
        _ -> do
          let callback = fromJust $ stateSecureWithTLSCallback state in do
          ((), clientState) <- lift $ runStateT (callback $ SecureWithTLSSuccess streamProperties "TODO") (stateClientState state)
          put $ state { stateClientState = clientState
                      , stateStreamState = PostFeatures streamProperties "TODO" }
          return Nothing

  -- TODO: Can we assume that it's safe to start to enumerate on handle when it
  -- might not have exited?
  IEE (EnumeratorXML XEProceed) -> do
    let Connected (ServerAddress hostName _) handle = stateConnectionState state
    tlsCtx <- lift $ liftIO $ handshake' handle hostName
    let tlsCtx_ = fromJust tlsCtx
    put $ (defaultState (stateChannel state) (stateThreadID state) (stateClientHandlers state) (stateClientState state) (stateIDGenerator state)) { stateTLSState = PostHandshake tlsCtx_, stateConnectionState = (stateConnectionState state), stateSecureWithTLSCallback = (stateSecureWithTLSCallback state) }
    threadID <- lift $ liftIO $ forkIO $ xmlEnumerator (stateChannel state) (Right tlsCtx_) -- double code
    lift $ liftIO $ putStrLn "00000000000000000000000000000000"
    lift $ liftIO $ swapMVar (stateThreadID state) threadID -- return value not used
    lift $ liftIO $ putStrLn "00000000000000000000000000000000"
    lift $ liftIO $ threadDelay 1000000
    lift $ liftIO $ putStrLn "00000000000000000000000000000000"
    lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++
      hostName ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/" ++
      "streams' version='1.0'>") (Right tlsCtx_)
    lift $ liftIO $ putStrLn "00000000000000000000000000000000"
    return Nothing

  IEE (EnumeratorXML (XEChallenge (Chal challenge))) -> do
    let serverHost = "jonkristensen.com"
    let challenge' = CBBS.decode challenge
    case stateAuthenticationState state of
      AuthenticatingPreChallenge1 userName password resource -> do
        id <- liftIO $ nextID $ stateIDGenerator state
        -- This is the first challenge - we need to calculate the reply
        case replyToChallenge1 challenge' serverHost userName password id of
          Left reply -> do
            let reply' = (filter (/= '\n') (CBBS.encode reply))
            lift $ liftIO $ send ("<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'>" ++ reply' ++ "</response>") handleOrTLSCtx
            put $ state { stateAuthenticationState = AuthenticatingPreChallenge2 userName password resource }
            return ()
          Right error -> do
            state' <- get
            lift $ liftIO $ putStrLn $ show error
            return ()
      AuthenticatingPreChallenge2 userName password resource -> do
        -- This is not the first challenge; [...]
        -- TODO: Can we assume "rspauth"?
        lift $ liftIO $ send "<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>" handleOrTLSCtx
        put $ state { stateAuthenticationState = AuthenticatingPreSuccess userName password resource }
        return ()
    return Nothing

  -- We have received a SASL "success" message over a secured connection
  -- TODO: Parse the success message?
  -- TODO: <?xml version='1.0'?>?
  IEE (EnumeratorXML (XESuccess (Succ _))) -> do
    let serverHost = "jonkristensen.com"
    let AuthenticatingPreSuccess userName _ resource = stateAuthenticationState state in do
      lift $ liftIO $ send ("<?xml version='1.0'?><stream:stream to='" ++ serverHost ++ "' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/" ++ "streams' version='1.0'>") handleOrTLSCtx
      put $ state { stateAuthenticationState = AuthenticatedUnbound userName resource }
    return Nothing

  IEE EnumeratorDone ->
    -- TODO: Exit?
    return Nothing

  -- ---------------------------------------------------------------------------
  --  XML EVENTS
  -- ---------------------------------------------------------------------------

  -- Ignore id="bind_1" and session IQ result, otherwise create client event
  IEE (EnumeratorXML (XEIQ iqEvent)) ->
    case shouldIgnoreIQ iqEvent of
        True ->
            return Nothing
        False -> do
            let stanzaID' = iqID iqEvent
            let newTimeouts = case stanzaID' of
                                Just stanzaID'' ->
                                    case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of
                                                True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)
                                                False -> (stateTimeoutStanzaIDs state)
                                Nothing -> (stateTimeoutStanzaIDs state)
            let iqReceivedFunctions = map (\ x -> iqReceived x) (stateClientHandlers state)
            let functions = map (\ x -> case x of
                                    Just f -> Just (f iqEvent)
                                    Nothing -> Nothing) iqReceivedFunctions
            let functions' = case lookup (fromJust $ iqID $ iqEvent) (stateIQCallbacks state) of
                                  Just f -> (Just (f $ iqEvent)):functions
                                  Nothing -> functions
            let clientState = stateClientState state
            clientState' <- sendToClient functions' clientState
            put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }
            return Nothing

  IEE (EnumeratorXML (XEPresence presenceEvent)) -> do
    let stanzaID' = presenceID $ presenceEvent
    let newTimeouts = case stanzaID' of
                        Just stanzaID'' ->
                            case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of
                                    True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)
                                    False -> (stateTimeoutStanzaIDs state)
                        Nothing -> (stateTimeoutStanzaIDs state)
    let presenceReceivedFunctions = map (\ x -> presenceReceived x) (stateClientHandlers state)
    let functions = map (\ x -> case x of
                            Just f -> Just (f presenceEvent)
                            Nothing -> Nothing) presenceReceivedFunctions
    let clientState = stateClientState state -- ClientState s m
    clientState' <- sendToClient functions clientState
    put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }
    return Nothing

  IEE (EnumeratorXML (XEMessage messageEvent)) -> do
    let stanzaID' = messageID $ messageEvent
    let newTimeouts = case stanzaID' of
                        Just stanzaID'' ->
                            case stanzaID'' `elem` (stateTimeoutStanzaIDs state) of
                                    True -> filter (\ e -> e /= stanzaID'') (stateTimeoutStanzaIDs state)
                                    False -> (stateTimeoutStanzaIDs state)
                        Nothing -> (stateTimeoutStanzaIDs state)
    let messageReceivedFunctions = map (\ x -> messageReceived x) (stateClientHandlers state)
    let functions = map (\ x -> case x of
                            Just f -> Just (f messageEvent)
                            Nothing -> Nothing) messageReceivedFunctions
    let clientState = stateClientState state -- ClientState s m
    clientState' <- sendToClient functions clientState
    put $ state { stateClientState = clientState', stateTimeoutStanzaIDs = newTimeouts }
    return Nothing

  IEC (CEPresence presence stanzaCallback timeoutCallback streamErrorCallback) -> do
    presence' <- case presenceID $ presence of
      Nothing -> do
        id <- liftIO $ nextID $ stateIDGenerator state
        return $ presence { presenceID = Just (SID id) }
      _ -> return presence
    case timeoutCallback of
        Just (t, timeoutCallback') ->
            let stanzaID' = (fromJust $ presenceID $ presence') in do
                registerTimeout (stateChannel state) stanzaID' t timeoutCallback'
                put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) }
        Nothing ->
            return ()
    let xml = presenceToXML presence'
    lift $ liftIO $ send xml handleOrTLSCtx
    return Nothing

  IEC (CEMessage message stanzaCallback timeoutCallback streamErrorCallback) -> do
    message' <- case messageID message of
      Nothing -> do
        id <- liftIO $ nextID $ stateIDGenerator state
        return $ message { messageID = Just (SID id) }
      _ -> return message
    case timeoutCallback of
        Just (t, timeoutCallback') ->
            let stanzaID' = (fromJust $ messageID message') in do
                registerTimeout (stateChannel state) stanzaID' t timeoutCallback'
                put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) }
        Nothing ->
            return ()
    let xml = messageToXML message'
    lift $ liftIO $ send xml handleOrTLSCtx
    return Nothing

  IEC (CEIQ iq stanzaCallback timeoutCallback stanzaErrorCallback) -> do
    iq' <- case iqID iq of
      Nothing -> do
        id <- liftIO $ nextID $ stateIDGenerator state
        return $ case iq of
          IQReq r -> do
            IQReq (r { iqRequestID = Just (SID id) })
          IQRes r -> do
            IQRes (r { iqResponseID = Just (SID id) })
      _ -> return iq
    case stanzaCallback of
      Just callback' -> case iq of
        IQReq {} -> put $ state { stateIQCallbacks = (fromJust $ iqID iq, callback'):(stateIQCallbacks state) }
        _ -> return ()
      Nothing -> return ()
    case timeoutCallback of
        Just (t, timeoutCallback') ->
            let stanzaID' = (fromJust $ iqID iq') in do
                registerTimeout (stateChannel state) stanzaID' t timeoutCallback'
                put $ state { stateTimeoutStanzaIDs = stanzaID':(stateTimeoutStanzaIDs state) }
        Nothing ->
            return ()
    -- TODO: Bind ID to callback
    let xml = iqToXML iq'
    lift $ liftIO $ send xml handleOrTLSCtx
    return Nothing

  IEC (CEAction predicate callback) -> do
    case predicate of
        Just predicate' -> do
            result <- runBoolClientCallback predicate'
            case result of
                True -> do
                    runUnitClientCallback callback
                    return Nothing
                False -> return Nothing
        Nothing -> do
            runUnitClientCallback callback
            return Nothing

  -- XOEDisconnect -> do
  --   -- TODO: Close stream
  --   return ()

  IET (TimeoutEvent i t c) ->
    case i `elem` (stateTimeoutStanzaIDs state) of
        True -> do
            runUnitClientCallback c
            return Nothing
        False -> return Nothing


  e -> do
    return Nothing
    -- lift $ liftIO $ putStrLn $ "UNCAUGHT EVENT: " ++ (show e)
    -- return $ Just (CE.SomeException $ CE.PatternMatchFail "processEvent")
  where
    -- Assumes handle is set
    send :: String -> Either Handle TLSCtx -> IO ()
    send s o = case o of
      Left handle -> do
        liftIO $ hPutStr handle $ encodeString $ s
        liftIO $ hFlush handle
        return ()
      Right tlsCtx -> do
        liftIO $ sendData tlsCtx $ DBLC.pack $ encodeString s
        return ()
    shouldIgnoreIQ :: IQ -> Bool
    shouldIgnoreIQ i = case iqPayload i of
      Nothing -> False
      Just e -> case nameNamespace $ elementName e of
        Just x | x == DT.pack "urn:ietf:params:xml:ns:xmpp-bind" -> True
        Just x | x == DT.pack "urn:ietf:params:xml:ns:xmpp-session" -> True
        Just _ -> False
        Nothing -> False


registerTimeout :: (ClientState s m, MonadIO m) => Chan (InternalEvent s m) -> StanzaID -> Timeout -> StateT s m () -> StateT (State s m) m ()
registerTimeout ch i t ca = do
    liftIO $ threadDelay $ t * 1000
    liftIO $ forkIO $ writeChan ch $ IET (TimeoutEvent i t ca)
    return ()


runBoolClientCallback :: (ClientState s m, MonadIO m) => StateT s m Bool -> StateT (State s m) m Bool
runBoolClientCallback c = do
    state <- get
    let clientState = stateClientState state
    (bool, clientState') <- lift $ runStateT c clientState
    put $ state { stateClientState = clientState' }
    return bool


runUnitClientCallback :: (ClientState s m, MonadIO m) => StateT s m () -> StateT (State s m) m ()
runUnitClientCallback c = do
    state <- get
    let clientState = stateClientState state
    ((), clientState') <- lift $ runStateT c clientState
    put $ state { stateClientState = clientState' }


sendToClient :: (MonadIO m, ClientState s m) => [Maybe (StateT s m Bool)] -> s -> (StateT (State s m) m) s
sendToClient [] s = return s
sendToClient (Nothing:fs) s = sendToClient fs s
sendToClient ((Just f):fs) s = do
  (b, s') <- lift $ runStateT f s
  case b of
    True -> return s'
    False -> sendToClient fs s'