summaryrefslogtreecommitdiff
path: root/Run/Que/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Run/Que/Server.hs')
-rw-r--r--Run/Que/Server.hs29
1 files changed, 7 insertions, 22 deletions
diff --git a/Run/Que/Server.hs b/Run/Que/Server.hs
index e30a96a..ba7ac86 100644
--- a/Run/Que/Server.hs
+++ b/Run/Que/Server.hs
@@ -80,28 +80,12 @@ routes :: Scotty.ScottyT Text App ()
routes = do
Scotty.middleware logStdout
- let quepath = "^/([[:alnum:]_]*)/([[:alnum:]._/]*)$"
- let namespace = "^/([[:alnum:]_]*)/?$" -- matches '/ns' and '/ns/' but not '/ns/path'
- let index = "^(/|/index.html)$"
+ let quepath = "^/([[:alnum:]_]+)/([[:alnum:]._/]*)$"
+ let namespace = "^/([[:alnum:]_]+)/?$" -- matches '/ns' and '/ns/' but not '/ns/path'
- -- | GET homepage
- Scotty.get (Scotty.regex index) <| do
- let (ns, qp) = ("_", ["index"])
- app . modify <| upsertNamespace ns
- q <- app <| que ns qp
- r <- liftIO <| takeQue q
- Scotty.html <| fromStrict <| Encoding.decodeUtf8 r
-
- -- | POST homepage
- Scotty.post (Scotty.regex index) <| do
- r <- Scotty.request
- guardIP r
- let (ns, qp) = ("_", ["index"])
- app . modify <| upsertNamespace ns
- q <- app <| que ns qp
- qdata <- Scotty.body
- liftIO <| pushQue (BSL.toStrict qdata) q
- return ()
+ -- | GET /index.html
+ Scotty.get (Scotty.literal "/index.html") <| Scotty.redirect "/_/index"
+ Scotty.get (Scotty.literal "/") <| Scotty.redirect "/_/index"
-- | Namespace management
Scotty.matchAny (Scotty.regex namespace) <| do
@@ -130,7 +114,8 @@ routes = do
Scotty.post (Scotty.regex quepath) <| do
r <- Scotty.request
(ns, qp) <- extract
- when (Text.isPrefixOf "_" ns) <| guardIP r
+ -- "_" is a special, internal namespace that only I can use
+ when ("_" == ns) <| guardIP r
app . modify <| upsertNamespace ns
q <- app <| que ns qp
qdata <- Scotty.body