Merge pull request #745 from diogob/moves_request_error_handling_to_user_api_request

Moves request error handling to user api request

src/PostgREST/ApiRequest.hs

@@ -3,6 +3,7 @@ Module      : PostgREST.ApiRequest
 Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
 -}
 module PostgREST.ApiRequest ( ApiRequest(..)
+                            , ApiRequestError(..)
                             , ContentType(..)
                             , Action(..)
                             , Target(..)
@@ -14,7 +15,6 @@ module PostgREST.ApiRequest ( ApiRequest(..)
                             ) where
 
 import           Protolude
-
 import qualified Data.Aeson                as JSON
 import qualified Data.ByteString           as BS
 import qualified Data.ByteString.Internal  as BS (c2w)
@@ -36,9 +36,9 @@ import           Network.Wai.Parse         (parseHttpAccept)
 import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
 import           Data.Ranged.Boundaries
 import           PostgREST.Types           (QualifiedIdentifier (..),
-                                            Schema, Payload(..),
+                                            Schema,
-                                            UniformObjects(..))
+                                            PayloadJSON(..))
-import           Data.Ranged.Ranges        (Range(..), singletonRange, rangeIntersection)
+import           Data.Ranged.Ranges        (Range(..), singletonRange, rangeIntersection, emptyRange)
 
 type RequestBody = BL.ByteString
 
@@ -47,7 +47,6 @@ data Action = ActionCreate | ActionRead
             | ActionUpdate | ActionDelete
             | ActionInfo   | ActionInvoke
             | ActionInspect
-            | ActionInappropriate
             deriving Eq
 -- | The target db object of a user action
 data Target = TargetIdent QualifiedIdentifier
@@ -62,6 +61,11 @@ data PreferRepresentation = Full | HeadersOnly | None deriving Eq
 data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
                  | CTAny | CTOther BS.ByteString deriving Eq
 
+data ApiRequestError = ErrorActionInappropriate
+                     | ErrorInvalidBody ByteString
+                     | ErrorInvalidRange
+                     deriving (Show, Eq)
+
 -- | Convert from ContentType to a full HTTP Header
 toHeader :: ContentType -> Header
 toHeader ct = (hContentType, toMime ct <> "; charset=utf-8")
@@ -91,7 +95,7 @@ data ApiRequest = ApiRequest {
   -- | Content types the client will accept, [CTAny] if no Accept header
   , iAccepts :: [ContentType]
   -- | Data sent by client and used for mutation actions
-  , iPayload :: Maybe Payload
+  , iPayload :: Maybe PayloadJSON
   -- | If client wants created items echoed back
   , iPreferRepresentation :: PreferRepresentation
   -- | If client wants first row as raw object
@@ -113,84 +117,75 @@ data ApiRequest = ApiRequest {
   }
 
 -- | Examines HTTP request and translates it into user intent.
-userApiRequest :: Schema -> Request -> RequestBody -> ApiRequest
+userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
-userApiRequest schema req reqBody =
+userApiRequest schema req reqBody
-  let action =
+  | isTargetingProc && method /= "POST" = Left ErrorActionInappropriate
-        if isTargetingProc
+  | topLevelRange == emptyRange = Left ErrorInvalidRange
-          then
+  | shouldParsePayload && isLeft payload = either (Left . ErrorInvalidBody . toS) undefined payload
-            if method == "POST"
+  | otherwise = Right ApiRequest {
-               then ActionInvoke
+      iAction = action
-               else ActionInappropriate
+      , iTarget = target
-          else
+      , iRange = ranges
-            case method of
+      , iAccepts = fromMaybe [CTAny] $
-               "GET"     -> if target == TargetRoot
+        map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
-                              then ActionInspect
+      , iPayload = relevantPayload
-                              else ActionRead
+      , iPreferRepresentation = representation
-               "POST"    -> ActionCreate
+      , iPreferSingular = singular
-               "PATCH"   -> ActionUpdate
+      , iPreferSingleObjectParameter = singleObject
-               "DELETE"  -> ActionDelete
+      , iPreferCount = not singular && hasPrefer "count=exact"
-               "OPTIONS" -> ActionInfo
+      , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset"] k) ]
-               _         -> ActionInappropriate
+      , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
-      target = case path of
+      , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
-                 []            -> TargetRoot
+      , iCanonicalQS = toS $ urlEncodeVars
-                 [table]       -> TargetIdent
+        . L.sortBy (comparing fst)
-                                  $ QualifiedIdentifier schema table
+        . map (join (***) toS)
-                 ["rpc", proc] -> TargetProc
+        . parseSimpleQuery
-                                  $ QualifiedIdentifier schema proc
+        $ rawQueryString req
-                 other         -> TargetUnknown other
+      , iJWT = tokenStr
-      payload = case decodeContentType
+      }
-                     . fromMaybe "application/json"
-                     $ lookupHeader "content-type" of
-        CTApplicationJSON ->
-          either (PayloadParseError . toS)
-            (\val -> case ensureUniform (pluralize val) of
-              Nothing -> PayloadParseError "All object keys must match"
-              Just json -> PayloadJSON json)
-            (JSON.eitherDecode reqBody)
-        CTTextCSV ->
-          either (PayloadParseError . toS)
-            (\val -> case ensureUniform (csvToJson val) of
-              Nothing -> PayloadParseError "All lines must have same number of fields"
-              Just json -> PayloadJSON json)
-            (CSV.decodeByName reqBody)
-        CTOther "application/x-www-form-urlencoded" ->
-          PayloadJSON . UniformObjects . V.singleton . M.fromList
-                      . map (toS *** JSON.String . toS) . parseSimpleQuery
-                      $ toS reqBody
-        ct ->
-          PayloadParseError $ "Content-Type not acceptable: " <> toMime ct
-      relevantPayload = case action of
-        ActionCreate -> Just payload
-        ActionUpdate -> Just payload
-        ActionInvoke -> Just payload
-        _            -> Nothing in
-
-  ApiRequest {
-    iAction = action
-  , iTarget = target
-  , iRange = ranges
-  , iAccepts = fromMaybe [CTAny] $
-      map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
-  , iPayload = relevantPayload
-  , iPreferRepresentation = representation
-  , iPreferSingular = singular
-  , iPreferSingleObjectParameter = singleObject
-  , iPreferCount = not singular && hasPrefer "count=exact"
-  , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset"] k) ]
-  , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
-  , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
-  , iCanonicalQS = toS $ urlEncodeVars
-     . L.sortBy (comparing fst)
-     . map (join (***) toS)
-     . parseSimpleQuery
-     $ rawQueryString req
-  , iJWT = tokenStr
-  }
-
  where
+  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
+  payload =
+    case decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type" of
+      CTApplicationJSON ->
+          either Left (\val -> case ensureUniform (pluralize val) of
+            Nothing -> Left "All object keys must match"
+            Just json -> Right json) (JSON.eitherDecode reqBody)
+      CTTextCSV ->
+          either Left (\val -> case ensureUniform (csvToJson val) of
+            Nothing -> Left "All lines must have same number of fields"
+            Just json -> Right json) (CSV.decodeByName reqBody)
+      CTOther "application/x-www-form-urlencoded" ->
+        Right . PayloadJSON . V.singleton . M.fromList
+                    . map (toS *** JSON.String . toS) . parseSimpleQuery
+                    $ toS reqBody
+      ct ->
+        Left $ toS $ "Content-Type not acceptable: " <> toMime ct
+  topLevelRange = fromMaybe allRange $ M.lookup "limit" ranges
+  action = case method of
+            "GET"     -> if target == TargetRoot
+                          then ActionInspect
+                          else ActionRead
+            "POST"    -> if isTargetingProc
+                          then ActionInvoke
+                          else ActionCreate
+            "PATCH"   -> ActionUpdate
+            "DELETE"  -> ActionDelete
+            "OPTIONS" -> ActionInfo
+            _         -> ActionInspect
+  target = case path of
+              []            -> TargetRoot
+              [table]       -> TargetIdent
+                              $ QualifiedIdentifier schema table
+              ["rpc", proc] -> TargetProc
+                              $ QualifiedIdentifier schema proc
+              other         -> TargetUnknown other
+  shouldParsePayload = action `elem` [ActionCreate, ActionUpdate, ActionInvoke]
+  relevantPayload = if shouldParsePayload
+                      then rightToMaybe payload
+                      else Nothing
   path            = pathInfo req
   method          = requestMethod req
-  isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path
   hdrs            = requestHeaders req
   qParams         = [(toS k, v)|(k,v) <- queryString req]
   lookupHeader    = flip lookup hdrs
@@ -288,8 +283,8 @@ pluralize (JSON.Array arr)    = arr
 pluralize _                   = V.empty
 
 -- | Test that Array contains only Objects having the same keys
--- and if so mark it as UniformObjects
+-- and if so mark it as PayloadJSON
-ensureUniform :: JSON.Array -> Maybe UniformObjects
+ensureUniform :: JSON.Array -> Maybe PayloadJSON
 ensureUniform arr =
   let objs :: V.Vector JSON.Object
       objs = foldr -- filter non-objects, map to raw objects
@@ -302,5 +297,5 @@ ensureUniform arr =
       areKeysUniform = all (==canonicalKeys) keysPerObj in
 
   if (V.length objs == V.length arr) && areKeysUniform
-    then Just (UniformObjects objs)
+    then Just (PayloadJSON objs)
     else Nothing

src/PostgREST/App.hs

@@ -11,7 +11,6 @@ import qualified Data.ByteString.Char8     as BS
 import           Data.IORef                (IORef, readIORef)
 import           Data.List                 (delete, lookup)
 import           Data.Maybe                (fromJust)
-import           Data.Ranged.Ranges        (emptyRange)
 import           Data.Text                 (replace, strip, isInfixOf, dropWhile, drop, intercalate)
 import           Data.Time.Clock.POSIX     (POSIXTime)
 import           Data.Tree
@@ -50,7 +49,7 @@ import           PostgREST.ApiRequest   ( ApiRequest(..), ContentType(..)
 import           PostgREST.Auth            (jwtClaims, containsRole)
 import           PostgREST.Config          (AppConfig (..))
 import           PostgREST.DbStructure
-import           PostgREST.Error           (errResponse, pgErrResponse)
+import           PostgREST.Error           (errResponse, pgErrResponse, apiRequestErrResponse)
 import           PostgREST.Parsers
 import           PostgREST.RangeQuery      (NonnegRange, allRange, rangeOffset, restrictRange)
 import           PostgREST.Middleware
@@ -81,17 +80,17 @@ postgrest conf refDbStructure pool getTime =
     body <- strictRequestBody req
     dbStructure <- readIORef refDbStructure
 
-    let schema = toS $ configSchema conf
+    response <- case userApiRequest (configSchema conf) req body of
-        apiRequest = userApiRequest schema req body
+      Left err -> return $ apiRequestErrResponse err
-        eClaims = jwtClaims
+      Right apiRequest -> do
-          (secret <$> configJwtSecret conf) (iJWT apiRequest) time
+        let jwtSecret = secret <$> configJwtSecret conf
-        authed = containsRole eClaims
+            eClaims = jwtClaims jwtSecret (iJWT apiRequest) time
-        handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
+            authed = containsRole eClaims
-        txMode = transactionMode $ iAction apiRequest
+            handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
-
+            txMode = transactionMode $ iAction apiRequest
-    resp <- either (pgErrResponse authed) id <$> P.use pool
+        response <- P.use pool $ HT.run handleReq HT.ReadCommitted txMode
-      (HT.run handleReq HT.ReadCommitted txMode)
+        return $ either (pgErrResponse authed) identity response
-    respond resp
+    respond response
 
 transactionMode :: Action -> H.Mode
 transactionMode ActionRead = HT.Read
@@ -108,7 +107,7 @@ app dbStructure conf apiRequest =
         (ActionRead, TargetIdent qi, Nothing) ->
           case readSqlParts of
             Left errorResponse -> return errorResponse
-            Right (q, cq) -> respondToRange $ do
+            Right (q, cq) -> do
               let singular = iPreferSingular apiRequest
                   stm = createReadStatement q cq singular shouldCount (contentType == CTTextCSV)
               row <- H.query () stm
@@ -129,7 +128,7 @@ app dbStructure conf apiRequest =
                     )
                   ] (toS body)
 
-        (ActionCreate, TargetIdent qi@(QualifiedIdentifier _ table), Just payload@(PayloadJSON uniform@(UniformObjects rows))) ->
+        (ActionCreate, TargetIdent qi@(QualifiedIdentifier _ table), Just payload@(PayloadJSON rows)) ->
           case mutateSqlParts of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
@@ -143,7 +142,7 @@ app dbStructure conf apiRequest =
                         |]
               let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
               let stm = createWriteStatement qi sq mq isSingle (iPreferRepresentation apiRequest) pKeys (contentType == CTTextCSV) payload
-              row <- H.query uniform stm
+              row <- H.query payload stm
               let (_, _, fs, body) = extractQueryResult row
                   headers = catMaybes [
                       if null fs
@@ -160,13 +159,13 @@ app dbStructure conf apiRequest =
                 if iPreferRepresentation apiRequest == Full
                   then toS body else ""
 
-        (ActionUpdate, TargetIdent qi, Just payload@(PayloadJSON uniform)) ->
+        (ActionUpdate, TargetIdent qi, Just payload) ->
           case mutateSqlParts of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
               let singular = iPreferSingular apiRequest
                   stm = createWriteStatement qi sq mq singular (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) payload
-              row <- H.query uniform stm
+              row <- H.query payload stm
               let (_, queryTotal, _, body) = extractQueryResult row
               when (singular && queryTotal > 1) $
                 HT.sql [P6.q| DO $$
@@ -188,10 +187,9 @@ app dbStructure conf apiRequest =
           case mutateSqlParts of
             Left errorResponse -> return errorResponse
             Right (sq, mq) -> do
-              let emptyUniform = UniformObjects V.empty
+              let emptyPayload = PayloadJSON V.empty
-                  fakeload = PayloadJSON emptyUniform
+                  stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) emptyPayload
-                  stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) fakeload
+              row <- H.query emptyPayload stm
-              row <- H.query emptyUniform stm
               let (_, queryTotal, _, body) = extractQueryResult row
                   r = contentRangeH 1 0 $
                         toInteger <$> if shouldCount then Just queryTotal else Nothing
@@ -209,10 +207,10 @@ app dbStructure conf apiRequest =
               let acceptH = (hAllow, if tableInsertable table then "GET,POST,PATCH,DELETE" else "GET") in
               return $ responseLBS status200 [allOrigins, acceptH] ""
 
-        (ActionInvoke, TargetProc qi, Just (PayloadJSON (UniformObjects payload))) ->
+        (ActionInvoke, TargetProc qi, Just (PayloadJSON payload)) ->
           case readSqlParts of
             Left errorResponse -> return errorResponse
-            Right (q, cq) -> respondToRange $ do
+            Right (q, cq) -> do
               let p = V.head payload
                   singular = iPreferSingular apiRequest
                   paramsAsSingleObject = iPreferSingleObjectParameter apiRequest
@@ -233,10 +231,6 @@ app dbStructure conf apiRequest =
           body <- encodeApi . toTableInfo <$> H.query schema accessibleTables
           return $ responseLBS status200 [toHeader CTOpenAPI] $ toS body
 
-        (_, _, Just (PayloadParseError e)) ->
-          return $ errResponse status400 $
-            toS (formatGeneralError "Cannot parse request payload" (toS e))
-
         _ -> return notFound
 
     where
@@ -273,16 +267,9 @@ app dbStructure conf apiRequest =
       countQuery = requestToCountQuery schema <$> readDbRequest
       readSqlParts = (,) <$> selectQuery <*> countQuery
       mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
-      respondToRange response =
-        if topLevelRange == emptyRange
-          then return $ errResponse status416 "HTTP Range error"
-          else response
 
 responseContentTypeOrError :: [ContentType] -> Action -> Either Response ContentType
-responseContentTypeOrError accepts action =
+responseContentTypeOrError accepts action = serves contentTypesForRequest accepts
-  case action of
-    ActionInappropriate -> Left $ errResponse status405 "Unsupported HTTP verb"
-    _ -> serves contentTypesForRequest accepts
   where
     contentTypesForRequest =
       case action of
@@ -293,7 +280,6 @@ responseContentTypeOrError accepts action =
         ActionInvoke -> [CTApplicationJSON]
         ActionInspect -> [CTOpenAPI]
         ActionInfo -> [CTTextCSV]
-        ActionInappropriate -> []
     serves sProduces cAccepts =
       case mutuallyAgreeable sProduces cAccepts of
         Nothing -> do

src/PostgREST/Error.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module PostgREST.Error (pgErrResponse, errResponse, prettyUsageError) where
+module PostgREST.Error (apiRequestErrResponse, pgErrResponse, errResponse, prettyUsageError) where
 
 import           Protolude
 import           Data.Aeson                ((.=))
@@ -12,7 +12,14 @@ import qualified Hasql.Pool                as P
 import qualified Hasql.Session             as H
 import qualified Network.HTTP.Types.Status as HT
 import           Network.Wai               (Response, responseLBS)
-import           PostgREST.ApiRequest      (toHeader, ContentType(..))
+import           PostgREST.ApiRequest      (toHeader, ContentType(..), ApiRequestError(..))
+
+apiRequestErrResponse :: ApiRequestError -> Response
+apiRequestErrResponse err =
+  case err of
+    ErrorActionInappropriate -> errResponse HT.status405 "Bad Request"
+    ErrorInvalidBody errorMessage -> errResponse HT.status400 $ toS errorMessage
+    ErrorInvalidRange -> errResponse HT.status416 "HTTP Range error"
 
 errResponse :: HT.Status -> Text -> Response
 errResponse status message = responseLBS status

src/PostgREST/QueryBuilder.hs

@@ -83,12 +83,12 @@ decodeStandardMay =
   HD.maybeRow standardRow
 
 {-| JSON and CSV payloads from the client are given to us as
-    UniformObjects (objects who all have the same keys),
+    PayloadJSON (objects who all have the same keys),
     and we turn this into an old fasioned JSON array
 -}
-encodeUniformObjs :: HE.Params UniformObjects
+encodeUniformObjs :: HE.Params PayloadJSON
 encodeUniformObjs =
-  contramap (JSON.Array . V.map JSON.Object . unUniformObjects) (HE.value HE.json)
+  contramap (JSON.Array . V.map JSON.Object . unPayloadJSON) (HE.value HE.json)
 
 createReadStatement :: SqlQuery -> SqlQuery -> Bool -> Bool -> Bool ->
                        H.Query () ResultsWithCount
@@ -111,11 +111,10 @@ createReadStatement selectQuery countQuery isSingle countTotal asCsv =
     | otherwise = asJsonF
 
 createWriteStatement :: QualifiedIdentifier -> SqlQuery -> SqlQuery -> Bool ->
-                        PreferRepresentation -> [Text] -> Bool -> Payload ->
+                        PreferRepresentation -> [Text] -> Bool -> PayloadJSON ->
-                        H.Query UniformObjects (Maybe ResultsWithCount)
+                        H.Query PayloadJSON (Maybe ResultsWithCount)
-createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined
 createWriteStatement _ _ mutateQuery _ None
-                     _ _ (PayloadJSON (UniformObjects _)) =
+                     _ _ (PayloadJSON _) =
   unicodeStatement sql encodeUniformObjs decodeStandardMay True
  where
   sql = [qc|
@@ -123,7 +122,7 @@ createWriteStatement _ _ mutateQuery _ None
       SELECT '', 0, {noLocationF}, '' |]
 
 createWriteStatement qi _ mutateQuery isSingle HeadersOnly
-                     pKeys _ (PayloadJSON (UniformObjects _)) =
+                     pKeys _ (PayloadJSON _) =
   unicodeStatement sql encodeUniformObjs decodeStandardMay True
  where
   sql = [qc|
@@ -138,7 +137,7 @@ createWriteStatement qi _ mutateQuery isSingle HeadersOnly
     ]
 
 createWriteStatement qi selectQuery mutateQuery isSingle Full
-                     pKeys asCsv (PayloadJSON (UniformObjects _)) =
+                     pKeys asCsv (PayloadJSON _) =
   unicodeStatement sql encodeUniformObjs decodeStandardMay True
  where
   sql = [qc|
@@ -322,8 +321,6 @@ requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _
    localConditions = filter fn conditions
 
 requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
-requestToQuery _ _ (DbMutate (Insert _ (PayloadParseError _))) = undefined
-requestToQuery _ _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined
 requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
   query
   where
@@ -384,7 +381,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions
     --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
     --posible relations are Child Parent Many
     getQueryParts _ _ = undefined --error "undefined getQueryParts"
-requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON (UniformObjects rows)))) =
+requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows))) =
   let qi = QualifiedIdentifier schema mainTbl
       cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
       colsString = intercalate ", " cols
@@ -396,7 +393,7 @@ requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON (UniformObjects r
                 else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"] in
   insInto <> vals
 
-requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON (UniformObjects rows)) conditions)) =
+requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions)) =
   case rows V.!? 0 of
     Just obj ->
       let assignments = map

src/PostgREST/Types.hs

@@ -2,7 +2,6 @@ module PostgREST.Types where
 import           Protolude
 import qualified GHC.Show
 import           Data.Aeson
-import qualified Data.ByteString      as BS
 import qualified Data.ByteString.Lazy as BL
 import           Data.Tree
 import qualified Data.Vector          as V
@@ -102,18 +101,11 @@ data Relation = Relation {
 
 -- | An array of JSON objects that has been verified to have
 -- the same keys in every object
-newtype UniformObjects = UniformObjects (V.Vector Object)
+newtype PayloadJSON = PayloadJSON (V.Vector Object)
   deriving (Show, Eq)
 
-unUniformObjects :: UniformObjects -> V.Vector Object
+unPayloadJSON :: PayloadJSON -> V.Vector Object
-unUniformObjects (UniformObjects objs) = objs
+unPayloadJSON (PayloadJSON objs) = objs
-
--- | When Hasql supports the COPY command then we can
--- have a special payload just for CSV, but until
--- then CSV is converted to a JSON array.
-data Payload = PayloadJSON UniformObjects
-             | PayloadParseError BS.ByteString
-             deriving (Show, Eq)
 
 data Proxy = Proxy {
   proxyScheme     :: Text
@@ -133,9 +125,9 @@ type NodeName = Text
 type SelectItem = (Field, Maybe Cast, Maybe Alias)
 type Path = [Text]
 data ReadQuery = Select { select::[SelectItem], from::[TableName], flt_::[Filter], order::Maybe [OrderTerm], range_::NonnegRange } deriving (Show, Eq)
-data MutateQuery = Insert { in_::TableName, qPayload::Payload }
+data MutateQuery = Insert { in_::TableName, qPayload::PayloadJSON }
                  | Delete { in_::TableName, where_::[Filter] }
-                 | Update { in_::TableName, qPayload::Payload, where_::[Filter] } deriving (Show, Eq)
+                 | Update { in_::TableName, qPayload::PayloadJSON, where_::[Filter] } deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
 type ReadNode = (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
 type ReadRequest = Tree ReadNode