postgresql-libpq-notify-0.2.0.0: test/Main.hs

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, RecordWildCards #-}
import           Control.Exception
import           Database.PostgreSQL.LibPQ.Notify
import           Test.Hspec
import qualified Database.Postgres.Temp as Temp
import           Control.Concurrent.Async
import           Data.IORef
import           Control.Concurrent
import           Data.Foldable
import           Control.Monad ((<=<))
import           Database.PostgreSQL.Simple.Options as Options
import qualified Database.PostgreSQL.LibPQ as PQ

main :: IO ()
main = hspec spec

aroundAll :: forall a. ((a -> IO ()) -> IO ()) -> SpecWith a -> Spec
aroundAll withFunc specWith = do
  (var, stopper, asyncer) <- runIO $
    (,,) <$> newEmptyMVar <*> newEmptyMVar <*> newIORef Nothing
  let theStart :: IO a
      theStart = do

        thread <- async $ do
          withFunc $ \x -> do
            putMVar var x
            takeMVar stopper
          pure $ error "Don't evaluate this"

        writeIORef asyncer $ Just thread

        either pure pure =<< (wait thread `race` takeMVar var)

      theStop :: a -> IO ()
      theStop _ = do
        putMVar stopper ()
        traverse_ cancel =<< readIORef asyncer

  beforeAll theStart $ afterAll theStop $ specWith

withSetup :: ((PQ.Connection, PQ.Connection) -> IO ()) -> IO ()
withSetup f = either throwIO pure <=< Temp.withDbCache $ \dbCache ->
  Temp.withConfig (Temp.defaultConfig <> Temp.cacheConfig dbCache) $ \db -> do
    let localhostOpts = Temp.toConnectionOptions db
    bracket (PQ.connectdb (Options.toConnectionString localhostOpts))
      PQ.finish
      $ \c -> bracket (PQ.connectdb (Options.toConnectionString localhostOpts))
          PQ.finish
          $ \c1 -> f (c, c1)

spec :: Spec
spec = aroundAll withSetup $ do
  describe "getNotificationWithConfig" $ describe "returns a notification" $ do
    it "before" $ \(conn1, conn2) -> do
      let initialChannel = "channel"
          initialData = "hi!"

      _ <- PQ.exec conn2 $ "LISTEN " <> initialChannel
      _ <- PQ.exec conn1 $ "NOTIFY " <> initialChannel <> ", '" <> initialData <>"';"

      Right PQ.Notify {..} <- getNotification conn2
      notifyRelname `shouldBe` initialChannel
      notifyExtra `shouldBe` initialData

    it "after file notifications are registered" $ \(conn1, conn2) -> do
      ender <- newEmptyMVar
      beforeWaiter <- newEmptyMVar
      let initialChannel = "channel"
          initialData = "hi!"
      _ <- PQ.exec conn2 $ "LISTEN " <> initialChannel
      _ <- forkIO $ do
             takeMVar beforeWaiter
             _ <- PQ.exec conn1 ("NOTIFY " <> initialChannel <> ", '" <> initialData <>"';")
             putMVar ender ()

      let config = defaultConfig
            { beforeWait = putMVar beforeWaiter ()
            }

      Right PQ.Notify {..} <- getNotificationWithConfig config conn2
      notifyRelname `shouldBe` initialChannel
      notifyExtra `shouldBe` initialData