Refactor error type and fix nested error message [fix #791] (#829)

This commit is contained in:
Diogo Biazus
2017-03-12 22:02:13 -07:00
committed by Joe Nelson
parent 2aabbbae58
commit 206ab163b6
11 changed files with 157 additions and 129 deletions
+10 -34
View File
@@ -3,15 +3,12 @@ Module : PostgREST.ApiRequest
Description : PostgREST functions to translate HTTP request to a domain type called ApiRequest.
-}
module PostgREST.ApiRequest ( ApiRequest(..)
, ApiRequestError(..)
, ContentType(..)
, Action(..)
, Target(..)
, PreferRepresentation (..)
, mutuallyAgreeable
, toHeader
, userApiRequest
, toMime
) where
import Protolude
@@ -29,15 +26,18 @@ import Control.Arrow ((***))
import qualified Data.Text as T
import qualified Data.Vector as V
import Network.HTTP.Base (urlEncodeVars)
import Network.HTTP.Types.Header (hAuthorization, hContentType, Header)
import Network.HTTP.Types.Header (hAuthorization)
import Network.HTTP.Types.URI (parseSimpleQuery)
import Network.Wai (Request (..))
import Network.Wai.Parse (parseHttpAccept)
import PostgREST.RangeQuery (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
import Data.Ranged.Boundaries
import PostgREST.Types (QualifiedIdentifier (..),
Schema,
PayloadJSON(..))
import PostgREST.Types ( QualifiedIdentifier (..)
, Schema
, PayloadJSON(..)
, ContentType(..)
, ApiRequestError(..)
, toMime)
import Data.Ranged.Ranges (Range(..), rangeIntersection, emptyRange)
type RequestBody = BL.ByteString
@@ -57,30 +57,6 @@ data Target = TargetIdent QualifiedIdentifier
-- | How to return the inserted data
data PreferRepresentation = Full | HeadersOnly | None deriving Eq
--
-- | Enumeration of currently supported response content types
data ContentType = CTApplicationJSON | CTTextCSV | CTOpenAPI
| CTSingularJSON | CTOctetStream
| 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")
-- | Convert from ContentType to a ByteString representing the mime type
toMime :: ContentType -> ByteString
toMime CTApplicationJSON = "application/json"
toMime CTTextCSV = "text/csv"
toMime CTOpenAPI = "application/openapi+json"
toMime CTSingularJSON = "application/vnd.pgrst.object+json"
toMime CTOctetStream = "application/octet-stream"
toMime CTAny = "*/*"
toMime (CTOther ct) = ct
{-|
Describes what the user wants to do. This data type is a
translation of the raw elements of an HTTP request into domain
@@ -120,9 +96,9 @@ data ApiRequest = ApiRequest {
-- | Examines HTTP request and translates it into user intent.
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
| isTargetingProc && method /= "POST" = Left ActionInappropriate
| topLevelRange == emptyRange = Left InvalidRange
| shouldParsePayload && isLeft payload = either (Left . InvalidBody . toS) undefined payload
| otherwise = Right ApiRequest {
iAction = action
, iTarget = target