diff --git a/src/PostgREST/Query.hs b/src/PostgREST/Query.hs index e72b535bf3..6e39cc1423 100644 --- a/src/PostgREST/Query.hs +++ b/src/PostgREST/Query.hs @@ -10,7 +10,7 @@ module PostgREST.Query , updateQuery , DbHandler , ReadQueryResult(..) - , WriteQueryResult(..) + , MutateQueryResult(..) , InvokeQueryResult(..) , OpenApiQueryResult ) where @@ -53,6 +53,7 @@ import PostgREST.Request.Preferences (PreferCount (..), import Protolude hiding (Handler) + type DbHandler = ExceptT Error SQL.Transaction data ReadQueryResult = ReadQueryResult @@ -64,6 +65,27 @@ data ReadQueryResult = ReadQueryResult , rqGucStatus :: Maybe HTTP.Status } +data MutateQueryResult = MutateQueryResult + { resRequest :: MutateRequestInfo + , resQueryTotal :: Int64 + , resFields :: [ByteString] + , resBody :: ByteString + , resGucStatus :: Maybe HTTP.Status + , resGucHeaders :: [GucHeader] + } + +data InvokeQueryResult = InvokeQueryResult + { iqRequest :: InvokeRequestInfo + , iqTableTotal :: Maybe Int64 + , iqQueryTotal :: Int64 + , iqBody :: BS8.ByteString + , iqGucHeaders :: [GucHeader] + , iqGucStatus :: Maybe HTTP.Status + } + +type OpenApiQueryResult = ([Table], Maybe Text, Proc.ProcsMap) + + readQuery :: ReadRequestInfo -> DbHandler ReadQueryResult readQuery reqInfo@ReadRequestInfo{..} = do (tableTotal, queryTotal, _ , body, gucHeaders, gucStatus) <- @@ -106,24 +128,24 @@ readQuery reqInfo@ReadRequestInfo{..} = do lift . SQL.statement mempty $ Statements.createExplainStatement countQry configDbPreparedStatements -createQuery :: MutateRequestInfo -> DbHandler WriteQueryResult +createQuery :: MutateRequestInfo -> DbHandler MutateQueryResult createQuery mutReq@MutateRequestInfo{..} = do - result <- writeQuery True pkCols mutReq + result <- mutateQuery True pkCols mutReq failNotSingular (iAcceptContentType mrApiRequest) (resQueryTotal result) return result where pkCols = tablePKCols mrDbStructure qiSchema qiName QualifiedIdentifier{..} = mrIdentifier -updateQuery :: MutateRequestInfo -> DbHandler WriteQueryResult +updateQuery :: MutateRequestInfo -> DbHandler MutateQueryResult updateQuery mutReq@MutateRequestInfo{..} = do - result <- writeQuery False mempty mutReq + result <- mutateQuery False mempty mutReq failNotSingular (iAcceptContentType mrApiRequest) (resQueryTotal result) return result -singleUpsertQuery :: MutateRequestInfo -> DbHandler WriteQueryResult +singleUpsertQuery :: MutateRequestInfo -> DbHandler MutateQueryResult singleUpsertQuery mutReq = do - result <- writeQuery False mempty mutReq + result <- mutateQuery False mempty mutReq -- Makes sure the querystring pk matches the payload pk -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted, @@ -136,20 +158,28 @@ singleUpsertQuery mutReq = do return result -deleteQuery :: MutateRequestInfo -> DbHandler WriteQueryResult +deleteQuery :: MutateRequestInfo -> DbHandler MutateQueryResult deleteQuery mutReq@MutateRequestInfo{..} = do - result <- writeQuery False mempty mutReq + result <- mutateQuery False mempty mutReq failNotSingular (iAcceptContentType mrApiRequest) (resQueryTotal result) return result -data InvokeQueryResult = InvokeQueryResult - { iqRequest :: InvokeRequestInfo - , iqTableTotal :: Maybe Int64 - , iqQueryTotal :: Int64 - , iqBody :: BS8.ByteString - , iqGucHeaders :: [GucHeader] - , iqGucStatus :: Maybe HTTP.Status - } +mutateQuery :: Bool -> [Text] -> MutateRequestInfo -> DbHandler MutateQueryResult +mutateQuery isInsert pkCols mr@MutateRequestInfo{..} = do + (_, queryTotal, fields, body, gucHeaders, gucStatus) <- + lift . SQL.statement mempty $ + Statements.createWriteStatement + (QueryBuilder.readRequestToQuery mrReadRequest) + (QueryBuilder.mutateRequestToQuery mrMutateRequest) + (iAcceptContentType mrApiRequest == CTSingularJSON) + isInsert + (iAcceptContentType mrApiRequest == CTTextCSV) + (iPreferRepresentation mrApiRequest) + pkCols + (pgVersion mrDbStructure) + (configDbPreparedStatements mrConfig) + + liftEither $ MutateQueryResult mr queryTotal fields body <$> gucStatus <*> gucHeaders invokeQuery :: InvokeRequestInfo -> DbHandler InvokeQueryResult invokeQuery ir@InvokeRequestInfo{..} = do @@ -182,8 +212,6 @@ invokeQuery ir@InvokeRequestInfo{..} = do returnsSingle (ApiRequest.TargetProc target _) = Proc.procReturnsSingle target returnsSingle _ = False -type OpenApiQueryResult = ([Table], Maybe Text, Proc.ProcsMap) - openApiQuery :: Schema -> AppConfig -> DbHandler OpenApiQueryResult openApiQuery tSchema AppConfig{..} = do lift $ (,,) @@ -211,33 +239,6 @@ txMode ApiRequest{..} = _ -> SQL.Write --- | Result from executing a write query on the database -data WriteQueryResult = WriteQueryResult - { resRequest :: MutateRequestInfo - , resQueryTotal :: Int64 - , resFields :: [ByteString] - , resBody :: ByteString - , resGucStatus :: Maybe HTTP.Status - , resGucHeaders :: [GucHeader] - } - -writeQuery :: Bool -> [Text] -> MutateRequestInfo -> DbHandler WriteQueryResult -writeQuery isInsert pkCols mr@MutateRequestInfo{..} = do - (_, queryTotal, fields, body, gucHeaders, gucStatus) <- - lift . SQL.statement mempty $ - Statements.createWriteStatement - (QueryBuilder.readRequestToQuery mrReadRequest) - (QueryBuilder.mutateRequestToQuery mrMutateRequest) - (iAcceptContentType mrApiRequest == CTSingularJSON) - isInsert - (iAcceptContentType mrApiRequest == CTTextCSV) - (iPreferRepresentation mrApiRequest) - pkCols - (pgVersion mrDbStructure) - (configDbPreparedStatements mrConfig) - - liftEither $ WriteQueryResult mr queryTotal fields body <$> gucStatus <*> gucHeaders - -- | Fail a response if a single JSON object was requested and not exactly one -- was found. failNotSingular :: ContentType -> Int64 -> DbHandler () diff --git a/src/PostgREST/Request.hs b/src/PostgREST/Request.hs index e5d11fae14..42e0485f39 100644 --- a/src/PostgREST/Request.hs +++ b/src/PostgREST/Request.hs @@ -37,40 +37,6 @@ import PostgREST.Request.ApiRequest (Action (..), import Protolude --- TODO: Carve out and use RequestError as Error type -parse :: AppConfig -> DbStructure -> Wai.Request -> LBS.ByteString -> Either Error Request -parse conf dbStructure waiRequest waiBody = do - apiRequest@ApiRequest{..} <- - mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf dbStructure waiRequest waiBody - - case (iAction, iTarget) of - (ActionRead headersOnly, TargetIdent identifier) -> do - readReq <- readRequest identifier conf dbStructure apiRequest - bField <- binaryField conf iTarget iAcceptContentType readReq - return . ReadRequest $ ReadRequestInfo conf dbStructure apiRequest headersOnly identifier readReq bField - (ActionCreate, TargetIdent identifier) -> - CreateRequest <$> mutateRequest conf dbStructure apiRequest identifier - (ActionUpdate, TargetIdent identifier) -> - UpdateRequest <$> mutateRequest conf dbStructure apiRequest identifier - (ActionSingleUpsert, TargetIdent identifier) -> - SingleUpsertRequest <$> mutateRequest conf dbStructure apiRequest identifier - (ActionDelete, TargetIdent identifier) -> - DeleteRequest <$> mutateRequest conf dbStructure apiRequest identifier - (ActionInfo, TargetIdent identifier) -> - return $ InfoRequest dbStructure apiRequest identifier - (ActionInvoke invMethod, TargetProc proc _) -> do - readReq <- readRequest identifier conf dbStructure apiRequest - bField <- binaryField conf iTarget iAcceptContentType readReq - return . InvokeRequest $ - InvokeRequestInfo conf dbStructure apiRequest invMethod proc readReq bField - where - identifier = - QualifiedIdentifier (pdSchema proc) - (fromMaybe (pdName proc) $ Proc.procTableName proc) - (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do - Right $ OpenApiRequest conf dbStructure apiRequest headersOnly tSchema - _ -> - Left Error.NotFound data Request = ReadRequest ReadRequestInfo @@ -111,6 +77,42 @@ data InvokeRequestInfo = InvokeRequestInfo , irBinaryField :: BinaryField } +type BinaryField = Maybe FieldName + +parse :: AppConfig -> DbStructure -> Wai.Request -> LBS.ByteString -> Either Error Request +parse conf dbStructure waiRequest waiBody = do + apiRequest@ApiRequest{..} <- + mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf dbStructure waiRequest waiBody + + case (iAction, iTarget) of + (ActionRead headersOnly, TargetIdent identifier) -> do + readReq <- readRequest identifier conf dbStructure apiRequest + bField <- binaryField conf iTarget iAcceptContentType readReq + return . ReadRequest $ ReadRequestInfo conf dbStructure apiRequest headersOnly identifier readReq bField + (ActionCreate, TargetIdent identifier) -> + CreateRequest <$> mutateRequest conf dbStructure apiRequest identifier + (ActionUpdate, TargetIdent identifier) -> + UpdateRequest <$> mutateRequest conf dbStructure apiRequest identifier + (ActionSingleUpsert, TargetIdent identifier) -> + SingleUpsertRequest <$> mutateRequest conf dbStructure apiRequest identifier + (ActionDelete, TargetIdent identifier) -> + DeleteRequest <$> mutateRequest conf dbStructure apiRequest identifier + (ActionInfo, TargetIdent identifier) -> + return $ InfoRequest dbStructure apiRequest identifier + (ActionInvoke invMethod, TargetProc proc _) -> do + readReq <- readRequest identifier conf dbStructure apiRequest + bField <- binaryField conf iTarget iAcceptContentType readReq + return . InvokeRequest $ + InvokeRequestInfo conf dbStructure apiRequest invMethod proc readReq bField + where + identifier = + QualifiedIdentifier (pdSchema proc) + (fromMaybe (pdName proc) $ Proc.procTableName proc) + (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do + Right $ OpenApiRequest conf dbStructure apiRequest headersOnly tSchema + _ -> + Left Error.NotFound + -- | Get the raw ApiRequest from a request. This should be obsoloted by further -- refactoring of this module. apiReq :: Request -> ApiRequest @@ -136,8 +138,6 @@ readRequest :: QualifiedIdentifier -> AppConfig -> DbStructure -> ApiRequest -> readRequest QualifiedIdentifier{..} AppConfig{..} dbStructure = ReqBuilder.readRequest qiSchema qiName configDbMaxRows (dbRelationships dbStructure) -type BinaryField = Maybe FieldName - -- | If raw(binary) output is requested, check that ContentType is one of the -- admitted rawContentTypes and that`?select=...` contains only one field other -- than `*` diff --git a/src/PostgREST/Response.hs b/src/PostgREST/Response.hs index 0665e463ad..d79ad78676 100644 --- a/src/PostgREST/Response.hs +++ b/src/PostgREST/Response.hs @@ -35,7 +35,7 @@ import PostgREST.GucHeader (GucHeader, import PostgREST.Query (InvokeQueryResult (..), OpenApiQueryResult, ReadQueryResult (..), - WriteQueryResult (..)) + MutateQueryResult (..)) import PostgREST.Request (InvokeRequestInfo (..), MutateRequestInfo (..), ReadRequestInfo (..)) @@ -67,8 +67,8 @@ readResponse ReadQueryResult{..} = ] ++ contentTypeHeaders rrApiRequest -createResponse :: WriteQueryResult -> Wai.Response -createResponse WriteQueryResult{..} = +createResponse :: MutateQueryResult -> Wai.Response +createResponse MutateQueryResult{..} = if iPreferRepresentation == Full then response (headers ++ contentTypeHeaders mrApiRequest) (toS resBody) else @@ -98,8 +98,8 @@ createResponse WriteQueryResult{..} = (\x -> ("Preference-Applied", BS8.pack $ show x)) <$> iPreferResolution ] -updateResponse :: WriteQueryResult -> Wai.Response -updateResponse WriteQueryResult{..} = +updateResponse :: MutateQueryResult -> Wai.Response +updateResponse MutateQueryResult{..} = if fullRepr then response (contentTypeHeaders mrApiRequest ++ [contentRangeHeader]) (toS resBody) else @@ -117,8 +117,8 @@ updateResponse WriteQueryResult{..} = RangeQuery.contentRangeH 0 (resQueryTotal - 1) $ if shouldCount (iPreferCount mrApiRequest) then Just resQueryTotal else Nothing -singleUpsertResponse :: WriteQueryResult -> Wai.Response -singleUpsertResponse WriteQueryResult{..} = +singleUpsertResponse :: MutateQueryResult -> Wai.Response +singleUpsertResponse MutateQueryResult{..} = if iPreferRepresentation mrApiRequest == Full then response HTTP.status200 (contentTypeHeaders mrApiRequest) (toS resBody) else @@ -127,8 +127,8 @@ singleUpsertResponse WriteQueryResult{..} = MutateRequestInfo{..} = resRequest response = gucResponse resGucStatus resGucHeaders -deleteResponse :: WriteQueryResult -> Wai.Response -deleteResponse WriteQueryResult{..} = +deleteResponse :: MutateQueryResult -> Wai.Response +deleteResponse MutateQueryResult{..} = if iPreferRepresentation mrApiRequest == Full then response HTTP.status200 (contentTypeHeaders mrApiRequest ++ [contentRangeHeader])