blob: 3fff4645410cd82fa26a4ee57249835bcb9372f1 (
plain)
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
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}
module Reaktor.API where
import Blessings
import Control.Monad.IO.Class
import Data.Proxy (Proxy)
import qualified Data.Text as T
import Network.Wai
import Network.Wai.Handler.Warp
import Reaktor.Internal
import Reaktor.IRC
import Servant
type API =
ReqBody '[JSON] Message :> PostAccepted '[JSON] NoContent
api :: Proxy API
api = Proxy
main :: Actions -> IO ()
main Actions{..} = do
run 7777
where
app :: Application
app = serve api server
server :: Server API
server =
serveTest
serveTest :: Message -> Handler NoContent
serveTest = \case
-- Allowing just private messages to (registered) channels for now.
msg@(Message Nothing PRIVMSG [msgtarget,_]) | isChannelName msgtarget -> do
liftIO $ aSend msg
return NoContent
_ ->
throwError err403
where
-- Channel names are defined in RFC 2812, 1.3
isChannelName msgtarget =
case T.uncons msgtarget of
Just (c, _) -> c `elem` ("&#+!" :: String)
Nothing -> False
|
