~singpolyma/cheogram-muc-bridge

ref: 3b77e21c249749ffa584a7ec079b50a2a9510601 cheogram-muc-bridge/Router.hs -rw-r--r-- 2.1 KiB
3b77e21c — Stephen Paul Weber Allow no subscript 1 year, 7 months ago 
                                                                                
d0cf3b4b Stephen Paul Weber 

















1a6f4069 Stephen Paul Weber 

d0cf3b4b Stephen Paul Weber 













































1 year, 9 months ago

















1 year, 8 months ago

1 year, 9 months ago













































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

module Router where

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


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 . 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 ()
}