packages feed

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 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 ============= +[![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). -<img src="https://github.com/winterland1989/mysql-haskell/blob/master/benchmark/benchmark2016-08-14.png?raw=true">+![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 -----
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