Skip to content

Fix issue with empty binary values #58

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 18, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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