{-# LANGUAGE ScopedTypeVariables #-}
module Test.Connection
( connectionTests
)
where
import qualified Control.Exception as E
import qualified Control.Monad.IO.Class as MIO
import qualified Data.ByteString.Char8 as B8
import qualified Data.Text.Encoding as Enc
import qualified Database.PostgreSQL.LibPQ as LibPQ
import Hedgehog ((===))
import qualified Hedgehog as HH
import qualified Hedgehog.Range as Range
import qualified Orville.PostgreSQL.Raw.Connection as Conn
import qualified Orville.PostgreSQL.Raw.PgTextFormatValue as PgTextFormatValue
import qualified Test.PgGen as PgGen
import qualified Test.Property as Property
connectionTests :: Conn.ConnectionPool -> Property.Group
connectionTests pool =
Property.Group "Connection" $
[ prop_safeOrUnsafeNonNullBytes pool
, prop_errorOnSafeNulByte pool
, prop_truncateValuesAtUnsafeNulByte pool
, prop_errorOnInvalidSql pool
, prop_returningAConnectionToPoolWithOpenTransactionCausesException pool
, prop_acquiredConnectionNotDestroyed pool
, prop_poolUsableAfterDestroyingConnections pool
]
prop_safeOrUnsafeNonNullBytes :: Property.NamedDBProperty
prop_safeOrUnsafeNonNullBytes =
Property.namedDBProperty "executeRaw can pass non-null bytes equivalents whether checked for NUL or not" $ \pool -> do
text <- HH.forAll $ PgGen.pgText (Range.linear 0 256)
let
notNulBytes =
Enc.encodeUtf8 text
value <-
MIO.liftIO . Conn.withPoolConnection pool $ \connection -> do
result <-
Conn.executeRaw
connection
(B8.pack "SELECT $1::text = $2::text")
[ Just $ PgTextFormatValue.fromByteString notNulBytes
, Just $ PgTextFormatValue.unsafeFromByteString notNulBytes
]
LibPQ.getvalue' result 0 0
value === Just (B8.pack "t")
prop_errorOnSafeNulByte :: Property.NamedDBProperty
prop_errorOnSafeNulByte =
Property.namedDBProperty "executeRaw returns error if nul byte is given using safe constructor" $ \pool -> do
textBefore <- HH.forAll $ PgGen.pgText (Range.linear 0 32)
textAfter <- HH.forAll $ PgGen.pgText (Range.linear 0 32)
let
bytesWithNul =
B8.concat
[ Enc.encodeUtf8 textBefore
, B8.pack "\NUL"
, Enc.encodeUtf8 textAfter
]
result <-
MIO.liftIO . E.try . Conn.withPoolConnection pool $ \connection ->
Conn.executeRaw
connection
(B8.pack "SELECT $1::text")
[ Just $ PgTextFormatValue.fromByteString bytesWithNul
]
case result of
Left PgTextFormatValue.NULByteFoundError ->
HH.success
Right _ -> do
HH.footnote "Expected 'executeRaw' to return failure, but it did not"
HH.failure
prop_truncateValuesAtUnsafeNulByte :: Property.NamedDBProperty
prop_truncateValuesAtUnsafeNulByte =
Property.namedDBProperty "executeRaw truncates values at the nul byte given using unsafe constructor" $ \pool -> do
textBefore <- HH.forAll $ PgGen.pgText (Range.linear 0 32)
textAfter <- HH.forAll $ PgGen.pgText (Range.linear 0 32)
let
bytesBefore =
Enc.encodeUtf8 textBefore
bytesWithNul =
B8.concat
[ bytesBefore
, B8.pack "\NUL"
, Enc.encodeUtf8 textAfter
]
value <-
MIO.liftIO . Conn.withPoolConnection pool $ \connection -> do
result <-
Conn.executeRaw
connection
(B8.pack "SELECT $1::text")
[ Just $ PgTextFormatValue.unsafeFromByteString bytesWithNul
]
LibPQ.getvalue' result 0 0
value === Just bytesBefore
prop_errorOnInvalidSql :: Property.NamedDBProperty
prop_errorOnInvalidSql =
-- Note: we only run this test once to cut down on the number of errors
-- printed out by the database server when running tests repeatedly.
Property.singletonNamedDBProperty "executeRaw returns error if invalid sql is given" $ \pool -> do
-- We generate non-empty queries here becaues libpq returns different
-- error details when an empty string is passed
randomText <- HH.forAll $ PgGen.pgText (Range.constant 1 16)
result <-
MIO.liftIO . E.try . Conn.withPoolConnection pool $ \connection ->
Conn.executeRaw
connection
(Enc.encodeUtf8 randomText)
[]
case result of
Left err -> do
Conn.sqlExecutionErrorExecStatus err === Just LibPQ.FatalError
let
syntaxErrorState = B8.pack "42601"
Conn.sqlExecutionErrorSqlState err === Just syntaxErrorState
Right _ -> do
HH.footnote "Expected 'executeRaw' to return failure, but it did not"
HH.failure
prop_returningAConnectionToPoolWithOpenTransactionCausesException :: Property.NamedDBProperty
prop_returningAConnectionToPoolWithOpenTransactionCausesException =
Property.singletonNamedDBProperty "returning a connection to the pool with an open transaction causes an exception" $ \pool -> do
result <-
MIO.liftIO . E.try . Conn.withPoolConnection pool $ \connection ->
Conn.executeRaw
connection
(B8.pack "BEGIN TRANSACTION")
[]
case result of
Left (_err :: Conn.ConnectionError) ->
pure ()
Right _ -> do
HH.footnote "Expected 'withPoolConnection' to return failure, but it did not"
HH.failure
prop_acquiredConnectionNotDestroyed :: Property.NamedDBProperty
prop_acquiredConnectionNotDestroyed =
Property.namedDBProperty "destroying idle connections in the pool does not affect connections already acquired" $ \pool -> do
textBytes <- fmap Enc.encodeUtf8 . HH.forAll $ PgGen.pgText (Range.linear 0 256)
value <-
MIO.liftIO . Conn.withPoolConnection pool $ \connection -> do
Conn.destroyIdleConnections pool
result <-
Conn.executeRaw
connection
(B8.pack "SELECT $1::text")
[ Just $ PgTextFormatValue.fromByteString textBytes
]
LibPQ.getvalue' result 0 0
value === Just textBytes
prop_poolUsableAfterDestroyingConnections :: Property.NamedDBProperty
prop_poolUsableAfterDestroyingConnections =
Property.namedDBProperty "the connection pool can be used after destroying idle connections" $ \pool -> do
textBytes1 <- fmap Enc.encodeUtf8 . HH.forAll $ PgGen.pgText (Range.linear 0 256)
textBytes2 <- fmap Enc.encodeUtf8 . HH.forAll $ PgGen.pgText (Range.linear 0 256)
value1 <-
MIO.liftIO . Conn.withPoolConnection pool $ \connection -> do
result <-
Conn.executeRaw
connection
(B8.pack "SELECT $1::text")
[ Just $ PgTextFormatValue.fromByteString textBytes1
]
LibPQ.getvalue' result 0 0
MIO.liftIO $ Conn.destroyIdleConnections pool
value2 <-
MIO.liftIO . Conn.withPoolConnection pool $ \connection -> do
result <-
Conn.executeRaw
connection
(B8.pack "SELECT $1::text")
[ Just $ PgTextFormatValue.fromByteString textBytes2
]
LibPQ.getvalue' result 0 0
value1 === Just textBytes1
value2 === Just textBytes2