aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Squeal/PostgreSQL
diff options
context:
space:
mode:
authorRaveline <eraveline@gmail.com>2019-05-03 11:43:58 +0200
committerRaveline <eraveline@gmail.com>2019-05-03 11:43:58 +0200
commitdd35032c658cf4136e94b18c87656a611931b0ed (patch)
treed18ec45af015342504dd89de39d297efd1217149 /src/Squeal/PostgreSQL
parentfc6d19e370eded2d5c819d1ef186e26ecd9419f2 (diff)
downloadsqueal-hspec-dd35032c658cf4136e94b18c87656a611931b0ed.tar.gz
squeal-hspec-dd35032c658cf4136e94b18c87656a611931b0ed.tar.zst
squeal-hspec-dd35032c658cf4136e94b18c87656a611931b0ed.zip
Support fixed databases
Diffstat (limited to 'src/Squeal/PostgreSQL')
-rw-r--r--src/Squeal/PostgreSQL/Hspec.hs39
1 files changed, 30 insertions, 9 deletions
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