@@ -12,19 +12,21 @@
1212module ExceptionHandling
1313 ( specs
1414 , User (..)
15− )
16−where
15+ ) where
1716
18−import Control.Monad (void)
17+import Control.Concurrent.Async (replicateConcurrently)
18+import Control.Monad (void)
1919import Control.Monad.IO.Class (MonadIO (..))
20−import qualified Data.ByteString.Char8 as Char8
21−import Data.Int (Int16)
22−import Data.Text (Text)
23−import Data.Vector (Vector)
24−import qualified Generics.SOP as SOP
25−import qualified GHC.Generics as GHC
26−import Squeal.PostgreSQL
27−import Test.Hspec
20+import Data.Int (Int16)
21+import Data.Text (Text)
22+import Data.Vector (Vector)
23+import Test.Hspec
24+
25+import qualified Data.ByteString.Char8 as Char8
26+import qualified Generics.SOP as SOP
27+import qualified GHC.Generics as GHC
28+
29+import Squeal.PostgreSQL
2830
2931type Schema =
3032 '[ "users" ::: 'Table (
@@ -123,3 +125,16 @@ specs = before_ setupDB $ after_ dropDB $
123125 it "should be rethrown for unique constraint violation in a manipulation by a transaction" $
124126 withConnection connectionString (transactionally_ insertUserTwice)
125127 `shouldThrow` (== dupKeyErr)
128+
129+ it "should handle concurrent transactions using pooled connections" $ do
130+ pool <- createConnectionPool
131+ "host=localhost port=5432 dbname=exampledb" 1 0.5 10
132+ let
133+ query :: Query_ (Public '[]) () (Only Char)
134+ query = values_ (literal 'a' `as` #fromOnly)
135+ session = useConnectionPool pool . transactionally_ $ do
136+ result <- runQuery query
137+ Just (Only chr) <- firstRow result
138+ return chr
139+ chrs <- replicateConcurrently 10 session
140+ chrs `shouldSatisfy` (all (== 'a'))