fix: compilation on Ubuntu, GHC 9.0.2 compat
This commit is contained in:
committed by
Steve Chavez
parent
d9261fa674
commit
40dc46ed2e
@@ -8,6 +8,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
|
|||||||
### Fixed
|
### Fixed
|
||||||
|
|
||||||
- #2821, Fix OPTIONS not accepting all available media types - @steve-chavez
|
- #2821, Fix OPTIONS not accepting all available media types - @steve-chavez
|
||||||
|
- #2834, Fix compilation on Ubuntu by being compatible with GHC 9.0.2 - @steve-chavez
|
||||||
|
|
||||||
## [11.1.0] - 2023-06-07
|
## [11.1.0] - 2023-06-07
|
||||||
|
|
||||||
|
|||||||
@@ -13,7 +13,6 @@ resource.
|
|||||||
{-# LANGUAGE DuplicateRecordFields #-}
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedRecordDot #-}
|
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
|
||||||
module PostgREST.Plan
|
module PostgREST.Plan
|
||||||
@@ -503,10 +502,10 @@ updateNode f (targetNodeName:remainingPath, a) (Right (Node rootNode forest)) =
|
|||||||
findNode = find (\(Node ReadPlan{relName, relAlias} _) -> relName == targetNodeName || relAlias == Just targetNodeName) forest
|
findNode = find (\(Node ReadPlan{relName, relAlias} _) -> relName == targetNodeName || relAlias == Just targetNodeName) forest
|
||||||
|
|
||||||
mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan
|
mutatePlan :: Mutation -> QualifiedIdentifier -> ApiRequest -> SchemaCache -> ReadPlanTree -> Either Error MutatePlan
|
||||||
mutatePlan mutation qi ApiRequest{iPreferences=preferences, ..} sCache readReq = mapLeft ApiRequestError $
|
mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} sCache readReq = mapLeft ApiRequestError $
|
||||||
case mutation of
|
case mutation of
|
||||||
MutationCreate ->
|
MutationCreate ->
|
||||||
mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> preferences.preferResolution <*> Just confCols) [] returnings pkCols applyDefaults) typedColumnsOrError
|
mapRight (\typedColumns -> Insert qi typedColumns body ((,) <$> preferResolution <*> Just confCols) [] returnings pkCols applyDefaults) typedColumnsOrError
|
||||||
MutationUpdate ->
|
MutationUpdate ->
|
||||||
mapRight (\typedColumns -> Update qi typedColumns body combinedLogic iTopLevelRange rootOrder returnings applyDefaults) typedColumnsOrError
|
mapRight (\typedColumns -> Update qi typedColumns body combinedLogic iTopLevelRange rootOrder returnings applyDefaults) typedColumnsOrError
|
||||||
MutationSingleUpsert ->
|
MutationSingleUpsert ->
|
||||||
@@ -524,7 +523,7 @@ mutatePlan mutation qi ApiRequest{iPreferences=preferences, ..} sCache readReq =
|
|||||||
confCols = fromMaybe pkCols qsOnConflict
|
confCols = fromMaybe pkCols qsOnConflict
|
||||||
QueryParams.QueryParams{..} = iQueryParams
|
QueryParams.QueryParams{..} = iQueryParams
|
||||||
returnings =
|
returnings =
|
||||||
if preferences.preferRepresentation == None
|
if preferRepresentation == None
|
||||||
then []
|
then []
|
||||||
else inferColsEmbedNeeds readReq pkCols
|
else inferColsEmbedNeeds readReq pkCols
|
||||||
pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache
|
pkCols = maybe mempty tablePKCols $ HM.lookup qi $ dbTables sCache
|
||||||
@@ -534,7 +533,7 @@ mutatePlan mutation qi ApiRequest{iPreferences=preferences, ..} sCache readReq =
|
|||||||
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
|
body = payRaw <$> iPayload -- the body is assumed to be json at this stage(ApiRequest validates)
|
||||||
tbl = HM.lookup qi $ dbTables sCache
|
tbl = HM.lookup qi $ dbTables sCache
|
||||||
typedColumnsOrError = resolveOrError tbl `traverse` S.toList iColumns
|
typedColumnsOrError = resolveOrError tbl `traverse` S.toList iColumns
|
||||||
applyDefaults = preferences.preferMissing == Just ApplyDefaults
|
applyDefaults = preferMissing == Just ApplyDefaults
|
||||||
|
|
||||||
resolveOrError :: Maybe Table -> FieldName -> Either ApiRequestError TypedField
|
resolveOrError :: Maybe Table -> FieldName -> Either ApiRequestError TypedField
|
||||||
resolveOrError Nothing _ = Left NotFound
|
resolveOrError Nothing _ = Left NotFound
|
||||||
|
|||||||
@@ -8,7 +8,6 @@ import Network.Wai.Test (SResponse (..))
|
|||||||
|
|
||||||
import Data.Aeson.Lens
|
import Data.Aeson.Lens
|
||||||
import Data.Aeson.QQ
|
import Data.Aeson.QQ
|
||||||
import qualified Data.ByteString as BS
|
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
@@ -66,7 +65,7 @@ spec actualPgVersion = do
|
|||||||
|
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=buffers; charset=utf-8")
|
resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; for=\"application/json\"; options=buffers; charset=utf-8")
|
||||||
resBody `shouldSatisfy` (\t -> T.isInfixOf "Shared Hit Blocks" (decodeUtf8 $ BS.toStrict t))
|
resBody `shouldSatisfy` (\t -> T.isInfixOf "Shared Hit Blocks" (decodeUtf8 $ LBS.toStrict t))
|
||||||
else do
|
else do
|
||||||
-- analyze is required for buffers on pg < 13
|
-- analyze is required for buffers on pg < 13
|
||||||
r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=analyze|buffers") ""
|
r <- request methodGet "/projects" (acceptHdrs "application/vnd.pgrst.plan+json; options=analyze|buffers") ""
|
||||||
@@ -338,7 +337,7 @@ spec actualPgVersion = do
|
|||||||
let resBody = simpleBody r
|
let resBody = simpleBody r
|
||||||
|
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getallusers" (decodeUtf8 $ BS.toStrict t))
|
resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getallusers" (decodeUtf8 $ LBS.toStrict t))
|
||||||
|
|
||||||
it "should inline a function with arguments(the function won't appear in the plan tree)" $ do
|
it "should inline a function with arguments(the function won't appear in the plan tree)" $ do
|
||||||
r <- request methodGet "/rpc/getitemrange?min=10&max=15"
|
r <- request methodGet "/rpc/getitemrange?min=10&max=15"
|
||||||
@@ -347,7 +346,7 @@ spec actualPgVersion = do
|
|||||||
let resBody = simpleBody r
|
let resBody = simpleBody r
|
||||||
|
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getitemrange" (decodeUtf8 $ BS.toStrict t))
|
resBody `shouldSatisfy` (\t -> not $ T.isInfixOf "getitemrange" (decodeUtf8 $ LBS.toStrict t))
|
||||||
|
|
||||||
disabledSpec :: SpecWith ((), Application)
|
disabledSpec :: SpecWith ((), Application)
|
||||||
disabledSpec =
|
disabledSpec =
|
||||||
|
|||||||
Reference in New Issue
Block a user