aboutsummaryrefslogtreecommitdiff
path: root/src/Application.hs
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2016-06-15 15:44:25 +0800
committerIgor Pashev <pashev.igor@gmail.com>2016-06-15 22:05:12 +0800
commitf8d1c5b2c6f9351f300c596bc51d38d793b9e389 (patch)
tree2d633146b47e6ba304dd2d614f77a827588af814 /src/Application.hs
parent76860ce667a40b69866241c1bf0b8ab76f50d1d2 (diff)
downloadmywatch-f8d1c5b2c6f9351f300c596bc51d38d793b9e389.tar.gz
Use HEAD /server/:server/processlist.json
To see which servers are really allowed by Sproxy
Diffstat (limited to 'src/Application.hs')
-rw-r--r--src/Application.hs22
1 files changed, 16 insertions, 6 deletions
diff --git a/src/Application.hs b/src/Application.hs
index 63aa258..899893e 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -18,14 +18,14 @@ import Data.Pool (Pool, withResource)
import Data.Text.Lazy (Text)
import Database.MySQL.Simple (Connection, query_)
import GHC.Generics (Generic)
-import Network.HTTP.Types (notFound404)
+import Network.HTTP.Types (ok200, notFound404, StdMethod(HEAD))
import Network.Wai (Application, Middleware)
import Network.Wai.Middleware.RequestLogger (Destination(Handle),
mkRequestLogger, RequestLoggerSettings(destination, outputFormat),
OutputFormat(CustomOutputFormat))
import Network.Wai.Middleware.Static (addBase, hasPrefix, staticPolicy, (>->))
import System.IO (stderr)
-import Web.Scotty (ScottyM, ActionM, middleware, json, file, get,
+import Web.Scotty (ScottyM, ActionM, middleware, json, file, addroute, get,
status, text, param, scottyApp)
import qualified Data.HashMap.Lazy as HM
@@ -51,7 +51,10 @@ myProcess ps logger dataDir = do
get "/index.html" $ file index_html
get "/serverlist.json" $ json (sort $ HM.keys ps)
- get "/server/:server/processlist.json" $ apiGetProcesses ps
+ get "/server/:server/processlist.json" $ apiGetProcessList ps
+
+ -- Used by client to see which servers are really allowed by Sproxy
+ addroute HEAD "/server/:server/processlist.json" $ apiCanProcessList ps
data Process = Process {
id :: Int
@@ -65,12 +68,19 @@ data Process = Process {
} deriving (Generic)
instance ToJSON Process
-apiGetProcesses :: Pools -> ActionM ()
-apiGetProcesses ps = do
+apiCanProcessList :: Pools -> ActionM ()
+apiCanProcessList ps = do
+ server <- param "server"
+ case HM.lookup server ps of
+ Nothing -> status notFound404 >> text server
+ Just _ -> status ok200
+
+apiGetProcessList :: Pools -> ActionM ()
+apiGetProcessList ps = do
server <- param "server"
case HM.lookup server ps of
Nothing -> status notFound404 >> text server
- Just p -> do
+ Just p -> do
res <- withDB p $ \c ->
query_ c "SELECT \
\id, user, host, db, command, time, state, info \