sqlcipher-1.0.0.0: tests/Main.hs

module Main where

import Control.Exception.Base (bracket)
import Data.Maybe
import System.FilePath ((</>))
import System.IO.Temp (withTempDirectory)
import Test.Hspec
import Text.Printf (printf)

import Database.SQLCipher


newTable :: TableName -> Table SQLType
newTable tName =
  VirtualTable
        { tabName    = tName
        , tabColumns =
              [ Column { colName    = "id"
                       , colType    = SQLInt NORMAL False False
                       , colClauses = [PrimaryKey True]
                       }

              , Column { colName    = "name"
                       , colType    = SQLVarChar 200
                       , colClauses = [IsNullable False]
                       }

              , Column { colName    = "age"
                       , colType    = SQLVarChar 200
                       , colClauses = [IsNullable True]
                       }
              ]

        , tabConstraints = []
        , tabUsing = "FTS3"
        }

withDB :: FilePath -> (SQLiteHandle -> IO a) -> IO a
withDB dbName = bracket (openConnection dbName) closeConnection

withTempDB :: (SQLiteHandle -> IO a) -> IO a
withTempDB f =
    withTempDirectory "tmp" "test." $ \dirname ->
    let dbName = dirname </> "database.sqlite3" in
    withDB dbName f


withTempTable :: (String -> SQLiteHandle -> IO a) -> IO a
withTempTable f = withTempDB $ \h ->
    let tab = "names" in
    defineTable h (newTable "names") >> f tab h


flatExecStatement :: SQLiteResult a => SQLiteHandle -> String -> IO (Either String [Row a])
flatExecStatement h sqlStmt =
    let flattenResults = concat
        mapResult f (Right r) = Right (f r)
        mapResult f (Left l) = Left l

    in mapResult flattenResults <$> execStatement h sqlStmt


insertManyRows :: SQLiteHandle -> String -> [Row String] -> IO (Maybe String)
insertManyRows h tab rows = chain insertions
    where insertions   = map (insertRow h tab) rows

          chain []     = return Nothing
          chain (i:is) = do
            r <- i
            case r of
                Nothing -> chain is
                Just err -> return $ Just err


spec :: Spec
spec = parallel $ do
    describe "execStatement and execStatement_" $ do
        it "runs select statements" $ withTempDB $ \h -> do
            result <- flatExecStatement h "SELECT 'Hello, World' AS h"
            result `shouldBe` Right [[("h", "Hello, World")]]

        it "fails on bad SQL" $ withTempDB $ \h -> do
            error <- execStatement_ h "SELECT aieauie"
            error `shouldSatisfy` isJust


    describe "insertRow" $ do
        it "stores data" $ withTempTable $ \tab h -> do
            let row = [("id", "1"), ("name", "John Doe"), ("age", "45")]
            error <- insertRow h tab row
            error `shouldSatisfy` isNothing

            ls <- flatExecStatement h $ printf "SELECT * FROM %s" tab
            ls `shouldBe` Right [row]


        it "can be called many times" $ withTempTable $ \tab h -> do
            let rows = [ [ ("id", "1"), ("name", "Erika Munstermann"), ("age", "28") ]
                       , [ ("id", "2"), ("name", "Max Munstermann"), ("age", "24") ]
                       ]
            error <- insertManyRows h tab rows
            error `shouldSatisfy` isNothing

            ls <- flatExecStatement h $ printf "SELECT * FROM %s ORDER BY id" tab
            ls `shouldBe` Right rows


        it "fails on bad row insertion" $ withTempTable $ \tab h -> do
            error <- insertRow h tab [("foo", "bar")]
            error `shouldSatisfy` isJust

    describe "createFunction" $ do
        it "runs haskell code" $ withTempDB $ \h -> do
            createFunction h "hi" (sum :: [Int] -> Int)
            ls <- flatExecStatement h "SELECT hi(1, 2, 3, 4, 5) AS greeting"
            ls `shouldBe` Right [[("greeting", show $ sum [1, 2, 3, 4, 5])]]


main :: IO ()
main = hspec spec