refactor: delete QueryCost, instead use PlanSpec

.github/workflows/ci.yaml

@@ -86,10 +86,6 @@ jobs:
         if: always()
         run: postgrest-with-postgresql-${{ matrix.pgVersion }} -f test/io/fixtures.sql postgrest-test-io
 
-      - name: Run query cost tests
-        if: always()
-        run: postgrest-with-postgresql-${{ matrix.pgVersion }} postgrest-test-querycost
-
 
   Test-Memory-Nix:
     name: Test memory (Nix)

nix/README.md

@@ -208,12 +208,6 @@ postgrest-loadtest-against master
 postgrest-loadtest-report
 ```
 
-Our query cost tests ensure that our generated queries don't surpass a threshold EXPLAIN cost.
-
-```bash
-postgrest-test-querycost
-```
-
 doctests for some of our modules are also available:
 
 ```bash

nix/tools/devTools.nix

@@ -77,7 +77,6 @@ let
       }
       ''
         ${tests}/bin/postgrest-test-spec
-        ${tests}/bin/postgrest-test-querycost
         ${tests}/bin/postgrest-test-doctests
         ${tests}/bin/postgrest-test-io
         ${style}/bin/postgrest-lint

nix/tools/tests.nix

@@ -32,18 +32,6 @@ let
           test:spec -- "''${_arg_leftovers[@]}"
       '';
 
-  testQuerycost =
-    checkedShellScript
-      {
-        name = "postgrest-test-querycost";
-        docs = "Run the Haskell test suite for query costs";
-        inRootDir = true;
-        withEnv = postgrest.env;
-      }
-      ''
-        ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
-      '';
-
   testDoctests =
     checkedShellScript
       {
@@ -140,7 +128,7 @@ let
           rm -rf coverage/*
 
           # build once before running all the tests
-          ${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:querycost
+          ${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec
 
           (
             trap 'echo Found dead code: Check file list above.' ERR ;
@@ -155,14 +143,11 @@ let
           HPCTIXFILE="$tmpdir"/spec.tix \
             ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
 
-          HPCTIXFILE="$tmpdir"/querycost.tix \
-            ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
-
           # Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
 
           # collect all the tix files
           ${ghc}/bin/hpc sum  --union --exclude=Paths_postgrest --output="$tmpdir"/tests.tix \
-            "$tmpdir"/io*.tix "$tmpdir"/spec.tix "$tmpdir"/querycost.tix
+            "$tmpdir"/io*.tix "$tmpdir"/spec.tix
 
           # prepare the overlay
           ${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
@@ -234,7 +219,6 @@ buildToolbox
   tools =
     [
       testSpec
-      testQuerycost
       testDoctests
       testSpecIdempotence
       testIO

postgrest.cabal

@@ -254,44 +254,6 @@ test-suite spec
                       -- https://github.com/PostgREST/postgrest/issues/387
                       -with-rtsopts=-K33K
 
-test-suite querycost
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  default-extensions: OverloadedStrings
-                      QuasiQuotes
-                      NoImplicitPrelude
-  hs-source-dirs:     test/spec
-  main-is:            QueryCost.hs
-  other-modules:      SpecHelper
-  build-depends:      base              >= 4.9 && < 4.17
-                    , aeson             >= 2.0.3 && < 2.2
-                    , base64-bytestring >= 1 && < 1.3
-                    , bytestring        >= 0.10.8 && < 0.12
-                    , case-insensitive  >= 1.2 && < 1.3
-                    , containers        >= 0.5.7 && < 0.7
-                    , contravariant     >= 1.4 && < 1.6
-                    , hasql             >= 1.6 && < 1.7
-                    , hasql-dynamic-statements >= 0.3.1 && < 0.4
-                    , hasql-pool        >= 0.8.0.2 && < 0.9
-                    , hasql-transaction >= 1.0.1 && < 1.1
-                    , heredoc           >= 0.2 && < 0.3
-                    , hspec             >= 2.3 && < 2.9
-                    , hspec-wai         >= 0.10 && < 0.12
-                    , hspec-wai-json    >= 0.10 && < 0.12
-                    , http-types        >= 0.12.3 && < 0.13
-                    , lens              >= 4.14 && < 5.3
-                    , lens-aeson        >= 1.0.1 && < 1.2
-                    , postgrest
-                    , process           >= 1.4.2 && < 1.7
-                    , protolude         >= 0.3.1 && < 0.4
-                    , regex-tdfa        >= 1.2.2 && < 1.4
-                    , wai-extra         >= 3.0.19 && < 3.2
-  ghc-options:        -O0 -Werror -Wall -fwarn-identities
-                      -fno-spec-constr -optP-Wno-nonportable-include-path
-                      -fwrite-ide-info
-                      -- https://github.com/PostgREST/postgrest/issues/387
-                      -with-rtsopts=-K1K
-
 test-suite doctests
   type:               exitcode-stdio-1.0
   default-language:   Haskell2010

test/spec/Feature/Query/PlanSpec.hs

@@ -13,6 +13,7 @@ import           Network.HTTP.Types
 import           Test.Hspec           hiding (pendingWith)
 import           Test.Hspec.Wai
 import           Test.Hspec.Wai.JSON
+import           Text.Heredoc
 
 import PostgREST.Config.PgVersion (PgVersion, pgVersion120,
                                    pgVersion130)
@@ -298,6 +299,41 @@ spec actualPgVersion = do
 
       liftIO $ planCost r `shouldSatisfy` (< 70.9)
 
+
+  describe "function call costs" $ do
+    it "should not exceed cost when calling setof composite proc" $ do
+      r <- request methodGet "/rpc/get_projects_below?id=3"
+             [planHdr] ""
+
+      liftIO $ planCost r `shouldSatisfy` (< 36.4)
+
+    it "should not exceed cost when calling setof composite proc with empty params" $ do
+      r <- request methodGet "/rpc/getallprojects"
+             [planHdr] ""
+
+      liftIO $ planCost r `shouldSatisfy` (< 71.0)
+
+    it "should not exceed cost when calling scalar proc" $ do
+      r <- request methodGet "/rpc/add_them?a=3&b=4"
+             [planHdr] ""
+
+      liftIO $ planCost r `shouldSatisfy` (< 1.18)
+
+    context "params=multiple-objects" $ do
+      it "should not exceed cost when calling setof composite proc" $ do
+        r <- request methodPost "/rpc/get_projects_below"
+               [planHdr, ("Prefer", "params=multiple-objects")]
+               [str| [{"id": 1}, {"id": 4}] |]
+
+        liftIO $ planCost r `shouldSatisfy` (< 4503.4)
+
+      it "should not exceed cost when calling scalar proc" $ do
+        r <- request methodPost "/rpc/add_them"
+               [planHdr, ("Prefer", "params=multiple-objects")]
+               [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]
+
+        liftIO $ planCost r `shouldSatisfy` (< 5.85)
+
 disabledSpec :: SpecWith ((), Application)
 disabledSpec =
   it "doesn't work if db-plan-enabled=false(the default)" $ do

test/spec/QueryCost.hs

@@ -1,86 +0,0 @@
--- TODO Can be replaced now by obtaining the EXPLAIN plan and adding the cost tests on PlanSpec.hs
-module Main where
-
-import           Control.Lens                      ((^?))
-import qualified Data.Aeson.Lens                   as L
-import qualified Hasql.Decoders                    as HD
-import qualified Hasql.DynamicStatements.Snippet   as H
-import qualified Hasql.DynamicStatements.Statement as H
-import qualified Hasql.Pool                        as P
-import qualified Hasql.Statement                   as H
-import qualified Hasql.Transaction                 as HT
-import qualified Hasql.Transaction.Sessions        as HT
-import           Text.Heredoc
-
-import Protolude hiding (get, toS)
-
-import PostgREST.Plan.CallPlan
-import PostgREST.Query.QueryBuilder (callPlanToQuery)
-
-import PostgREST.SchemaCache.Identifiers
-import PostgREST.SchemaCache.Proc
-
-import Test.Hspec
-
-main :: IO ()
-main = do
-  pool <- P.acquire 3 Nothing "postgresql://"
-
-  hspec $ describe "QueryCost" $
-    context "call proc query" $ do
-      it "should not exceed cost when calling setof composite proc" $ do
-        cost <- exec pool $
-          callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below")
-          (KeyParams [ProcParam "id" "int" True False])
-          (Just [str| {"id": 3} |]) False False [])
-        liftIO $
-          cost `shouldSatisfy` (< Just 40)
-
-      it "should not exceed cost when calling setof composite proc with empty params" $ do
-        cost <- exec pool $
-          callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "getallprojects") (KeyParams []) Nothing False False [])
-        liftIO $
-          cost `shouldSatisfy` (< Just 30)
-
-      it "should not exceed cost when calling scalar proc" $ do
-        cost <- exec pool $
-          callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "add_them")
-          (KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False])
-          (Just [str| {"a": 3, "b": 4} |]) True False [])
-        liftIO $
-          cost `shouldSatisfy` (< Just 10)
-
-      context "params=multiple-objects" $ do
-        it "should not exceed cost when calling setof composite proc" $ do
-          cost <- exec pool $
-            callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below")
-            (KeyParams [ProcParam "id" "int" True False])
-            (Just [str| [{"id": 1}, {"id": 4}] |]) False True [])
-          liftIO $ do
-            -- lower bound needed for now to make sure that cost is not Nothing
-            cost `shouldSatisfy` (> Just 2000)
-            cost `shouldSatisfy` (< Just 2100)
-
-        it "should not exceed cost when calling scalar proc" $ do
-          cost <- exec pool $
-            callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "add_them")
-            (KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False])
-            (Just [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]) True False [])
-          liftIO $
-            cost `shouldSatisfy` (< Just 10)
-
-
-exec :: P.Pool -> H.Snippet -> IO (Maybe Int64)
-exec pool query =
-  join . rightToMaybe <$>
-  P.use pool (HT.transaction HT.ReadCommitted HT.Read $ HT.statement mempty $ explainCost query)
-
-explainCost :: H.Snippet -> H.Statement () (Maybe Int64)
-explainCost query =
-  H.dynamicallyParameterized snippet decodeExplain False
- where
-   snippet = "EXPLAIN (FORMAT JSON) " <> query
-   decodeExplain :: HD.Result (Maybe Int64)
-   decodeExplain =
-     let row = HD.singleRow $ HD.column $ HD.nonNullable HD.bytea in
-     (^? L.nth 0 . L.key "Plan" .  L.key "Total Cost" . L._Integral) <$> row