content: module Serializable (testSerializable) where
  
  import Common
  import Control.Concurrent
  import Control.Exception as E
  import Data.IORef
  import Database.PostgreSQL.Simple.Transaction
  
  initCounter :: Connection -> IO ()
  initCounter conn = do
      0 <- execute_ conn "DROP TABLE IF EXISTS testSerializableCounter;\
                        \ CREATE TABLE testSerializableCounter (n INT)"
      1 <- execute_ conn "INSERT INTO testSerializableCounter VALUES (0)"
      return ()
  
  getCounter :: Connection -> IO Int
  getCounter conn = do
      [Only n] <- query_ conn "SELECT n FROM testSerializableCounter"
      return n
  
  putCounter :: Connection -> Int -> IO ()
  putCounter conn n = do
      1 <- execute conn "UPDATE testSerializableCounter SET n=?" (Only n)
      return ()
  
  testSerializable :: TestEnv -> Assertion
  testSerializable TestEnv{..} =
      withConn $ \conn2 -> do
          initCounter conn
  
          attemptCounter  <- newIORef (0 :: Int)
          readyToBother   <- newEmptyMVar
          bothered        <- newEmptyMVar
          finished        <- newEmptyMVar
  
          _ <- forkIO $ do
              withTransactionSerializable conn2 $ do
                  modifyIORef attemptCounter (+1)
                  n <- getCounter conn2
                  True <- tryPutMVar readyToBother ()
                  readMVar bothered
                  putCounter conn2 (n+1)
              putMVar finished ()
  
          takeMVar readyToBother
          withTransactionSerializable conn $ do
              n <- getCounter conn
              putCounter conn (n+1)
          True <- tryPutMVar bothered ()
  
          takeMVar finished
  
          ac <- readIORef attemptCounter
          assertEqual "attemptCounter" 2 ac
  
          ok <- E.catch (do withTransactionSerializable conn (fail "Whoops")
                            return False)
                        (\(_ :: IOException) -> return True)
          assertBool "Exceptions (besides serialization failure) should be\
                     \ propagated through withTransactionSerializable"
                     ok
  
          -- Make sure transaction isn't dangling
          1 <- execute_ conn "UPDATE testSerializableCounter SET n=12345"
          0 <- execute_ conn "ROLLBACK"
              -- This prints "NOTICE:  there is no transaction in progress"
          [Only (12345 :: Int)] <- query_ conn "SELECT n FROM testSerializableCounter"
          return ()
  