DirectoryDevice.hs

{-

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: XPMN device implementing the Pontarius Directory profile
--   Copyright:   Copyright © 2010-2011 Jon Kristensen
--   License:     AGPL-3
--   
--   Maintainer:  info@pontarius.org
--   Stability:   unstable
--   Portability: portable

module Media.XPMN.Server.DirectoryDevice (start) where

import Network.XMPP
import Network.XMPP.Utilities -- TODO
import qualified Media.XPMN.DeviceServer as MXD
import Media.XPMN.Server.Object
import qualified Media.XPMN.Server.ObjectServer as MXSO
import qualified Media.XPMN.Server.Object as MXSO_
import Media.XPMN.Server.ObjectServer hiding (start)

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Data.Maybe
import Data.XML.Types
import qualified Data.Text as DT
import System.Random

import qualified Data.Map as DM

data State = State { deviceServer :: MXD.DeviceServer
                   , objectServerWrite :: (ObjectServerInEvent -> IO ())
                   , stateQueries :: [MXD.Query ObjectServerOutEvent] }

data InternalEvent = IED MXD.DeviceInEvent | IEO ObjectServerOutEvent deriving (Show)

-- instance XMLable ObjectServerOutEvent where
--   toXML Ping = [NodeElement (Element (Name (DT.pack "ping") Nothing Nothing) (DM.fromList []) [])]
--   fromXML [NodeElement (Element { elementName = n })] | nameLocalName n == DT.pack "ping" = Ping

start h u s po r pa osw osr =
  do deviceServer <- MXD.start s po u pa r [] ["..."] -- TODO
     c <- newChan
     putStrLn $ "?????????????????"
     forkIO $ readObjectStuff osr c
     forkIO $ readXMPPStuff (MXD.inEvents deviceServer) c
     forkIO $ loop (State { deviceServer = deviceServer
                          , objectServerWrite = osw
                          , stateQueries = [] }) c
     return ()
    where
      loop :: State -> Chan InternalEvent -> IO ()
      loop s c =
        do putStrLn $ "!!!!!!!!!!!!!!!!!"
           e <- readChan c
           putStrLn $ "DirectoryDevice: Got Event: " ++ (show e)
           s' <- processEvent s e
           loop s' c
      
      processEvent :: State -> InternalEvent -> IO State
      
      processEvent s (IED MXD.DIEOnline) = do
        putStrLn "We are online!"
        return s
      
      -- TODO: There is an architectural problem with Pontarius XMPP, Pontarius
      -- XPMN and the ObjectServer that prohibits us to have a proper system for
      -- message passing, replying to messages and ID's. We need to look this
      -- over soon.
      
      -- TODO:
      -- processEvent s (IED (MXD.DIEQuery j "even-numbers" _)) = do
      --   let que = query j even :: Query Integer
      --   return s { stateQueries = que:(stateQueries s) }
      
      -- TODO: Add (optional) metadata
      processEvent s (IED (MXD.DIEIQ (IQSet { iqSetPayload = p })))
        | (nameLocalName $ elementName p) == DT.pack "add-container" = do
        putStrLn $ "Got request to add a container."
        objectServerWrite s $ MXSO.OSIEPersistObject (MXSO_.container Nothing Nothing)
        return s
      
      -- TODO: Add size, hash and (optional) metadata
      processEvent s (IED (MXD.DIEIQ (IQSet { iqSetPayload = p })))
        | (nameLocalName $ elementName p) == DT.pack "add-item" = do
        putStrLn $ "Got request to add an item."
        objectServerWrite s $ MXSO.OSIEPersistObject (MXSO_.item Nothing Nothing Nothing Nothing)
        return s
      
      -- TODO: Add object ID and (optional) metadata
      processEvent s (IED (MXD.DIEIQ (IQSet { iqSetPayload = p })))
        | (nameLocalName $ elementName p) == DT.pack "modify-object" = do
        putStrLn $ "Got request to modify an object."
        objectServerWrite s $ MXSO.OSIEUpdateObject (MXSO_.item Nothing Nothing Nothing Nothing)
        return s
      
      -- TODO: Add object ID
      processEvent s (IED (MXD.DIEIQ (IQSet { iqSetPayload = p })))
        | (nameLocalName $ elementName p) == DT.pack "delete-object" = do
        putStrLn $ "Got request to delete an object."
        -- TODO: Delete using the object server
        return s
      
      processEvent s (IED (MXD.DIEIQ i)) = do
        putStrLn $ "Got an IQ that was not processed by DeviceServer or us: " ++
          (show i)
        return s
      
      processEvent s (IEO x) = do
        putStrLn $ show x
        return s
      --   q' <- mapM (\ q -> (queryRetract (deviceServer s)) q idToRemove) (stateQueries s)
      --   q'' <- mapM (\ q -> (queryPublish (deviceServer s)) q idToAdd number) (stateQueries s)
        
      --   return s { pingpongVar = s', stateStd = stdGen', stateQueries = q'' }

-- IO ObjectServerOutEvent
readObjectStuff c c' = do
  e <- c
  writeChan c' (IEO e)
  readObjectStuff c c'

readXMPPStuff c c' = do
  e <- readChan c
  writeChan c' (IED e)
  readXMPPStuff c c'