Reaktor.API: make configurable

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