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