diff options
Diffstat (limited to 'Run/Que/Server.hs')
| -rw-r--r-- | Run/Que/Server.hs | 26 |
1 files changed, 15 insertions, 11 deletions
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 |