diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index 30fef3380..26efe7f34 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/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(..), - 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 diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 3f0ba8d8b..db00892cb 100644 --- a/src/PostgREST/App.hs +++ b/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 - 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 diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index be4c2b1ac..75ae6d98d 100644 --- a/src/PostgREST/Error.hs +++ b/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 diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 93a5410fd..03a077c82 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/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 -> - 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 diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 52a592077..5136ffc04 100644 --- a/src/PostgREST/Types.hs +++ b/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 -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