diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for mysql-haskell -## 0.1.0.0 -- YYYY-mm-dd +## 0.2.0.0 -- 2016-8-19 + +* Fix OK packet decoder. +* Fix sending large packet(>16M). +* Add `executeMany`, `withTransaction` to Base module. +* Add timestamp field to `RowBinLogEvent`. +* Add test, add insert benchmark. + +## 0.1.0.0 -- 2016-8-16 * First version. Released on an unsuspecting world. diff --git a/Database/MySQL/Base.hs b/Database/MySQL/Base.hs --- a/Database/MySQL/Base.hs +++ b/Database/MySQL/Base.hs @@ -35,6 +35,7 @@ , ping -- * direct query , execute + , executeMany , execute_ , query_ , query @@ -45,23 +46,25 @@ , queryStmt , closeStmt , resetStmt + -- * helpers + , withTransaction + , Query(..) + , renderParams + , command + , Stream.skipToEof -- * MySQL protocol , module Database.MySQL.Protocol.Auth , module Database.MySQL.Protocol.Command , module Database.MySQL.Protocol.ColumnDef , module Database.MySQL.Protocol.Packet , module Database.MySQL.Protocol.MySQLValue - -- * helpers - , Query(..) - , renderParams - , command - , Stream.skipToEof ) where import Control.Applicative -import Control.Exception (throwIO) +import Control.Exception (mask, onException, throwIO) import Control.Monad -import Data.IORef (writeIORef) +import qualified Data.ByteString.Lazy as L +import Data.IORef (writeIORef) import Database.MySQL.Connection import Database.MySQL.Protocol.Auth import Database.MySQL.Protocol.ColumnDef @@ -69,13 +72,13 @@ import Database.MySQL.Protocol.MySQLValue import Database.MySQL.Protocol.Packet -import System.IO.Streams (InputStream, OutputStream) -import qualified System.IO.Streams as Stream import Database.MySQL.Query +import System.IO.Streams (InputStream, OutputStream) +import qualified System.IO.Streams as Stream -------------------------------------------------------------------------------- --- | Execute a MySQL query with parameters which don't return a resultSet. +-- | Execute a MySQL query with parameters which don't return a result-set. -- -- The query may contain placeholders @?@, for filling up parameters, the parameters -- will be escaped before get filled into the query, please DO NOT enable @NO_BACKSLASH_ESCAPES@, @@ -84,16 +87,26 @@ execute :: MySQLConn -> Query -> [MySQLValue] -> IO OK execute conn qry params = execute_ conn (renderParams qry params) --- | Execute a MySQL query which don't return a resultSet. +-- | Execute a multi-row query which don't return result-set. -- +-- Leverage MySQL's multi-statement support to do batch insert\/update\/delete, +-- you may want to use 'withTransaction' to make sure it's atomic, and +-- use @sum . map okAffectedRows@ to get all affected rows count. +-- +-- @since 0.2.0.0 +-- +executeMany :: MySQLConn -> Query -> [[MySQLValue]]-> IO [OK] +executeMany conn@(MySQLConn is os _ _) qry paramsList = do + guardUnconsumed conn + let qry' = L.intercalate ";" $ map (fromQuery . renderParams qry) paramsList + writeCommand (COM_QUERY qry') os + mapM (\ _ -> waitCommandReply is) paramsList + +-- | Execute a MySQL query which don't return a result-set. +-- execute_ :: MySQLConn -> Query -> IO OK execute_ conn (Query qry) = command conn (COM_QUERY qry) -{- -executeBatch :: MySQLConn -> Query -> OutputStream [MySQLValue] -> IO (InputStream OK) -executeBatch --} - -- | Execute a MySQL query which return a result-set with parameters. -- -- Note that you must fully consumed the result-set before start a new query on @@ -103,7 +116,7 @@ query :: MySQLConn -> Query -> [MySQLValue] -> IO ([ColumnDef], InputStream [MySQLValue]) query conn qry params = query_ conn (renderParams qry params) --- | Execute a MySQL query which return a resultSet. +-- | Execute a MySQL query which return a result-set. -- query_ :: MySQLConn -> Query -> IO ([ColumnDef], InputStream [MySQLValue]) query_ conn@(MySQLConn is os _ consumed) (Query qry) = do @@ -135,9 +148,9 @@ then decodeFromPacket p >>= throwIO . ERRException else do StmtPrepareOK stid colCnt paramCnt _ <- getFromPacket getStmtPrepareOK p - _ <- replicateM paramCnt (readPacket is) + _ <- replicateM_ paramCnt (readPacket is) _ <- unless (colCnt == 0) (void (readPacket is)) -- EOF - _ <- replicateM colCnt (readPacket is) + _ <- replicateM_ colCnt (readPacket is) _ <- unless (paramCnt == 0) (void (readPacket is)) -- EOF return stid @@ -184,6 +197,8 @@ -- | Execute prepared query statement with parameters, expecting resultset. -- +-- Rules about 'UnconsumedResultSet' applied here too. +-- queryStmt :: MySQLConn -> StmtID -> [MySQLValue] -> IO ([ColumnDef], InputStream [MySQLValue]) queryStmt conn@(MySQLConn is os _ consumed) stid params = do guardUnconsumed conn @@ -203,3 +218,14 @@ | isERR q -> decodeFromPacket q >>= throwIO . ERRException | otherwise -> throwIO (UnexpectedPacket q) return (fields, rows) + +-- | Run querys inside a transaction, querys will be rolled back if exception arise. +-- +-- @since 0.2.0.0 +-- +withTransaction :: MySQLConn -> IO a -> IO a +withTransaction conn procedure = mask $ \restore -> do + _ <- execute_ conn "BEGIN" + r <- restore procedure `onException` (execute_ conn "ROLLBACK") + _ <- execute_ conn "COMMIT" + pure r diff --git a/Database/MySQL/BinLog.hs b/Database/MySQL/BinLog.hs --- a/Database/MySQL/BinLog.hs +++ b/Database/MySQL/BinLog.hs @@ -25,6 +25,7 @@ -- * re-export , module Database.MySQL.BinLogProtocol.BinLogEvent , module Database.MySQL.BinLogProtocol.BinLogValue + , module Database.MySQL.BinLogProtocol.BinLogMeta ) where import Control.Applicative @@ -39,8 +40,10 @@ import Data.Word import Database.MySQL.Base import Database.MySQL.BinLogProtocol.BinLogEvent +import Database.MySQL.BinLogProtocol.BinLogMeta import Database.MySQL.BinLogProtocol.BinLogValue import Database.MySQL.Connection +import GHC.Generics (Generic) import System.IO.Streams (InputStream, OutputStream) import qualified System.IO.Streams as Stream @@ -52,7 +55,7 @@ data BinLogTracker = BinLogTracker { btFileName :: {-# UNPACK #-} !ByteString , btNextPos :: {-# UNPACK #-} !Word32 - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) -- | Register a pesudo slave to master, although MySQL document suggests you should call this -- before calling 'dumpBinLog', but it seems it's not really necessary. @@ -61,7 +64,7 @@ registerPesudoSlave conn sid = command conn (COM_REGISTER_SLAVE sid "" "" "" 0 0 0) -- | Setup binlog listening on given connection, during listening --- the connection *can not* be used to do query, or an 'UnconsumedResultSet' will be thrown. +-- the connection CAN NOT be used to do query, or an 'UnconsumedResultSet' will be thrown. -- dumpBinLog :: MySQLConn -- ^ connection to be listened -> SlaveID -- ^ a number for our pesudo slave. @@ -69,6 +72,7 @@ -> Bool -- ^ if master support semi-ack, do we want to enable it? -- if master doesn't support, this parameter will be ignored. -> IO (FormatDescription, IORef ByteString, InputStream BinLogPacket) + -- ^ 'FormatDescription', 'IORef' contains current binlog filename, 'BinLogPacket' stream. dumpBinLog conn@(MySQLConn is os _ consumed) sid (BinLogTracker initfn initpos) wantAck = do guardUnconsumed conn checksum <- isCheckSumEnabled conn @@ -122,18 +126,21 @@ -- | Row based biblog event type. -- --- It's recommended to call 'enableRowQueryEvent' before 'dumpBinLog', so that you can get --- 'RowQueryEvent' in row based binlog(it's important for detect a table change for example). +-- It's recommended to enable row query event before 'dumpBinLog', so that you can get +-- 'RowQueryEvent' in row based binlog(it's important for detect a table change for example), +-- more information please refer -- -- a 'BinLogTracker' is included so that you can roll up your own HA solutions, --- for example, writing 'BinLogPacket' to a zookeeper when you done with an event. +-- for example, writing the tracker to zookeeper when you done with an event. -- +-- The first 'Word32' field is a timestamp present when this event is logged. +-- data RowBinLogEvent - = RowQueryEvent !BinLogTracker !QueryEvent' - | RowDeleteEvent !BinLogTracker !TableMapEvent !DeleteRowsEvent - | RowWriteEvent !BinLogTracker !TableMapEvent !WriteRowsEvent - | RowUpdateEvent !BinLogTracker !TableMapEvent !UpdateRowsEvent - deriving (Show, Eq) + = RowQueryEvent !Word32 !BinLogTracker !QueryEvent' + | RowDeleteEvent !Word32 !BinLogTracker !TableMapEvent !DeleteRowsEvent + | RowWriteEvent !Word32 !BinLogTracker !TableMapEvent !WriteRowsEvent + | RowUpdateEvent !Word32 !BinLogTracker !TableMapEvent !UpdateRowsEvent + deriving (Show, Eq, Generic) -- | decode row based event from 'BinLogPacket' stream. decodeRowBinLogEvent :: (FormatDescription, IORef ByteString, InputStream BinLogPacket) @@ -149,7 +156,7 @@ if | t == BINLOG_ROWS_QUERY_EVENT -> do tr <- track p' fref e <- getFromBinLogPacket getQueryEvent' p' - pure (Just (RowQueryEvent tr e)) + pure (Just (RowQueryEvent (blTimestamp p') tr e)) | t == BINLOG_TABLE_MAP_EVENT -> do tme <- getFromBinLogPacket (getTableMapEvent fd) p' q <- Stream.read is @@ -160,15 +167,15 @@ if | u == BINLOG_WRITE_ROWS_EVENTv1 || u == BINLOG_WRITE_ROWS_EVENTv2 -> do tr <- track q' fref e <- getFromBinLogPacket' (getWriteRowEvent fd tme) q' - pure (Just (RowWriteEvent tr tme e)) + pure (Just (RowWriteEvent (blTimestamp q') tr tme e)) | u == BINLOG_DELETE_ROWS_EVENTv1 || u == BINLOG_DELETE_ROWS_EVENTv2 -> do tr <- track q' fref e <- getFromBinLogPacket' (getDeleteRowEvent fd tme) q' - pure (Just (RowDeleteEvent tr tme e)) + pure (Just (RowDeleteEvent (blTimestamp q') tr tme e)) | u == BINLOG_UPDATE_ROWS_EVENTv1 || u == BINLOG_UPDATE_ROWS_EVENTv2 -> do tr <- track q' fref e <- getFromBinLogPacket' (getUpdateRowEvent fd tme) q' - pure (Just (RowUpdateEvent tr tme e)) + pure (Just (RowUpdateEvent (blTimestamp q') tr tme e)) | otherwise -> loop fd fref is | otherwise -> loop fd fref is diff --git a/Database/MySQL/BinLogProtocol/BinLogEvent.hs b/Database/MySQL/BinLogProtocol/BinLogEvent.hs --- a/Database/MySQL/BinLogProtocol/BinLogEvent.hs +++ b/Database/MySQL/BinLogProtocol/BinLogEvent.hs @@ -32,6 +32,7 @@ import Control.Exception (throwIO) import Database.MySQL.Query +import GHC.Generics (Generic) -------------------------------------------------------------------------------- -- | binlog tyoe @@ -127,7 +128,7 @@ -- , eventHeaderLen :: !Word8 -- const 19 , fdEventHeaderLenVector :: !ByteString -- ^ a array indexed by Binlog Event Type - 1 -- to extract the length of the event specific header. - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) getFormatDescription :: Get FormatDescription getFormatDescription = FormatDescription <$> getWord16le @@ -155,7 +156,7 @@ , qStatusVars :: !ByteString , qSchemaName :: !ByteString , qQuery :: !Query - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) getQueryEvent :: Get QueryEvent getQueryEvent = do @@ -188,7 +189,7 @@ , tmColumnType :: ![FieldType] , tmColumnMeta :: ![BinLogMeta] , tmNullMap :: !ByteString - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) getTableMapEvent :: FormatDescription -> Get TableMapEvent getTableMapEvent fd = do @@ -220,7 +221,7 @@ , deleteColumnCnt :: !Int , deletePresentMap :: !BitMap , deleteRowData :: ![[BinLogValue]] - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) getDeleteRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get DeleteRowsEvent getDeleteRowEvent fd tme typ = do @@ -242,7 +243,7 @@ , writeColumnCnt :: !Int , writePresentMap :: !BitMap , writeRowData :: ![[BinLogValue]] - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) getWriteRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get WriteRowsEvent getWriteRowEvent fd tme typ = do @@ -264,7 +265,7 @@ , updateColumnCnt :: !Int , updatePresentMap :: !(BitMap, BitMap) , updateRowData :: ![ ([BinLogValue], [BinLogValue]) ] - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) getUpdateRowEvent :: FormatDescription -> TableMapEvent -> BinLogEventType -> Get UpdateRowsEvent getUpdateRowEvent fd tme typ = do diff --git a/Database/MySQL/Connection.hs b/Database/MySQL/Connection.hs --- a/Database/MySQL/Connection.hs +++ b/Database/MySQL/Connection.hs @@ -29,6 +29,7 @@ import qualified Data.ByteString.Unsafe as B import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import qualified Data.TLSSetting as TLS import Data.Typeable import Data.Word import Database.MySQL.Protocol.Auth @@ -36,13 +37,12 @@ import Database.MySQL.Protocol.Packet import Network.Socket (HostName, PortNumber) import qualified Network.Socket as N +import qualified Network.TLS as TLS import System.IO.Streams (InputStream, OutputStream) import qualified System.IO.Streams as Stream import qualified System.IO.Streams.Binary as Binary import qualified System.IO.Streams.TCP as TCP import qualified System.IO.Streams.TLS as TLS -import qualified Data.TLSSetting as TLS -import qualified Network.TLS as TLS -------------------------------------------------------------------------------- @@ -155,10 +155,10 @@ loopRead acc k is = do bs <- Stream.read is case bs of Nothing -> throwIO NetworkException - Just bs' -> do let l = B.length bs' + Just bs' -> do let l = fromIntegral (B.length bs') if l >= k then do - let (a, rest) = B.splitAt k bs' + let (a, rest) = B.splitAt (fromIntegral k) bs' unless (B.null rest) (Stream.unRead rest is) return $! L.fromChunks (reverse (a:acc)) else do @@ -186,11 +186,16 @@ command conn@(MySQLConn is os _ _) cmd = do guardUnconsumed conn writeCommand cmd os + waitCommandReply is +{-# INLINE command #-} + +waitCommandReply :: InputStream Packet -> IO OK +waitCommandReply is = do p <- readPacket is if | isERR p -> decodeFromPacket p >>= throwIO . ERRException | isOK p -> decodeFromPacket p | otherwise -> throwIO (UnexpectedPacket p) -{-# INLINE command #-} +{-# INLINE waitCommandReply #-} readPacket :: InputStream Packet -> IO Packet readPacket is = Stream.read is >>= maybe @@ -209,13 +214,19 @@ {-# INLINE readPacket #-} writeCommand :: Command -> OutputStream Packet -> IO () -writeCommand a = let bs = Binary.runPut (Binary.put a) in - go (fromIntegral (L.length bs)) 0 bs +writeCommand a os = let bs = Binary.runPut (Binary.put a) in + go (fromIntegral (L.length bs)) 0 bs os where - go len seqN bs = + go len seqN bs os' = do if len < 16777215 - then Stream.write (Just (Packet len seqN bs)) - else go (len - 16777215) (seqN + 1) (L.drop 16777215 bs) + then Stream.write (Just (Packet len seqN bs)) os' + else do + let (bs', rest) = L.splitAt 16777215 bs + seqN' = seqN + 1 + len' = len - 16777215 + + Stream.write (Just (Packet 16777215 seqN bs')) os' + seqN' `seq` len' `seq` go len' seqN' rest os' {-# INLINE writeCommand #-} guardUnconsumed :: MySQLConn -> IO () @@ -261,6 +272,7 @@ .|. CLIENT_IGNORE_SPACE .|. CLIENT_PROTOCOL_41 .|. CLIENT_TRANSACTIONS + .|. CLIENT_MULTI_STATEMENTS .|. CLIENT_SECURE_CONNECTION clientMaxPacketSize :: Word32 diff --git a/Database/MySQL/Protocol/Command.hs b/Database/MySQL/Protocol/Command.hs --- a/Database/MySQL/Protocol/Command.hs +++ b/Database/MySQL/Protocol/Command.hs @@ -112,7 +112,7 @@ -- | call 'isOK' with this packet return true data StmtPrepareOK = StmtPrepareOK - { stmtId :: !Word32 + { stmtId :: !StmtID , stmtColumnCnt :: !Int , stmtParamCnt :: !Int , stmtWarnCnt :: !Int diff --git a/Database/MySQL/Protocol/Packet.hs b/Database/MySQL/Protocol/Packet.hs --- a/Database/MySQL/Protocol/Packet.hs +++ b/Database/MySQL/Protocol/Packet.hs @@ -25,6 +25,7 @@ import Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L import Data.Int.Int24 +import Data.Int import Data.Typeable import Data.Word.Word24 @@ -32,7 +33,7 @@ -- | MySQL packet type -- data Packet = Packet - { pLen :: !Int + { pLen :: !Int64 , pSeqN :: !Word8 , pBody :: !L.ByteString } deriving (Show, Eq) @@ -122,8 +123,9 @@ } deriving (Show, Eq) getOK :: Get OK -getOK = OK <$> getLenEncInt +getOK = OK <$ skip 1 <*> getLenEncInt + <*> getLenEncInt <*> getWord16le <*> getWord16le @@ -174,7 +176,8 @@ } deriving (Show, Eq) getEOF :: Get EOF -getEOF = EOF <$> getWord16le +getEOF = EOF <$ skip 1 + <*> getWord16le <*> getWord16le putEOF :: EOF -> Put diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ mysql-haskell ============= +[![Hackage](https://img.shields.io/hackage/v/mysql-haskell.svg?style=flat)](http://hackage.haskell.org/package/mysql-haskell) [![Build Status](https://travis-ci.org/winterland1989/mysql-haskell.svg)](https://travis-ci.org/winterland1989/mysql-haskell) `mysql-haskell` is a MySQL driver written entirely in haskell by @winterland1989 at infrastructure department of Didi group, it's going to be used in projects aiming at replacing old java based MySQL middlewares. @@ -12,10 +13,15 @@ In short, it's about 2 times slower than pure c/c++, but 5 times faster than old FFI bindings(mysql by Bryan O'Sullivan). - +![result figure](https://github.com/winterland1989/mysql-haskell/blob/master/benchmark/result.png?raw=true) -Above figures showed the time to perform a "select * from employees" from a [sample table](https://github.com/datacharmer/test_db). +Above figures showed the time to: +* perform a "select * from employees" from a [sample table](https://github.com/datacharmer/test_db) +* insert 1000 rows into a 29-columns table per thread with auto-commit off. + +The benchmarks are run by my MacBook Pro 13' 2015. + Motivation ---------- @@ -41,8 +47,10 @@ cabal build ``` -Running tests require a local MySQL server, a user `testMySQLHaskell` and a database `testMySQLHaskell`, you can do it use following script: +Running tests require: +* A local MySQL server, a user `testMySQLHaskell` and a database `testMySQLHaskell`, you can do it use following script: + ```bash mysql -u root -e "CREATE DATABASE IF NOT EXISTS testMySQLHaskell;" mysql -u root -e "CREATE USER 'testMySQLHaskell'@'localhost' IDENTIFIED BY ''" @@ -50,17 +58,18 @@ mysql -u root -e "FLUSH PRIVILEGES" ``` -You should enable binlog by adding `log_bin = filename` to `my.cnf` or add `--log-bin=filename` to the server, and grant replication access to `testMySQLHaskell` with: +* Enable binlog by adding `log_bin = filename` to `my.cnf` or add `--log-bin=filename` to the server, and grant replication access to `testMySQLHaskell` with: ```bash mysql -u root -e "GRANT REPLICATION SLAVE, REPLICATION CLIENT ON *.* TO 'testMySQLHaskell'@'localhost';" ``` -And you should set binlog to `row` by adding `binlog_format = ROW` to `my.cnf`. +* Set `binlog_format` to `ROW`. -New features in MySQL 5.7 are tested seperately, you can run them by setting environment varible `MYSQLVER=5.7`, travis is keeping -an eye on following combinations: +* Set `max_allowed_packet` to larger than 64MB(for test large packet). +New features will be automatically tested by inspecting MySQL server's version, travis is keeping an eye on following combinations: + + CABALVER=1.18 GHCVER=7.8.4 MYSQLVER=5.5 + CABALVER=1.22 GHCVER=7.10.2 MYSQLVER=5.5 + CABALVER=1.24 GHCVER=8.0.1 MYSQLVER=5.5 @@ -69,7 +78,7 @@ Please reference `.travis.yml` if you have problems with setting up test environment. -Enter benchmark directory and run `./bench.sh` to benchmark 1) c++ version 2) mysql-haskell 3) FFI version mysql, you may need to modify `bench.sh`(change the include path) to get c++ version compiled. +Enter benchmark directory and run `./bench.sh` to benchmark 1) c++ version 2) mysql-haskell 3) FFI version mysql, you may need to modify `bench.sh`(change the include path) to get c++ version compiled, and you may need to adjust rts options `-N` to get best results, with `-N10` on my company's 24-core machine, binary protocol performs almost identical to c version! Guide ----- diff --git a/mysql-haskell.cabal b/mysql-haskell.cabal --- a/mysql-haskell.cabal +++ b/mysql-haskell.cabal @@ -1,5 +1,5 @@ name: mysql-haskell -version: 0.1.0.0 +version: 0.2.0.0 synopsis: pure haskell MySQL driver description: pure haskell MySQL driver license: BSD3 @@ -45,7 +45,7 @@ , bytestring >= 0.10.2.0 , text >= 1.1 && < 1.3 , cryptonite == 0.* - , memory >= 0.8 + , memory , time >= 1.5.0 , scientific == 0.3.* , bytestring-lexing == 0.5.* @@ -63,13 +63,20 @@ test-suite test type: exitcode-stdio-1.0 main-is: Main.hs - other-modules: BinaryRow, BinaryRowNew, BinLog, BinLogNew, TextRow, TextRowNew + other-modules: BinaryRow + , BinaryRowNew + , BinLog + , BinLogNew + , TextRow + , TextRowNew + , ExecuteMany hs-source-dirs: test build-depends: mysql-haskell , base , bytestring - , tasty + , optparse-applicative < 0.13 + , tasty == 0.11.* , tasty-hunit , text , io-streams diff --git a/test/BinLog.hs b/test/BinLog.hs --- a/test/BinLog.hs +++ b/test/BinLog.hs @@ -32,7 +32,7 @@ z <- getCurrentTimeZone let timestamp = round $ utcTimeToPOSIXSeconds (localTimeToUTC z t) - Just (RowUpdateEvent _ tme ue) <- Stream.read rowEventStream + Just (RowUpdateEvent _ _ tme ue) <- Stream.read rowEventStream assertEqual "decode update event cloumn" (updateColumnCnt ue) 30 assertEqual "decode update event rows" (updateRowData ue) [ @@ -101,7 +101,7 @@ ) ] - Just (RowUpdateEvent _ tme ue) <- Stream.read rowEventStream + Just (RowUpdateEvent _ _ tme ue) <- Stream.read rowEventStream assertEqual "decode update event rows" (updateRowData ue) [ ( diff --git a/test/BinLogNew.hs b/test/BinLogNew.hs --- a/test/BinLogNew.hs +++ b/test/BinLogNew.hs @@ -32,7 +32,7 @@ z <- getCurrentTimeZone let timestamp = round $ utcTimeToPOSIXSeconds (localTimeToUTC z t) - Just (RowUpdateEvent _ tme ue) <- Stream.read rowEventStream + Just (RowUpdateEvent _ _ tme ue) <- Stream.read rowEventStream assertEqual "decode update event cloumn" (updateColumnCnt ue) 4 assertEqual "decode update event rows" (updateRowData ue) [ @@ -49,7 +49,7 @@ ) ] - Just (RowUpdateEvent _ tme ue) <- Stream.read rowEventStream + Just (RowUpdateEvent _ _ tme ue) <- Stream.read rowEventStream assertEqual "decode update event rows" (updateRowData ue) [ ( @@ -65,7 +65,7 @@ ) ] - Just (RowUpdateEvent _ tme ue) <- Stream.read rowEventStream + Just (RowUpdateEvent _ _ tme ue) <- Stream.read rowEventStream assertEqual "decode update event rows" (updateRowData ue) [ ( diff --git a/test/ExecuteMany.hs b/test/ExecuteMany.hs new file mode 100644 --- /dev/null +++ b/test/ExecuteMany.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module ExecuteMany where + +import Control.Applicative +import Data.Time.Calendar (fromGregorian) +import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..)) +import Database.MySQL.Base +import qualified System.IO.Streams as Stream +import Test.Tasty.HUnit + +tests :: MySQLConn -> Assertion +tests c = do + oks <- withTransaction c $ executeMany c "INSERT INTO test VALUES(\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \? ,\ + \?)" + (replicate 50000 + [ MySQLInt32 0 + , MySQLBit 255 + , MySQLInt8 (-128) + , MySQLInt8U 255 + , MySQLInt16 (-32768) + , MySQLInt16U 65535 + , MySQLInt32 (-8388608) + , MySQLInt32U 16777215 + , MySQLInt32 (-2147483648) + , MySQLInt32U 4294967295 + , MySQLInt64 (-9223372036854775808) + , MySQLInt64U 18446744073709551615 + , MySQLDecimal 1234567890.0123456789 + , MySQLFloat 3.14159 + , MySQLDouble 3.1415926535 + , MySQLDate (fromGregorian 2016 08 08) + , MySQLDateTime (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59)) + , MySQLTimeStamp (LocalTime (fromGregorian 2016 08 08) (TimeOfDay 17 25 59)) + , MySQLTime 1 (TimeOfDay 199 59 59) + , MySQLYear 1999 + , MySQLText "12345678" + , MySQLText "韩冬真赞" + , MySQLBytes "12345678" + , MySQLBytes "12345678" + , MySQLBytes "12345678" + , MySQLText "韩冬真赞" + , MySQLBytes "12345678" + , MySQLText "韩冬真赞" + , MySQLText "foo" + , MySQLText "foo,bar" + ] + ) + assertEqual "executeMany affected rows" (sum $ map okAffectedRows oks) 50000 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -11,9 +11,11 @@ import Database.MySQL.Base import Database.MySQL.BinLog import System.Environment +import qualified System.IO.Streams as Stream import Test.Tasty import Test.Tasty.HUnit import qualified TextRow +import qualified ExecuteMany import qualified TextRowNew main :: IO () @@ -65,6 +67,11 @@ \__enum ENUM('foo', 'bar', 'qux'),\ \__set SET('foo', 'bar', 'qux')\ \) CHARACTER SET utf8" + + resetTestTable c + + step "testing executeMany" + ExecuteMany.tests c resetTestTable c diff --git a/test/TextRow.hs b/test/TextRow.hs --- a/test/TextRow.hs +++ b/test/TextRow.hs @@ -215,7 +215,6 @@ , MySQLText "foo,bar" ] - (_, is) <- query_ c "SELECT * FROM test" Just v <- Stream.read is