diff options
author | tv <tv@krebsco.de> | 2020-04-16 14:04:05 +0200 |
---|---|---|
committer | tv <tv@krebsco.de> | 2020-04-17 23:10:46 +0200 |
commit | d6d51de7c9d54691b33a8ae9691fd0402259006a (patch) | |
tree | 25051459285859f0c7840cb94e4d5da2e2c61421 /src/Reaktor/API.hs | |
parent | 2bd52320dfc3bbf5d86cd74e7b76209a8cb7a330 (diff) |
Reaktor.API: init
Diffstat (limited to 'src/Reaktor/API.hs')
-rw-r--r-- | src/Reaktor/API.hs | 52 |
1 files changed, 52 insertions, 0 deletions
diff --git a/src/Reaktor/API.hs b/src/Reaktor/API.hs new file mode 100644 index 0000000..3fff464 --- /dev/null +++ b/src/Reaktor/API.hs @@ -0,0 +1,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 |