mysql-haskell-openssl (empty) → 0.7.0.0
raw patch · 5 files changed
+148/−0 lines, 5 filesdep +HsOpenSSLdep +basedep +io-streamssetup-changed
Dependencies added: HsOpenSSL, base, io-streams, mysql-haskell, network, tcp-streams, tcp-streams-openssl, wire-streams
Files
- ChangeLog.md +5/−0
- Database/MySQL/OpenSSL.hs +74/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- mysql-haskell-openssl.cabal +37/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for mysql-haskell-openssl++## 0.7.0.0 -- 2016-11-09++* Split from mysql-haskell.
+ Database/MySQL/OpenSSL.hs view
@@ -0,0 +1,74 @@+{-|+Module : Database.MySQL.Connection+Description : Alternative TLS support for mysql-haskell via @HsOpenSSL@ package.+Copyright : (c) Winterland, 2016+License : BSD+Maintainer : drkoster@qq.com+Stability : experimental+Portability : PORTABLE++This module provides secure MySQL connection using 'HsOpenSSL' package.++-}++module Database.MySQL.OpenSSL+ ( connect+ , connectDetail+ , module Data.OpenSSLSetting+ ) where++import Control.Exception (bracketOnError, throwIO)+import Control.Monad+import Data.IORef (newIORef)+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 OpenSSL as SSL+import qualified OpenSSL.X509 as X509+import qualified OpenSSL.Session as Session+import qualified System.IO.Streams as Stream+import qualified System.IO.Streams.Binary as Binary+import qualified System.IO.Streams.OpenSSL as SSL+import qualified System.IO.Streams.TCP as TCP+import Data.OpenSSLSetting++--------------------------------------------------------------------------------++-- | Provide a 'Session.SSLContext' and a subject name to establish a TLS connection.+--+connect :: ConnectInfo -> (Session.SSLContext, String) -> IO MySQLConn+connect c cp = fmap snd (connectDetail c cp)++connectDetail :: ConnectInfo -> (Session.SSLContext, String) -> IO (Greeting, MySQLConn)+connectDetail (ConnectInfo host port db user pass) (ctx, subname) =+ 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+ if supportTLS (greetingCaps greet)+ then SSL.withOpenSSL $ do+ Stream.write (Just (encodeToPacket 1 sslRequest)) os'+ bracketOnError (Session.connection ctx sock) SSL.close $ \ ssl -> do+ Session.connect ssl+ trusted <- Session.getVerifyResult ssl+ cert <- Session.getPeerCertificate ssl+ subnames <- maybe (return []) (`X509.getSubjectName` False) cert+ let cnname = lookup "CN" subnames+ verified = maybe False (== subname) cnname+ unless (trusted && verified) (throwIO $ Session.ProtocolError "fail to verify certificate")+ (sslIs, sslOs) <- SSL.sslToStreams ssl+ sslIs' <- decodeInputStream sslIs+ sslOs' <- Binary.encodeOutputStream sslOs+ let auth = mkAuth db user pass greet+ Stream.write (Just (encodeToPacket 2 auth)) sslOs'+ q <- readPacket sslIs'+ if isOK q+ then do+ consumed <- newIORef True+ let conn = MySQLConn sslIs' sslOs' (SSL.close ssl) consumed+ return (greet, conn)+ else Stream.write Nothing sslOs' >> decodeFromPacket q >>= throwIO . ERRException+ else error "Database.MySQL.OpenSSL: server doesn't support TLS connection"
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, winterland1989++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of winterland1989 nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mysql-haskell-openssl.cabal view
@@ -0,0 +1,37 @@+name: mysql-haskell-openssl+version: 0.7.0.0+synopsis: TLS support for mysql-haskell package using openssl+description: TLS support for mysql-haskell package using openssl+license: BSD3+license-file: LICENSE+author: winterland1989+maintainer: winterland1989@gmail.com+copyright: (c) 2016 Winterland +category: Database+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10+homepage: https://github.com/winterland1989/mysql-haskell+bug-reports: https://github.com/winterland1989/mysql-haskell/issues++source-repository head+ type: git+ location: git://github.com/winterland1989/mysql-haskell.git++library+ exposed-modules: Database.MySQL.OpenSSL+ build-depends: base >= 4.7 && < 5+ , network >= 2.3 && < 3.0+ , io-streams >= 1.2 && < 2.0+ , tcp-streams >= 0.6 && < 0.7+ , tcp-streams-openssl >= 0.6 && < 0.7+ , wire-streams >= 0.1+ , mysql-haskell >= 0.7+ , HsOpenSSL >=0.10.3 && <0.12++ default-language: Haskell2010+ default-extensions: DeriveDataTypeable+ , DeriveGeneric+ , MultiWayIf+ , OverloadedStrings+ ghc-options: -Wall