Skip to content

Commit

Permalink
Fix issue with empty binary values
Browse files Browse the repository at this point in the history
  • Loading branch information
phadej committed Apr 18, 2024
1 parent 7998053 commit 2b6d5ae
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 13 deletions.
5 changes: 5 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -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
--------

Expand Down
1 change: 1 addition & 0 deletions postgresql-libpq.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 7 additions & 3 deletions src/Database/PostgreSQL/LibPQ.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)]
Expand Down
7 changes: 7 additions & 0 deletions src/Database/PostgreSQL/LibPQ/Ptr.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
{-# LANGUAGE MagicHash #-}
module Database.PostgreSQL.LibPQ.Ptr (emptyPtr) where

import GHC.Ptr (Ptr (..))

emptyPtr :: Ptr a
emptyPtr = Ptr ""#
48 changes: 38 additions & 10 deletions test/Smoke.hs
Original file line number Diff line number Diff line change
@@ -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 ()
Expand All @@ -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
Expand All @@ -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

0 comments on commit 2b6d5ae

Please sign in to comment.