sqlite-easy-1.1.0.1: test/SqliteEasySpec.hs

{-# language ViewPatterns #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}

module SqliteEasySpec (spec) where

import Data.List (isInfixOf)
import Test.Hspec
import Database.Sqlite.Easy
import UnliftIO.Exception (try, catch, displayException, SomeException(..))
import GHC.Conc (forkIO, threadDelay)

spec :: Spec
spec = do
  describe "basics" $ do
    it "create insert select" $ do
      result <- withDb ":memory:" $ do
        [] <- run "create table t(x int not null)"
        [] <- run "insert into t values (1),(2),(3)"
        run "select * from t"
      shouldBe
        result
        [[SQLInteger 1], [SQLInteger 2], [SQLInteger 3]]

    it "select with params" $ do
      result <- withDb ":memory:" $ do
        [] <- run "create table t(x int not null)"
        [] <- run "insert into t values (1),(2),(3)"
        runWith "select * from t where x = ?" [SQLInteger 1]
      shouldBe
        result
        [[SQLInteger 1]]

    it "sql injection" $ do
      result <- withDb ":memory:" $ do
        [] <- run "create table students(name text not null)"
        [] <- runWith "insert into students values (?)" [SQLText "Robert'); DROP TABLE students;--"]
        run "select * from students"
      shouldBe
        result
        [[SQLText "Robert'); DROP TABLE students;--"]]

    it "finalize prepared statement on error" $ do
      shouldThrow
        ( withDb ":memory:" $ do
          [] <- run "create table test (id integer primary key autoincrement, val text unique)"
          run "insert into test (val) values ('hello'), ('hello')"
        )
        (\(SomeException e) -> "constraint failed: test.val" `isInfixOf` displayException e)

  describe "transactions" $ do
    it "transaction is rolled back in case of error" $ do
      result <- withDb ":memory:" $ do
        [] <- run "create table t(x int not null)"
        Left SQLError{} <- try $ transaction $ do
          [] <- run "insert into t values (1)"
          [] <- run "insert into t values (2"
          pure ()
        run "select * from t"
      shouldBe result []

    it "transaction is commited" $ do
      result <- withDb ":memory:" $ do
        [] <- run "create table t(x int not null)"
        (Right () :: Either SQLError ()) <- try $ transaction $ do
          [] <- run "insert into t values (1)"
          [] <- run "insert into t values (2)"
          pure ()
        run "select * from t"
      shouldBe result [[SQLInteger 1], [SQLInteger 2]]

    it "transaction is cancelled" $ do
      result <- withDb ":memory:" $ do
        [] <- run "create table t(x int not null)"
        (Right transactionResult :: Either SQLError [[SQLData]]) <- try $ transaction $ do
          [] <- run "insert into t values (1)"
          rollback []
        result <- run "select * from t"
        pure (transactionResult, result)
      uncurry shouldBe result

    it "nested transaction is cancelled" $ do
      result <- withDb ":memory:" $ do
        [] <- run "create table t(x int not null)"
        transactionResult <-
          transaction $ do
            transactionResult <-
              transaction $ do
                [] <- run "insert into t values (1)"
                rollback [[SQLInteger 2]]
            run "insert into t values (2)"
            pure transactionResult
        result <- run "select * from t"
        pure (transactionResult, result)
      uncurry shouldBe result

    it "all transactions are cancelled" $ do
      result <- withDb ":memory:" $ do
        [] <- run "create table t(x int not null)"
        transactionResult <-
          transaction $ do
            _ :: [[SQLData]] <- transaction $ do
              [] <- run "insert into t values (1)"
              rollbackAll []
            run "insert into t values (2)"
        result <- run "select * from t"
        pure (transactionResult, result)
      uncurry shouldBe result

  describe "pool" $ do
    it "create, use, and destroy" $ do
      pool <- createSqlitePool ":memory:"
      result <- withPool pool $ do
        [] <- run "create table t(x int not null)"
        [] <- run "insert into t values (1)"
        run "select * from t"
      destroyAllResources pool
      shouldBe result [[SQLInteger 1]]

  describe "concurrency" $ do
    it "write concurrently to default pool" $ do
      pool <- createSqlitePool "/tmp/sqlite-easy-test.db"
      let table = "test_conc"
      withPool pool $ do
        [] <- run $ "drop table if exists " <> table
        [] <- run $ "create table " <> table <> "(x int not null)"
        pure ()
      forkIO $ withPool pool $ transaction $ do
        liftIO $ threadDelay 100000
        [] <- run $ "insert into " <> table <> " values (2)"
        pure ()
      liftIO $ threadDelay 50000
      forkIO $ withPool pool $ transaction $ do
        [] <- run $ "insert into " <> table <> " values (1)"
        liftIO $ threadDelay 100000
        pure ()
      liftIO $ threadDelay 80000
      readerResult <- withPool pool $ transaction $ do
        run $ "select * from " <> table
      liftIO $ threadDelay 200000
      result <- withPool pool $ do
        run $ "select * from " <> table <> " order by rowid"
      destroyAllResources pool
      shouldBe (readerResult, result) ([], [[SQLInteger 1], [SQLInteger 2]])

  describe "migrations" $ do
    it "create" $ do
      pool <- createSqlitePool ":memory:"
      withPool pool runMigrations
      result <- withPool pool $ do
        [] <- run "insert into post(title) values ('hello world')"
        run "select id, title from post"
      destroyAllResources pool
      shouldBe result [[SQLInteger 1, SQLText "hello world"]]

runMigrations :: SQLite ()
runMigrations = migrate migrations migrateUp migrateDown

migrations :: [MigrationName]
migrations =
  [ "post"
  , "add-date-column"
  ]

migrateUp :: MigrationName -> SQLite ()
migrateUp m = case m of
  "post" -> do
    [] <-
      run
        "create table post(id integer primary key autoincrement, title text not null) strict;"
    pure ()
  "add-date-column" -> do
    [] <- transaction $ do
        void $ run
          "create table post_without_date as select * from post;"
        void $ run
          "drop table post;"
        void $ run
          "create table post(id integer primary key autoincrement, title text not null, date text default current_date) strict;"
        void $ run
          "insert into post(title) select title from post_without_date;"
        run
          "drop table post_without_date;"
    pure ()
  unknown ->
    error ("Unexpected migration: " <> show unknown)

migrateDown :: MigrationName -> SQLite ()
migrateDown m = case m of
  "post" -> do
    [] <- run "DROP TABLE post"
    pure ()
  "add-date-column" -> do
    [] <- transaction $ do
        void $ run
          "create table post_with_date as select * from post;"
        void $ run
          "drop table post;"
        void $ run
          "create table post(id integer primary key autoincrement, title text not null) strict;"
        void $ run
          "insert into post(title) select title from post_with_date;"
        run
          "drop table post_with_date;"
    pure ()
  unknown ->
    error ("Unexpected migration: " <> show unknown)