aboutsummaryrefslogtreecommitdiffstats
path: root/src/Reaktor
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2020-04-17 22:41:53 +0200
committertv <tv@krebsco.de>2020-04-17 23:11:07 +0200
commit7dfc802b753f21afcb656b13d30d49bc548ac150 (patch)
tree664d84c3f6ec28b7affc26b509ddc608bd06939d /src/Reaktor
parentd6d51de7c9d54691b33a8ae9691fd0402259006a (diff)
Reaktor.API: make configurable
Diffstat (limited to 'src/Reaktor')
-rw-r--r--src/Reaktor/API.hs49
1 files changed, 45 insertions, 4 deletions
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