~singpolyma/cheogram-smtp

ref: 24e7ff2802e3c403dc33c156c26f18d58792b111 cheogram-smtp/Router.hs -rw-r--r-- 1.4 KiB
24e7ff28Stephen Paul Weber Initial commit 2 years 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
module Router where

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

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

runRouted :: Routes -> XMPP.XMPP ()
runRouted routes = forever $ XMPP.getStanza >>= 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.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 (),
	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 (),
	messageErrorRoute = const $ return ()
}