mysql-haskell 0.1.0.0 → 0.2.0.0
raw patch · 14 files changed
+230/−72 lines, 14 filesdep +optparse-applicativedep ~memorydep ~tastyPVP ok
version bump matches the API change (PVP)
Dependencies added: optparse-applicative
Dependency ranges changed: memory, tasty
API changes (from Hackage documentation)
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_0BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_10BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_11BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_12BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_13BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_14BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_15BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_16BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_17BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_18BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_19BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_1BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_20BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_21BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_2BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_3BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_4BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_5BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_6BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_7BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_8BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Constructor Database.MySQL.BinLogProtocol.BinLogValue.C1_9BinLogValue
- Database.MySQL.BinLogProtocol.BinLogValue: instance GHC.Generics.Datatype Database.MySQL.BinLogProtocol.BinLogValue.D1BinLogValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_0MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_10MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_11MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_12MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_13MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_14MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_15MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_16MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_17MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_18MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_19MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_1MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_20MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_2MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_3MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_4MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_5MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_6MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_7MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_8MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Constructor Database.MySQL.Protocol.MySQLValue.C1_9MySQLValue
- Database.MySQL.Protocol.MySQLValue: instance GHC.Generics.Datatype Database.MySQL.Protocol.MySQLValue.D1MySQLValue
+ Database.MySQL.Base: executeMany :: MySQLConn -> Query -> [[MySQLValue]] -> IO [OK]
+ Database.MySQL.Base: withTransaction :: MySQLConn -> IO a -> IO a
+ Database.MySQL.BinLog: instance GHC.Generics.Generic Database.MySQL.BinLog.BinLogTracker
+ Database.MySQL.BinLog: instance GHC.Generics.Generic Database.MySQL.BinLog.RowBinLogEvent
+ Database.MySQL.BinLogProtocol.BinLogEvent: instance GHC.Generics.Generic Database.MySQL.BinLogProtocol.BinLogEvent.DeleteRowsEvent
+ Database.MySQL.BinLogProtocol.BinLogEvent: instance GHC.Generics.Generic Database.MySQL.BinLogProtocol.BinLogEvent.FormatDescription
+ Database.MySQL.BinLogProtocol.BinLogEvent: instance GHC.Generics.Generic Database.MySQL.BinLogProtocol.BinLogEvent.QueryEvent
+ Database.MySQL.BinLogProtocol.BinLogEvent: instance GHC.Generics.Generic Database.MySQL.BinLogProtocol.BinLogEvent.TableMapEvent
+ Database.MySQL.BinLogProtocol.BinLogEvent: instance GHC.Generics.Generic Database.MySQL.BinLogProtocol.BinLogEvent.UpdateRowsEvent
+ Database.MySQL.BinLogProtocol.BinLogEvent: instance GHC.Generics.Generic Database.MySQL.BinLogProtocol.BinLogEvent.WriteRowsEvent
- Database.MySQL.BinLog: RowDeleteEvent :: !BinLogTracker -> !TableMapEvent -> !DeleteRowsEvent -> RowBinLogEvent
+ Database.MySQL.BinLog: RowDeleteEvent :: !Word32 -> !BinLogTracker -> !TableMapEvent -> !DeleteRowsEvent -> RowBinLogEvent
- Database.MySQL.BinLog: RowQueryEvent :: !BinLogTracker -> !QueryEvent' -> RowBinLogEvent
+ Database.MySQL.BinLog: RowQueryEvent :: !Word32 -> !BinLogTracker -> !QueryEvent' -> RowBinLogEvent
- Database.MySQL.BinLog: RowUpdateEvent :: !BinLogTracker -> !TableMapEvent -> !UpdateRowsEvent -> RowBinLogEvent
+ Database.MySQL.BinLog: RowUpdateEvent :: !Word32 -> !BinLogTracker -> !TableMapEvent -> !UpdateRowsEvent -> RowBinLogEvent
- Database.MySQL.BinLog: RowWriteEvent :: !BinLogTracker -> !TableMapEvent -> !WriteRowsEvent -> RowBinLogEvent
+ Database.MySQL.BinLog: RowWriteEvent :: !Word32 -> !BinLogTracker -> !TableMapEvent -> !WriteRowsEvent -> RowBinLogEvent
- Database.MySQL.Protocol.Packet: Packet :: !Int -> !Word8 -> !ByteString -> Packet
+ Database.MySQL.Protocol.Packet: Packet :: !Int64 -> !Word8 -> !ByteString -> Packet
- Database.MySQL.Protocol.Packet: [pLen] :: Packet -> !Int
+ Database.MySQL.Protocol.Packet: [pLen] :: Packet -> !Int64
Files
- ChangeLog.md +9/−1
- Database/MySQL/Base.hs +45/−19
- Database/MySQL/BinLog.hs +21/−14
- Database/MySQL/BinLogProtocol/BinLogEvent.hs +7/−6
- Database/MySQL/Connection.hs +22/−10
- Database/MySQL/Protocol/Command.hs +1/−1
- Database/MySQL/Protocol/Packet.hs +6/−3
- README.md +17/−8
- mysql-haskell.cabal +11/−4
- test/BinLog.hs +2/−2
- test/BinLogNew.hs +3/−3
- test/ExecuteMany.hs +79/−0
- test/Main.hs +7/−0
- test/TextRow.hs +0/−1
ChangeLog.md view
@@ -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.
Database/MySQL/Base.hs view
@@ -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
Database/MySQL/BinLog.hs view
@@ -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 <http://dev.mysql.com/doc/refman/5.7/en/replication-options-binary-log.html#sysvar_binlog_rows_query_log_events sysvar_binlog_rows_query_log_events> -- -- 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
Database/MySQL/BinLogProtocol/BinLogEvent.hs view
@@ -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
Database/MySQL/Connection.hs view
@@ -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
Database/MySQL/Protocol/Command.hs view
@@ -112,7 +112,7 @@ -- | call 'isOK' with this packet return true data StmtPrepareOK = StmtPrepareOK- { stmtId :: !Word32+ { stmtId :: !StmtID , stmtColumnCnt :: !Int , stmtParamCnt :: !Int , stmtWarnCnt :: !Int
Database/MySQL/Protocol/Packet.hs view
@@ -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
README.md view
@@ -1,6 +1,7 @@ mysql-haskell ============= +[](http://hackage.haskell.org/package/mysql-haskell) [](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). -<img src="https://github.com/winterland1989/mysql-haskell/blob/master/benchmark/benchmark2016-08-14.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 -----
mysql-haskell.cabal view
@@ -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
test/BinLog.hs view
@@ -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) [ (
test/BinLogNew.hs view
@@ -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) [ (
+ test/ExecuteMany.hs view
@@ -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
test/Main.hs view
@@ -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
test/TextRow.hs view
@@ -215,7 +215,6 @@ , MySQLText "foo,bar" ] - (_, is) <- query_ c "SELECT * FROM test" Just v <- Stream.read is