postgres-haskell/postgres-wire
1
1
Fork 0
mirror of https://github.com/postgres-haskell/postgres-wire.git synced 2024-11-22 05:53:12 +03:00
Code Issues Projects Releases Wiki Activity

Changed Vector to [] in Query and client messages

Browse Source
This commit is contained in:
VyacheslavHashov 2017-07-13 14:38:05 +03:00
parent 2071eff1fc
commit a2536fd5f4
8 changed files with 30 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
bench/Codecs.hs
View File

@ -6,7 +6,6 @@ import Data.ByteString (ByteString)
import Data.Monoid
import Data.Foldable
import System.IO.Unsafe
import Data.Vector as V(fromList, empty)
import Criterion.Main
import Data.Time
import Data.UUID
@ -82,7 +81,7 @@ encodeMessage params = runEncode $
where
bindMessage = Bind (PortalName "") stmtName Binary
(encodedParams params) Binary
encodedParams (a, b, c, d, e, f, g) = V.fromList
encodedParams (a, b, c, d, e, f, g) =
[ Just . runEncode $ PE.bool a
, Just . runEncode $ PE.bytea b
, Just . runEncode $ PE.float8 c
@ -95,7 +94,7 @@ encodeMessage params = runEncode $
stmtName = StatementName "_pw_statement_0010"
stmt = StatementSQL
"SELECT a, b, c FROM table_name WHERE name LIKE $1 AND a > $2"
oids = V.fromList $ map PGT.oidType
oids = map PGT.oidType
[ PGT.bool
, PGT.bytea
, PGT.float8

4
src/Database/PostgreSQL/Driver/Query.hs
View File

@ -32,7 +32,7 @@ import Database.PostgreSQL.Driver.StatementStorage
-- Public
data Query = Query
{ qStatement :: B.ByteString
, qValues :: V.Vector (Oid, Maybe B.ByteString)
, qValues :: [(Oid, Maybe B.ByteString)]
, qParamsFormat :: Format
, qResultFormat :: Format
, qCachePolicy :: CachePolicy
@ -126,7 +126,7 @@ describeStatement
-> IO (Either Error (V.Vector Oid, V.Vector FieldDescription))
describeStatement conn stmt = do
sendEncode conn $
encodeClientMessage (Parse sname (StatementSQL stmt) V.empty)
encodeClientMessage (Parse sname (StatementSQL stmt) [])
<> encodeClientMessage (DescribeStatement sname)
<> encodeClientMessage Sync
msgs <- collectUntilReadyForQuery conn

5
src/Database/PostgreSQL/Protocol/Encoders.hs
View File

@ -6,7 +6,6 @@ module Database.PostgreSQL.Protocol.Encoders
import Data.Word (Word32)
import Data.Monoid ((<>))
import Data.Char (ord)
import qualified Data.Vector as V
import qualified Data.ByteString as B
import Database.PostgreSQL.Protocol.Types
@ -40,7 +39,7 @@ encodeClientMessage (Bind (PortalName portalName) (StatementName stmtName)
-- `1` means that the specified format code is applied to all parameters
putWord16BE 1 <>
encodeFormat paramFormat <>
putWord16BE (fromIntegral $ V.length values) <>
putWord16BE (fromIntegral $ length values) <>
foldMap encodeValue values <>
-- `1` means that the specified format code is applied to all
-- result columns (if any)
@ -64,7 +63,7 @@ encodeClientMessage (Parse (StatementName stmtName) (StatementSQL stmt) oids)
= prependHeader 'P' $
putByteStringNull stmtName <>
putByteStringNull stmt <>
putWord16BE (fromIntegral $ V.length oids) <>
putWord16BE (fromIntegral $ length oids) <>
foldMap (putWord32BE . unOid) oids
encodeClientMessage (PasswordMessage passtext)
= prependHeader 'p' $ putByteStringNull $ getPassword passtext

4
src/Database/PostgreSQL/Protocol/Types.hs
View File

@ -128,7 +128,7 @@ data AuthResponse
data ClientMessage
= Bind !PortalName !StatementName
!Format -- parameter format code, one format for all
!(Vector (Maybe ByteString)) -- the values of parameters, Nothing
![Maybe ByteString] -- the values of parameters, Nothing
-- is recognized as NULL
!Format -- to apply code to all result columns
-- Postgres use one command `close` for closing both statements and
@ -141,7 +141,7 @@ data ClientMessage
| DescribePortal !PortalName
| Execute !PortalName !RowsToReceive
| Flush
| Parse !StatementName !StatementSQL !(Vector Oid)
| Parse !StatementName !StatementSQL ![Oid]
| PasswordMessage !PasswordText
-- PostgreSQL names it `Query`
| SimpleQuery !StatementSQL

5
tests/Codecs/QuickCheck.hs
View File

@ -14,7 +14,6 @@ import Data.UUID (UUID, fromWords)
import Data.String (IsString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.Vector as V
import Database.PostgreSQL.Driver
import Database.PostgreSQL.Protocol.DataRows
@ -37,7 +36,7 @@ makeCodecProperty
-> a -> Property
makeCodecProperty c oid encoder fd v = monadicIO $ do
let bs = runEncode $ encoder v
q = Query "SELECT $1" (V.fromList [(oid, Just bs)])
q = Query "SELECT $1" [(oid, Just bs)]
Binary Binary AlwaysCache
decoder = PD.dataRowHeader *> PD.getNonNullable fd
r <- run $ do
@ -60,7 +59,7 @@ makeCodecEncodeProperty
-> a -> Property
makeCodecEncodeProperty c oid queryString encoder fPrint v = monadicIO $ do
let bs = runEncode $ encoder v
q = Query queryString (V.fromList [(oid, Just bs)])
q = Query queryString [(oid, Just bs)]
Binary Text AlwaysCache
decoder = PD.dataRowHeader *> PD.getNonNullable PD.bytea
r <- run $ do

29
tests/Driver.hs
View File

@ -45,12 +45,11 @@ testDriver = testGroup "Driver"
]
makeQuery1 :: B.ByteString -> Query
makeQuery1 n = Query "SELECT $1" (V.fromList [(Oid 23, Just n)])
Text Text AlwaysCache
makeQuery1 n = Query "SELECT $1" [(Oid 23, Just n)] Text Text AlwaysCache
makeQuery2 :: B.ByteString -> B.ByteString -> Query
makeQuery2 n1 n2 = Query "SELECT $1 + $2"
(V.fromList [(Oid 23, Just n1), (Oid 23, Just n2)]) Text Text AlwaysCache
[(Oid 23, Just n1), (Oid 23, Just n2)] Text Text AlwaysCache
fromRight :: Either e a -> a
fromRight (Right v) = v
@ -108,12 +107,12 @@ testMultipleBatches = withConnection $ replicateM_ 10 . assertSingleBatch
-- | Query is empty string.
testEmptyQuery :: IO ()
testEmptyQuery = assertQueryNoData $
Query "" V.empty Text Text NeverCache
Query "" [] Text Text NeverCache
-- | Query than returns no datarows.
testQueryWithoutResult :: IO ()
testQueryWithoutResult = assertQueryNoData $
Query "SET client_encoding TO UTF8" V.empty Text Text NeverCache
Query "SET client_encoding TO UTF8" [] Text Text NeverCache
-- | Asserts that query returns no data rows.
assertQueryNoData :: Query -> IO ()
@ -141,9 +140,9 @@ checkInvalidResult conn n = readNextData conn >>=
testInvalidBatch :: IO ()
testInvalidBatch = do
let rightQuery = makeQuery1 "5"
q1 = Query "SEL $1" (V.fromList [(Oid 23, Just "5")]) Text Text NeverCache
q2 = Query "SELECT $1" (V.fromList [(Oid 23, Just "a")]) Text Text NeverCache
q4 = Query "SELECT $1" (V.fromList []) Text Text NeverCache
q1 = Query "SEL $1" [(Oid 23, Just "5")] Text Text NeverCache
q2 = Query "SELECT $1" [(Oid 23, Just "a")] Text Text NeverCache
q4 = Query "SELECT $1" [] Text Text NeverCache
assertInvalidBatch "Parse error" [q1]
assertInvalidBatch "Invalid param" [ q2]
@ -162,7 +161,7 @@ testValidAfterError :: IO ()
testValidAfterError = withConnection $ \c -> do
let a = "5"
rightQuery = makeQuery1 a
invalidQuery = Query "SELECT $1" (V.fromList []) Text Text NeverCache
invalidQuery = Query "SELECT $1" [] Text Text NeverCache
sendBatchAndSync c [invalidQuery]
checkInvalidResult c 1
waitReadyForQuery c
@ -186,15 +185,15 @@ testDescribeStatement = withConnectionCommon $ \c -> do
testDescribeStatementNoData :: IO ()
testDescribeStatementNoData = withConnectionCommon $ \c -> do
r <- fromRight <$> describeStatement c "SET client_encoding TO UTF8"
assertBool "Should be empty" $ V.null (fst r)
assertBool "Should be empty" $ V.null (snd r)
assertBool "Should be empty" $ null (fst r)
assertBool "Should be empty" $ null (snd r)
-- | Describes statement that is empty string.
testDescribeStatementEmpty :: IO ()
testDescribeStatementEmpty = withConnectionCommon $ \c -> do
r <- fromRight <$> describeStatement c ""
assertBool "Should be empty" $ V.null (fst r)
assertBool "Should be empty" $ V.null (snd r)
assertBool "Should be empty" $ null (fst r)
assertBool "Should be empty" $ null (snd r)
-- | Query using simple query protocol.
testSimpleQuery :: IO ()
@ -231,7 +230,7 @@ testPreparedStatementCache = withConnection $ \c -> do
-- | Test that large responses are properly handled
testLargeQuery :: IO ()
testLargeQuery = withConnection $ \c -> do
sendBatchAndSync c [Query largeStmt V.empty Text Text NeverCache ]
sendBatchAndSync c [Query largeStmt [] Text Text NeverCache ]
r <- readNextData c
waitReadyForQuery c
assertBool "Should be Right" $ isRight r
@ -243,7 +242,7 @@ testLargeQuery = withConnection $ \c -> do
testCorrectDatarows :: IO ()
testCorrectDatarows = withConnection $ \c -> do
let stmt = "SELECT * FROM generate_series(1, 1000)"
sendBatchAndSync c [Query stmt V.empty Text Text NeverCache]
sendBatchAndSync c [Query stmt [] Text Text NeverCache]
r <- readNextData c
case r of
Left e -> error $ show e

3
tests/Fault.hs
View File

@ -7,7 +7,6 @@ import Data.Maybe
import Data.Either
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector as V
import System.Socket (SocketException(..))
import System.Mem.Weak (Weak, deRefWeak)
import Control.Concurrent (throwTo, threadDelay, killThread)
@ -27,7 +26,7 @@ import Database.PostgreSQL.Protocol.Types
import Connection
longQuery :: Query
longQuery = Query "SELECT pg_sleep(5)" V.empty Text Text NeverCache
longQuery = Query "SELECT pg_sleep(5)" [] Text Text NeverCache
testFaults :: TestTree
testFaults = testGroup "Faults"

11
tests/Protocol.hs
View File

@ -3,7 +3,6 @@ module Protocol where
import Data.Monoid ((<>))
import Data.Foldable
import Control.Monad
import qualified Data.Vector as V
import Test.Tasty
import Test.Tasty.HUnit
@ -49,9 +48,9 @@ testExtendedQuery = withConnectionCommonAll $ \c -> do
sname = StatementName "statement"
pname = PortalName "portal"
statement = StatementSQL "SELECT $1 + $2"
sendMessage rawConn $ Parse sname statement (V.fromList [Oid 23, Oid 23])
sendMessage rawConn $ Parse sname statement [Oid 23, Oid 23]
sendMessage rawConn $
Bind pname sname Text (V.fromList [Just "1", Just "2"]) Text
Bind pname sname Text [Just "1", Just "2"] Text
sendMessage rawConn $ Execute pname noLimitToReceive
sendMessage rawConn $ DescribeStatement sname
sendMessage rawConn $ DescribePortal pname
@ -93,9 +92,9 @@ testExtendedEmptyQuery = withConnectionCommonAll $ \c -> do
sname = StatementName "statement"
pname = PortalName ""
statement = StatementSQL ""
sendMessage rawConn $ Parse sname statement V.empty
sendMessage rawConn $ Parse sname statement []
sendMessage rawConn $
Bind pname sname Text V.empty Text
Bind pname sname Text [] Text
sendMessage rawConn $ Execute pname noLimitToReceive
sendMessage rawConn Sync
msgs <- collectUntilReadyForQuery c
@ -112,7 +111,7 @@ testExtendedQueryNoData = withConnectionCommonAll $ \c -> do
let rawConn = connRawConnection c
sname = StatementName "statement"
statement = StatementSQL "SET client_encoding to UTF8"
sendMessage rawConn $ Parse sname statement V.empty
sendMessage rawConn $ Parse sname statement []
sendMessage rawConn $ DescribeStatement sname
sendMessage rawConn Sync