mysql-haskell 0.8.1.0 → 0.8.2.0
raw patch · 6 files changed
+71/−52 lines, 6 filesdep ~memorydep ~tcp-streamsdep ~tlsPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: memory, tcp-streams, tls
API changes (from Hackage documentation)
+ Database.MySQL.Connection: connectWithBufferSize :: HostName -> PortNumber -> Int -> IO TCPConnection
+ Database.MySQL.Connection: type TCPConnection = Connection (Socket, SockAddr)
+ Database.MySQL.Connection: write :: Binary a => Connection x -> a -> IO ()
- Database.MySQL.Connection: MySQLConn :: {-# UNPACK #-} !(InputStream Packet) -> {-# UNPACK #-} !(OutputStream Packet) -> IO () -> {-# UNPACK #-} !(IORef Bool) -> MySQLConn
+ Database.MySQL.Connection: MySQLConn :: {-# UNPACK #-} !(InputStream Packet) -> (Packet -> IO ()) -> IO () -> {-# UNPACK #-} !(IORef Bool) -> MySQLConn
- Database.MySQL.Connection: [mysqlWrite] :: MySQLConn -> {-# UNPACK #-} !(OutputStream Packet)
+ Database.MySQL.Connection: [mysqlWrite] :: MySQLConn -> (Packet -> IO ())
- Database.MySQL.Connection: writeCommand :: Command -> OutputStream Packet -> IO ()
+ Database.MySQL.Connection: writeCommand :: Command -> (Packet -> IO ()) -> IO ()
Files
- ChangeLog.md +7/−0
- Database/MySQL/BinLog.hs +6/−6
- Database/MySQL/Connection.hs +40/−27
- Database/MySQL/TLS.hs +11/−11
- README.md +1/−1
- mysql-haskell.cabal +6/−7
ChangeLog.md view
@@ -1,5 +1,12 @@ # Revision history for mysql-haskell +## 0.8.2.0 -- 2016-11-09++Courtesy of naushadh, `mysql-haskell` will be on stackage again.++* Update to use `tcp-streams-1.x`.+* Fix compatibility with new `tls/memory` version.+ ## 0.8.1.0 -- 2016-11-09 * Add `Show` instance to `ConnectInfo`.
Database/MySQL/BinLog.hs view
@@ -73,14 +73,14 @@ -- 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+dumpBinLog conn@(MySQLConn is wp _ consumed) sid (BinLogTracker initfn initpos) wantAck = do guardUnconsumed conn checksum <- isCheckSumEnabled conn when checksum $ void $ execute_ conn "SET @master_binlog_checksum = @@global.binlog_checksum" semiAck <- isSemiSyncEnabled conn let needAck = semiAck && wantAck when needAck . void $ execute_ conn "SET @rpl_semi_sync_slave = 1"- writeCommand (COM_BINLOG_DUMP initpos 0x00 sid initfn) os+ writeCommand (COM_BINLOG_DUMP initpos 0x00 sid initfn) wp writeIORef consumed False rp <- skipToPacketT (readBinLogPacket checksum needAck is) BINLOG_ROTATE_EVENT@@ -88,7 +88,7 @@ fref <- newIORef (rFileName re) p <- skipToPacketT (readBinLogPacket checksum needAck is) BINLOG_FORMAT_DESCRIPTION_EVENT- replyAck needAck p fref os+ replyAck needAck p fref wp fmt <- getFromBinLogPacket getFormatDescription p es <- Stream.makeInputStream $ do@@ -98,7 +98,7 @@ Just q' -> do when (blEventType q' == BINLOG_ROTATE_EVENT) $ do e <- getFromBinLogPacket getRotateEvent q' writeIORef' fref (rFileName e)- replyAck needAck q' fref os+ replyAck needAck q' fref wp return q return (fmt, fref, es) where@@ -109,9 +109,9 @@ if blEventType p' == typ then return p' else skipToPacketT iop typ Nothing -> throwIO NetworkException - replyAck needAck p fref os' = when (needAck && blSemiAck p) $ do+ replyAck needAck p fref wp' = when (needAck && blSemiAck p) $ do fn <- readIORef fref- Stream.write (Just (makeSemiAckPacket (blLogPos p) fn)) os'+ wp' (makeSemiAckPacket (blLogPos p) fn) makeSemiAckPacket pos fn = putToPacket 0 $ do putWord8 0xEF -- semi-ack
Database/MySQL/Connection.hs view
@@ -17,6 +17,7 @@ throwIO) import Control.Monad import qualified Crypto.Hash as Crypto+import qualified Data.Binary as Binary import qualified Data.Binary.Put as Binary import Data.Bits import qualified Data.ByteArray as BA@@ -37,6 +38,7 @@ 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 Data.Connection as TCP -------------------------------------------------------------------------------- @@ -47,7 +49,7 @@ -- data MySQLConn = MySQLConn { mysqlRead :: {-# UNPACK #-} !(InputStream Packet)- , mysqlWrite :: {-# UNPACK #-} !(OutputStream Packet)+ , mysqlWrite :: (Packet -> IO ()) , mysqlCloseSocket :: IO () , isConsumed :: {-# UNPACK #-} !(IORef Bool) }@@ -105,22 +107,24 @@ -- | 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 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 charset greet- Stream.write (Just (encodeToPacket 1 auth)) os'- q <- readPacket is'- if isOK q- then do- consumed <- newIORef True- let conn = MySQLConn is' os' (N.close sock) consumed- return (greet, conn)- else Stream.write Nothing os' >> decodeFromPacket q >>= throwIO . ERRException+connectDetail (ConnectInfo host port db user pass charset)+ = bracketOnError open TCP.close go+ where+ open = connectWithBufferSize host port bUFSIZE+ go c = do+ let is = TCP.source c+ is' <- decodeInputStream is+ p <- readPacket is'+ greet <- decodeFromPacket p+ let auth = mkAuth db user pass charset greet+ write c $ encodeToPacket 1 auth+ q <- readPacket is'+ if isOK q+ then do+ consumed <- newIORef True+ let conn = MySQLConn is' (write c) (TCP.close c) consumed+ return (greet, conn)+ else TCP.close c >> decodeFromPacket q >>= throwIO . ERRException mkAuth :: ByteString -> ByteString -> ByteString -> Word8 -> Greeting -> Auth mkAuth db user pass charset greet =@@ -166,9 +170,7 @@ -- | Close a MySQL connection. -- close :: MySQLConn -> IO ()-close (MySQLConn _ os closeSocket _) = do- Stream.write Nothing os- closeSocket+close (MySQLConn _ _ closeSocket _) = closeSocket -- | Send a 'COM_PING'. --@@ -211,20 +213,20 @@ ) {-# INLINE readPacket #-} -writeCommand :: Command -> OutputStream Packet -> IO ()-writeCommand a os = let bs = Binary.runPut (putCommand a) in- go (fromIntegral (L.length bs)) 0 bs os+writeCommand :: Command -> (Packet -> IO ()) -> IO ()+writeCommand a writePacket = let bs = Binary.runPut (putCommand a) in+ go (fromIntegral (L.length bs)) 0 bs writePacket where- go len seqN bs os' = do+ go len seqN bs writePacket' = do if len < 16777215- then Stream.write (Just (Packet len seqN bs)) os'+ then writePacket (Packet len seqN bs) 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'+ writePacket (Packet 16777215 seqN bs')+ seqN' `seq` len' `seq` go len' seqN' rest writePacket' {-# INLINE writeCommand #-} guardUnconsumed :: MySQLConn -> IO ()@@ -251,3 +253,14 @@ data UnexpectedPacket = UnexpectedPacket Packet deriving (Typeable, Show) instance Exception UnexpectedPacket++--------------------------------------------------------------------------------+-- TCP shims++type TCPConnection = TCP.Connection (N.Socket, N.SockAddr)++connectWithBufferSize :: N.HostName -> N.PortNumber -> Int -> IO TCPConnection+connectWithBufferSize h p bs = TCP.connectSocket h p >>= TCP.socketToConnection bs++write :: Binary.Binary a => TCP.Connection x -> a -> IO ()+write c a = TCP.send c $ Binary.runPut . Binary.put $ a
Database/MySQL/TLS.hs view
@@ -29,6 +29,7 @@ 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 Data.Connection as TCP import qualified System.IO.Streams.TLS as TLS --------------------------------------------------------------------------------@@ -40,10 +41,10 @@ connectDetail :: ConnectInfo -> (TLS.ClientParams, String) -> IO (Greeting, MySQLConn) connectDetail (ConnectInfo host port db user pass charset) (cparams, subName) =- bracketOnError (TCP.connectWithBufferSize host port bUFSIZE)- (\(_, _, sock) -> N.close sock) $ \ (is, os, sock) -> do+ bracketOnError (connectWithBufferSize host port bUFSIZE)+ (TCP.close) $ \ (c) -> do+ let is = TCP.source c is' <- decodeInputStream is- os' <- Binary.encodeOutputStream os p <- readPacket is' greet <- decodeFromPacket p if supportTLS (greetingCaps greet)@@ -52,19 +53,18 @@ TLS.clientUseServerNameIndication = False , TLS.clientServerIdentification = (subName, "") }- 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+ let connect' = TLS.connect cparams' Nothing host port+ write c (encodeToPacket 1 $ sslRequest charset)+ bracketOnError connect' TCP.close $ \ tc -> do+ let tlsIs = TCP.source tc tlsIs' <- decodeInputStream tlsIs- tlsOs' <- Binary.encodeOutputStream tlsOs let auth = mkAuth db user pass charset greet- Stream.write (Just (encodeToPacket 2 auth)) tlsOs'+ write tc (encodeToPacket 2 auth) q <- readPacket tlsIs' if isOK q then do consumed <- newIORef True- let conn = MySQLConn tlsIs' tlsOs' (TLS.close ctx) consumed+ let conn = MySQLConn tlsIs' (write c) (TCP.close c) consumed return (greet, conn)- else Stream.write Nothing tlsOs' >> decodeFromPacket q >>= throwIO . ERRException+ else TCP.close c >> decodeFromPacket q >>= throwIO . ERRException else error "Database.MySQL.TLS: server doesn't support TLS connection"
README.md view
@@ -66,7 +66,7 @@ ... s <- prepareStmt conn "SELECT * FROM some_table where person_age > ?" ...- (defs, is) <- queryStmt s [MySQLInt32U 18]+ (defs, is) <- queryStmt conn s [MySQLInt32U 18] ... ```
mysql-haskell.cabal view
@@ -1,12 +1,12 @@ name: mysql-haskell-version: 0.8.1.0+version: 0.8.2.0 synopsis: pure haskell MySQL driver description: pure haskell MySQL driver license: BSD3 license-file: LICENSE author: winterland1989 maintainer: winterland1989@gmail.com-copyright: (c) 2016 Winterland +copyright: (c) 2016 Winterland category: Database build-type: Simple extra-source-files: ChangeLog.md, README.md@@ -20,7 +20,7 @@ library exposed-modules: Database.MySQL.Base- , Database.MySQL.TLS + , Database.MySQL.TLS , Database.MySQL.Protocol.Auth , Database.MySQL.Protocol.Command , Database.MySQL.Protocol.ColumnDef@@ -37,7 +37,7 @@ , monad-loops == 0.4.* , network >= 2.3 && < 3.0 , io-streams >= 1.2 && < 2.0- , tcp-streams >= 0.6 && < 0.7+ , tcp-streams >= 1.0 && < 1.1 , wire-streams >= 0.1 , binary >= 0.8.3 , binary-ieee754@@ -45,13 +45,13 @@ , bytestring >= 0.10.2.0 , text >= 1.1 && < 1.3 , cryptonite == 0.*- , memory <= 0.14.2+ , memory >= 0.14.4 && < 0.15 , time >= 1.5.0 , scientific == 0.3.* , bytestring-lexing == 0.5.* , blaze-textual == 0.2.* , word24 >= 1.0 && <= 3.0- , tls >= 1.3.5 && < 1.4+ , tls >= 1.3.5 && < 1.5 , vector >= 0.8 default-language: Haskell2010@@ -83,6 +83,5 @@ , vector default-extensions: MultiWayIf , OverloadedStrings- ghc-options: -threaded default-language: Haskell2010