Robert VollmertandSteve Chavez
3da5a2875e
The good part is that protolude 0.3.0 builds with GHC 8.10. The bad part is that this change is a bit painful: - the default `toS` has changed to no longer convert to and from ByteString - similarly, `show` no longer outputs ByteString The changes here are pretty much minimal to keep things compiling; I didn't see a nice way to work with the new ConvertText class, even though `toUtf8` seems like it might help if used besides `toS` at just the right spots.
78 lines
3.3 KiB
Haskell
78 lines
3.3 KiB
Haskell
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, toS)
|
|
import Protolude.Conv (toS)
|
|
|
|
import PostgREST.QueryBuilder (requestToCallProcQuery)
|
|
import PostgREST.Types
|
|
|
|
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 Nothing []
|
|
liftIO $
|
|
cost `shouldSatisfy` (< Just 40)
|
|
|
|
it "should not exceed cost when calling setof composite proc with empty params" $ do
|
|
cost <- exec pool mempty $
|
|
requestToCallProcQuery (QualifiedIdentifier "test" "getallprojects") [] False Nothing []
|
|
liftIO $
|
|
cost `shouldSatisfy` (< Just 30)
|
|
|
|
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 Nothing []
|
|
liftIO $
|
|
cost `shouldSatisfy` (< Just 10)
|
|
|
|
context "params=multiple-objects" $ do
|
|
it "should not exceed cost when calling setof composite proc" $ do
|
|
cost <- exec pool [str| [{"id": 1}, {"id": 4}] |] $
|
|
requestToCallProcQuery (QualifiedIdentifier "test" "get_projects_below") [PgArg "id" "int" True] False (Just MultipleObjects) []
|
|
liftIO $ do
|
|
cost `shouldSatisfy` (> Just 2000)
|
|
cost `shouldSatisfy` (< Just 2100)
|
|
|
|
it "should not exceed cost when calling scalar proc" $ do
|
|
cost <- exec pool [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |] $
|
|
requestToCallProcQuery (QualifiedIdentifier "test" "add_them") [PgArg "a" "int" True, PgArg "b" "int" True] True Nothing []
|
|
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
|