duckdb-ffi-0.1.4.1: test/OpenConnectTest.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE RecordWildCards #-}

module OpenConnectTest (tests) where

import Control.Monad (when)
import Database.DuckDB.FFI
import Foreign.C.String (peekCString, withCString)
import Foreign.C.Types (CBool (..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (castPtr, nullPtr)
import Foreign.Storable (peek, poke)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, testCase, (@?=))

tests :: TestTree
tests =
    testGroup
        "Open Connect"
        [ testLibraryVersion
        , testOpenAndConnect
        , testOpenExtWithConfig
        , testInstanceCache
        ]

testLibraryVersion :: TestTree
testLibraryVersion =
    testCase "duckdb_library_version returns a non-empty string" $ do
        versionPtr <- c_duckdb_library_version
        version <- peekCString versionPtr
        assertBool "library version should not be empty" (not (null version))

testOpenAndConnect :: TestTree
testOpenAndConnect =
    testCase "open, connect, and gather connection details" $
        withCString ":memory:" $ \path ->
            alloca $ \dbPtr -> do
                state <- c_duckdb_open path dbPtr
                state @?= DuckDBSuccess
                db <- peek dbPtr

                alloca $ \connPtr -> do
                    connState <- c_duckdb_connect db connPtr
                    connState @?= DuckDBSuccess
                    conn <- peek connPtr

                    -- Query progress information (should succeed even without a running query)
                    alloca $ \progressPtr -> do
                        poke progressPtr (DuckDBQueryProgress 0 0 0)
                        c_duckdb_query_progress conn progressPtr
                        DuckDBQueryProgress{..} <- peek progressPtr
                        assertBool "rows processed should be non-negative" (duckDBQueryProgressRowsProcessed >= 0 && duckDBQueryProgressTotalRows >= 0)

                    -- Interrupt is a no-op but should succeed
                    c_duckdb_interrupt conn

                    -- Retrieve client context and confirm it points back to the same connection
                    alloca $ \ctxPtr -> do
                        poke ctxPtr nullPtr
                        c_duckdb_connection_get_client_context conn ctxPtr
                        ctx <- peek ctxPtr
                        assertBool "client context should not be null" (ctx /= nullPtr)
                        cid <- c_duckdb_client_context_get_connection_id ctx
                        assertBool "connection id should be non-negative" (cid >= 0)
                        c_duckdb_destroy_client_context ctxPtr

                    -- Retrieve arrow options object
                    alloca $ \arrowPtr -> do
                        poke arrowPtr nullPtr
                        c_duckdb_connection_get_arrow_options conn arrowPtr
                        arrowOpts <- peek arrowPtr
                        assertBool "arrow options should not be null" (arrowOpts /= nullPtr)
                        c_duckdb_destroy_arrow_options arrowPtr

                    -- Fetch table names (there should be none, but the call should succeed)
                    alloca $ \valuePtr -> do
                        tablesValue <- withCString "%" $ \filterStr -> c_duckdb_get_table_names conn filterStr (CBool 0)
                        poke valuePtr tablesValue
                        c_duckdb_destroy_value valuePtr

                    -- Disconnect and close database
                    c_duckdb_disconnect connPtr

                c_duckdb_close dbPtr

testOpenExtWithConfig :: TestTree
testOpenExtWithConfig =
    testCase "open_ext with configuration" $
        withCString ":memory:" $ \path ->
            alloca $ \configPtr -> do
                cfgState <- c_duckdb_create_config configPtr
                cfgState @?= DuckDBSuccess
                config <- peek configPtr

                alloca $ \errorPtr -> do
                    poke errorPtr nullPtr
                    alloca $ \dbPtr -> do
                        state <- c_duckdb_open_ext path dbPtr config errorPtr
                        state @?= DuckDBSuccess

                        errMsgPtr <- peek errorPtr
                        when (errMsgPtr /= nullPtr) $
                            c_duckdb_free (castPtr errMsgPtr)

                        c_duckdb_close dbPtr

                c_duckdb_destroy_config configPtr

testInstanceCache :: TestTree
testInstanceCache =
    testCase "create instance cache and reuse database handle" $
        withCString ":memory:" $ \path ->
            alloca $ \configPtr -> do
                cfgState <- c_duckdb_create_config configPtr
                cfgState @?= DuckDBSuccess
                config <- peek configPtr

                cache <- c_duckdb_create_instance_cache
                assertBool "instance cache should not be null" (cache /= nullPtr)

                alloca $ \dbPtr -> do
                    alloca $ \errorPtr -> do
                        poke errorPtr nullPtr
                        state <- c_duckdb_get_or_create_from_cache cache path dbPtr config errorPtr
                        state @?= DuckDBSuccess
                        err <- peek errorPtr
                        when (err /= nullPtr) $
                            c_duckdb_free (castPtr err)

                        -- the database returned from the cache should be usable (we close it immediately)
                        c_duckdb_close dbPtr

                alloca $ \cachePtr -> do
                    poke cachePtr cache
                    c_duckdb_destroy_instance_cache cachePtr

                c_duckdb_destroy_config configPtr