diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for mysql-haskell +## 0.8.0.0 -- 2016-11-09 + +* Add `ciCharset` field to support `utf8mb4` charset. +* Add `BitMap` field to `COM_STMT_EXECUTE`, and [#8](https://github.com/winterland1989/mysql-haskell/pull/8) by [alexbiehl](https://github.com/alexbiehl). + ## 0.7.1.0 -- 2016-11-21 * Add `QueryParam` class and `Param` datatype for multi-valued parameter(s) by [naushadh](https://github.com/naushadh). diff --git a/Database/MySQL/Base.hs b/Database/MySQL/Base.hs --- a/Database/MySQL/Base.hs +++ b/Database/MySQL/Base.hs @@ -29,6 +29,7 @@ MySQLConn , ConnectInfo(..) , defaultConnectInfo + , defaultConnectInfoMB4 , connect , connectDetail , close @@ -248,7 +249,8 @@ -- | Execute prepared query statement with parameters, expecting no resultset. -- executeStmt :: MySQLConn -> StmtID -> [MySQLValue] -> IO OK -executeStmt conn stid params = command conn (COM_STMT_EXECUTE stid params) +executeStmt conn stid params = + command conn (COM_STMT_EXECUTE stid params (makeNullMap params)) -- | Execute prepared query statement with parameters, expecting resultset. -- @@ -257,7 +259,7 @@ queryStmt :: MySQLConn -> StmtID -> [MySQLValue] -> IO ([ColumnDef], InputStream [MySQLValue]) queryStmt conn@(MySQLConn is os _ consumed) stid params = do guardUnconsumed conn - writeCommand (COM_STMT_EXECUTE stid params) os + writeCommand (COM_STMT_EXECUTE stid params (makeNullMap params)) os p <- readPacket is if isERR p then decodeFromPacket p >>= throwIO . ERRException @@ -281,7 +283,7 @@ queryStmtVector :: MySQLConn -> StmtID -> [MySQLValue] -> IO (V.Vector ColumnDef, InputStream (V.Vector MySQLValue)) queryStmtVector conn@(MySQLConn is os _ consumed) stid params = do guardUnconsumed conn - writeCommand (COM_STMT_EXECUTE stid params) os + writeCommand (COM_STMT_EXECUTE stid params (makeNullMap params)) os p <- readPacket is if isERR p then decodeFromPacket p >>= throwIO . ERRException diff --git a/Database/MySQL/Connection.hs b/Database/MySQL/Connection.hs --- a/Database/MySQL/Connection.hs +++ b/Database/MySQL/Connection.hs @@ -27,6 +27,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Typeable +import Data.Word import Database.MySQL.Protocol.Auth import Database.MySQL.Protocol.Command import Database.MySQL.Protocol.Packet @@ -61,13 +62,32 @@ , ciDatabase :: ByteString , ciUser :: ByteString , ciPassword :: ByteString + , ciCharset :: Word8 } -- | A simple 'ConnectInfo' targeting localhost with @user=root@ and empty password. -- +-- Default charset is set to @utf8_general_ci@ to support older(< 5.5.3) MySQL versions, +-- but be aware this is a partial utf8 encoding, you may want to use 'defaultConnectInfoMB4' +-- instead to support full utf8 charset(emoji, etc.). You can query your server's support +-- with @SELECT id, collation_name FROM information_schema.collations ORDER BY id;@ +-- defaultConnectInfo :: ConnectInfo -defaultConnectInfo = ConnectInfo "127.0.0.1" 3306 "" "root" "" +defaultConnectInfo = ConnectInfo "127.0.0.1" 3306 "" "root" "" utf8_general_ci +-- | 'defaultConnectInfo' with charset set to @utf8mb4_unicode_ci@ +-- +-- This is recommanded on any MySQL server version >= 5.5.3. +-- +defaultConnectInfoMB4 :: ConnectInfo +defaultConnectInfoMB4 = ConnectInfo "127.0.0.1" 3306 "" "root" "" utf8mb4_unicode_ci + +utf8_general_ci :: Word8 +utf8_general_ci = 33 + +utf8mb4_unicode_ci :: Word8 +utf8mb4_unicode_ci = 224 + -------------------------------------------------------------------------------- -- | Socket buffer size. @@ -85,14 +105,14 @@ -- | Establish a MySQL connection with 'Greeting' back, so you can find server's version .etc. -- connectDetail :: ConnectInfo -> IO (Greeting, MySQLConn) -connectDetail (ConnectInfo host port db user pass) = +connectDetail (ConnectInfo host port db user pass charset) = bracketOnError (TCP.connectWithBufferSize host port bUFSIZE) (\(_, _, sock) -> N.close sock) $ \ (is, os, sock) -> do is' <- decodeInputStream is os' <- Binary.encodeOutputStream os p <- readPacket is' greet <- decodeFromPacket p - let auth = mkAuth db user pass greet + let auth = mkAuth db user pass charset greet Stream.write (Just (encodeToPacket 1 auth)) os' q <- readPacket is' if isOK q @@ -102,11 +122,11 @@ return (greet, conn) else Stream.write Nothing os' >> decodeFromPacket q >>= throwIO . ERRException -mkAuth :: ByteString -> ByteString -> ByteString -> Greeting -> Auth -mkAuth db user pass greet = +mkAuth :: ByteString -> ByteString -> ByteString -> Word8 -> Greeting -> Auth +mkAuth db user pass charset greet = let salt = greetingSalt1 greet `B.append` greetingSalt2 greet scambleBuf = scramble salt pass - in Auth clientCap clientMaxPacketSize clientCharset user scambleBuf db + in Auth clientCap clientMaxPacketSize charset user scambleBuf db where scramble :: ByteString -> ByteString -> ByteString scramble salt pass' diff --git a/Database/MySQL/Protocol/Auth.hs b/Database/MySQL/Protocol/Auth.hs --- a/Database/MySQL/Protocol/Auth.hs +++ b/Database/MySQL/Protocol/Auth.hs @@ -25,6 +25,7 @@ import qualified Data.ByteString as B import Data.ByteString.Char8 as BC import Data.Bits +import Data.Word import Database.MySQL.Protocol.Packet -------------------------------------------------------------------------------- @@ -186,13 +187,9 @@ clientMaxPacketSize :: Word32 clientMaxPacketSize = 0x00ffffff :: Word32 --- | Always use @utf8_general_ci@ when connecting mysql server, --- since this will simplify string decoding. -clientCharset :: Word8 -clientCharset = 0x21 :: Word8 supportTLS :: Word32 -> Bool supportTLS x = (x .&. CLIENT_SSL) /= 0 -sslRequest :: SSLRequest -sslRequest = SSLRequest (clientCap .|. CLIENT_SSL) clientMaxPacketSize clientCharset +sslRequest :: Word8 -> SSLRequest +sslRequest charset = SSLRequest (clientCap .|. CLIENT_SSL) clientMaxPacketSize charset 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 @@ -43,7 +43,7 @@ | COM_REGISTER_SLAVE !Word32 !ByteString !ByteString !ByteString !Word16 !Word32 !Word32 -- ^ 0x15 -- server-id, slaves hostname, slaves user, slaves password, slaves port, replication rank(ignored), master-id(usually 0) | COM_STMT_PREPARE !L.ByteString -- ^ 0x16 statement - | COM_STMT_EXECUTE !StmtID ![MySQLValue] -- ^ 0x17 stmtId, params + | COM_STMT_EXECUTE !StmtID ![MySQLValue] !BitMap -- ^ 0x17 stmtId, params | COM_STMT_CLOSE !StmtID -- ^ 0x19 stmtId | COM_STMT_RESET !StmtID -- ^ 0x1A stmtId | COM_UNSUPPORTED @@ -70,13 +70,13 @@ putWord32le rrank putWord32le mid putCommand (COM_STMT_PREPARE stmt) = putWord8 0x16 >> putLazyByteString stmt -putCommand (COM_STMT_EXECUTE stid params) = do +putCommand (COM_STMT_EXECUTE stid params nullmap) = do putWord8 0x17 putWord32le stid putWord8 0x00 -- we only use @CURSOR_TYPE_NO_CURSOR@ here putWord32le 1 -- const 1 unless (null params) $ do - putByteString . fromBitMap $ makeNullMap params + putByteString (fromBitMap nullmap) putWord8 0x01 -- always use new-params-bound-flag mapM_ putParamMySQLType params forM_ params putBinaryField diff --git a/Database/MySQL/Protocol/MySQLValue.hs b/Database/MySQL/Protocol/MySQLValue.hs --- a/Database/MySQL/Protocol/MySQLValue.hs +++ b/Database/MySQL/Protocol/MySQLValue.hs @@ -530,8 +530,9 @@ -- isColumnSet :: BitMap -> Int -> Bool isColumnSet (BitMap bitmap) pos = - let (i, j) = pos `quotRem` 8 - in (bitmap `B.unsafeIndex` i) `testBit` j + let i = pos `unsafeShiftR` 3 + j = pos .&. 7 + in (bitmap `B.unsafeIndex` i) `testBit` j {-# INLINE isColumnSet #-} -- | Test if a column is null(binary protocol). @@ -540,8 +541,11 @@ -- isColumnNull :: BitMap -> Int -> Bool isColumnNull (BitMap nullmap) pos = - let (i, j) = (pos + 2) `quotRem` 8 - in (nullmap `B.unsafeIndex` i) `testBit` j + let + pos' = pos + 2 + i = pos' `unsafeShiftR` 3 + j = pos' .&. 7 + in (nullmap `B.unsafeIndex` i) `testBit` j {-# INLINE isColumnNull #-} -- | Make a nullmap for params(binary protocol) without offset. diff --git a/Database/MySQL/TLS.hs b/Database/MySQL/TLS.hs --- a/Database/MySQL/TLS.hs +++ b/Database/MySQL/TLS.hs @@ -39,7 +39,7 @@ connect c cp = fmap snd (connectDetail c cp) connectDetail :: ConnectInfo -> (TLS.ClientParams, String) -> IO (Greeting, MySQLConn) -connectDetail (ConnectInfo host port db user pass) (cparams, subName) = +connectDetail (ConnectInfo host port db user pass charset) (cparams, subName) = bracketOnError (TCP.connectWithBufferSize host port bUFSIZE) (\(_, _, sock) -> N.close sock) $ \ (is, os, sock) -> do is' <- decodeInputStream is @@ -52,13 +52,13 @@ TLS.clientUseServerNameIndication = False , TLS.clientServerIdentification = (subName, "") } - Stream.write (Just (encodeToPacket 1 sslRequest)) os' + Stream.write (Just (encodeToPacket 1 $ sslRequest charset)) os' bracketOnError (TLS.contextNew sock cparams') TLS.close $ \ ctx -> do TLS.handshake ctx (tlsIs, tlsOs) <- TLS.tlsToStreams ctx tlsIs' <- decodeInputStream tlsIs tlsOs' <- Binary.encodeOutputStream tlsOs - let auth = mkAuth db user pass greet + let auth = mkAuth db user pass charset greet Stream.write (Just (encodeToPacket 2 auth)) tlsOs' q <- readPacket tlsIs' if isOK q 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.7.1.0 +version: 0.8.0.0 synopsis: pure haskell MySQL driver description: pure haskell MySQL driver license: BSD3