module Router where

import Prelude ()
import BasicPrelude
import Control.Error                   (ExceptT (..))
import qualified Network.Protocol.XMPP as XMPP

import Util

runRoutedComponent ::
	   XMPP.Server
	-> Text
	-> XMPP.XMPP Routes
	-> ExceptT XMPP.Error IO ()
runRoutedComponent server secret =
	ExceptT . XMPP.runComponent server secret . (runRouted =<<)

runRouted :: Routes -> XMPP.XMPP ()
runRouted routes = forever $ XMPP.getStanza >>= (void . forkXMPP . handle)
	where
	handle (XMPP.ReceivedIQ iq@XMPP.IQ { XMPP.iqType = XMPP.IQGet }) =
		iqGetRoute routes iq
	handle (XMPP.ReceivedIQ iq@XMPP.IQ { XMPP.iqType = XMPP.IQSet }) =
		iqSetRoute routes iq
	handle (XMPP.ReceivedIQ iq@XMPP.IQ { XMPP.iqType = XMPP.IQResult }) =
		iqResultRoute routes iq
	handle (XMPP.ReceivedIQ iq@XMPP.IQ { XMPP.iqType = XMPP.IQError }) =
		iqErrorRoute routes iq
	handle (XMPP.ReceivedMessage message@XMPP.Message {
		XMPP.messageType = XMPP.MessageNormal
	}) = messageNormalRoute routes message
	handle (XMPP.ReceivedMessage message@XMPP.Message {
		XMPP.messageType = XMPP.MessageChat
	}) = messageChatRoute routes message
	handle (XMPP.ReceivedMessage message@XMPP.Message {
		XMPP.messageType = XMPP.MessageHeadline
	}) = messageHeadlineRoute routes message
	handle (XMPP.ReceivedMessage message@XMPP.Message {
		XMPP.messageType = XMPP.MessageError
	}) = messageErrorRoute routes message
	handle _ = return ()

data Routes = Routes {
	iqGetRoute :: XMPP.IQ -> XMPP.XMPP (),
	iqSetRoute :: XMPP.IQ -> XMPP.XMPP (),
	iqResultRoute :: XMPP.IQ -> XMPP.XMPP (),
	iqErrorRoute :: XMPP.IQ -> XMPP.XMPP (),
	messageNormalRoute :: XMPP.Message -> XMPP.XMPP (),
	messageChatRoute :: XMPP.Message -> XMPP.XMPP (),
	messageHeadlineRoute :: XMPP.Message -> XMPP.XMPP (),
	messageErrorRoute :: XMPP.Message -> XMPP.XMPP ()
}

defaultRoutes :: Routes
defaultRoutes = Routes {
	iqGetRoute = XMPP.putStanza . iqError notImplemented,
	iqSetRoute = XMPP.putStanza . iqError notImplemented,
	iqResultRoute = const $ return (),
	iqErrorRoute = const $ return (),
	messageNormalRoute = const $ return (),
	messageChatRoute = const $ return (),
	messageHeadlineRoute = const $ return (),
	messageErrorRoute = const $ return ()
}