aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--README.md15
-rw-r--r--src/Squeal/PostgreSQL/Hspec.hs39
2 files changed, 41 insertions, 13 deletions
diff --git a/README.md b/README.md
index e254c58..02ed812 100644
--- a/README.md
+++ b/README.md
@@ -1,11 +1,18 @@
1# squeal-hspec 1# squeal-hspec
2 2
3Helpers for creating database tests with hspec and squeal, inspired by Jonathan Fischoff's 3Helpers for creating database tests with hspec and squeal, inspired by Jonathan
4Fischoff's
4[hspec-pg-transact](http://hackage.haskell.org/package/hspec-pg-transact). 5[hspec-pg-transact](http://hackage.haskell.org/package/hspec-pg-transact).
5 6
6This uses @tmp-postgres@ to automatically and connect to a temporary instance of postgres on a random port. 7This uses @tmp-postgres@ to automatically and connect to a temporary instance of
8postgres on a random port.
7 9
8Current version is done to operate with Squeal 0.4.0.0. 10Current version is done to operate with Squeal 0.4.0.0.
9 11
10`describeDB` lets you initate a series of `itDB` specs which will operate in the same context. 12`describeDB` lets you initate a series of `itDB` specs which will operate in the
11It takes migrations to run and a series of fixtures to fill the database. 13same context. It takes migrations to run and a series of fixtures to fill the
14database.
15
16Setting the env var `TEST_DB_CONNECTION_STRING` will let you use a non-temporary
17database if need be. Tear down will run the `migrateDown` to make sure the test
18db doesn't get filled with invalid data.
diff --git a/src/Squeal/PostgreSQL/Hspec.hs b/src/Squeal/PostgreSQL/Hspec.hs
index 3cd886b..d065048 100644
--- a/src/Squeal/PostgreSQL/Hspec.hs
+++ b/src/Squeal/PostgreSQL/Hspec.hs
@@ -13,6 +13,7 @@ The libary also provides a few other functions for more fine grained control ove
13{-# LANGUAGE MonoLocalBinds #-} 13{-# LANGUAGE MonoLocalBinds #-}
14{-# LANGUAGE RankNTypes #-} 14{-# LANGUAGE RankNTypes #-}
15{-# LANGUAGE RecordWildCards #-} 15{-# LANGUAGE RecordWildCards #-}
16{-# LANGUAGE TupleSections #-}
16{-# LANGUAGE TypeInType #-} 17{-# LANGUAGE TypeInType #-}
17{-# LANGUAGE TypeOperators #-} 18{-# LANGUAGE TypeOperators #-}
18module Squeal.PostgreSQL.Hspec 19module Squeal.PostgreSQL.Hspec
@@ -21,33 +22,49 @@ where
21import Control.Exception 22import Control.Exception
22import Control.Monad 23import Control.Monad
23import Control.Monad.Base (liftBase) 24import Control.Monad.Base (liftBase)
25import Data.ByteString (ByteString)
24import qualified Data.ByteString.Char8 as BSC 26import qualified Data.ByteString.Char8 as BSC
25import qualified Database.Postgres.Temp as Temp 27import qualified Database.Postgres.Temp as Temp
26import Generics.SOP (K) 28import Generics.SOP (K)
27import Squeal.PostgreSQL 29import Squeal.PostgreSQL
28import Squeal.PostgreSQL.Pool 30import Squeal.PostgreSQL.Pool
31import System.Environment (lookupEnv)
29import Test.Hspec 32import Test.Hspec
30 33
31data TestDB a = TestDB 34data TestDB a = TestDB
32 { tempDB :: Temp.DB 35 { tempDB :: Maybe Temp.DB
33 -- ^ Handle for temporary @postgres@ process 36 -- ^ Handle for temporary @postgres@ process
34 , pool :: Pool a 37 , pool :: Pool a
35 -- ^ Pool of 50 connections to the temporary @postgres@ 38 -- ^ Pool of 50 connections to the temporary @postgres@
39 , connectionString :: ByteString
36 } 40 }
37 41
38type Fixtures schema = (Pool (K Connection schema) -> IO ()) 42type Fixtures schema = (Pool (K Connection schema) -> IO ())
39type Actions schema a = PoolPQ schema IO a 43type Actions schema a = PoolPQ schema IO a
40type SquealContext schema = TestDB (K Connection schema) 44type SquealContext schema = TestDB (K Connection schema)
41 45
46testDBEnv :: String
47testDBEnv = "TEST_DB_CONNECTION_STRING"
48
49getOrCreateConnectionString :: IO (ByteString, Maybe Temp.DB)
50getOrCreateConnectionString = do
51 hasConnectionString <- lookupEnv testDBEnv
52 maybe createTempDB (pure . (, Nothing) . BSC.pack) hasConnectionString
53
54createTempDB :: IO (ByteString, Maybe Temp.DB)
55createTempDB = do
56 tempDB <- either throwIO return =<< Temp.startAndLogToTmp []
57 let connectionString = BSC.pack (Temp.connectionString tempDB)
58 pure (connectionString, Just tempDB)
59
42-- | Start a temporary @postgres@ process and create a pool of connections to it 60-- | Start a temporary @postgres@ process and create a pool of connections to it
43setupDB 61setupDB
44 :: AlignedList (Migration (Terminally PQ IO)) schema0 schema 62 :: AlignedList (Migration (Terminally PQ IO)) schema0 schema
45 -> Fixtures schema 63 -> Fixtures schema
46 -> IO (SquealContext schema) 64 -> IO (SquealContext schema)
47setupDB migration fixtures = do 65setupDB migration fixtures = do
48 tempDB <- either throwIO return =<< Temp.startAndLogToTmp [] 66 (connectionString, tempDB) <- getOrCreateConnectionString
49 let connectionString = BSC.pack (Temp.connectionString tempDB) 67 BSC.putStrLn connectionString
50 putStrLn $ Temp.connectionString tempDB
51 let singleStripe = 1 68 let singleStripe = 1
52 keepConnectionForOneHour = 3600 69 keepConnectionForOneHour = 3600
53 poolSizeOfFifty = 50 70 poolSizeOfFifty = 50
@@ -61,10 +78,14 @@ setupDB migration fixtures = do
61 pure TestDB {..} 78 pure TestDB {..}
62 79
63-- | Drop all the connections and shutdown the @postgres@ process 80-- | Drop all the connections and shutdown the @postgres@ process
64teardownDB :: TestDB a -> IO () 81teardownDB
65teardownDB TestDB {..} = do 82 :: AlignedList (Migration (Terminally PQ IO)) schema0 schema
83 -> TestDB a
84 -> IO ()
85teardownDB migration TestDB {..} = do
86 withConnection connectionString (migrateDown migration)
66 destroyAllResources pool 87 destroyAllResources pool
67 void $ Temp.stop tempDB 88 maybe (pure ()) (void . Temp.stop) tempDB
68 89
69-- | Run an 'IO' action with a connection from the pool 90-- | Run an 'IO' action with a connection from the pool
70withPool :: TestDB (K Connection schema) -> Actions schema a -> IO a 91withPool :: TestDB (K Connection schema) -> Actions schema a -> IO a
@@ -104,4 +125,4 @@ describeDB
104 -> SpecWith (SquealContext schema) 125 -> SpecWith (SquealContext schema)
105 -> Spec 126 -> Spec
106describeDB migrate fixture str = 127describeDB migrate fixture str =
107 beforeAll (setupDB migrate fixture) . afterAll teardownDB . describe str 128 beforeAll (setupDB migrate fixture) . afterAll (teardownDB migrate) . describe str