PostgreSQL_Tests.hs

{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE ScopedTypeVariables #-}
module Database.Migrant.Driver.PostgreSQL_Tests
( tests
)
where

import Test.Tasty
import Test.Tasty.QuickCheck
import Test.Tasty.HUnit
import Data.Text (Text)
import Control.Monad (void)
import System.Environment
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Database.PostgreSQL.Simple as PostgreSQL
import System.Process (callProcess)
import Control.Exception (catch, bracket)
import System.Random

import Database.Migrant
import Database.Migrant.Driver.PostgreSQL

tests :: TestTree
tests = testGroup "PostgreSQL"
  [ testCase "Setup/init" testPostgreSQLSetup
  , testCase "Up" testPostgreSQLUp
  , testCase "Down" testPostgreSQLDown
  ]

withTestDB :: (PostgreSQL.Connection -> IO a) -> IO a
withTestDB action = do
  i <- randomRIO (1000000, 9999999)
  let dbname = "_migrant_test_" <> show (i :: Int)
  callProcess "createdb" [dbname]
  let dsn = "dbname=" <> dbname
  bracket
    (PostgreSQL.connectPostgreSQL $ Text.encodeUtf8 . Text.pack $ dsn)
    (\conn -> do
        PostgreSQL.close conn
        callProcess "dropdb" [dbname] `catch` (\(e :: IOError) -> return ())
    )
    action

testPostgreSQLSetup :: Assertion
testPostgreSQLSetup = withTestDB $ \conn -> do
  migrate [] undefined undefined conn
  actual <- PostgreSQL.query_ conn "SELECT name FROM _migrations ORDER BY id"
  let expected = [] :: [PostgreSQL.Only Text]
  assertEqual "Migration table exists" expected actual

testPostgreSQLUp :: Assertion
testPostgreSQLUp = do
  let up "foo" conn =
        void $ PostgreSQL.execute_ conn "CREATE TABLE foo (id INTEGER PRIMARY KEY)"
      up name _ = error ("Invalid name " <> show name)
      down "foo" conn =
        void $ PostgreSQL.execute_ conn "DROP TABLE foo"
      down name _ = error ("Invalid name " <> show name)
  withTestDB $ \conn -> do
    migrate ["foo"] up down conn

    actual <- PostgreSQL.query_ conn "SELECT name FROM _migrations ORDER BY id"
    let expected = [PostgreSQL.Only ("foo" :: Text)]
    assertEqual "Up migration logged" expected actual

    actual <- PostgreSQL.query_ conn "SELECT COUNT(1) FROM information_schema.tables WHERE table_schema = 'public' AND table_name = 'foo'"
    let expected = [PostgreSQL.Only (1 :: Int)]
    assertEqual "Up migration happened" expected actual

testPostgreSQLDown :: Assertion
testPostgreSQLDown = do
  let up "foo" conn =
        void $ PostgreSQL.execute_ conn "CREATE TABLE foo (id INTEGER PRIMARY KEY)"
      up name _ = error ("Invalid name " <> show name)
      down "foo" conn =
        void $ PostgreSQL.execute_ conn "DROP TABLE foo"
      down name _ = error ("Invalid name " <> show name)

  withTestDB $ \conn -> do
    migrate ["foo"] up down conn
    migrate [] up down conn

    actual <- PostgreSQL.query_ conn "SELECT name FROM _migrations ORDER BY id"
    let expected = [] :: [PostgreSQL.Only Text]
    assertEqual "Down migration logged" expected actual

    actual <- PostgreSQL.query_ conn "SELECT COUNT(1) FROM information_schema.tables WHERE table_schema = 'public' AND table_name = 'foo'"
    let expected = [PostgreSQL.Only (0 :: Int)]
    assertEqual "Down migration happened" expected actual