hasql-1.4: tasty/Main.hs
module Main where
import Main.Prelude hiding (assert)
import Test.QuickCheck.Instances
import Test.Tasty
import Test.Tasty.Runners
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import qualified Test.QuickCheck as QuickCheck
import qualified Main.Statements as Statements
import qualified Main.DSL as DSL
import qualified Main.Connection as Connection
import qualified Hasql.Statement as Statement
import qualified Hasql.Encoders as Encoders
import qualified Hasql.Decoders as Decoders
import qualified Hasql.Session as Session
main =
defaultMain tree
tree =
localOption (NumThreads 1) $
testGroup "All tests"
[
testGroup "Roundtrips" $ let
roundtrip encoder decoder input = let
session = let
statement = Statement.Statement "select $1" encoder decoder True
in Session.statement input statement
in unsafePerformIO $ do
x <- Connection.with (Session.run session)
return (Right (Right input) === x)
in [
testProperty "Array" $ let
encoder = Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))
decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8))))))
in roundtrip encoder decoder
,
testProperty "2D Array" $ let
encoder = Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))
decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))))
in \ list -> list /= [] ==> roundtrip encoder decoder (replicate 3 list)
]
,
testCase "Failed query" $
let
statement =
Statement.Statement "select true where 1 = any ($1) and $2" encoder decoder True
where
encoder =
contrazip2
(Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))
(Encoders.param (Encoders.nonNullable (Encoders.text)))
decoder =
fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))
session =
Session.statement ([3, 7], "a") statement
in do
x <- Connection.with (Session.run session)
assertBool (show x) $ case x of
Right (Left (Session.QueryError "select true where 1 = any ($1) and $2" ["[3, 7]", "\"a\""] _)) -> True
_ -> False
,
testCase "IN simulation" $
let
statement =
Statement.Statement "select true where 1 = any ($1)" encoder decoder True
where
encoder =
Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))
decoder =
fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))
session =
do
result1 <- Session.statement [1, 2] statement
result2 <- Session.statement [2, 3] statement
return (result1, result2)
in do
x <- Connection.with (Session.run session)
assertEqual (show x) (Right (Right (True, False))) x
,
testCase "NOT IN simulation" $
let
statement =
Statement.Statement "select true where 3 <> all ($1)" encoder decoder True
where
encoder =
Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))
decoder =
fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))
session =
do
result1 <- Session.statement [1, 2] statement
result2 <- Session.statement [2, 3] statement
return (result1, result2)
in do
x <- Connection.with (Session.run session)
assertEqual (show x) (Right (Right (True, False))) x
,
testCase "Composite decoding" $
let
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select (1, true)"
encoder =
mempty
decoder =
Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.composite ((,) <$> (Decoders.field . Decoders.nonNullable) Decoders.int8 <*> (Decoders.field . Decoders.nonNullable) Decoders.bool)))
session =
Session.statement () statement
in do
x <- Connection.with (Session.run session)
assertEqual (show x) (Right (Right (1, True))) x
,
testCase "Complex composite decoding" $
let
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select (1, true) as entity1, ('hello', 3) as entity2"
encoder =
mempty
decoder =
Decoders.singleRow $
(,) <$> (Decoders.column . Decoders.nonNullable) entity1 <*> (Decoders.column . Decoders.nonNullable) entity2
where
entity1 =
Decoders.composite $
(,) <$> (Decoders.field . Decoders.nonNullable) Decoders.int8 <*> (Decoders.field . Decoders.nonNullable) Decoders.bool
entity2 =
Decoders.composite $
(,) <$> (Decoders.field . Decoders.nonNullable) Decoders.text <*> (Decoders.field . Decoders.nonNullable) Decoders.int8
session =
Session.statement () statement
in do
x <- Connection.with (Session.run session)
assertEqual (show x) (Right (Right ((1, True), ("hello", 3)))) x
,
testCase "Empty array" $
let
io =
do
x <- Connection.with (Session.run session)
assertEqual (show x) (Right (Right [])) x
where
session =
Session.statement () statement
where
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select array[]::int8[]"
encoder =
mempty
decoder =
Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))
in io
,
testCase "Failing prepared statements" $
let
io =
Connection.with (Session.run session) >>=
(assertBool <$> show <*> resultTest)
where
resultTest =
\case
Right (Left (Session.QueryError _ _ (Session.ResultError (Session.ServerError "26000" _ _ _)))) -> False
_ -> True
session =
catchError session (const (pure ())) *> session
where
session =
Session.statement () statement
where
statement =
Statement.Statement sql encoder decoder True
where
sql =
"absurd"
encoder =
mempty
decoder =
Decoders.noResult
in io
,
testCase "Prepared statements after error" $
let
io =
Connection.with (Session.run session) >>=
\x -> assertBool (show x) (either (const False) isRight x)
where
session =
try *> fail *> try
where
try =
Session.statement 1 statement
where
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select $1 :: int8"
encoder =
Encoders.param (Encoders.nonNullable (Encoders.int8))
decoder =
Decoders.singleRow $ (Decoders.column . Decoders.nonNullable) Decoders.int8
fail =
catchError (Session.sql "absurd") (const (pure ()))
in io
,
testCase "\"in progress after error\" bugfix" $
let
sumStatement :: Statement.Statement (Int64, Int64) Int64
sumStatement =
Statement.Statement sql encoder decoder True
where
sql =
"select ($1 + $2)"
encoder =
contramap fst (Encoders.param (Encoders.nonNullable (Encoders.int8))) <>
contramap snd (Encoders.param (Encoders.nonNullable (Encoders.int8)))
decoder =
Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8)
sumSession :: Session.Session Int64
sumSession =
Session.sql "begin" *> Session.statement (1, 1) sumStatement <* Session.sql "end"
errorSession :: Session.Session ()
errorSession =
Session.sql "asldfjsldk"
io =
Connection.with $ \c -> do
Session.run errorSession c
Session.run sumSession c
in io >>= \x -> assertBool (show x) (either (const False) isRight x)
,
testCase "\"another command is already in progress\" bugfix" $
let
sumStatement :: Statement.Statement (Int64, Int64) Int64
sumStatement =
Statement.Statement sql encoder decoder True
where
sql =
"select ($1 + $2)"
encoder =
contramap fst (Encoders.param (Encoders.nonNullable (Encoders.int8))) <>
contramap snd (Encoders.param (Encoders.nonNullable (Encoders.int8)))
decoder =
Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8)
session :: Session.Session Int64
session =
do
Session.sql "begin;"
s <- Session.statement (1,1) sumStatement
Session.sql "end;"
return s
in DSL.session session >>= \x -> assertEqual (show x) (Right 2) x
,
testCase "Executing the same query twice" $
pure ()
,
testCase "Interval Encoding" $
let
actualIO =
DSL.session $ do
let
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select $1 = interval '10 seconds'"
decoder =
(Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.bool)))
encoder =
Encoders.param (Encoders.nonNullable (Encoders.interval))
in DSL.statement (10 :: DiffTime) statement
in actualIO >>= \x -> assertEqual (show x) (Right True) x
,
testCase "Interval Decoding" $
let
actualIO =
DSL.session $ do
let
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select interval '10 seconds'"
decoder =
(Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.interval)))
encoder =
Encoders.noParams
in DSL.statement () statement
in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x
,
testCase "Interval Encoding/Decoding" $
let
actualIO =
DSL.session $ do
let
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select $1"
decoder =
(Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.interval)))
encoder =
Encoders.param (Encoders.nonNullable (Encoders.interval))
in DSL.statement (10 :: DiffTime) statement
in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x
,
testCase "Unknown" $
let
actualIO =
DSL.session $ do
let
statement =
Statement.Statement sql mempty Decoders.noResult True
where
sql =
"drop type if exists mood"
in DSL.statement () statement
let
statement =
Statement.Statement sql mempty Decoders.noResult True
where
sql =
"create type mood as enum ('sad', 'ok', 'happy')"
in DSL.statement () statement
let
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select $1 = ('ok' :: mood)"
decoder =
(Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.bool)))
encoder =
Encoders.param (Encoders.nonNullable (Encoders.unknown))
in DSL.statement "ok" statement
in actualIO >>= assertEqual "" (Right True)
,
testCase "Textual Unknown" $
let
actualIO =
DSL.session $ do
let
statement =
Statement.Statement sql mempty Decoders.noResult True
where
sql =
"create or replace function overloaded(a int, b int) returns int as $$ select a + b $$ language sql;"
in DSL.statement () statement
let
statement =
Statement.Statement sql mempty Decoders.noResult True
where
sql =
"create or replace function overloaded(a text, b text, c text) returns text as $$ select a || b || c $$ language sql;"
in DSL.statement () statement
let
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select overloaded($1, $2) || overloaded($3, $4, $5)"
decoder =
(Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.text)))
encoder =
contramany (Encoders.param (Encoders.nonNullable (Encoders.unknown)))
in DSL.statement ["1", "2", "4", "5", "6"] statement
in actualIO >>= assertEqual "" (Right "3456")
,
testCase "Enum" $
let
actualIO =
DSL.session $ do
let
statement =
Statement.Statement sql mempty Decoders.noResult True
where
sql =
"drop type if exists mood"
in DSL.statement () statement
let
statement =
Statement.Statement sql mempty Decoders.noResult True
where
sql =
"create type mood as enum ('sad', 'ok', 'happy')"
in DSL.statement () statement
let
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select ($1 :: mood)"
decoder =
(Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.enum (Just . id))))
encoder =
Encoders.param (Encoders.nonNullable ((Encoders.enum id)))
in DSL.statement "ok" statement
in actualIO >>= assertEqual "" (Right "ok")
,
testCase "The same prepared statement used on different types" $
let
actualIO =
DSL.session $ do
let
effect1 =
DSL.statement "ok" statement
where
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select $1"
encoder =
Encoders.param (Encoders.nonNullable (Encoders.text))
decoder =
(Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.text)))
effect2 =
DSL.statement 1 statement
where
statement =
Statement.Statement sql encoder decoder True
where
sql =
"select $1"
encoder =
Encoders.param (Encoders.nonNullable (Encoders.int8))
decoder =
(Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8))
in (,) <$> effect1 <*> effect2
in actualIO >>= assertEqual "" (Right ("ok", 1))
,
testCase "Affected rows counting" $
replicateM_ 13 $
let
actualIO =
DSL.session $ do
dropTable
createTable
replicateM_ 100 insertRow
deleteRows <* dropTable
where
dropTable =
DSL.statement () $ Statements.plain $
"drop table if exists a"
createTable =
DSL.statement () $ Statements.plain $
"create table a (id bigserial not null, name varchar not null, primary key (id))"
insertRow =
DSL.statement () $ Statements.plain $
"insert into a (name) values ('a')"
deleteRows =
DSL.statement () $ Statement.Statement sql mempty decoder False
where
sql =
"delete from a"
decoder =
Decoders.rowsAffected
in actualIO >>= assertEqual "" (Right 100)
,
testCase "Result of an auto-incremented column" $
let
actualIO =
DSL.session $ do
DSL.statement () $ Statements.plain $ "drop table if exists a"
DSL.statement () $ Statements.plain $ "create table a (id serial not null, v char not null, primary key (id))"
id1 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('a') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False
id2 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('b') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False
DSL.statement () $ Statements.plain $ "drop table if exists a"
pure (id1, id2)
in assertEqual "" (Right (1, 2)) =<< actualIO
,
testCase "List decoding" $
let
actualIO =
DSL.session $ DSL.statement () $ Statements.selectList
in assertEqual "" (Right [(1, 2), (3, 4), (5, 6)]) =<< actualIO
]