diff options
author | Ben Sima <ben@bsima.me> | 2020-03-31 17:50:07 -0700 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2020-03-31 17:50:07 -0700 |
commit | 492ba39739c869d3f2b9766112232d384a145e38 (patch) | |
tree | df725f32c7ac155db31d39888a497ff71427e8a8 /Run/Que/Server.hs | |
parent | 9493e2dbf9671d55fea2a96aa057589670e9673a (diff) |
Cleanup index and _ ns handling
So now _ is the special namespace that only I can post to. Unfortunately
I think the guardIP function is still broken.
Diffstat (limited to 'Run/Que/Server.hs')
-rw-r--r-- | Run/Que/Server.hs | 29 |
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 |