Merge pull request #58 from haskellari/issue-54

Fix issue with empty binary values

Author: phadej

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
 --------
 

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

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)]

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 ""#

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