Merge pull request #745 from diogob/moves_request_error_handling_to_user_api_request

Moves request error handling to user api request
2016-11-30 09:17:56 -08:00
parent ae40641963 6c275fcec2
commit 0f66e99f78
5 changed files with 126 additions and 149 deletions
@@ -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(..),
-                                            UniformObjects(..))
-import           Data.Ranged.Ranges        (Range(..), singletonRange, rangeIntersection)
+                                            Schema,
+                                            PayloadJSON(..))
+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 req reqBody =
-  let action =
-        if isTargetingProc
-          then
-            if method == "POST"
-               then ActionInvoke
-               else ActionInappropriate
-          else
-            case method of
-               "GET"     -> if target == TargetRoot
-                              then ActionInspect
-                              else ActionRead
-               "POST"    -> ActionCreate
-               "PATCH"   -> ActionUpdate
-               "DELETE"  -> ActionDelete
-               "OPTIONS" -> ActionInfo
-               _         -> ActionInappropriate
-      target = case path of
-                 []            -> TargetRoot
-                 [table]       -> TargetIdent
-                                  $ QualifiedIdentifier schema table
-                 ["rpc", proc] -> TargetProc
-                                  $ QualifiedIdentifier schema proc
-                 other         -> TargetUnknown other
-      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
-  }
-
+userApiRequest :: Schema -> Request -> RequestBody -> Either ApiRequestError ApiRequest
+userApiRequest schema req reqBody
+  | isTargetingProc && method /= "POST" = Left ErrorActionInappropriate
+  | topLevelRange == emptyRange = Left ErrorInvalidRange
+  | shouldParsePayload && isLeft payload = either (Left . ErrorInvalidBody . toS) undefined payload
+  | otherwise = Right 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
-ensureUniform :: JSON.Array -> Maybe UniformObjects
+-- and if so mark it as PayloadJSON
+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
@@ -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
-        apiRequest = userApiRequest schema req body
-        eClaims = jwtClaims
-          (secret <$> configJwtSecret conf) (iJWT apiRequest) time
-        authed = containsRole eClaims
-        handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
-        txMode = transactionMode $ iAction apiRequest
-
-    resp <- either (pgErrResponse authed) id <$> P.use pool
-      (HT.run handleReq HT.ReadCommitted txMode)
-    respond resp
+    response <- case userApiRequest (configSchema conf) req body of
+      Left err -> return $ apiRequestErrResponse err
+      Right apiRequest -> do
+        let jwtSecret = secret <$> configJwtSecret conf
+            eClaims = jwtClaims jwtSecret (iJWT apiRequest) time
+            authed = containsRole eClaims
+            handleReq = runWithClaims conf eClaims (app dbStructure conf) apiRequest
+            txMode = transactionMode $ iAction apiRequest
+        response <- P.use pool $ HT.run handleReq HT.ReadCommitted txMode
+        return $ either (pgErrResponse authed) identity response
+    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
-                  fakeload = PayloadJSON emptyUniform
-                  stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) fakeload
-              row <- H.query emptyUniform stm
+              let emptyPayload = PayloadJSON V.empty
+                  stm = createWriteStatement qi sq mq False (iPreferRepresentation apiRequest) [] (contentType == CTTextCSV) emptyPayload
+              row <- H.query emptyPayload 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 =
-  case action of
-    ActionInappropriate -> Left $ errResponse status405 "Unsupported HTTP verb"
-    _ -> serves contentTypesForRequest accepts
+responseContentTypeOrError accepts action = 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
@@ -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
@@ -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 ->
-                        H.Query UniformObjects (Maybe ResultsWithCount)
-createWriteStatement _ _ _ _ _ _ _ (PayloadParseError _) = undefined
+                        PreferRepresentation -> [Text] -> Bool -> PayloadJSON ->
+                        H.Query PayloadJSON (Maybe ResultsWithCount)
 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
@@ -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
-unUniformObjects (UniformObjects 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)
+unPayloadJSON :: PayloadJSON -> V.Vector Object
+unPayloadJSON (PayloadJSON objs) = objs

 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