diff options
Diffstat (limited to 'Run/Que/Server.hs')
| -rw-r--r-- | Run/Que/Server.hs | 28 |
1 files changed, 19 insertions, 9 deletions
diff --git a/Run/Que/Server.hs b/Run/Que/Server.hs index 4974498..146a16a 100644 --- a/Run/Que/Server.hs +++ b/Run/Que/Server.hs @@ -35,6 +35,7 @@ import qualified Data.Text.Encoding as Encoding import Data.Text.Lazy ( Text , fromStrict ) +import qualified Data.Text.Lazy.IO as Text import qualified Network.HTTP.Types.Status as Http import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp @@ -84,6 +85,19 @@ routes = do Scotty.get (Scotty.literal "/index.html") <| Scotty.redirect "/_/index" Scotty.get (Scotty.literal "/") <| Scotty.redirect "/_/index" + -- | GET /_/dash + Scotty.get (Scotty.literal "/_/dash") <| do + authkey <- fromMaybe "" </ Scotty.header "Authorization" + adminkey <- liftIO <| lchomp </ Text.readFile "/run/keys/que-admin" + if authkey == adminkey + then do + d <- app <| gets ques + Scotty.json d + else do + Scotty.status Http.methodNotAllowed405 + Scotty.text "not allowed" + + -- | Namespace management Scotty.matchAny (Scotty.regex namespace) <| do Scotty.status Http.notImplemented501 @@ -110,17 +124,13 @@ routes = do -- -- Put a value on a que. Returns immediately. Scotty.post (Scotty.regex quepath) <| do - xFwdHost <- Scotty.header "X-Forwarded-Host" - xRealIP <- Scotty.header "X-Real-IP" - host <- Scotty.header "Host" + authkey <- fromMaybe "" </ Scotty.header "Authorization" + adminkey <- liftIO <| lchomp </ Text.readFile "/run/keys/que-admin" (ns, qp) <- extract -- 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 ("localhost:3000")) -> Scotty.status Http.ok200 - _ -> Scotty.status Http.methodNotAllowed405 - >> Scotty.text "not allowed: _ is a reserved namespace" + when ("_" == ns && authkey /= adminkey) + <| Scotty.status Http.methodNotAllowed405 + >> Scotty.text "not allowed: _ is a reserved namespace" guardNs ns ["pub", "_"] -- passed all auth checks app . modify <| upsertNamespace ns |