From 85f883f4de4f454a485e527ce70b183b60031a0c Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Tue, 21 Oct 2014 16:31:22 +0200 Subject: [PATCH] make sure the path matches exactly in GET, and check that the client actually made a GET request --- src/Soenke.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/Soenke.hs b/src/Soenke.hs index 8026673a..44394942 100644 --- a/src/Soenke.hs +++ b/src/Soenke.hs @@ -64,13 +64,15 @@ class HasServer layout where instance ToJSON result => HasServer (Get result) where type Server (Get result) = (EitherT (Int, String) IO result) - route Proxy action _request = do - e <- runEitherT action - return $ Just $ case e of - Right output -> - responseLBS ok200 [("Content-Type", "application/json")] (encode output) - Left (status, message) -> - responseLBS (mkStatus status (cs message)) [] (cs message) + route Proxy action request + | null (pathInfo request) && requestMethod request == methodGet = do + e <- runEitherT action + return $ Just $ case e of + Right output -> + responseLBS ok200 [("Content-Type", "application/json")] (encode output) + Left (status, message) -> + responseLBS (mkStatus status (cs message)) [] (cs message) + | otherwise = return Nothing instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where type Server (path :> sublayout) = path :> (Server sublayout)