diff options
Diffstat (limited to 'src/Reaktor')
-rw-r--r-- | src/Reaktor/API.hs | 49 |
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 |