summaryrefslogtreecommitdiff
path: root/Que
diff options
context:
space:
mode:
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