summaryrefslogtreecommitdiff
path: root/Run
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2020-04-10 23:39:07 -0700
committerBen Sima <ben@bsima.me>2020-04-11 00:04:47 -0700
commitca7ac04518b57180cd6cb0d46bc12fadeb7406ee (patch)
tree36544daab25a99d58b2661eff42fdf39927fd412 /Run
parent76112b8bd26c0e282d5479ccae9d79c4dc28c35d (diff)
Switch que-server to envy
Diffstat (limited to 'Run')
-rw-r--r--Run/Que/Server.hs84
-rw-r--r--Run/Que/Server.nix3
2 files changed, 38 insertions, 49 deletions
diff --git a/Run/Que/Server.hs b/Run/Que/Server.hs
index 5973ec2..45ad1bc 100644
--- a/Run/Que/Server.hs
+++ b/Run/Que/Server.hs
@@ -2,11 +2,14 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DeriveGeneric #-}
-- | Interprocess communication
--
-- : exe que-server
+--
-- : dep async
+-- : dep envy
-- : dep protolude
-- : dep scotty
-- : dep stm
@@ -41,38 +44,45 @@ import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import Network.Wai.Middleware.RequestLogger
( logStdout )
-import qualified System.Console.GetOpt as Opt
-import qualified System.Environment as Environment
+import qualified System.Envy as Envy
+import qualified System.Exit as Exit
import qualified Web.Scotty.Trans as Scotty
main :: IO ()
-main = Exception.bracket startup shutdown run
+main = Exception.bracket startup shutdown <| uncurry Warp.run
where
- run (p, waiapp) =
- putText ("que-server starting on port " <> show p) >> Warp.run p waiapp
- startup = do
- opts <- Environment.getArgs /> getOpts
- sync <- STM.newTVarIO opts
- let runActionToIO m = runReaderT (runApp m) sync
- waiapp <- Scotty.scottyAppT runActionToIO routes
- return (port opts, waiapp)
+ startup = Envy.decodeEnv >>= \case
+ Left e -> Exit.die e
+ Right c -> do
+ sync <- STM.newTVarIO initialAppState
+ let runActionToIO m = runReaderT (runApp m) sync
+ waiapp <- Scotty.scottyAppT runActionToIO routes
+ putText <| "port:" <> (show <| quePort c)
+ return (quePort c, waiapp)
shutdown :: a -> IO a
shutdown = pure . identity
- getOpts args = case Opt.getOpt Opt.Permute options args of
- ([] , [], _) -> Exception.throw ErrorParsingOptions
- (opts, _ , _) -> smoosh initialAppState opts
- options =
- [ Opt.Option
- ['p']
- ["port"]
- (Opt.ReqArg (\n m -> m { port = read n :: Warp.Port }) "PORT")
- "port to run on "
- ]
-
-data Error = ErrorParsingOptions
- deriving (Show)
-
-instance Exception.Exception Error
+
+newtype App a = App
+ { runApp :: ReaderT (STM.TVar AppState) IO a
+ }
+ deriving (Applicative, Functor, Monad, MonadIO, MonadReader
+ (STM.TVar AppState))
+
+data AppState = AppState
+ { ques :: HashMap Namespace Quebase
+ }
+
+initialAppState :: AppState
+initialAppState = AppState { ques = mempty }
+
+data Config = Config
+ { quePort :: Warp.Port -- ^ QUE_PORT
+ } deriving (Generic, Show)
+
+instance Envy.DefConfig Config where
+ defConfig = Config 3000
+
+instance Envy.FromEnv Config
routes :: Scotty.ScottyT Text App ()
routes = do
@@ -191,28 +201,6 @@ extract = do
path <- Scotty.param "2"
return (ns, path)
-newtype App a = App
- { runApp :: ReaderT (STM.TVar AppState) IO a
- }
- deriving (Applicative, Functor, Monad, MonadIO, MonadReader
- (STM.TVar AppState))
-
-data AppState = AppState
- { ques :: HashMap Namespace Quebase
- , port :: Warp.Port
- }
-
-initialAppState :: AppState
-initialAppState = AppState { port = 80, ques = mempty }
-
--- | Resolve a list of 'AppState' transitions into one.
-smoosh
- :: AppState -- ^ Initial app state to start with
- -> [AppState -> AppState] -- ^ List of functions to apply in order
- -> AppState
-smoosh = foldr identity
--- there's gotta be a standard name for this
-
-- | A synonym for 'lift' in order to be explicit about when we are
-- operating at the 'App' layer.
app :: MonadTrans t => App a -> t App a
diff --git a/Run/Que/Server.nix b/Run/Que/Server.nix
index 272ea6e..e326483 100644
--- a/Run/Que/Server.nix
+++ b/Run/Que/Server.nix
@@ -29,12 +29,13 @@ in
path = [ cfg.package ];
wantedBy = [ "multi-user.target" ];
script = ''
- ${cfg.package}/bin/que-server -p ${toString cfg.port}
+ ${cfg.package}/bin/que-server
'';
description = ''
Que server
'';
serviceConfig = {
+ Environment = ["QUE_PORT=${toString cfg.port}"];
KillSignal = "INT";
Type = "simple";
Restart = "on-abort";