Robert Vollmert
90eaaefe12
This version of hasql-pool is a simplified rewrite that doesn't use the resource-pool package. The major API changes are that idle connections are no longer timed out (and the corresponding setting is gone), and that `release` makes the pool unusable, where it used to remain usable and only flushed idle connections. We depend on a PostgREST fork of 0.7.2 that gives us reliable flushing, compare https://github.com/PostgREST/hasql-pool/pull/1 - hasql-pool 0.7 removes timing out of idle connections, so this change removes the db-pool-timeout option. Given that we were typically running with very high timeout settings, I don't anticipate the lack of timeout to introduce new issues, though we might want to consider introducing some retry-logic down the line when we encounter connection failures. - See https://github.com/PostgREST/postgrest/issues/2422 for a discussion on depending on a forked dependency. Besides adding the dependency to the nix overlay, we're also adding it to stack.yaml and a new cabal.project to allow stack/cabal users to build the project.
87 lines
3.6 KiB
Haskell
87 lines
3.6 KiB
Haskell
-- 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.Query.QueryBuilder (requestToCallProcQuery)
|
|
import PostgREST.Request.Types
|
|
|
|
import PostgREST.DbStructure.Identifiers
|
|
import PostgREST.DbStructure.Proc
|
|
|
|
import Test.Hspec
|
|
|
|
main :: IO ()
|
|
main = do
|
|
pool <- P.acquire 3 "postgresql://"
|
|
|
|
hspec $ describe "QueryCost" $
|
|
context "call proc query" $ do
|
|
it "should not exceed cost when calling setof composite proc" $ do
|
|
cost <- exec pool $
|
|
requestToCallProcQuery (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 $
|
|
requestToCallProcQuery (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 $
|
|
requestToCallProcQuery (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 $
|
|
requestToCallProcQuery (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 $
|
|
requestToCallProcQuery (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
|