Ensure payload parse errors are not suppressed

Fixes #490

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

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

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" [] ""