From 91ebff5793573ddcfbd40ca13f8c900e8b41ab32 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Tue, 31 Mar 2020 13:17:45 -0700
Subject: Fix guardIP and some other cleanup
Apparently guardIP wasn't working because it wasn't matching on the
right string, *and* I had typo'ed my IP address. I took this opportunity
to also organize the Scotty code a bit better with some comments.
---
Run/Que/Server.hs | 26 +++++++++++++++-----------
1 file changed, 15 insertions(+), 11 deletions(-)
(limited to 'Run')
diff --git a/Run/Que/Server.hs b/Run/Que/Server.hs
index 1acbe60..fe88014 100644
--- a/Run/Que/Server.hs
+++ b/Run/Que/Server.hs
@@ -20,7 +20,6 @@ import qualified Com.Simatime.Go as Go
import qualified Control.Concurrent.STM as STM
import qualified Control.Exception as Exception
import Control.Monad.Reader ( MonadTrans )
-import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder.Extra as Builder
import qualified Data.ByteString.Lazy as BSL
import Data.HashMap.Lazy ( HashMap )
@@ -75,15 +74,17 @@ guardIP r = case Wai.remoteHost r of
Socket.SockAddrInet _ ip | ip `elem` allowed -> Scotty.status Http.ok200
_ -> Scotty.status Http.methodNotAllowed405
where
- allowed = Socket.tupleToHostAddress </ [(72, 222, 221, 62), (127, 0, 0, 1)]
+ allowed = Socket.tupleToHostAddress </ [(73, 222, 221, 62), (127, 0, 0, 1)]
routes :: Scotty.ScottyT Text App ()
routes = do
Scotty.middleware logStdoutDev
- let quepath = "^/([[:alnum:]_]*)/([[:alnum:]._/]*)$"
- let index = "^(/|/index.html)$"
+ let quepath = "^/([[:alnum:]_]*)/([[:alnum:]._/]*)$"
+ let namespace = "^/([[:alnum:]_]*)/?$" -- matches '/ns' and '/ns/' but not '/ns/path'
+ let index = "^(/|/index.html)$"
+ -- | GET homepage
Scotty.get (Scotty.regex index) <| do
let (ns, qp) = ("_", ["index"])
app . modify <| upsertNamespace ns
@@ -91,6 +92,7 @@ routes = do
r <- liftIO <| takeQue q
Scotty.html <| fromStrict <| Encoding.decodeUtf8 r
+ -- | POST homepage
Scotty.post (Scotty.regex index) <| do
r <- Scotty.request
guardIP r
@@ -101,17 +103,18 @@ routes = do
liftIO <| pushQue (BSL.toStrict qdata) q
return ()
- Scotty.matchAny (Scotty.regex "^/([[:alnum:]_]*)/?$") <| do
- -- matches '/ns' and '/ns/' but not '/ns/path'
+ -- | Namespace management
+ Scotty.matchAny (Scotty.regex namespace) <| do
Scotty.status Http.notImplemented501
Scotty.text "namespace management coming soon"
- -- | Receive a value from a que. Blocks until a value is received,
+ -- | GET que
+ --
+ -- Receive a value from a que. Blocks until a value is received,
-- then returns. If 'poll=true', then stream data from the Que to the
-- client.
Scotty.get (Scotty.regex quepath) <| do
(ns, qp) <- extract
- -- ensure namespace exists
app . modify <| upsertNamespace ns
q <- app <| que ns qp
poll <- Scotty.param "poll" !: (pure . const False)
@@ -121,12 +124,13 @@ routes = do
r <- liftIO <| takeQue q
Scotty.html <| fromStrict <| Encoding.decodeUtf8 r
- -- | Put a value on a que. Returns immediately.
+ -- | POST que
+ --
+ -- Put a value on a que. Returns immediately.
Scotty.post (Scotty.regex quepath) <| do
r <- Scotty.request
- when (BS.isPrefixOf "/_" <| Wai.rawPathInfo r) $ guardIP r
(ns, qp) <- extract
- -- ensure namespace exists
+ when (Text.isPrefixOf "_" ns) <| guardIP r
app . modify <| upsertNamespace ns
q <- app <| que ns qp
qdata <- Scotty.body
--
cgit v1.2.3