diff options
| -rw-r--r-- | Que/Host.hs (renamed from Que/Server.hs) | 25 | ||||
| -rw-r--r-- | Que/Host.nix (renamed from Que/Server.nix) | 0 | ||||
| -rw-r--r-- | Que/Site.hs (renamed from Que/Website.hs) | 2 | ||||
| -rw-r--r-- | Que/Site.nix (renamed from Que/Website.nix) | 0 | ||||
| -rw-r--r-- | default.nix | 12 |
5 files changed, 21 insertions, 18 deletions
diff --git a/Que/Server.hs b/Que/Host.hs index 9217ee8..5b51dba 100644 --- a/Que/Server.hs +++ b/Que/Host.hs @@ -20,7 +20,7 @@ -- : dep stm -- : dep unagi-chan -- : dep unordered-containers -module Que.Server +module Que.Host ( main, ) where @@ -55,11 +55,12 @@ main = Exception.bracket startup shutdown <| uncurry Warp.run startup = Envy.decodeWithDefaults Envy.defConfig >>= \c -> do sync <- STM.newTVarIO initialAppState let runActionToIO m = runReaderT (runApp m) sync - waiapp <- Scotty.scottyAppT runActionToIO routes + waiapp <- Scotty.scottyAppT runActionToIO <| routes c putText "*" - putText "que-server" + putText "Que.Host" putText <| "port: " <> (show <| quePort c) - return (quePort c, waiapp) + putText <| "skey: " <> (show <| queSkey c) + return (port c, waiapp) shutdown :: a -> IO a shutdown = pure . identity @@ -84,20 +85,22 @@ newtype AppState initialAppState :: AppState initialAppState = AppState {ques = mempty} -newtype Config +data Config = Config { -- | QUE_PORT - quePort :: Warp.Port + quePort :: Warp.Port, + -- | QUE_SKEY + queSkey :: FilePath } deriving (Generic, Show) instance Envy.DefConfig Config where - defConfig = Config 3000 + defConfig = Config 3000 "/run/skey/que-admin" instance Envy.FromEnv Config -routes :: Scotty.ScottyT Text.Lazy.Text App () -routes = do +routes :: Config -> Scotty.ScottyT Text.Lazy.Text App () +routes cfg = do Scotty.middleware logStdout let quepath = "^\\/([[:alnum:]_-]+)\\/([[:alnum:]._/-]*)$" let namespace = "^\\/([[:alnum:]_-]+)\\/?$" -- matches '/ns' and '/ns/' but not '/ns/path' @@ -108,7 +111,7 @@ routes = do -- GET /_/dash Scotty.get (Scotty.literal "/_/dash") <| do authkey <- fromMaybe "" </ Scotty.header "Authorization" - adminkey <- liftIO <| lchomp </ Text.Lazy.IO.readFile "/run/keys/que-admin" + adminkey <- liftIO <| lchomp </ Text.Lazy.IO.readFile (queSkey cfg) if authkey == adminkey then do d <- app <| gets ques @@ -141,7 +144,7 @@ routes = do -- Put a value on a que. Returns immediately. Scotty.post (Scotty.regex quepath) <| do authkey <- fromMaybe "" </ Scotty.header "Authorization" - adminkey <- liftIO <| lchomp </ Text.Lazy.IO.readFile "/run/keys/que-admin" + adminkey <- liftIO <| lchomp </ Text.Lazy.IO.readFile (queSkey cfg) (ns, qp) <- extract -- Only allow my IP or localhost to publish to '_' namespace when ("_" == ns && authkey /= adminkey) diff --git a/Que/Server.nix b/Que/Host.nix index e326483..e326483 100644 --- a/Que/Server.nix +++ b/Que/Host.nix diff --git a/Que/Website.hs b/Que/Site.hs index 623173b..2b35956 100644 --- a/Que/Website.hs +++ b/Que/Site.hs @@ -12,7 +12,7 @@ -- : dep process -- : dep protolude -- : dep req -module Que.Website +module Que.Site ( main, ) where diff --git a/Que/Website.nix b/Que/Site.nix index 6a24d9d..6a24d9d 100644 --- a/Que/Website.nix +++ b/Que/Site.nix diff --git a/default.nix b/default.nix index 29ed1a3..2915990 100644 --- a/default.nix +++ b/default.nix @@ -43,8 +43,8 @@ in rec { imports = [ ./Biz/packages.nix ./Biz/users.nix - ./Que/Server.nix - ./Que/Website.nix + ./Que/Host.nix + ./Que/Site.nix ./Que/Prod.nix ]; networking.hostName = "prod-que"; @@ -52,12 +52,12 @@ in rec { services.que-server = { enable = true; port = 80; - package = Que.Server; + package = Que.Host; }; services.que-website = { enable = true; namespace = "_"; - package = Que.Website; + package = Que.Site; }; }; # Production server for herocomics.app @@ -84,8 +84,8 @@ in rec { Biz.Ibb.Client = build.ghcjs Biz/Ibb/Client.hs; Hero.Host = build.ghc Hero/Host.hs; Hero.Node = build.ghcjs Hero/Node.hs; - Que.Server = build.ghc ./Que/Server.hs; - Que.Website = build.ghc ./Que/Website.hs; + Que.Host = build.ghc ./Que/Host.hs; + Que.Site = build.ghc ./Que/Site.hs; # Development environment env = build.env; # Fall through to any of our overlay packages |