diff --git a/.circleci/config.yml b/.circleci/config.yml index 07b4d7907..0857ec024 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -144,7 +144,7 @@ jobs: stack build --fast --test --no-run-tests - run: name: run tests - command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test + command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec build-test-10: docker: @@ -176,7 +176,7 @@ jobs: stack build --fast --test --no-run-tests - run: name: run tests - command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test + command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec build-test-11: docker: @@ -208,7 +208,7 @@ jobs: stack build --fast --test --no-run-tests - run: name: run tests - command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test + command: POSTGREST_TEST_CONNECTION=$(test/create_test_db "postgres://circleci@localhost" postgrest_test) stack test postgrest:spec build-prof-test: docker: diff --git a/postgrest.cabal b/postgrest.cabal index e40047818..be6e6320b 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -184,3 +184,42 @@ test-suite spec QuasiQuotes NoImplicitPrelude ghc-options: -threaded -rtsopts -with-rtsopts=-N + +Test-Suite spec-querycost + Type: exitcode-stdio-1.0 + Default-Language: Haskell2010 + default-extensions: OverloadedStrings, QuasiQuotes, NoImplicitPrelude + Hs-Source-Dirs: test + Main-Is: QueryCost.hs + Other-Modules: SpecHelper + Build-Depends: base >= 4.9 && < 4.13 + , aeson >= 0.11.3 && < 1.5 + , aeson-qq >= 0.8.1 && < 0.9 + , async >= 2.1.1 && < 2.3 + , auto-update >= 0.1.4 && < 0.2 + , base64-bytestring >= 1 && < 1.1 + , bytestring >= 0.10.8 && < 0.11 + , case-insensitive >= 1.2 && < 1.3 + , cassava >= 0.4.5 && < 0.6 + , containers >= 0.5.7 && < 0.7 + , contravariant >= 1.4 && < 1.6 + , hasql >= 1.4 && < 1.5 + , hasql-pool >= 0.5 && < 0.6 + , hasql-transaction >= 0.7.2 && < 0.8 + , heredoc >= 0.2 && < 0.3 + , hspec >= 2.3 && < 2.8 + , hspec-wai >= 0.7 && < 0.10 + , hspec-wai-json >= 0.7 && < 0.10 + , http-types >= 0.12.3 && < 0.13 + , lens >= 4.14 && < 4.18 + , lens-aeson >= 1.0.1 && < 1.1 + , monad-control >= 1.0.1 && < 1.1 + , postgrest + , process >= 1.4.2 && < 1.7 + , protolude >= 0.2.2 && < 0.3 + , regex-tdfa >= 1.2.2 && < 1.3 + , text >= 1.2.2 && < 1.3 + , time >= 1.6 && < 1.9 + , transformers-base >= 0.4.4 && < 0.5 + , wai >= 3.2.1 && < 3.3 + , wai-extra >= 3.0.19 && < 3.1 diff --git a/test/QueryCost.hs b/test/QueryCost.hs new file mode 100644 index 000000000..700a7f057 --- /dev/null +++ b/test/QueryCost.hs @@ -0,0 +1,62 @@ +module Main where + +import Control.Lens ((^?)) +import qualified Data.Aeson.Lens as L +import qualified Hasql.Decoders as HD +import qualified Hasql.Encoders as HE +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) + +import PostgREST.QueryBuilder (requestToCallProcQuery) +import PostgREST.Types (PgArg (..), QualifiedIdentifier (..), + SqlQuery) + +import SpecHelper (getEnvVarWithDefault) + +import Test.Hspec + +main :: IO () +main = do + testDbConn <- getEnvVarWithDefault "POSTGREST_TEST_CONNECTION" "postgres://postgrest_test@localhost/postgrest_test" + -- To speed things up, assume setupDb has ben ran in the previous spec. + pool <- P.acquire (3, 10, toS testDbConn) + + hspec $ describe "QueryCost" $ + context "call proc query" $ do + it "should not exceed cost when calling setof composite proc" $ do + cost <- exec pool [str| {"id": 3} |] $ + requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True] False False + liftIO $ + cost `shouldSatisfy` (< Just 2100) + + it "should not exceed cost when calling setof composite proc with empty params" $ do + cost <- exec pool mempty $ + requestToCallProcQuery (QualifiedIdentifier "test" "getallprojects") [] False False + liftIO $ + cost `shouldSatisfy` (< Just 20) + + it "should not exceed cost when calling scalar proc" $ do + cost <- exec pool [str| {"a": 3, "b": 4} |] $ + requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True, PgArg "b" "int" True] True False + liftIO $ + cost `shouldSatisfy` (< Just 10) + +exec :: P.Pool -> ByteString -> SqlQuery -> IO (Maybe Int64) +exec pool input query = + join . rightToMaybe <$> + P.use pool (HT.transaction HT.ReadCommitted HT.Read $ HT.statement input $ explainCost query) + +explainCost :: SqlQuery -> H.Statement ByteString (Maybe Int64) +explainCost query = + H.Statement (encodeUtf8 sql) (HE.param $ HE.nonNullable HE.unknown) decodeExplain False + where + sql = "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