diff --git a/default.nix b/default.nix index 52c9ea7055..c057494c15 100644 --- a/default.nix +++ b/default.nix @@ -3,7 +3,7 @@ let "postgrest"; compiler = - "ghc8107"; + "ghc922"; # PostgREST source files, filtered based on the rules in the .gitignore files # and file extensions. We want to include as litte as possible, as the files diff --git a/nix/hsie/Main.hs b/nix/hsie/Main.hs index 4ef6084c77..b3a52c55d3 100644 --- a/nix/hsie/Main.hs +++ b/nix/hsie/Main.hs @@ -24,21 +24,22 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Dot import qualified GHC +import qualified GHC.Paths import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint import qualified Options.Applicative as O import qualified System.FilePath as FP -import Bag (bagToList) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Function ((&)) import Data.List (intercalate) import Data.Maybe (catMaybes, mapMaybe) import Data.Text (Text) +import GHC.Data.Bag (bagToList) import GHC.Generics (Generic) import GHC.Hs.Extension (GhcPs) -import Module (moduleNameString) -import OccName (occNameString) -import RdrName (rdrNameOcc) +import GHC.Types.Name.Occurrence (occNameString) +import GHC.Types.Name.Reader (rdrNameOcc) +import GHC.Unit.Module.Name (moduleNameString) import System.Directory.Recursive (getFilesRecursive) import System.Exit (exitFailure) @@ -197,11 +198,11 @@ sourceSymbols source = do return $ concatMap (importSymbols source filepath . GHC.unLoc) hsmodImports -- | Parse a Haskell module -parseModule :: String -> IO (GHC.HsModule GhcPs) +parseModule :: FilePath -> IO GHC.HsModule parseModule filepath = do - result <- ExactPrint.parseModule filepath + result <- ExactPrint.parseModule GHC.Paths.libdir filepath case result of - Right (_, hsmod) -> + Right hsmod -> return $ GHC.unLoc hsmod Left errs -> fail $ "Errors with " <> show filepath <> ":\n " @@ -212,7 +213,6 @@ parseModule filepath = do -- If the import is a wildcard, i.e. no symbols are selected for import, then -- only one item is returned. importSymbols :: FilePath -> FilePath -> GHC.ImportDecl GhcPs -> [ImportedSymbol] -importSymbols _ _ (GHC.XImportDecl _) = mempty importSymbols source filepath GHC.ImportDecl{..} = case ideclHiding of Just (hiding, syms) -> diff --git a/nix/overlays/haskell-packages.nix b/nix/overlays/haskell-packages.nix index 33a5a3cacb..f3d3a7f353 100644 --- a/nix/overlays/haskell-packages.nix +++ b/nix/overlays/haskell-packages.nix @@ -70,6 +70,25 @@ let hspec-wai-json = lib.dontCheck (lib.unmarkBroken prev.hspec-wai-json); + + ptr = + prev.callHackageDirect + { + pkg = "ptr"; + ver = "0.16.8.2"; + sha256 = "sha256-Ei2GeQ0AjoxvsvmWbdPELPLtSaowoaj9IzsIiySgkAQ="; + } + { }; + + weeder = + lib.dontCheck (prev.callHackageDirect + { + pkg = "weeder"; + ver = "2.4.0"; + sha256 = "sha256-Nhp8EogHJ5SIr67060TPEvQbN/ECg3cRJFQnUtJUyC0="; + } + { }); + } // extraOverrides final prev; in { diff --git a/nix/static-haskell-package.nix b/nix/static-haskell-package.nix index 6710764ccd..69c0caccd8 100644 --- a/nix/static-haskell-package.nix +++ b/nix/static-haskell-package.nix @@ -58,6 +58,7 @@ let defaultCabalPackageVersionComingWithGhc = { ghc8107 = "Cabal_3_2_1_0"; + ghc922 = "Cabal_3_6_3_0"; }."${compiler}"; # The static-haskell-nix 'survey' derives a full static set of Haskell diff --git a/postgrest.cabal b/postgrest.cabal index 2c6fb8eaa2..1663009dd8 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -62,19 +62,21 @@ library PostgREST.RangeQuery PostgREST.Request.ApiRequest PostgREST.Request.DbRequestBuilder + PostgREST.Request.MutateQuery PostgREST.Request.Preferences - PostgREST.Request.Types PostgREST.Request.QueryParams + PostgREST.Request.ReadQuery + PostgREST.Request.Types PostgREST.Version PostgREST.Workers other-modules: Paths_postgrest - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , HTTP >= 4000.3.7 && < 4000.4 , Ranged-sets >= 0.3 && < 0.5 , aeson >= 2.0.3 && < 2.1 , auto-update >= 0.1.4 && < 0.2 , base64-bytestring >= 1 && < 1.3 - , bytestring >= 0.10.8 && < 0.11 + , bytestring >= 0.10.8 && < 0.12 , case-insensitive >= 1.2 && < 1.3 , cassava >= 0.4.5 && < 0.6 , configurator-pg >= 0.2 && < 0.3 @@ -93,7 +95,7 @@ library , insert-ordered-containers >= 0.2.2 && < 0.3 , interpolatedstring-perl6 >= 1 && < 1.1 , jose >= 0.8.5.1 && < 0.10 - , lens >= 4.14 && < 5.1 + , lens >= 4.14 && < 5.2 , lens-aeson >= 1.0.1 && < 1.2 , mtl >= 2.2.2 && < 2.3 , network >= 2.6 && < 3.2 @@ -106,7 +108,7 @@ library , scientific >= 0.3.4 && < 0.4 , swagger2 >= 2.4 && < 2.9 , text >= 1.2.2 && < 1.3 - , time >= 1.6 && < 1.11 + , time >= 1.6 && < 1.12 , unordered-containers >= 0.2.8 && < 0.3 , vault >= 0.3.1.5 && < 0.4 , vector >= 0.11 && < 0.13 @@ -147,7 +149,7 @@ executable postgrest NoImplicitPrelude hs-source-dirs: main main-is: Main.hs - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , containers >= 0.5.7 && < 0.7 , postgrest , protolude >= 0.3.1 && < 0.4 @@ -210,13 +212,13 @@ test-suite spec Feature.RpcPreRequestGucsSpec SpecHelper TestTypes - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , aeson >= 2.0.3 && < 2.1 , aeson-qq >= 0.8.1 && < 0.9 , async >= 2.1.1 && < 2.3 , auto-update >= 0.1.4 && < 0.2 , base64-bytestring >= 1 && < 1.3 - , bytestring >= 0.10.8 && < 0.11 + , bytestring >= 0.10.8 && < 0.12 , case-insensitive >= 1.2 && < 1.3 , containers >= 0.5.7 && < 0.7 , hasql-pool >= 0.5 && < 0.6 @@ -226,7 +228,7 @@ test-suite spec , hspec-wai >= 0.10 && < 0.12 , hspec-wai-json >= 0.10 && < 0.12 , http-types >= 0.12.3 && < 0.13 - , lens >= 4.14 && < 5.1 + , lens >= 4.14 && < 5.2 , lens-aeson >= 1.0.1 && < 1.2 , monad-control >= 1.0.1 && < 1.1 , postgrest @@ -253,10 +255,10 @@ test-suite querycost hs-source-dirs: test/spec main-is: QueryCost.hs other-modules: SpecHelper - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , aeson >= 2.0.3 && < 2.1 , base64-bytestring >= 1 && < 1.3 - , bytestring >= 0.10.8 && < 0.11 + , bytestring >= 0.10.8 && < 0.12 , case-insensitive >= 1.2 && < 1.3 , containers >= 0.5.7 && < 0.7 , contravariant >= 1.4 && < 1.6 @@ -268,7 +270,7 @@ test-suite querycost , hspec >= 2.3 && < 2.9 , hspec-wai >= 0.10 && < 0.12 , http-types >= 0.12.3 && < 0.13 - , lens >= 4.14 && < 5.1 + , lens >= 4.14 && < 5.2 , lens-aeson >= 1.0.1 && < 1.2 , postgrest , process >= 1.4.2 && < 1.7 @@ -288,7 +290,7 @@ test-suite doctests NoImplicitPrelude hs-source-dirs: test/doc main-is: Main.hs - build-depends: base >= 4.9 && < 4.16 + build-depends: base >= 4.9 && < 4.17 , doctest >= 0.8 , postgrest , pretty-simple diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index a3f79e9052..afd97fdf57 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -82,7 +82,7 @@ import PostgREST.Request.Preferences (PreferCount (..), PreferRepresentation (..), toAppliedHeader) import PostgREST.Request.QueryParams (QueryParams (..)) -import PostgREST.Request.Types (ReadRequest, fstFieldNames) +import PostgREST.Request.ReadQuery (ReadRequest, fstFieldNames) import PostgREST.Version (prettyVersion) import PostgREST.Workers (connectionWorker, listener) diff --git a/src/PostgREST/Query/QueryBuilder.hs b/src/PostgREST/Query/QueryBuilder.hs index 0c794cf71b..a114892c8f 100644 --- a/src/PostgREST/Query/QueryBuilder.hs +++ b/src/PostgREST/Query/QueryBuilder.hs @@ -28,7 +28,9 @@ import PostgREST.DbStructure.Relationship (Cardinality (..), import PostgREST.Request.Preferences (PreferResolution (..)) import PostgREST.Query.SqlFragment -import PostgREST.RangeQuery (allRange) +import PostgREST.RangeQuery (allRange) +import PostgREST.Request.MutateQuery +import PostgREST.Request.ReadQuery import PostgREST.Request.Types import Protolude diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 2ca2e0b99b..bff595d907 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -50,6 +50,7 @@ import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier (..)) import PostgREST.RangeQuery (NonnegRange, allRange, rangeLimit, rangeOffset) +import PostgREST.Request.ReadQuery (SelectItem) import PostgREST.Request.Types (Alias, Field, Filter (..), FtsOperator (..), JoinCondition (..), @@ -61,7 +62,7 @@ import PostgREST.Request.Types (Alias, Field, Filter (..), Operation (..), OrderDirection (..), OrderNulls (..), - OrderTerm (..), SelectItem, + OrderTerm (..), SimpleOperator (..), TrileanVal (..)) diff --git a/src/PostgREST/RangeQuery.hs b/src/PostgREST/RangeQuery.hs index bbe7b3df4b..f37cfc393e 100644 --- a/src/PostgREST/RangeQuery.hs +++ b/src/PostgREST/RangeQuery.hs @@ -36,13 +36,14 @@ rangeParse :: BS.ByteString -> NonnegRange rangeParse range = do let rangeRegex = "^([0-9]+)-([0-9]*)$" :: BS.ByteString - case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of - Just parsedRange -> - let [_, mLower, mUpper] = readMaybe . BS.unpack <$> parsedRange - lower = maybe emptyRange rangeGeq mLower - upper = maybe allRange rangeLeq mUpper in + case range =~ rangeRegex :: [[BS.ByteString]] of + [[_, l, u]] -> + let lower = maybe emptyRange rangeGeq (readInteger l) + upper = maybe allRange rangeLeq (readInteger u) in rangeIntersection lower upper - Nothing -> allRange + _ -> allRange + where + readInteger = readMaybe . BS.unpack rangeRequested :: RequestHeaders -> NonnegRange rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers diff --git a/src/PostgREST/Request/DbRequestBuilder.hs b/src/PostgREST/Request/DbRequestBuilder.hs index 2ac728c8d8..9e9c663f12 100644 --- a/src/PostgREST/Request/DbRequestBuilder.hs +++ b/src/PostgREST/Request/DbRequestBuilder.hs @@ -48,7 +48,9 @@ import PostgREST.Request.ApiRequest (Action (..), Mutation (..), Payload (..)) +import PostgREST.Request.MutateQuery import PostgREST.Request.Preferences +import PostgREST.Request.ReadQuery as ReadQuery import PostgREST.Request.Types import qualified PostgREST.Request.QueryParams as QueryParams @@ -263,7 +265,7 @@ addFilters ApiRequest{..} rReq = addFilterToNode :: (EmbedPath, Filter) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest addFilterToNode = - updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{where_=addFilterToLogicForest flt lf}::ReadQuery, i) f) + updateNode (\flt (Node (q@Select {where_=lf}, i) f) -> Node (q{ReadQuery.where_=addFilterToLogicForest flt lf}, i) f) addOrders :: ApiRequest -> ReadRequest -> Either ApiRequestError ReadRequest addOrders ApiRequest{..} rReq = @@ -295,7 +297,7 @@ addLogicTrees ApiRequest{..} rReq = QueryParams.QueryParams{..} = iQueryParams addLogicTreeToNode :: (EmbedPath, LogicTree) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest - addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{where_=t:lf}::ReadQuery, i) f) + addLogicTreeToNode = updateNode (\t (Node (q@Select{where_=lf},i) f) -> Node (q{ReadQuery.where_=t:lf}, i) f) -- Find a Node of the Tree and apply a function to it updateNode :: (a -> ReadRequest -> ReadRequest) -> (EmbedPath, a) -> Either ApiRequestError ReadRequest -> Either ApiRequestError ReadRequest diff --git a/src/PostgREST/Request/MutateQuery.hs b/src/PostgREST/Request/MutateQuery.hs new file mode 100644 index 0000000000..cf0e62638f --- /dev/null +++ b/src/PostgREST/Request/MutateQuery.hs @@ -0,0 +1,45 @@ +module PostgREST.Request.MutateQuery + ( MutateQuery(..) + , MutateRequest + ) +where + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Set as S + +import PostgREST.DbStructure.Identifiers (FieldName, + QualifiedIdentifier) +import PostgREST.RangeQuery (NonnegRange) +import PostgREST.Request.Preferences (PreferResolution) +import PostgREST.Request.Types (LogicTree, OrderTerm) + +import Protolude + +type MutateRequest = MutateQuery + +data MutateQuery + = Insert + { in_ :: QualifiedIdentifier + , insCols :: S.Set FieldName + , insBody :: Maybe LBS.ByteString + , onConflict :: Maybe (PreferResolution, [FieldName]) + , where_ :: [LogicTree] + , returning :: [FieldName] + } + | Update + { in_ :: QualifiedIdentifier + , updCols :: S.Set FieldName + , updBody :: Maybe LBS.ByteString + , where_ :: [LogicTree] + , pkFilters :: [FieldName] + , mutRange :: NonnegRange + , mutOrder :: [OrderTerm] + , returning :: [FieldName] + } + | Delete + { in_ :: QualifiedIdentifier + , where_ :: [LogicTree] + , mutRange :: NonnegRange + , mutOrder :: [OrderTerm] + , returning :: [FieldName] + } diff --git a/src/PostgREST/Request/QueryParams.hs b/src/PostgREST/Request/QueryParams.hs index d7cb2ed175..f985b398a1 100644 --- a/src/PostgREST/Request/QueryParams.hs +++ b/src/PostgREST/Request/QueryParams.hs @@ -44,16 +44,18 @@ import PostgREST.RangeQuery (NonnegRange, allRange, rangeGeq, rangeLimit, rangeOffset, restrictRange) -import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field, - Filter (..), FtsOperator (..), - JoinType (..), JsonOperand (..), - JsonOperation (..), JsonPath, ListVal, - LogicOperator (..), LogicTree (..), - OpExpr (..), Operation (..), - OrderDirection (..), OrderNulls (..), - OrderTerm (..), QPError (..), - SelectItem, SimpleOperator (..), - SingleVal, TrileanVal (..)) +import PostgREST.Request.ReadQuery (SelectItem) +import PostgREST.Request.Types (EmbedParam (..), EmbedPath, Field, + Filter (..), FtsOperator (..), + JoinType (..), JsonOperand (..), + JsonOperation (..), JsonPath, + ListVal, LogicOperator (..), + LogicTree (..), OpExpr (..), + Operation (..), + OrderDirection (..), + OrderNulls (..), OrderTerm (..), + QPError (..), SimpleOperator (..), + SingleVal, TrileanVal (..)) import Protolude hiding (try) diff --git a/src/PostgREST/Request/ReadQuery.hs b/src/PostgREST/Request/ReadQuery.hs new file mode 100644 index 0000000000..8cdf3d4c31 --- /dev/null +++ b/src/PostgREST/Request/ReadQuery.hs @@ -0,0 +1,48 @@ +module PostgREST.Request.ReadQuery + ( ReadNode + , ReadQuery(..) + , ReadRequest + , SelectItem + , fstFieldNames + ) where + +import Data.Tree (Tree (..)) + +import PostgREST.DbStructure.Identifiers (FieldName, + QualifiedIdentifier) +import PostgREST.DbStructure.Relationship (Relationship) +import PostgREST.RangeQuery (NonnegRange) +import PostgREST.Request.Types (Alias, Cast, Depth, Field, + Hint, JoinCondition, + JoinType, LogicTree, + NodeName, OrderTerm) + + +import Protolude + +type ReadRequest = Tree ReadNode + +type ReadNode = + (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth)) + +-- | The select value in `/tbl?select=alias:field::cast` +type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType) + +data ReadQuery = Select + { select :: [SelectItem] + , from :: QualifiedIdentifier + -- ^ A table alias is used in case of self joins + , fromAlias :: Maybe Alias + -- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins. + , implicitJoins :: [QualifiedIdentifier] + , where_ :: [LogicTree] + , joinConditions :: [JoinCondition] + , order :: [OrderTerm] + , range_ :: NonnegRange + } + deriving (Eq) + +-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d)) +fstFieldNames :: ReadRequest -> [FieldName] +fstFieldNames (Node (sel, _) _) = + fst . (\(f, _, _, _, _) -> f) <$> select sel diff --git a/src/PostgREST/Request/Types.hs b/src/PostgREST/Request/Types.hs index 315e9aeaa7..16c0769826 100644 --- a/src/PostgREST/Request/Types.hs +++ b/src/PostgREST/Request/Types.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} module PostgREST.Request.Types ( Alias + , Cast , Depth , EmbedParam(..) , ApiRequestError(..) @@ -19,8 +20,6 @@ module PostgREST.Request.Types , ListVal , LogicOperator(..) , LogicTree(..) - , MutateQuery(..) - , MutateRequest , NodeName , OpExpr(..) , Operation (..) @@ -28,21 +27,13 @@ module PostgREST.Request.Types , OrderNulls(..) , OrderTerm(..) , QPError(..) - , ReadNode - , ReadQuery(..) - , ReadRequest - , SelectItem , SingleVal , TrileanVal(..) - , fstFieldNames , SimpleOperator(..) , FtsOperator(..) ) where import qualified Data.ByteString.Lazy as LBS -import qualified Data.Set as S - -import Data.Tree (Tree (..)) import PostgREST.ContentType (ContentType (..)) import PostgREST.DbStructure.Identifiers (FieldName, @@ -50,8 +41,6 @@ import PostgREST.DbStructure.Identifiers (FieldName, import PostgREST.DbStructure.Proc (ProcDescription (..), ProcParam (..)) import PostgREST.DbStructure.Relationship (Relationship) -import PostgREST.RangeQuery (NonnegRange) -import PostgREST.Request.Preferences (PreferResolution) import Protolude @@ -76,30 +65,11 @@ data ApiRequestError data QPError = QPError Text Text -type ReadRequest = Tree ReadNode -type MutateRequest = MutateQuery type CallRequest = CallQuery -type ReadNode = - (ReadQuery, (NodeName, Maybe Relationship, Maybe Alias, Maybe Hint, Maybe JoinType, Depth)) - type NodeName = Text type Depth = Integer -data ReadQuery = Select - { select :: [SelectItem] - , from :: QualifiedIdentifier - -- ^ A table alias is used in case of self joins - , fromAlias :: Maybe Alias - -- ^ Only used for Many to Many joins. Parent and Child joins use explicit joins. - , implicitJoins :: [QualifiedIdentifier] - , where_ :: [LogicTree] - , joinConditions :: [JoinCondition] - , order :: [OrderTerm] - , range_ :: NonnegRange - } - deriving (Eq) - data JoinCondition = JoinCondition (QualifiedIdentifier, FieldName) @@ -123,33 +93,6 @@ data OrderNulls | OrderNullsLast deriving (Eq) -data MutateQuery - = Insert - { in_ :: QualifiedIdentifier - , insCols :: S.Set FieldName - , insBody :: Maybe LBS.ByteString - , onConflict :: Maybe (PreferResolution, [FieldName]) - , where_ :: [LogicTree] - , returning :: [FieldName] - } - | Update - { in_ :: QualifiedIdentifier - , updCols :: S.Set FieldName - , updBody :: Maybe LBS.ByteString - , where_ :: [LogicTree] - , pkFilters :: [FieldName] - , mutRange :: NonnegRange - , mutOrder :: [OrderTerm] - , returning :: [FieldName] - } - | Delete - { in_ :: QualifiedIdentifier - , where_ :: [LogicTree] - , mutRange :: NonnegRange - , mutOrder :: [OrderTerm] - , returning :: [FieldName] - } - data CallQuery = FunctionCall { funCQi :: QualifiedIdentifier , funCParams :: CallParams @@ -163,9 +106,6 @@ data CallParams = KeyParams [ProcParam] -- ^ Call with key params: func(a := val1, b:= val2) | OnePosParam ProcParam -- ^ Call with positional params(only one supported): func(val) --- | The select value in `/tbl?select=alias:field::cast` -type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType) - type Field = (FieldName, JsonPath) type Cast = Text type Alias = Text @@ -205,12 +145,6 @@ data JsonOperand | JIdx { jVal :: Text } deriving (Eq) --- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d)) -fstFieldNames :: ReadRequest -> [FieldName] -fstFieldNames (Node (sel, _) _) = - fst . (\(f, _, _, _, _) -> f) <$> select sel - - -- | Boolean logic expression tree e.g. "and(name.eq.N,or(id.eq.1,id.eq.2))" is: -- -- And diff --git a/test/spec/Feature/Query/InsertSpec.hs b/test/spec/Feature/Query/InsertSpec.hs index 7a8caddca7..18ff349573 100644 --- a/test/spec/Feature/Query/InsertSpec.hs +++ b/test/spec/Feature/Query/InsertSpec.hs @@ -498,7 +498,7 @@ spec actualPgVersion = do [json|[ { "k":"圍棋", "extra":"￥" } ]|] { matchStatus = 201 } - let Just location = lookup hLocation $ simpleHeaders p + Just location <- pure $ lookup hLocation $ simpleHeaders p get location `shouldRespondWith` [json|[ { "k":"圍棋", "extra":"￥" } ]|] diff --git a/test/spec/SpecHelper.hs b/test/spec/SpecHelper.hs index 3a01eaa80d..d2b07c4023 100644 --- a/test/spec/SpecHelper.hs +++ b/test/spec/SpecHelper.hs @@ -52,7 +52,7 @@ validateOpenApiResponse headers = do let respHeaders = simpleHeaders r in respHeaders `shouldSatisfy` \hs -> ("Content-Type", "application/openapi+json; charset=utf-8") `elem` hs - let Just body = decode (simpleBody r) + Just body <- pure $ decode (simpleBody r) Just schema <- liftIO $ decode <$> BL.readFile "test/spec/fixtures/openapi.json" let args :: M.Map Text Value args = M.fromList