From 8b3d224b803f4cfa53540ea9deca6790f700e69a Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Thu, 11 Feb 2016 16:24:02 -0800
Subject: [PATCH] Ensure payload parse errors are not suppressed

Fixes #490
---
 src/PostgREST/ApiRequest.hs | 26 ++++++++++++++++----------
 src/PostgREST/App.hs        |  8 +++-----
 test/Feature/QuerySpec.hs   | 10 ++++++++++
 3 files changed, 29 insertions(+), 15 deletions(-)

diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs
index 3fb3b05e3..f2c1815b3 100644
--- a/src/PostgREST/ApiRequest.hs
+++ b/src/PostgREST/ApiRequest.hs
@@ -28,7 +28,8 @@ type RequestBody = BL.ByteString
 data Action = ActionCreate | ActionRead
             | ActionUpdate | ActionDelete
             | ActionInfo   | ActionInvoke
-            | ActionUnknown BS.ByteString deriving Eq
+            | ActionInappropriate
+            deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
             | TargetProc  QualifiedIdentifier
@@ -78,15 +79,20 @@ data ApiRequest = ApiRequest {
 -- | Examines HTTP request and translates it into user intent.
 userApiRequest :: Schema -> Request -> RequestBody -> ApiRequest
 userApiRequest schema req reqBody =
-  let action = case method of
-                 "GET"     -> ActionRead
-                 "POST"    -> if isTargetingProc
-                                then ActionInvoke
-                                else ActionCreate
-                 "PATCH"   -> ActionUpdate
-                 "DELETE"  -> ActionDelete
-                 "OPTIONS" -> ActionInfo
-                 other     -> ActionUnknown other
+  let action =
+        if isTargetingProc
+          then
+            if method == "POST"
+               then ActionInvoke
+               else ActionInappropriate
+          else
+            case method of
+               "GET"     -> ActionRead
+               "POST"    -> ActionCreate
+               "PATCH"   -> ActionUpdate
+               "DELETE"  -> ActionDelete
+               "OPTIONS" -> ActionInfo
+               _         -> ActionInappropriate
       target = case path of
                  []            -> TargetRoot
                  [table]       -> TargetIdent
diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs
index d1d27b4a8..418a84f55 100644
--- a/src/PostgREST/App.hs
+++ b/src/PostgREST/App.hs
@@ -179,16 +179,14 @@ app dbStructure conf reqBody req =
       body <- encode <$> H.query schema accessibleTables
       return $ responseLBS status200 [jsonH] $ cs body
 
-    (ActionUnknown _, _, _) -> return notFound
-
-    (_, TargetProc _, _) -> return $ responseLBS status405 [] ""
-
-    (_, TargetUnknown _, _) -> return notFound
+    (ActionInappropriate, _, _) -> return $ responseLBS status405 [] ""
 
     (_, _, Just (PayloadParseError e)) ->
       return $ responseLBS status400 [jsonH] $
         cs (formatGeneralError "Cannot parse request payload" (cs e))
 
+    (_, TargetUnknown _, _) -> return notFound
+
     (_, _, _) -> return notFound
 
  where
diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs
index 7cfa8cf22..3c3062db2 100644
--- a/test/Feature/QuerySpec.hs
+++ b/test/Feature/QuerySpec.hs
@@ -386,6 +386,16 @@ spec struct c = around (withApp cfgDefault struct c) $ do
         post "/rpc/sayhello" [json| { "name": "world" } |] `shouldRespondWith`
           [json| [{"sayhello":"Hello, world"}] |]
 
+    context "improper input" $ do
+      it "rejects unknown content type even if payload is good" $
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "audio/mpeg3") [json| { "name": "world" } |]
+            `shouldRespondWith` 415
+      it "rejects malformed json payload" $
+        request methodPost "/rpc/sayhello"
+          (acceptHdrs "application/json") "sdfsdf"
+            `shouldRespondWith` 400
+
     context "unsupported verbs" $ do
       it "DELETE fails" $
         request methodDelete "/rpc/sayhello" [] ""