diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,12 @@ # Revision history for mysql-haskell -## 0.8.2.0 -- 2016-11-09 +## 0.8.3.0 -- 2017-10-09 + +* Remove unnecessary exports from `Database.MySQL.Base`. +* Reuse TCP connection when using TLS. +* Clean up some compiler warnings. + +## 0.8.2.0 -- 2017-10-09 Courtesy of naushadh, `mysql-haskell` will be on stackage again. diff --git a/Database/MySQL/Base.hs b/Database/MySQL/Base.hs --- a/Database/MySQL/Base.hs +++ b/Database/MySQL/Base.hs @@ -86,7 +86,7 @@ import Database.MySQL.Protocol.Packet import Database.MySQL.Query -import System.IO.Streams (InputStream, OutputStream) +import System.IO.Streams (InputStream) import qualified System.IO.Streams as Stream import qualified Data.Vector as V diff --git a/Database/MySQL/BinLog.hs b/Database/MySQL/BinLog.hs --- a/Database/MySQL/BinLog.hs +++ b/Database/MySQL/BinLog.hs @@ -44,8 +44,7 @@ import Database.MySQL.BinLogProtocol.BinLogValue import Database.MySQL.Connection import GHC.Generics (Generic) -import System.IO.Streams (InputStream, - OutputStream) +import System.IO.Streams (InputStream) import qualified System.IO.Streams as Stream type SlaveID = Word32 diff --git a/Database/MySQL/BinLogProtocol/BinLogValue.hs b/Database/MySQL/BinLogProtocol/BinLogValue.hs --- a/Database/MySQL/BinLogProtocol/BinLogValue.hs +++ b/Database/MySQL/BinLogProtocol/BinLogValue.hs @@ -16,7 +16,7 @@ import Control.Applicative import Data.Binary.Get import Data.Binary.IEEE754 -import Data.Binary.Put +import Data.Binary.Put () import Data.Bits import Data.ByteString (ByteString) import qualified Data.ByteString as B diff --git a/Database/MySQL/Connection.hs b/Database/MySQL/Connection.hs --- a/Database/MySQL/Connection.hs +++ b/Database/MySQL/Connection.hs @@ -33,10 +33,8 @@ import Database.MySQL.Protocol.Command import Database.MySQL.Protocol.Packet import Network.Socket (HostName, PortNumber) -import qualified Network.Socket as N -import System.IO.Streams (InputStream, OutputStream) +import System.IO.Streams (InputStream) 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 @@ -126,6 +124,9 @@ return (greet, conn) else TCP.close c >> decodeFromPacket q >>= throwIO . ERRException + connectWithBufferSize h p bs = TCP.connectSocket h p >>= TCP.socketToConnection bs + write c a = TCP.send c $ Binary.runPut . Binary.put $ a + mkAuth :: ByteString -> ByteString -> ByteString -> Word8 -> Greeting -> Auth mkAuth db user pass charset greet = let salt = greetingSalt1 greet `B.append` greetingSalt2 greet @@ -254,13 +255,3 @@ 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 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,7 +25,6 @@ import qualified Data.ByteString as B import Data.ByteString.Char8 as BC import Data.Bits -import Data.Word import Database.MySQL.Protocol.Packet -------------------------------------------------------------------------------- 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 @@ -24,7 +24,6 @@ import qualified Data.ByteString as B import Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Internal as L import Data.Int.Int24 import Data.Int import Data.Word diff --git a/Database/MySQL/TLS.hs b/Database/MySQL/TLS.hs --- a/Database/MySQL/TLS.hs +++ b/Database/MySQL/TLS.hs @@ -18,16 +18,15 @@ ) where import Control.Exception (bracketOnError, throwIO) -import Control.Monad +import qualified Data.Binary as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.Connection as Conn import Data.IORef (newIORef) import Data.TLSSetting import Database.MySQL.Connection hiding (connect, connectDetail) import Database.MySQL.Protocol.Auth import Database.MySQL.Protocol.Packet -import qualified Network.Socket as N import qualified Network.TLS as TLS -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 @@ -42,7 +41,7 @@ connectDetail :: ConnectInfo -> (TLS.ClientParams, String) -> IO (Greeting, MySQLConn) connectDetail (ConnectInfo host port db user pass charset) (cparams, subName) = bracketOnError (connectWithBufferSize host port bUFSIZE) - (TCP.close) $ \ (c) -> do + (TCP.close) $ \ c -> do let is = TCP.source c is' <- decodeInputStream is p <- readPacket is' @@ -53,9 +52,12 @@ TLS.clientUseServerNameIndication = False , TLS.clientServerIdentification = (subName, "") } - let connect' = TLS.connect cparams' Nothing host port + let (sock, sockAddr) = Conn.connExtraInfo c write c (encodeToPacket 1 $ sslRequest charset) - bracketOnError connect' TCP.close $ \ tc -> do + bracketOnError (TLS.contextNew sock cparams') + ( \ ctx -> TLS.bye ctx >> TCP.close c ) $ \ ctx -> do + TLS.handshake ctx + tc <- TLS.tLsToConnection (ctx, sockAddr) let tlsIs = TCP.source tc tlsIs' <- decodeInputStream tlsIs let auth = mkAuth db user pass charset greet @@ -68,3 +70,6 @@ return (greet, conn) else TCP.close c >> decodeFromPacket q >>= throwIO . ERRException else error "Database.MySQL.TLS: server doesn't support TLS connection" + where + connectWithBufferSize h p bs = TCP.connectSocket h p >>= TCP.socketToConnection bs + write c a = TCP.send c $ Binary.runPut . Binary.put $ a 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.8.2.0 +version: 0.8.3.0 synopsis: pure haskell MySQL driver description: pure haskell MySQL driver license: BSD3