diff --git a/CHANGELOG.md b/CHANGELOG.md index baedb68..2d732e7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.10.1.0 +-------- + +- Fix issue with empty binary values (https://github.com/haskellari/postgresql-libpq/issues/54) + 0.10.0.0 -------- diff --git a/postgresql-libpq.cabal b/postgresql-libpq.cabal index f3a13ce..e9cfd9b 100644 --- a/postgresql-libpq.cabal +++ b/postgresql-libpq.cabal @@ -72,6 +72,7 @@ library Database.PostgreSQL.LibPQ.Marshal Database.PostgreSQL.LibPQ.Notify Database.PostgreSQL.LibPQ.Oid + Database.PostgreSQL.LibPQ.Ptr build-depends: , base >=4.12.0.0 && <4.20 diff --git a/src/Database/PostgreSQL/LibPQ.hs b/src/Database/PostgreSQL/LibPQ.hs index aeb3e89..49529ca 100644 --- a/src/Database/PostgreSQL/LibPQ.hs +++ b/src/Database/PostgreSQL/LibPQ.hs @@ -238,6 +238,7 @@ import Database.PostgreSQL.LibPQ.Internal import Database.PostgreSQL.LibPQ.Marshal import Database.PostgreSQL.LibPQ.Notify import Database.PostgreSQL.LibPQ.Oid +import Database.PostgreSQL.LibPQ.Ptr -- $dbconn -- The following functions deal with making a connection to a @@ -662,10 +663,13 @@ newtype Result = Result (ForeignPtr PGresult) deriving (Eq, Show) -- * 'ByteString' uses pinned memory -- * the reference to the 'CString' doesn't escape unsafeUseParamAsCString :: (B.ByteString, Format) -> (CString -> IO a) -> IO a -unsafeUseParamAsCString (bs, format) = +unsafeUseParamAsCString (bs, format) kont = case format of - Binary -> B.unsafeUseAsCString bs - Text -> B.useAsCString bs + Binary -> B.unsafeUseAsCStringLen bs kont' + Text -> B.useAsCString bs kont + where + kont' (ptr, 0) = if ptr == nullPtr then kont emptyPtr else kont ptr + kont' (ptr, _) = kont ptr -- | Convert a list of parameters to the format expected by libpq FFI calls. withParams :: [Maybe (Oid, B.ByteString, Format)] diff --git a/src/Database/PostgreSQL/LibPQ/Ptr.hs b/src/Database/PostgreSQL/LibPQ/Ptr.hs new file mode 100644 index 0000000..c4162d8 --- /dev/null +++ b/src/Database/PostgreSQL/LibPQ/Ptr.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE MagicHash #-} +module Database.PostgreSQL.LibPQ.Ptr (emptyPtr) where + +import GHC.Ptr (Ptr (..)) + +emptyPtr :: Ptr a +emptyPtr = Ptr ""# diff --git a/test/Smoke.hs b/test/Smoke.hs index 29ed9c6..355849e 100644 --- a/test/Smoke.hs +++ b/test/Smoke.hs @@ -1,20 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Control.Monad (unless) -import Test.Tasty (defaultMain, testGroup) -import Test.Tasty.HUnit (testCaseSteps, assertEqual) +import Control.Monad (unless) +import Data.Foldable (toList) import Database.PostgreSQL.LibPQ -import Data.Foldable (toList) -import System.Environment (getEnvironment) -import System.Exit (exitFailure) +import System.Environment (getEnvironment) +import System.Exit (exitFailure) +import Test.Tasty (defaultMain, testGroup) +import Test.Tasty.HUnit (assertEqual, testCaseSteps) +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 main :: IO () main = do libpqVersion >>= print withConnstring $ \connString -> defaultMain $ testGroup "postgresql-libpq" - [ testCaseSteps "smoke" $ \info -> smoke info connString + [ testCaseSteps "smoke" $ smoke connString + , testCaseSteps "issue54" $ issue54 connString ] withConnstring :: (BS8.ByteString -> IO ()) -> IO () @@ -39,8 +42,8 @@ withConnstring kont = do , "port=5432" ] -smoke :: (String -> IO ()) -> BS8.ByteString -> IO () -smoke info connstring = do +smoke :: BS8.ByteString -> (String -> IO ()) -> IO () +smoke connstring info = do let infoShow x = info (show x) conn <- connectdb connstring @@ -56,6 +59,31 @@ smoke info connstring = do serverVersion conn >>= infoShow s <- status conn - assertEqual "connection not ok" s ConnectionOk + assertEqual "connection not ok" ConnectionOk s finish conn + +issue54 :: BS8.ByteString -> (String -> IO ()) -> IO () +issue54 connString info = do + conn <- connectdb connString + + Just result <- execParams conn + "SELECT ($1 :: bytea), ($2 :: bytea)" + [Just (Oid 17,"",Binary), Just (Oid 17,BS.empty,Binary)] + Binary + s <- resultStatus result + assertEqual "result status" TuplesOk s + + -- ntuples result >>= info . show + -- nfields result >>= info . show + + null1 <- getisnull result 0 0 + null2 <- getisnull result 0 1 + assertEqual "fst not null" False null1 + assertEqual "snd not null" False null2 + + Just val1 <- getvalue result 0 0 + Just val2 <- getvalue result 0 1 + + assertEqual "fst not null" BS.empty val1 + assertEqual "snd not null" BS.empty val2