refactor: Carve out QueryParams module
This commit is contained in:
monacoremo
committed by
Wolfgang Walther
Wolfgang Walther
parent
51ee072f84
commit
bfbec8fa36
@@ -31,15 +31,11 @@ import qualified Data.Vector as V
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import Data.Aeson.Types (emptyArray, emptyObject)
|
||||
import Data.List (last, lookup, partition, union)
|
||||
import Data.List (lookup, union)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Ranged.Boundaries (Boundary (..))
|
||||
import Data.Ranged.Ranges (Range (..), emptyRange,
|
||||
rangeIntersection)
|
||||
import Network.HTTP.Base (urlEncodeVars)
|
||||
import Data.Ranged.Ranges (emptyRange, rangeIntersection)
|
||||
import Network.HTTP.Types.Header (hAuthorization, hCookie)
|
||||
import Network.HTTP.Types.URI (parseQueryReplacePlus,
|
||||
parseSimpleQuery)
|
||||
import Network.HTTP.Types.URI (parseSimpleQuery)
|
||||
import Network.Wai (Request (..))
|
||||
import Network.Wai.Parse (parseHttpAccept)
|
||||
import Web.Cookie (parseCookies)
|
||||
@@ -53,21 +49,19 @@ import PostgREST.DbStructure.Identifiers (FieldName,
|
||||
Schema)
|
||||
import PostgREST.DbStructure.Proc (ProcDescription (..),
|
||||
ProcParam (..), ProcsMap)
|
||||
import PostgREST.Error (ApiRequestError (..))
|
||||
import PostgREST.Query.SqlFragment (ftsOperators, operators)
|
||||
import PostgREST.RangeQuery (NonnegRange, allRange,
|
||||
rangeGeq, rangeLimit,
|
||||
rangeOffset, rangeRequested,
|
||||
restrictRange)
|
||||
import PostgREST.Request.Parsers (pRequestColumns)
|
||||
rangeRequested)
|
||||
import PostgREST.Request.Preferences (PreferCount (..),
|
||||
PreferParameters (..),
|
||||
PreferRepresentation (..),
|
||||
PreferResolution (..),
|
||||
PreferTransaction (..))
|
||||
import PostgREST.Request.QueryParams (QueryParams (..))
|
||||
import PostgREST.Request.Types (ApiRequestError (..))
|
||||
|
||||
import qualified PostgREST.ContentType as ContentType
|
||||
import qualified PostgREST.Request.Preferences as Preferences
|
||||
import qualified PostgREST.Request.QueryParams as QueryParams
|
||||
|
||||
import Protolude
|
||||
|
||||
@@ -161,13 +155,8 @@ data ApiRequest = ApiRequest {
|
||||
, iPreferCount :: Maybe PreferCount -- ^ Whether the client wants a result count
|
||||
, iPreferResolution :: Maybe PreferResolution -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
|
||||
, iPreferTransaction :: Maybe PreferTransaction -- ^ Whether the clients wants to commit or rollback the transaction
|
||||
, iFilters :: [(Text, Text)] -- ^ Filters on the result ("id", "eq.10")
|
||||
, iLogic :: [(Text, Text)] -- ^ &and and &or parameters used for complex boolean logic
|
||||
, iSelect :: Maybe Text -- ^ &select parameter used to shape the response
|
||||
, iOnConflict :: Maybe Text -- ^ &on_conflict parameter used to upsert on specific unique keys
|
||||
, iQueryParams :: QueryParams.QueryParams
|
||||
, iColumns :: S.Set FieldName -- ^ parsed colums from &columns parameter and payload
|
||||
, iOrder :: [(Text, Text)] -- ^ &order parameters for each level
|
||||
, iCanonicalQS :: ByteString -- ^ Alphabetized (canonical) request query string for response URLs
|
||||
, iJWT :: Text -- ^ JSON Web Token
|
||||
, iHeaders :: [(ByteString, ByteString)] -- ^ HTTP request headers
|
||||
, iCookies :: [(ByteString, ByteString)] -- ^ Request Cookies
|
||||
@@ -180,12 +169,16 @@ data ApiRequest = ApiRequest {
|
||||
|
||||
-- | Examines HTTP request and translates it into user intent.
|
||||
userApiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> Either ApiRequestError ApiRequest
|
||||
userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
userApiRequest conf dbStructure req reqBody =
|
||||
apiRequest conf dbStructure req reqBody =<< first QueryParamError (QueryParams.parse (rawQueryString req))
|
||||
|
||||
apiRequest :: AppConfig -> DbStructure -> Request -> RequestBody -> QueryParams.QueryParams -> Either ApiRequestError ApiRequest
|
||||
apiRequest conf@AppConfig{..} dbStructure req reqBody queryparams@QueryParams{..}
|
||||
| isJust profile && fromJust profile `notElem` configDbSchemas = Left $ UnacceptableSchema $ toList configDbSchemas
|
||||
| isTargetingProc && method `notElem` ["HEAD", "GET", "POST"] = Left ActionInappropriate
|
||||
| topLevelRange == emptyRange = Left InvalidRange
|
||||
| shouldParsePayload && isLeft payload = either (Left . InvalidBody) witness payload
|
||||
| isLeft parsedColumns = either Left witness parsedColumns
|
||||
| not expectParams && not (L.null qsParams) = Left $ ParseRequestError "Unexpected param or filter missing operator" ("Failed to parse " <> show qsParams)
|
||||
| otherwise = do
|
||||
acceptContentType <- findAcceptContentType conf action path accepts
|
||||
checkedTarget <- target
|
||||
@@ -200,16 +193,8 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
, iPreferCount = preferCount
|
||||
, iPreferResolution = preferResolution
|
||||
, iPreferTransaction = preferTransaction
|
||||
, iFilters = filters
|
||||
, iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
|
||||
, iSelect = toS <$> join (lookup "select" qParams)
|
||||
, iOnConflict = toS <$> join (lookup "on_conflict" qParams)
|
||||
, iQueryParams = queryparams
|
||||
, iColumns = payloadColumns
|
||||
, iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
|
||||
, iCanonicalQS = BS.pack $ urlEncodeVars
|
||||
. L.sortOn fst
|
||||
. map (join (***) BS.unpack . second (fromMaybe mempty))
|
||||
$ qString
|
||||
, iJWT = tokenStr
|
||||
, iHeaders = [ (CI.foldedCase k, v) | (k,v) <- hdrs, k /= hCookie]
|
||||
, iCookies = maybe [] parseCookies $ lookupHeader "Cookie"
|
||||
@@ -221,24 +206,9 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
}
|
||||
where
|
||||
accepts = maybe [CTAny] (map ContentType.decodeContentType . parseHttpAccept) $ lookupHeader "accept"
|
||||
-- queryString with '+' converted to ' '(space)
|
||||
qString = parseQueryReplacePlus True $ rawQueryString req
|
||||
-- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..)
|
||||
(filters, rpcQParams) =
|
||||
case action of
|
||||
ActionInvoke InvGet -> partitionFlts
|
||||
ActionInvoke InvHead -> partitionFlts
|
||||
_ -> (flts, [])
|
||||
partitionFlts = partition (liftM2 (||) (isEmbedPath . fst) (hasOperator . snd)) flts
|
||||
flts =
|
||||
[ (toS k, toS $ fromJust v) |
|
||||
(k,v) <- qParams, isJust v,
|
||||
k `notElem` ["select", "columns"],
|
||||
not (endingIn ["order", "limit", "offset", "and", "or"] k) ]
|
||||
hasOperator val = any (`T.isPrefixOf` val) $
|
||||
((<> ".") <$> "not":M.keys operators) ++
|
||||
((<> "(") <$> M.keys ftsOperators)
|
||||
isEmbedPath = T.isInfixOf "."
|
||||
|
||||
expectParams = isTargetingProc && method /= "POST"
|
||||
|
||||
isTargetingProc = case path of
|
||||
PathInfo{pHasRpc, pIsRootSpec} -> pHasRpc || pIsRootSpec
|
||||
_ -> False
|
||||
@@ -246,16 +216,19 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
PathInfo{pIsDefaultSpec=True} -> True
|
||||
_ -> False
|
||||
contentType = maybe CTApplicationJSON ContentType.decodeContentType $ lookupHeader "content-type"
|
||||
columns
|
||||
| action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] = toS <$> join (lookup "columns" qParams)
|
||||
| otherwise = Nothing
|
||||
parsedColumns = pRequestColumns columns
|
||||
|
||||
columns =
|
||||
if action `elem` [ActionCreate, ActionUpdate, ActionInvoke InvPost] then
|
||||
qsColumns
|
||||
else
|
||||
Nothing
|
||||
|
||||
payloadColumns =
|
||||
case (contentType, action) of
|
||||
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> rpcQParams
|
||||
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> rpcQParams
|
||||
(_, ActionInvoke InvGet) -> S.fromList $ fst <$> qsParams
|
||||
(_, ActionInvoke InvHead) -> S.fromList $ fst <$> qsParams
|
||||
(CTUrlEncoded, _) -> S.fromList $ map (T.decodeUtf8 . fst) $ parseSimpleQuery $ LBS.toStrict reqBody
|
||||
_ -> case (relevantPayload, fromRight Nothing parsedColumns) of
|
||||
_ -> case (relevantPayload, columns) of
|
||||
(Just ProcessedJSON{payKeys}, _) -> payKeys
|
||||
(Just RawJSON{}, Just cls) -> cls
|
||||
_ -> S.empty
|
||||
@@ -333,8 +306,8 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
relevantPayload = case (contentType, action) of
|
||||
-- Though ActionInvoke GET/HEAD doesn't really have a payload, we use the payload variable as a way
|
||||
-- to store the query string arguments to the function.
|
||||
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
|
||||
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) rpcQParams
|
||||
(_, ActionInvoke InvGet) -> targetToJsonRpcParams (rightToMaybe target) qsParams
|
||||
(_, ActionInvoke InvHead) -> targetToJsonRpcParams (rightToMaybe target) qsParams
|
||||
(CTUrlEncoded, ActionInvoke InvPost) -> targetToJsonRpcParams (rightToMaybe target) $ (T.decodeUtf8 *** T.decodeUtf8) <$> parseSimpleQuery (LBS.toStrict reqBody)
|
||||
_ | shouldParsePayload -> rightToMaybe payload
|
||||
| otherwise -> Nothing
|
||||
@@ -349,7 +322,6 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
_ -> PathUnknown
|
||||
method = requestMethod req
|
||||
hdrs = requestHeaders req
|
||||
qParams = [(T.decodeUtf8 k, T.decodeUtf8 <$> v)|(k,v) <- qString]
|
||||
lookupHeader = flip lookup hdrs
|
||||
Preferences.Preferences{..} = Preferences.fromHeaders hdrs
|
||||
auth = fromMaybe "" $ lookupHeader hAuthorization
|
||||
@@ -357,24 +329,9 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody
|
||||
("Bearer" : t : _) -> t
|
||||
("bearer" : t : _) -> t
|
||||
_ -> ""
|
||||
endingIn:: [Text] -> Text -> Bool
|
||||
endingIn xx key = lastWord `elem` xx
|
||||
where lastWord = last $ T.split (=='.') key
|
||||
|
||||
headerRange = rangeRequested hdrs
|
||||
replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
|
||||
limitParams :: M.HashMap Text NonnegRange
|
||||
limitParams = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe . toS =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
|
||||
offsetParams :: M.HashMap Text NonnegRange
|
||||
offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe . toS =<< v)) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
|
||||
|
||||
urlRange = M.unionWith f limitParams offsetParams
|
||||
where
|
||||
f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
|
||||
where
|
||||
l = fromMaybe 0 $ rangeLimit rl
|
||||
o = rangeOffset ro
|
||||
ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" urlRange))) urlRange
|
||||
ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" qsRanges))) qsRanges
|
||||
|
||||
{-|
|
||||
Find the best match from a list of content types accepted by the
|
||||
|
||||
Reference in New Issue
Block a user