From a2536fd5f41da9ddaa012b3c195b2529ad35445d Mon Sep 17 00:00:00 2001 From: VyacheslavHashov Date: Thu, 13 Jul 2017 14:38:05 +0300 Subject: [PATCH] Changed Vector to [] in Query and client messages --- bench/Codecs.hs | 5 ++-- src/Database/PostgreSQL/Driver/Query.hs | 4 +-- src/Database/PostgreSQL/Protocol/Encoders.hs | 5 ++-- src/Database/PostgreSQL/Protocol/Types.hs | 4 +-- tests/Codecs/QuickCheck.hs | 5 ++-- tests/Driver.hs | 29 ++++++++++---------- tests/Fault.hs | 3 +- tests/Protocol.hs | 11 ++++---- 8 files changed, 30 insertions(+), 36 deletions(-) diff --git a/bench/Codecs.hs b/bench/Codecs.hs index ef2eba1..7e69d25 100644 --- a/bench/Codecs.hs +++ b/bench/Codecs.hs @@ -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 diff --git a/src/Database/PostgreSQL/Driver/Query.hs b/src/Database/PostgreSQL/Driver/Query.hs index 451f8fa..a88aa99 100644 --- a/src/Database/PostgreSQL/Driver/Query.hs +++ b/src/Database/PostgreSQL/Driver/Query.hs @@ -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 diff --git a/src/Database/PostgreSQL/Protocol/Encoders.hs b/src/Database/PostgreSQL/Protocol/Encoders.hs index 9746ea5..dd0b240 100644 --- a/src/Database/PostgreSQL/Protocol/Encoders.hs +++ b/src/Database/PostgreSQL/Protocol/Encoders.hs @@ -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 diff --git a/src/Database/PostgreSQL/Protocol/Types.hs b/src/Database/PostgreSQL/Protocol/Types.hs index b168ba9..2b07a0e 100644 --- a/src/Database/PostgreSQL/Protocol/Types.hs +++ b/src/Database/PostgreSQL/Protocol/Types.hs @@ -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 diff --git a/tests/Codecs/QuickCheck.hs b/tests/Codecs/QuickCheck.hs index 519992a..d0d95d1 100644 --- a/tests/Codecs/QuickCheck.hs +++ b/tests/Codecs/QuickCheck.hs @@ -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 diff --git a/tests/Driver.hs b/tests/Driver.hs index 93d8459..218e1f5 100644 --- a/tests/Driver.hs +++ b/tests/Driver.hs @@ -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 diff --git a/tests/Fault.hs b/tests/Fault.hs index 37dae60..fdf87af 100644 --- a/tests/Fault.hs +++ b/tests/Fault.hs @@ -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" diff --git a/tests/Protocol.hs b/tests/Protocol.hs index 4e80e84..cb9b0a2 100644 --- a/tests/Protocol.hs +++ b/tests/Protocol.hs @@ -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