{-

Copyright © Jon Kristensen, 2010-2011.

This file is part of Pontarius Media Server.

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

Pontarius Media Server 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 Affero General Public License for
more details.

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

-}


-- | Module:      $Header$
--   Description: An abstraction layer between Pontarius XMPP and the logic of
--                XPMN devices (controllers and/or services)
--   Copyright:   Copyright © 2010-2011 Jon Kristensen
--   License:     AGPL-3
--   
--   Maintainer:  info@pontarius.org
--   Stability:   unstable
--   Portability: portable

-- | A logical entity (application) in an extended personal media network is
--   called an XPMN device. Such devices are service providers, controllers, or
--   both. These devices have a lot in common, such as the need for managing
--   their (XMPP) connections, variables, events, and queries. This module
--   serves as a helping abstraction layer for doing this, exposing as few
--   underlying (XMPP) details as possible.
--   
--   Interaction with this module is mostly event-based. The client works with
--   two functions, one dealing with acquiring DeviceInEvents (received events
--   that are either generated by an (to the client/device) external source
--   (such as another client, the XMPP library or this module)), and another
--   dealing with the transmission of DeviceOutEvents (outgoing events,
--   generated by the client). An example of a DeviceInEvent would be a
--   notification that the device is on-line. A DeviceOutEvent could be a
--   request to set a simple variable in a foreign device. The client acquires
--   these two functions by using the 'start' function, which is the only
--   function that this module exports.
--   
--   More documentation on how to use this module will be available by the time
--   Pontarius XPMN enters beta.

-- Internally, this module uses two channels in its interaction with Pontarius
-- XMPP. The principle here is the same; XMPPInEvents are events generated by
-- Pontarius XMPP and sent to the XMPP client (this module) and XMPPOutEvents
-- are events sent from this XMPP client to Pontarius XMPP.

{-# LANGUAGE PolymorphicComponents #-}

module Media.XPMN.DeviceServer ( ServiceEvent (..)
                               , ComplexVariable
                               , DeviceInEvent (..)
                               , DeviceOutEvent (..)
                               , DeviceServer (..)
                               , start
                               , SimpleVariable
                               -- , simpleVariable
                               , simpleVariableName
                               , simpleVariableValue
                               , complexVariable
                               , complexVariableValue
                               , query
                               , XMLable (toXML, fromXML)
                               , Query ) where

import Network.XMPP
import Network.XMPP.JID -- TODO

import Control.Concurrent (forkIO)
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Data.List (elem, delete)
import Data.Maybe
import Data.String
import Data.XML.Types
import qualified Data.List as DL
import qualified Data.Map as DM
import qualified Data.Text as DT


-- | All XPMN variables deals with XML in terms of a list of XML nodes.

type VariableValue = [Node]


-- Undocumented types:
type VariableName = String -- TODO: Document rules, create protected variable.
-- type NodeName = String
type ItemID = String -- TODO: Document rules, create protected variable.
type Subscriber = JID


-- | An 'XMLable' is a type which can be converted from/to XML.

class XMLable a where
  fromXML :: [Node] -> a
  toXML :: a -> [Node]


-- | Example instance of the XMLable for an integer.

instance XMLable Integer where
  toXML i = [NodeContent (ContentText (DT.pack (show i)))]
  fromXML [NodeContent (ContentText t)] = read $ DT.unpack t


-- A pubsub node is basically just an ordered list of ItemIDs and arbitrary
-- objects, and a list of subscribers.

data PubsubNode a = PubsubNode VariableName [(ItemID, a)] [Subscriber]
                  deriving (Show)


-- | A simple XPMN variable is a variable which has only one value. Changing a
--   simple variable overrides its current value.

type SimpleVariable = PubsubNode


-- | A complex XPMN variable is a variable which has a list of values. You can
--   retract from and publish to a complex variable.

type ComplexVariable = PubsubNode


data Query a = Query (PubsubNode a) (a -> Bool)


data DeviceServer = DeviceServer { inEvents  :: Chan DeviceInEvent
                                 , outEvents :: Chan DeviceOutEvent
                                 , createSimpleVar :: XMLable a =>
                                                      VariableName -> a ->
                                                      [Subscriber] -> IO (SimpleVariable a)
                                 , modifySimpleVar :: XMLable a =>
                                                      SimpleVariable a -> a ->
                                                      IO (SimpleVariable a)
                                 , subscribeSimpleVar :: XMLable a =>
                                                         SimpleVariable a ->
                                                         Subscriber ->
                                                         IO (SimpleVariable a)
                                 , unsubscribeSimpleVar :: XMLable a =>
                                                           SimpleVariable a ->
                                                           Subscriber ->
                                                           SimpleVariable a
                                 , publish :: XMLable a =>
                                              ComplexVariable a ->
                                              ItemID ->
                                              a ->
                                              IO (ComplexVariable a)
                                 , retract :: XMLable a => ComplexVariable a ->
                                              ItemID -> IO (ComplexVariable a)
                                 , subscribeComplexVar :: XMLable a =>
                                                          ComplexVariable a ->
                                                          Subscriber ->
                                                          ComplexVariable a
                                 , unsubscribeComplexVar :: XMLable a =>
                                                            ComplexVariable a ->
                                                            Subscriber ->
                                                            ComplexVariable a
                                 , queryPublish :: XMLable a => Query a ->
                                                   ItemID -> a -> IO (Query a)
                                 , queryRetract :: XMLable a => Query a -> ItemID ->
                                                   IO (Query a) }

data Identity = Identity { identityCategory :: String
                         , identityType :: String
                         , identityName :: Maybe String }

-- TODO: Validate feature string

data InternalEvent = IEX XMPPInEvent | IED DeviceOutEvent deriving (Eq, Show)

data State = State { stateServer :: String
                   , statePort :: Integer
                   , stateUserName :: String
                   , statePassword :: String
                   , stateResource :: String
                   , stateOurJID :: JID
                   , stateVariableNames :: [String]
                   , stateQueryNames :: [String] }


-- TODO: Later: Forward presence and node subscription requests to client.

data DeviceInEvent = DIEIncomingSimpleVariableGet From String |
                     DIEIncomingSimpleVariableSet To String [Node] |
                     DIEOnline |
                     DIEIQ IQ |
                     DIEPresence Presence |
                     DIESubscribe JID String |
                     DIEUnsubscribe JID String |
                     DIEQuery JID String [Node] |
                     DIEItems Subscriber String
                     deriving (Eq, Show)

data DeviceOutEvent = DOEOutgoingSimpleVariableGet From String |
                      DOEOutgoingSimpleVariableSet To String [Node] |
                      DOEOutgoingSimpleVariableResult To String [Node] |
                      DOEIQ IQ |
                      DOEPresence Presence |
                      DOEMessage Message |
                      DOESubscribed JID String
                      deriving (Eq, Show)


-- TODO: Later: First String should be something like StanzaID.
data ServiceEvent = AutoSubscriptionRequest (String, JID) | -- TODO: Only in
                    ManualSubscriptionRequest (String, JID) | -- TODO: Only in
                    Action (String, JID, Element) |
                    ActionResponse (String, JID, Element) |
                    SimpleVariableGet (String, JID) |
                    SimpleVariableGetResponse (String, JID, String) |
                    SimpleVariableSet (String, JID, String) |
                    SimpleVariableSetResponse (String, JID, Maybe String) |
                    -- IQ ID, _, Item ID, _
                    ComplexVariableExtend (String, JID, String, Element) |
                    ComplexVariableExtendResponse (String, JID, String, Maybe Element) |
                    ComplexVariableRetract (String, JID, String) |
                    ComplexVariableRetractResponse (String, JID, Maybe String) deriving (Eq, Show)


pubsubNodeName :: XMLable a => PubsubNode a -> VariableName
pubsubNodeName (PubsubNode n _ _) = n

pubsubNodeValue :: XMLable a => PubsubNode a -> [(ItemID, a)]
pubsubNodeValue (PubsubNode _ v _) = v

pubsubNodeSubscribers :: XMLable a => PubsubNode a -> [JID]
pubsubNodeSubscribers (PubsubNode _ _ s) = s


-- Unsubscribes a JID from a simple variable and notifies the subscriber.

unsubscribeFromPubsubNode :: XMLable a => PubsubNode a -> Subscriber -> PubsubNode a

unsubscribeFromPubsubNode p s
  -- JID not subscribed
  | not $ s `elem` subscribers = p
  | otherwise = setPubsubNodeSubscribers p (delete s subscribers)
  where
    subscribers = pubsubNodeSubscribers p


-- | Create a simple variable with an initial set of subscribers and notify the
--   subscribers of the new value.

simpleVariable :: XMLable a => Chan XMPPOutEvent -> VariableName -> a ->
                  [Subscriber] -> IO (SimpleVariable a)

simpleVariable c n v s = do
  let var = PubsubNode n [(n, v)] s
  mapM_ (\ x -> writeChan c (XOEMessage (getSimpleMessage n (toXML v) x))) s
  return var


simpleVariableName :: XMLable a => SimpleVariable a -> VariableName
simpleVariableName (PubsubNode n _ _) = n

simpleVariableValue :: XMLable a => SimpleVariable a -> a
simpleVariableValue (PubsubNode _ v _) = snd $ head v

simpleVariableSubscribers :: XMLable a => SimpleVariable a -> [Subscriber]
simpleVariableSubscribers (PubsubNode _ _ s) = s


-- | Modifies a simple variable and notifies the subscribers.

modifySimpleVariable :: XMLable a => Chan XMPPOutEvent -> SimpleVariable a -> a ->
                        IO (SimpleVariable a)

modifySimpleVariable c s v = do
    mapM_ (\ x -> writeChan c (XOEMessage (getSimpleMessage name (toXML v) x))) subscribers
    return $ PubsubNode name [(name, v)] subscribers
  where
    name = simpleVariableName s
    subscribers = simpleVariableSubscribers s


-- No notifications.

setPubsubNodeSubscribers :: XMLable a => PubsubNode a -> [Subscriber] -> PubsubNode a
setPubsubNodeSubscribers (PubsubNode n v _) s = PubsubNode n v s


-- Subscribes a JID to a simple variable and notifies the subscriber.

subscribeToSimpleVariable :: XMLable a => Chan XMPPOutEvent ->
                             SimpleVariable a -> Subscriber ->
                             IO (SimpleVariable a)

subscribeToSimpleVariable c si su
  -- JID already subscribed
  | su `elem` simpleVariableSubscribers si = return si
  | otherwise = do
    writeChan c (XOEMessage (getSimpleMessage name (toXML value) su))
    return $ setPubsubNodeSubscribers si (su:subscribers)
  where
    name = simpleVariableName si
    value = simpleVariableValue si
    subscribers = simpleVariableSubscribers si


-- Unsubscribes a JID from a simple variable and notifies the subscriber.

unsubscribeFromSimpleVariable :: XMLable a => SimpleVariable a -> Subscriber ->
                                 SimpleVariable a

unsubscribeFromSimpleVariable si su
  -- JID not subscribed
  | not $ su `elem` simpleVariableSubscribers si = si
  | otherwise = setPubsubNodeSubscribers si (delete su subscribers)
  where
    subscribers = simpleVariableSubscribers si


-- | A complex variable is a pubsub node which can only be published to
--   internally.

complexVariable :: XMLable a => VariableName -> [(ItemID, a)] -> [Subscriber] ->
                   ComplexVariable a

complexVariable n v s = PubsubNode n v s


complexVariableName :: XMLable a => ComplexVariable a -> VariableName
complexVariableName (PubsubNode n _ _) = n

complexVariableValue ::XMLable a => ComplexVariable a -> [(ItemID, a)]
complexVariableValue (PubsubNode _ v _) = v

complexVariableSubscribers :: XMLable a => ComplexVariable a -> [JID]
complexVariableSubscribers (PubsubNode _ _ s) = s


-- | Modifies a simple variable and notifies the subscribers.

-- TODO: Check if element of list.

publish_ :: XMLable a => Chan XMPPOutEvent -> ComplexVariable a -> ItemID -> a ->
            IO (ComplexVariable a)

publish_ c (PubsubNode n v s) i v_ = do
  mapM_ (\ x ->
          writeChan c (XOEMessage (getComplexPublishMessage n i (toXML v_) x)))
    s
  return newvar
  where
    newvar = PubsubNode n ((i, v_):v) s


-- | Modifies a simple variable and notifies the subscribers.

retract_ :: XMLable a => Chan XMPPOutEvent -> ComplexVariable a -> ItemID -> IO (ComplexVariable a)

retract_ c (PubsubNode n v s) i = do
  mapM_ (\ x -> writeChan c (XOEMessage (getComplexRetractMessage n i x))) s
  return newvar
  where
    newvar = PubsubNode n v' s
    -- v' is v without the retracted element
    v' = DL.filter (\ x -> fst x /= i) v


-- Subscribes a JID to a complex variable.

subscribeToComplexVariable :: XMLable a => ComplexVariable a ->
                              Subscriber -> ComplexVariable a

subscribeToComplexVariable (PubsubNode n v s) s_
  | s_ `elem` s = PubsubNode n v s
  | otherwise = do
    PubsubNode n v (s_:s)


-- Unsubscribes a JID from a complex variable.

unsubscribeFromComplexVariable :: XMLable a => ComplexVariable a ->
                                  Subscriber -> ComplexVariable a
unsubscribeFromComplexVariable (PubsubNode n v s) s_
  | s_ `elem` s = do
    let s' = delete s_ s
    PubsubNode n v s'
  | otherwise = PubsubNode n v s


query :: XMLable a => Subscriber -> (a -> Bool) -> Query a
query s f = Query (PubsubNode "" [] [s]) f

queryPublish_ :: XMLable a => Chan XMPPOutEvent -> Query a -> ItemID -> a -> IO (Query a)
queryPublish_ c q i v = do
  case (queryFilter q) v of
    True -> do
      pubsubNode <- publish_ c (queryPubsubNode q) i v
      return $ Query pubsubNode (queryFilter q)
    False ->
      return q

queryRetract_ :: XMLable a => Chan XMPPOutEvent -> Query a -> ItemID -> IO (Query a)
queryRetract_ c q i = do
  case DL.lookup i (pubsubNodeValue $ queryPubsubNode q) of
    Just _ -> do
      pubsubNode <- retract_ c (queryPubsubNode q) i
      return $ Query pubsubNode (queryFilter q)
    Nothing -> do
      return q

queryPubsubNode (Query p _) = p
queryFilter (Query _ f) = f


-- TODO: Validate
identity c t n = Identity { identityCategory = c
                          , identityType = t
                          , identityName = n }


start :: String -> Integer -> String -> String -> String -> [String] ->
         [String] -> IO DeviceServer

start s po u pa r v q = do
  -- Create an XMPP session and request to connect
  (xmppIn, xmppOut) <- createSession
  writeChan xmppOut $ XOEConnect s po
  
  -- Create the three additional channels that are needed; one internal for the
  -- state loop of this module, and two dealing with the message passing between
  -- this module and the device
  internalChan <- newChan
  deviceIn <- newChan
  deviceOut <- newChan
  
  -- Start three threads - one to listen for events from Pontarius XMPP, one for
  -- events from the device and one for the state loop
  forkIO $ xmppListener xmppIn internalChan
  forkIO $ deviceListener deviceOut internalChan
  forkIO $ stateLoop (State { stateServer = s
                            , statePort = po
                            , stateUserName = u
                            , statePassword = pa
                            , stateResource = r
                            , stateOurJID = jid (Just u) s (Just r)
                            , stateVariableNames = v
                            , stateQueryNames = q })
    internalChan xmppOut deviceIn
  
  return DeviceServer { inEvents = deviceIn
                      , outEvents = deviceOut
                      , createSimpleVar = simpleVariable xmppOut
                      , modifySimpleVar = modifySimpleVariable xmppOut
                      , subscribeSimpleVar = subscribeToSimpleVariable xmppOut
                      , unsubscribeSimpleVar = unsubscribeFromSimpleVariable
                      , publish = publish_ xmppOut
                      , retract = retract_ xmppOut
                      , subscribeComplexVar = subscribeToComplexVariable
                      , unsubscribeComplexVar = unsubscribeFromComplexVariable
                      , queryPublish = queryPublish_ xmppOut
                      , queryRetract = queryRetract_ xmppOut }
  where
    xmppListener :: Chan XMPPInEvent -> Chan InternalEvent -> IO ()
    xmppListener c c_ = do e <- readChan c
                           writeChan c_ $ IEX e
                           xmppListener c c_
    
    deviceListener :: Chan DeviceOutEvent -> Chan InternalEvent -> IO ()
    deviceListener c c_ = do e <- readChan c
                             writeChan c_ $ IED e
                             deviceListener c c_
    
    stateLoop :: State -> Chan InternalEvent -> Chan XMPPOutEvent ->
                 Chan DeviceInEvent -> IO ()
    stateLoop s c c_ c__ = do
      e <- readChan c
      -- putStrLn $ "InternalEvent: " ++ (show e)
      s' <- processEvent s e c_ c__
      stateLoop s c c_ c__
    
    -- Processes XMPP events from Pontarius XMPP
    processEvent :: State -> InternalEvent -> Chan XMPPOutEvent ->
                    Chan DeviceInEvent -> IO State
    
    processEvent s (IEX XIEConnectionSucceeded) c c_ = do
      writeChan c $ XOEAuthenticate (stateUserName s) (statePassword s)
        (stateResource s)
      return s
    
    processEvent s (IEX XIEAuthenticationSucceeded) c c_ = do
      writeChan c_ DIEOnline
      writeChan c $ XOEPresence $
        presence Nothing Nothing Nothing Nothing Available []
      return s
    
    -- Query for service discovery when someone comes on-line
    processEvent s (IEX (XIEPresence (Presence { presenceStanza = stanza
                                               , presenceType = Available }))) c c_
      | fromJust (stanzaFrom stanza) /= stateOurJID s = do
      let jid = stanzaFrom stanza
      writeChan c $ XOEIQ $ iqGet Nothing Nothing (stanzaFrom stanza) Nothing
        (Element { elementName = Name { nameLocalName = DT.pack "query"
                                      , nameNamespace = Just (DT.pack "http://jabber.org/protocol/disco#info")
                                      , namePrefix = Nothing }
                 , elementAttributes = DM.fromList []
                 , elementNodes = [] })
      return s
    
    -- Auto-accept subscriptions when asked and ask for subscription
    processEvent s (IEX (XIEPresence (Presence { presenceStanza = stanza
                                               , presenceType = Subscribe }))) c c_ = do
      let jid = stanzaFrom stanza
      writeChan c $ XOEPresence $ presence Nothing Nothing jid Nothing
        Subscribe []
      writeChan c $ XOEPresence $ presence Nothing Nothing jid Nothing
        Subscribed []
      return s
    
    -- Reply when service discovery is requested from us
    processEvent s (IEX (XIEIQ (IQGet { iqGetStanza = stanza
                                      , iqGetPayload = p }))) c c_
      | (nameNamespace $ elementName p) ==
        Just (DT.pack "http://jabber.org/protocol/disco#info") = do
          let jid = stanzaFrom stanza
          writeChan c $ XOEIQ $ iqResult Nothing Nothing jid Nothing
            (Just discoInfoElement)
          return s
    
    -- Complex "items" query
    processEvent s (IEX (XIEIQ (IQGet { iqGetStanza = stanza
                                      , iqGetPayload = p }))) c c_
      | (nameNamespace $ elementName p) == Just (DT.pack "http://jabber.org/protocol/pubsub") &&
        (nameLocalName $ elementName p) == DT.pack "pubsub" &&
        length (elementChildren p) > 0 &&
        (nameLocalName $ elementName $ head (elementChildren p)) == DT.pack "items" = do
          let fromJID = fromJust $ stanzaFrom stanza
          let nodeName = DT.unpack $ fromJust $ attributeText
                         (fromString "node") (head (elementChildren p))
          case nodeName `elem` stateVariableNames s of
            True -> do
              writeChan c_ $ DIEItems fromJID nodeName
              return s
            False -> do
              putStrLn "Variable not offered by device (items)!"
              return s
    
    -- Simple variable get
    processEvent s (IEX (XIEIQ (IQGet { iqGetStanza = stanza
                                      , iqGetPayload = p }))) c c_
      | (nameNamespace $ elementName p) == Just (DT.pack "urn:xmpp:xpmn:0") &&
        (nameLocalName $ elementName p) == DT.pack "simple-variable" = do
          let jid = fromJust $ stanzaFrom stanza
          let name = DT.unpack $ fromJust $ attributeText (fromString "name") p
          case name `elem` stateVariableNames s of
            True -> do
              putStrLn "Hmm..."
              writeChan c_ $ DIEIncomingSimpleVariableGet jid name
              return s
            False -> do
              putStrLn "Variable not offered by device (set)!"
              return s
    
    -- Simple variable set
    processEvent s (IEX (XIEIQ (IQSet { iqSetStanza = stanza
                                      , iqSetPayload = p }))) c c_
      | (nameNamespace $ elementName p) == Just (DT.pack "urn:xmpp:xpmn:0") &&
        (nameLocalName $ elementName p) == DT.pack "simple-variable" = do
          let jid = fromJust $ stanzaFrom stanza
          let name = DT.unpack $ fromJust $ attributeText (fromString "name") p
          case name `elem` stateVariableNames s of
            True -> do
              putStrLn "Hmm2..."
              writeChan c_ $ DIEIncomingSimpleVariableSet jid name (elementNodes p)
              return s
            False -> do
              putStrLn "Variable not offered by device (set)!"
              return s
    
    -- Variable subscription - simple and complex
    processEvent s (IEX (XIEIQ (IQSet { iqSetStanza = stanza
                                      , iqSetPayload = p }))) c c_
      | (nameNamespace $ elementName p) == Just (DT.pack "http://jabber.org/protocol/pubsub") &&
        (nameLocalName $ elementName p) == DT.pack "pubsub" &&
        length (elementChildren p) > 0 &&
        (nameLocalName $ elementName $ head (elementChildren p)) == DT.pack "subscribe" = do
          let fromJID = fromJust $ stanzaFrom stanza
          let nodeName = DT.unpack $ fromJust $ attributeText
                         (fromString "node") (head (elementChildren p))
          let subscribeJID = fromJust $ stringToJID $ DT.unpack $ fromJust $
                             attributeText (fromString "jid") (head (elementChildren p))
          case nodeName `elem` stateVariableNames s of
            True -> do
              writeChan c_ $ DIESubscribe subscribeJID nodeName
              return s
            False -> do
              putStrLn "Variable not offered by device (subscr)!"
              return s
    
    -- Variable unsubscription
    processEvent s (IEX (XIEIQ (IQSet { iqSetStanza = stanza
                                      , iqSetPayload = p }))) c c_
      | (nameNamespace $ elementName p) == Just (DT.pack "http://jabber.org/protocol/pubsub") &&
        (nameLocalName $ elementName p) == DT.pack "pubsub" &&
        length (elementChildren p) > 0 &&
        (nameLocalName $ elementName $ head (elementChildren p)) == DT.pack "unsubscribe" = do
          let fromJID = fromJust $ stanzaFrom stanza
          let nodeName = DT.unpack $ fromJust $ attributeText
                         (fromString "node") (head (elementChildren p))
          let subscribeJID = fromJust $ stringToJID $ DT.unpack $ fromJust $
                             attributeText (fromString "jid") (head (elementChildren p))
          case nodeName `elem` stateVariableNames s of
            True -> do
              writeChan c_ $ DIEUnsubscribe subscribeJID nodeName
              return s
            False -> do
              putStrLn "Variable not offered by device (unsubscr)!"
              return s
    
    -- Query
    processEvent s (IEX (XIEIQ (IQSet { iqSetStanza = stanza
                                      , iqSetPayload = p }))) c c_
      | (nameLocalName $ elementName p) == DT.pack "query" &&
        (nameNamespace $ elementName p) /= Nothing && 
        DT.unpack (fromJust (nameNamespace $ elementName p)) `elem` stateQueryNames s = do
          let fromJID = fromJust $ stanzaFrom stanza
          let nodeName = DT.unpack (fromJust $ nameNamespace $ elementName p)
          let nodes = elementNodes p
          writeChan c_ $ DIEQuery fromJID nodeName nodes
          return s
    
    -- Service discovery result, auto-subscribe user to relevant variables
    -- TODO: Verify that auto-subscription is detected
    processEvent s (IEX (XIEIQ (IQResult { iqResultStanza = stanza
                                         , iqResultPayload = p }))) c c_
      | p /= Nothing &&
        (nameNamespace $ elementName $ fromJust p) ==
        Just (DT.pack "http://jabber.org/protocol/disco#info") = do
          let jid = fromJust $ stanzaFrom stanza
          -- Get all features elements
          let features = filter (\ x -> not $ null (isNamed (Name { nameLocalName = DT.pack "feature"
                                                                  , nameNamespace = Just (DT.pack "http://jabber.org/protocol/disco#info")
                                                                  , namePrefix = Nothing }) x)) (elementChildren $ fromJust p)
          -- Features to strings
          let features_ = map (\ x -> DT.unpack $ fromJust $ attributeText (fromString "var") x) features
          
          -- For each string in variables, check if "[string]+notify" is part of features_
          let autovars = filter (\ x -> x ++ "+notify" `elem` features_) (stateVariableNames s)
          
          mapM_ (\ x -> writeChan c_ $ DIESubscribe jid x) autovars
          
          return s
    
    -- Other IQ, send it to device
    processEvent s (IEX (XIEIQ iq)) c c_ = do
      putStrLn "This is happening"
      writeChan c_ $ DIEIQ iq
      return s
    
    -- Get an external simple variable
    processEvent s (IED (DOEOutgoingSimpleVariableGet j n)) c c_ = do
      writeChan c $ XOEIQ $ iqGet Nothing Nothing (Just j) Nothing
        (Element { elementName = Name { nameLocalName = DT.pack "simple-variable"
                                      , namePrefix = Nothing
                                      , nameNamespace = Just (DT.pack "urn:xmpp:xpmn:0") }
                 , elementAttributes = DM.fromList [( Name { nameLocalName = DT.pack "variable"
                                                           , namePrefix = Nothing
                                                           , nameNamespace = Nothing } 
                                                    , [ContentText (DT.pack n)])]
                 , elementNodes = [] })
      return s
    
    -- Set an external simple variable
    processEvent s (IED (DOEOutgoingSimpleVariableSet j n v)) c c_ = do
      writeChan c $ XOEIQ $ iqSet Nothing Nothing (Just j) Nothing
        (Element { elementName = Name { nameLocalName = DT.pack "simple-variable"
                                      , namePrefix = Nothing
                                      , nameNamespace = Just (DT.pack "urn:xmpp:xpmn:0") }
                 , elementAttributes = DM.fromList [( Name { nameLocalName = DT.pack "variable"
                                                           , namePrefix = Nothing
                                                           , nameNamespace = Nothing } 
                                                    , [ContentText (DT.pack n)])]
                 , elementNodes = v }) -- Only difference from above
      return s
    
    -- -- Set an external simple variable
    -- processEvent s (IED (DOEOutgoingSimpleVariableResult j n v)) c c_ = do
    --   writeChan c $ XOEIQ $ iqResult Nothing Nothing (Just j) Nothing
    --     (Just (Element { elementName = Name { nameLocalName = DT.pack "simple-variable"
    --                                   , namePrefix = Nothing
    --                                   , nameNamespace = Just (DT.pack "urn:xmpp:xpmn:0") }
    --              , elementAttributes = DM.fromList [( Name { nameLocalName = DT.pack "variable"
    --                                                        , namePrefix = Nothing
    --                                                        , nameNamespace = Nothing } 
    --                                                 , [ContentText (DT.pack n)])]
    --              , elementNodes = v })) -- Only difference from above
    --   return s
    
    -- Send a device-specific IQ
    processEvent s (IED (DOEIQ i)) c c_ = do
      writeChan c $ XOEIQ i
      return s
    
    processEvent s (IEX xmppEvent) c c_ = do
      putStrLn $ "Uncaught XMPP Event: " ++ (show xmppEvent)
      return s
    
    processEvent s (IED deviceEvent) c c_ = do
      putStrLn $ "Uncaught Device Event: " ++ (show deviceEvent)
      return s
    
    discoInfoElement :: Element
    discoInfoElement = (Element { elementName = fromString "query"
                                , elementAttributes = DM.empty
                                , elementNodes = identities (snd $
                                                             features___ []) ++
                                                 features (fst $
                                                           features___ fea) })
    identities :: [Identity] -> [Node]
    identities [] = []
    identities (i':is) = (NodeElement (Element { elementName = fromString "identity"
                                               , elementAttributes = DM.fromList $ attrList i'
                                               , elementNodes = [] })):(identities is)
    attrList :: Identity -> [(Name, [Content])]
    attrList i' = case identityName i' of
      Just name -> [(fromString "category", [ContentText $ DT.pack $ identityCategory i']),
                    (fromString "type", [ContentText $ DT.pack $ identityType i']),
                    (fromString "name", [ContentText $ DT.pack $ name])]
      Nothing -> [(fromString "category", [ContentText $ DT.pack $ identityCategory i']),
                  (fromString "type", [ContentText $ DT.pack $ identityType i'])]
    
    features :: [String] -> [Node]
    features [] = []
    features (f:fs) = (NodeElement (Element { elementName = fromString "feature"
                                            , elementAttributes = DM.fromList [(fromString "var", [ContentText $ DT.pack f])]
                                            , elementNodes = [] })):(features fs)
    
    -- TODO: Should be configured by the device client later
    features___ :: [String] -> ([String], [Identity])
    features___ f = case elem "http://jabber.org/protocol/disco#info" f of 
      False -> (("http://jabber.org/protocol/disco#info":features'___ f),
                [Identity { identityCategory = "xpmn"
                          , identityType = "service"
                          , identityName = Nothing   }]) -- TODO
      True -> (features'___ f , [Identity { identityCategory = "xpmn"
                                          , identityType = "service"
                                          , identityName = Nothing   }]) -- TODO
    features'___ [] = []
    features'___ (f:fs) = (f:(features'___ fs))

    fea :: [String]
    fea = ["pingpong+notify"]


getSimpleMessage :: VariableName -> VariableValue -> JID -> Message

getSimpleMessage n v s = message Nothing Nothing (Just s) Nothing Normal [event]
  where
    event :: Element
    event = Element { elementName = Name { nameLocalName = DT.pack "event"
                                         , nameNamespace = Just (DT.pack "http://jabber.org/protocol/pubsub#event")
                                         , namePrefix = Nothing }
                    , elementAttributes = DM.fromList []
                    , elementNodes = [NodeElement items] }
    items :: Element
    items = Element { elementName = fromString "items"
                    , elementAttributes = DM.fromList [(fromString "node", [ContentText (DT.pack n)])]
                    , elementNodes = [NodeElement item] }
    item :: Element
    item = Element { elementName = fromString "item"
                   , elementAttributes = DM.fromList [(fromString "id", [ContentText (DT.pack n)])]
                   , elementNodes = v }


getComplexPublishMessage :: VariableName -> ItemID -> VariableValue ->
                            Subscriber -> Message

getComplexPublishMessage n i v s = message Nothing Nothing (Just s) Nothing
                                   Normal [event]
  where
    event :: Element
    event = Element { elementName = Name { nameLocalName = DT.pack "event"
                                         , nameNamespace = Just (DT.pack "http://jabber.org/protocol/pubsub#event")
                                         , namePrefix = Nothing }
                    , elementAttributes = DM.fromList []
                    , elementNodes = [NodeElement items] }
    items :: Element
    items = Element { elementName = fromString "items"
                    , elementAttributes = DM.fromList [(fromString "node", [ContentText (DT.pack n)])]
                    , elementNodes = [NodeElement item] }
    item :: Element
    item = Element { elementName = fromString "item"
                   , elementAttributes = DM.fromList [(fromString "id", [ContentText (DT.pack i)])]
                   , elementNodes = v }


getComplexRetractMessage :: VariableName -> ItemID -> Subscriber -> Message

getComplexRetractMessage n i s = message Nothing Nothing (Just s) Nothing Normal
                                 [event]
  where
    event :: Element
    event = Element { elementName = Name { nameLocalName = DT.pack "event"
                                         , nameNamespace = Just (DT.pack "http://jabber.org/protocol/pubsub#event")
                                         , namePrefix = Nothing }
                    , elementAttributes = DM.fromList []
                    , elementNodes = [NodeElement items] }
    items :: Element
    items = Element { elementName = fromString "items"
                    , elementAttributes = DM.fromList [(fromString "node", [ContentText (DT.pack n)])]
                    , elementNodes = [NodeElement retract] }
    retract :: Element
    retract = Element { elementName = fromString "retract"
                   , elementAttributes = DM.fromList [(fromString "id", [ContentText (DT.pack i)])]
                   , elementNodes = [] }