{-|
Helpers for creating database tests with hspec and pg-transact
@hspec-pg-transact@ utilizes @tmp-postgres@ to automatically and connect to a temporary instance of @postgres@ on a random port.
@
'describeDB' migrate "Query” $
itDB "work" $ do
'execute_' [sql|
INSERT INTO things
VALUES (‘me’) |]
'query_' [sql|
SELECT name
FROM things |]
`shouldReturn` [Only "me"]
@
In the example above 'describeDB' wraps 'describe' with a 'beforeAll' hook for creating a db and a 'afterAll' hook for stopping a db.
.
Tests can be written with 'itDB' which is wrapper around 'it' that uses the passed in 'TestDB' to run a db transaction automatically for the test.
The libary also provides a few other functions for more fine grained control over running transactions in tests.
-}
module Test.Hspec.DB where
import Control.Monad
import Data.Pool
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Transact
import qualified Database.Postgres.Temp as Temp
import Test.Hspec
data TestDB = TestDB
{ tempDB :: Temp.DB
-- ^ Handle for temporary @postgres@ process
, pool :: Pool Connection
-- ^ Pool of 50 connections to the temporary @postgres@
}
-- | Start a temporary @postgres@ process and create a pool of connections to it
setupDB :: (Connection -> IO ()) -> IO (Either Temp.StartError TestDB)
setupDB = setupDBWithConfig Temp.defaultConfig
-- | Start a temporary @postgres@ process using the provided configuration
setupDBWithConfig :: Temp.Config
-> (Connection -> IO ())
-> IO (Either Temp.StartError TestDB)
setupDBWithConfig c f =
traverse (wrapCallback f) =<< Temp.startConfig c
wrapCallback :: (Connection -> IO ()) -> Temp.DB -> IO TestDB
wrapCallback f d = do
p <- createPool
(connectPostgreSQL $ Temp.toConnectionString d)
close
1
100000000
50
withResource p f
pure $ TestDB d p
-- | Drop all the connections and shutdown the @postgres@ process
teardownDB :: TestDB -> IO ()
teardownDB (TestDB d p) = do
destroyAllResources p
void $ Temp.stop d
-- | Run an 'IO' action with a connection from the pool
withPool :: TestDB -> (Connection -> IO a) -> IO a
withPool testDB = withResource (pool testDB)
-- | Run an 'DB' transaction. Uses 'runDBTSerializable'.
withDB :: DB a -> TestDB -> IO a
withDB action testDB =
withResource (pool testDB) (runDBTSerializable action)
-- | Flipped version of 'withDB'
runDB :: TestDB -> DB a -> IO a
runDB = flip withDB
-- | Helper for writing tests. Wrapper around 'it' that uses the passed
-- in 'TestDB' to run a db transaction automatically for the test.
itDB :: String -> DB a -> SpecWith TestDB
itDB msg action = it msg $ void . withDB action
-- | Wraps 'describeDBWithConfig' using the default configuration
describeDB :: (Connection -> IO ()) -> String -> SpecWith TestDB -> Spec
describeDB = describeDBWithConfig Temp.defaultConfig
-- | Wraps 'describe' with a
--
-- @
-- 'beforeAll' ('setupDB' migrate)
-- @
--
-- hook for creating a db and a
--
-- @
-- 'afterAll' 'teardownDB'
-- @
--
-- hook for stopping a db.
describeDBWithConfig :: Temp.Config -> (Connection -> IO ()) -> String -> SpecWith TestDB -> Spec
describeDBWithConfig c f s =
beforeAll (catch =<< setupDBWithConfig c f) . afterAll teardownDB . describe s
where
catch :: Either Temp.StartError TestDB -> IO TestDB
catch r = case r of
Left x -> error (show x)
Right db -> pure db