refactor: dry some timings calculation
This commit is contained in:
steve-chavez
committed by
Steve Chavez
Steve Chavez
parent
378c11104b
commit
745e7868b0
+43
-51
@@ -5,16 +5,11 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module PostgREST.Response
|
||||
( createResponse
|
||||
, deleteResponse
|
||||
, infoIdentResponse
|
||||
( infoIdentResponse
|
||||
, infoProcResponse
|
||||
, infoRootResponse
|
||||
, invokeResponse
|
||||
, openApiResponse
|
||||
, readResponse
|
||||
, singleUpsertResponse
|
||||
, updateResponse
|
||||
, actionResponse
|
||||
, PgrstResponse(..)
|
||||
) where
|
||||
|
||||
@@ -34,7 +29,8 @@ import qualified PostgREST.RangeQuery as RangeQuery
|
||||
import qualified PostgREST.Response.OpenAPI as OpenAPI
|
||||
|
||||
import PostgREST.ApiRequest (ApiRequest (..),
|
||||
InvokeMethod (..))
|
||||
InvokeMethod (..),
|
||||
Mutation (..))
|
||||
import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
|
||||
PreferResolution (..),
|
||||
Preferences (..),
|
||||
@@ -43,9 +39,8 @@ import PostgREST.ApiRequest.Preferences (PreferRepresentation (..),
|
||||
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
|
||||
import PostgREST.Config (AppConfig (..))
|
||||
import PostgREST.MediaType (MediaType (..))
|
||||
import PostgREST.Plan (CallReadPlan (..),
|
||||
MutateReadPlan (..),
|
||||
WrappedReadPlan (..))
|
||||
import PostgREST.Plan (ActionPlan (..),
|
||||
InspectPlan (..))
|
||||
import PostgREST.Plan.MutatePlan (MutatePlan (..))
|
||||
import PostgREST.Query.Statements (ResultSet (..))
|
||||
import PostgREST.Response.GucHeader (GucHeader, unwrapGucHeader)
|
||||
@@ -68,8 +63,9 @@ data PgrstResponse = PgrstResponse {
|
||||
, pgrstBody :: LBS.ByteString
|
||||
}
|
||||
|
||||
readResponse :: WrappedReadPlan -> Bool -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
|
||||
readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet =
|
||||
actionResponse :: ActionPlan -> QualifiedIdentifier -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
|
||||
|
||||
actionResponse WrappedReadPlan{wrMedia, wrHdrsOnly=headersOnly} identifier ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet =
|
||||
case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
@@ -98,8 +94,7 @@ readResponse WrappedReadPlan{wrMedia} headersOnly identifier ctxApiRequest@ApiRe
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders wrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
createResponse :: QualifiedIdentifier -> MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
|
||||
createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
|
||||
actionResponse MutateReadPlan{mrMutation=MutationCreate, mrMutatePlan, mrMedia} QualifiedIdentifier{..} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}, ..} resultSet = case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
pkCols = case mrMutatePlan of { Insert{insPkCols} -> insPkCols; _ -> mempty;}
|
||||
@@ -139,8 +134,7 @@ createResponse QualifiedIdentifier{..} MutateReadPlan{mrMutatePlan, mrMedia} ctx
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
updateResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
|
||||
updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
actionResponse MutateReadPlan{mrMutation=MutationUpdate, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
RSStandard{..} -> do
|
||||
let
|
||||
contentRangeHeader =
|
||||
@@ -162,8 +156,7 @@ updateResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
singleUpsertResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
|
||||
singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
actionResponse MutateReadPlan{mrMutation=MutationSingleUpsert, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing preferRepresentation Nothing preferCount preferTransaction Nothing preferHandling preferTimezone Nothing []
|
||||
@@ -183,8 +176,7 @@ singleUpsertResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferenc
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
deleteResponse :: MutateReadPlan -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
|
||||
deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
actionResponse MutateReadPlan{mrMutation=MutationDelete, mrMedia} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..}} resultSet = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
contentRangeHeader =
|
||||
@@ -206,6 +198,34 @@ deleteResponse MutateReadPlan{mrMedia} ctxApiRequest@ApiRequest{iPreferences=Pre
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders mrMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
actionResponse CallReadPlan{crMedia, crInvMthd=invMethod, crProc=proc} _ ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
(status, contentRange) =
|
||||
RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
|
||||
rsOrErrBody = if status == HTTP.status416
|
||||
then Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange
|
||||
$ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
|
||||
else LBS.fromStrict rsBody
|
||||
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling preferTimezone preferMaxAffected []
|
||||
headers = contentRange : prefHeader
|
||||
|
||||
let (status', headers', body) =
|
||||
if Routine.funcReturnsVoid proc then
|
||||
(HTTP.status204, headers, mempty)
|
||||
else
|
||||
(status,
|
||||
headers ++ contentTypeHeaders crMedia ctxApiRequest,
|
||||
if invMethod == InvRead True then mempty else rsOrErrBody)
|
||||
|
||||
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status' headers'
|
||||
|
||||
Right $ PgrstResponse ovStatus ovHeaders body
|
||||
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders crMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
|
||||
infoIdentResponse :: QualifiedIdentifier -> SchemaCache -> Either Error.Error PgrstResponse
|
||||
infoIdentResponse identifier sCache = do
|
||||
case HM.lookup identifier (dbTables sCache) of
|
||||
@@ -233,36 +253,8 @@ respondInfo allowHeader =
|
||||
let allOrigins = ("Access-Control-Allow-Origin", "*") in
|
||||
Right $ PgrstResponse HTTP.status200 [allOrigins, (HTTP.hAllow, allowHeader)] mempty
|
||||
|
||||
invokeResponse :: CallReadPlan -> InvokeMethod -> Routine -> ApiRequest -> ResultSet -> Either Error.Error PgrstResponse
|
||||
invokeResponse CallReadPlan{crMedia} invMethod proc ctxApiRequest@ApiRequest{iPreferences=Preferences{..},..} resultSet = case resultSet of
|
||||
RSStandard {..} -> do
|
||||
let
|
||||
(status, contentRange) =
|
||||
RangeQuery.rangeStatusHeader iTopLevelRange rsQueryTotal rsTableTotal
|
||||
rsOrErrBody = if status == HTTP.status416
|
||||
then Error.errorPayload $ Error.ApiRequestError $ ApiRequestTypes.InvalidRange
|
||||
$ ApiRequestTypes.OutOfBounds (show $ RangeQuery.rangeOffset iTopLevelRange) (maybe "0" show rsTableTotal)
|
||||
else LBS.fromStrict rsBody
|
||||
prefHeader = maybeToList . prefAppliedHeader $ Preferences Nothing Nothing preferParameters preferCount preferTransaction Nothing preferHandling preferTimezone preferMaxAffected []
|
||||
headers = contentRange : prefHeader
|
||||
|
||||
let (status', headers', body) =
|
||||
if Routine.funcReturnsVoid proc then
|
||||
(HTTP.status204, headers, mempty)
|
||||
else
|
||||
(status,
|
||||
headers ++ contentTypeHeaders crMedia ctxApiRequest,
|
||||
if invMethod == InvRead True then mempty else rsOrErrBody)
|
||||
|
||||
(ovStatus, ovHeaders) <- overrideStatusHeaders rsGucStatus rsGucHeaders status' headers'
|
||||
|
||||
Right $ PgrstResponse ovStatus ovHeaders body
|
||||
|
||||
RSPlan plan ->
|
||||
Right $ PgrstResponse HTTP.status200 (contentTypeHeaders crMedia ctxApiRequest) $ LBS.fromStrict plan
|
||||
|
||||
openApiResponse :: (Text, Text) -> Bool -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
|
||||
openApiResponse versions headersOnly body conf sCache schema negotiatedByProfile =
|
||||
openApiResponse :: InspectPlan -> (Text, Text) -> Maybe (TablesMap, RoutineMap, Maybe Text) -> AppConfig -> SchemaCache -> Schema -> Bool -> Either Error.Error PgrstResponse
|
||||
openApiResponse InspectPlan{ipHdrsOnly=headersOnly} versions body conf sCache schema negotiatedByProfile =
|
||||
Right $ PgrstResponse HTTP.status200
|
||||
(MediaType.toContentType MTOpenAPI : maybeToList (profileHeader schema negotiatedByProfile))
|
||||
(maybe mempty (\(x, y, z) -> if headersOnly then mempty else OpenAPI.encode versions conf sCache x y z) body)
|
||||
|
||||
Reference in New Issue
Block a user