diff options
Diffstat (limited to 'Que')
-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 |
4 files changed, 15 insertions, 12 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 |