65 lines
2.1 KiB
Haskell
65 lines
2.1 KiB
Haskell
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.ReceivedPresence presence@XMPP.Presence {
|
|
XMPP.presenceType = XMPP.PresenceProbe
|
|
}) = presenceProbeRoute routes presence
|
|
handle (XMPP.ReceivedPresence presence@XMPP.Presence {
|
|
XMPP.presenceType = XMPP.PresenceSubscribe
|
|
}) = presenceSubscribeRoute routes presence
|
|
handle (XMPP.ReceivedPresence presence@XMPP.Presence {
|
|
XMPP.presenceType = XMPP.PresenceError
|
|
}) = presenceErrorRoute routes presence
|
|
handle (XMPP.ReceivedPresence presence) =
|
|
presenceRoute routes presence
|
|
|
|
handle (XMPP.ReceivedIQ iq) = iqRoute routes iq
|
|
|
|
handle (XMPP.ReceivedMessage message@XMPP.Message {
|
|
XMPP.messageType = XMPP.MessageGroupChat
|
|
}) = messageGroupChatRoute routes message
|
|
handle (XMPP.ReceivedMessage message@XMPP.Message {
|
|
XMPP.messageType = XMPP.MessageError
|
|
}) = messageErrorRoute routes message
|
|
handle (XMPP.ReceivedMessage message) = messageRoute routes message
|
|
|
|
data Routes = Routes {
|
|
presenceRoute :: XMPP.Presence -> XMPP.XMPP (),
|
|
presenceErrorRoute :: XMPP.Presence -> XMPP.XMPP (),
|
|
presenceProbeRoute :: XMPP.Presence -> XMPP.XMPP (),
|
|
presenceSubscribeRoute :: XMPP.Presence -> XMPP.XMPP (),
|
|
iqRoute :: XMPP.IQ -> XMPP.XMPP (),
|
|
messageRoute :: XMPP.Message -> XMPP.XMPP (),
|
|
messageGroupChatRoute :: XMPP.Message -> XMPP.XMPP (),
|
|
messageErrorRoute :: XMPP.Message -> XMPP.XMPP ()
|
|
}
|
|
|
|
defaultRoutes :: Routes
|
|
defaultRoutes = Routes {
|
|
presenceRoute = const $ return (),
|
|
presenceErrorRoute = const $ return (),
|
|
presenceProbeRoute = const $ return (),
|
|
presenceSubscribeRoute = const $ return (),
|
|
iqRoute = const $ return (),
|
|
messageRoute = const $ return (),
|
|
messageGroupChatRoute = const $ return (),
|
|
messageErrorRoute = const $ return ()
|
|
}
|