From 7dfc802b753f21afcb656b13d30d49bc548ac150 Mon Sep 17 00:00:00 2001 From: tv Date: Fri, 17 Apr 2020 22:41:53 +0200 Subject: Reaktor.API: make configurable --- README.md | 41 ++++++++++++++++++++ reaktor2.cabal | 1 + src/Network/Socket/Extended.hs | 78 ++++++++++++++++++++++++++++++++++++++ src/Reaktor.hs | 6 +-- src/Reaktor/API.hs | 49 ++++++++++++++++++++++-- src/System/Posix/Files/Extended.hs | 17 +++++++++ src/main.hs | 7 +++- 7 files changed, 191 insertions(+), 8 deletions(-) create mode 100644 src/Network/Socket/Extended.hs create mode 100644 src/System/Posix/Files/Extended.hs diff --git a/README.md b/README.md index fecb136..c5a5cc6 100644 --- a/README.md +++ b/README.md @@ -29,3 +29,44 @@ withArgs ["config.json"] main :r +# HTTP API + + Reaktor can provide an HTTP API so external applications can control + its behavior. At the moment this is restricted to send PRIVMSGs to + registered channels. + +## Enable the HTTP API + + To enable the HTTP API, a listening address has to be configured. + This address can be a TCP port, specified like follows: + + { + "API": { + "listen": "inet://127.0.0.1:7777" + } + } + + or it can be an Unix domain socket, specified like follows: + + { + "API": { + "listen": "unix:/path/to/reaktor.sock" + } + } + +## Example usage of the HTTP API + + Let's say your reaktor instance has been configured to listen to + inet://localhost:7777, and the register plugin has been configured + to join #somechannel. Then it is possible to send a PRIVMSG to + this channel using e.g. following command: + + curl -fsSv http://localhost:7777/ \ + -H content-type:application/json \ + -d "$(jq -n '{command:"PRIVMSG",params:["#somechannel","derp!"]}')" + + And similarly if unix:/path/to/reaktor.sock has been used instead: + + curl -fsSv --unix-socket /path/to/reaktor.sock http://dontcare/ \ + -H content-type:application/json \ + -d "$(jq -n '{command:"PRIVMSG",params:["#somechannel","derp!"]}')" diff --git a/reaktor2.cabal b/reaktor2.cabal index 2c227dd..76095f9 100644 --- a/reaktor2.cabal +++ b/reaktor2.cabal @@ -23,6 +23,7 @@ executable reaktor network, network-simple, network-simple-tls, + network-uri, pcre-light, process, random, diff --git a/src/Network/Socket/Extended.hs b/src/Network/Socket/Extended.hs new file mode 100644 index 0000000..8d71956 --- /dev/null +++ b/src/Network/Socket/Extended.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +module Network.Socket.Extended + ( module Exports + , openSocket + , closeSocket + , getAddrFamily + , getAddrPort + , readListenString + ) where + +import qualified Network.Socket as Exports + +import Network.Socket +import Network.URI +import Network.Wai.Handler.Warp (Port) +import System.Posix.Files.Extended (removeIfExists) + +openSocket :: SockAddr -> IO Socket +openSocket sockAddr = do + let family = getAddrFamily sockAddr + case sockAddr of + SockAddrUnix sockFile -> removeIfExists sockFile + _ -> return () + socket family Stream defaultProtocol + +closeSocket :: Socket -> IO () +closeSocket sock = do + name <- getSocketName sock + close sock + case name of + SockAddrUnix sockFile -> removeIfExists sockFile + _ -> return () + +getAddrFamily :: SockAddr -> Family +getAddrFamily = \case + SockAddrInet _ _ -> AF_INET + SockAddrInet6 _ _ _ _ -> AF_INET6 + SockAddrUnix _ -> AF_UNIX + sockAddr -> error ("getAddrFamily: don't know family of " <> show sockAddr) + +getAddrPort :: SockAddr -> Port +getAddrPort = \case + SockAddrInet portNumber _ -> fromIntegral portNumber + SockAddrInet6 portNumber _ _ _ -> fromIntegral portNumber + _ -> 0 + +readListenString :: String -> IO (Either String SockAddr) +readListenString cListen = + case parseURI cListen of + Just URI{..} -> + case uriScheme of + "inet:" -> + case uriAuthority of + Just URIAuth{..} -> do + let + hostName = + if uriRegName == "" then + Nothing + else + Just uriRegName + serviceName = + if uriPort == "" then + Nothing + else + Just (tail uriPort) + AddrInfo{..}:_ <- + getAddrInfo Nothing hostName serviceName + return (Right addrAddress) + Nothing -> + return (Left "could not parse inet listen string") + "unix:" -> + return (Right (SockAddrUnix uriPath)) + invalid -> + return (Left ("unsupported listen scheme: " <> invalid)) + Nothing -> + return (Left "could not parse listen string") + diff --git a/src/Reaktor.hs b/src/Reaktor.hs index 0d4e42c..cc93109 100644 --- a/src/Reaktor.hs +++ b/src/Reaktor.hs @@ -41,8 +41,8 @@ import System.IO (hIsTerminalDevice) import System.Posix.Signals -run :: Config -> (Actions -> IO [Message -> IO ()]) -> IO () -run Config{..} getPlugins = +run :: Config -> Maybe API.Config -> (Actions -> IO [Message -> IO ()]) -> IO () +run Config{..} apiConfig getPlugins = if cUseTLS then do s <- TLS.getDefaultClientSettings (cHostName, BS.pack cServiceName) TLS.connect s cHostName cServiceName $ \(ctx, sockAddr) -> @@ -84,7 +84,7 @@ run Config{..} getPlugins = plugins <- getPlugins actions threads <- mapM (\f -> forkIO $ f `finally` shutdown) [ - API.main actions, + API.main actions apiConfig, receiver actions putInMsg sockRecv, logger cLogHandle takeLog, pinger aSend, diff --git a/src/Reaktor/API.hs b/src/Reaktor/API.hs index 3fff464..4cc4fe9 100644 --- a/src/Reaktor/API.hs +++ b/src/Reaktor/API.hs @@ -7,12 +7,19 @@ module Reaktor.API where import Blessings +import Control.Concurrent +import Control.Exception (bracket) +import Control.Monad import Control.Monad.IO.Class +import Data.Aeson +import Data.Aeson.Types (typeMismatch) +import Data.Function ((&)) import Data.Proxy (Proxy) import qualified Data.Text as T +import Network.Socket.Extended import Network.Wai import Network.Wai.Handler.Warp -import Reaktor.Internal +import Reaktor.Internal (Actions(..),Message(..)) import Reaktor.IRC import Servant @@ -21,14 +28,48 @@ type API = ReqBody '[JSON] Message :> PostAccepted '[JSON] NoContent +data Config = Config + { cListen :: String + } +instance FromJSON Config where + parseJSON = \case + Object v -> do + cListen <- v .: "listen" + pure Config{..} + invalid -> typeMismatch "Config" invalid + + api :: Proxy API api = Proxy -main :: Actions -> IO () -main Actions{..} = do - run 7777 +main :: Actions -> Maybe Config -> IO () +main Actions{..} = \case + Just Config{..} -> + either disable enable =<< readListenString cListen + Nothing -> + disable "no configuration" where + enable sockAddr = + bracket + (openSocket sockAddr) + closeSocket + $ \sock -> do + aLog $ SGR [38,5,155] + ("* enabling API on " <> Plain (T.pack $ show sockAddr)) + let port = getAddrPort sockAddr + settings = defaultSettings & setPort port + bind sock sockAddr + listen sock maxListenQueue + runSettingsSocket settings sock + $ app + + disable :: String -> IO () + disable reason = do + aLog $ SGR [38,5,196] + ("! disabling API due to " <> Plain (T.pack reason)) + forever $ threadDelay 60000 + app :: Application app = serve api server diff --git a/src/System/Posix/Files/Extended.hs b/src/System/Posix/Files/Extended.hs new file mode 100644 index 0000000..da82359 --- /dev/null +++ b/src/System/Posix/Files/Extended.hs @@ -0,0 +1,17 @@ +module System.Posix.Files.Extended + ( module Exports + , removeIfExists + ) where + +import qualified System.Posix.Files as Exports + +import Control.Exception (catch, throwIO) +import System.IO.Error (isDoesNotExistError) +import System.Posix.Files (removeLink) + +removeIfExists :: FilePath -> IO () +removeIfExists fileName = removeLink fileName `catch` handleExists + where handleExists e + | isDoesNotExistError e = return () + | otherwise = throwIO e + diff --git a/src/main.hs b/src/main.hs index 89966c2..51bc17c 100644 --- a/src/main.hs +++ b/src/main.hs @@ -23,7 +23,7 @@ main = do v <- preview _Value <$> readFile configPath - Reaktor.run (reaktorConfig v) $ \actions -> + Reaktor.run (reaktorConfig v) (apiConfig v) $ \actions -> mapM id [ Reaktor.Plugins.Mention.new actions, Reaktor.Plugins.Ping.new actions, @@ -32,6 +32,11 @@ main = do ] +apiConfig :: (FromJSON b) => Maybe Value -> Maybe b +apiConfig = \case + Just v -> maybe Nothing parseOrDie (v ^? key "API") + Nothing -> Nothing + reaktorConfig :: (FromJSON b, Default b) => Maybe Value -> b reaktorConfig = maybe def parseOrDie -- cgit v1.2.3