Make pub the only publically-writable namespace

1 files changed, 16 insertions, 3 deletions

diff --git a/Run/Que/Server.hs b/Run/Que/Server.hs
index 218c821..38c6bdc 100644
--- a/Run/Que/Server.hs
+++ b/Run/Que/Server.hs
@@ -92,6 +92,7 @@ routes = do
     app . modify <| upsertNamespace ns
     q    <- app <| que ns qp
     poll <- Scotty.param "poll" !: (pure . const False)
+    guardNs ns ["pub", "_"]
     case poll of
       True -> Scotty.stream $ streamQue q
       _    -> do
@@ -106,19 +107,31 @@ routes = do
     xRealIP  <- Scotty.header "X-Real-IP"
     host     <- Scotty.header "Host"
     (ns, qp) <- extract
-    -- Only allow my IP or localhost to access '_' namespace
+    -- Only allow my IP or localhost to publish to '_' namespace
     when ("_" == ns) <| case (xFwdHost, xRealIP, host) of
       (Just "73.222.221.62", _, _) -> Scotty.status Http.ok200
       (_, Just "73.222.221.62", _) -> Scotty.status Http.ok200
-      (Just "::1", Just "::1", Just "localhost") -> Scotty.status Http.ok200
+      (_, _, Just ("localhost:3000")) -> Scotty.status Http.ok200
       _ -> Scotty.status Http.methodNotAllowed405
-        >> Scotty.text "error 405 not allowed: _ is a reserved namespace"
+        >> Scotty.text "not allowed: _ is a reserved namespace"
+    guardNs ns ["pub"]
+    -- passed all auth checks
     app . modify <| upsertNamespace ns
     q     <- app <| que ns qp
     qdata <- Scotty.body
     liftIO <| pushQue (BSL.toStrict qdata) q
     return ()
 
+-- | Given `guardNs ns whitelist`, if `ns` is not in the `whitelist`
+-- list, return a 405 error.
+guardNs :: Text -> [Text] -> Scotty.ActionT Text App ()
+guardNs ns whitelist = when (not <| ns `elem` whitelist) <| do
+  Scotty.status Http.methodNotAllowed405
+  Scotty.text
+    <| "not allowed: use 'pub' namespace or signup to protect '"
+    <> ns
+    <> "' at https://que.run"
+
 -- | recover from a scotty-thrown exception.
 (!:)
   :: Scotty.ActionT Text App a -- ^ action that might throw