diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # Revision history for mysql-haskell +## 1.2.1 -- 2026.03.23 ++ Export `connectUnixSocket` function. ++ Tweak cabal file to better handle crypton vs cryptonite. ++ Fix version cut off for tls compatibility. ++ Fix missing `liftA2` import when running tests on GHC 9.4. ++ Add integration test for Unix socket. + ## 1.2.0 -- 2026.03.07 + Add support for caching_sha2_password authentiation. diff --git a/mysql-haskell.cabal b/mysql-haskell.cabal --- a/mysql-haskell.cabal +++ b/mysql-haskell.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: mysql-haskell -version: 1.2.0 +version: 1.2.1 synopsis: pure haskell MySQL driver description: pure haskell MySQL driver. license: BSD-3-Clause @@ -42,6 +42,10 @@ type: git location: https://github.com/winterland1989/mysql-haskell +flag crypton-1-1 + description: Build with crypton >= 1.1.0 (uses ram instead of memory for ByteArrayAccess) + default: True + manual: False common common-options ghc-options: @@ -90,16 +94,13 @@ blaze-textual >=0.2 && <0.3, bytestring >=0.10.2.0 && <0.12 || ^>=0.12.0, bytestring-lexing >=0.5 && <0.6, - crypton >=0.31 && <0.40 || ^>=1.0.0 || ^>=1.1.0, crypton-x509 >=1.5 && <2.0, crypton-x509-store >=1.5 && <2.0, crypton-x509-system >=1.5 && <2.0, data-default-class >=0.1.2 && <0.2 || ^>=0.2.0, deepseq >=1.4.6 && <1.5 || ^>=1.5.0, io-streams >=1.2 && <2.0, - memory >=0.14.4 && <0.19, monad-loops >=0.4 && <0.5, - ram >=0.20 && <0.23, network >=2.3 && <4.0, pem >=0.2.4 && <0.3, scientific >=0.3 && <0.4, @@ -109,6 +110,15 @@ vector >=0.8 && <0.13 || ^>=0.13.0, word-compat >=0.0 && <0.1 + if flag(crypton-1-1) + build-depends: + crypton ^>=1.1.0, + ram >=0.20 && <0.23 + else + build-depends: + crypton >=0.31 && <0.40 || ^>=1.0.0, + memory >=0.14.4 && <0.19 + default-extensions: DeriveDataTypeable DeriveGeneric @@ -177,11 +187,13 @@ SelectOne TextRow TextRowNew + UnixSocket hs-source-dirs: test build-depends: base, bytestring >=0.10, + directory, io-streams, mysql-haskell, tasty >=0.11 && <2.0, diff --git a/src/Data/TLSSetting.hs b/src/Data/TLSSetting.hs --- a/src/Data/TLSSetting.hs +++ b/src/Data/TLSSetting.hs @@ -26,7 +26,7 @@ import Paths_mysql_haskell (getDataFileName) import qualified System.X509 as X509 -#if !MIN_VERSION_tls(2,0,0) +#if !MIN_VERSION_tls(2,1,4) import Data.Default.Class (def) #endif @@ -144,8 +144,8 @@ } } --- Compatibility shims for tls < 2.0 vs >= 2.0 -#if MIN_VERSION_tls(2,0,0) +-- Compatibility shims for tls < 2.1.4 vs >= 2.1.4 +#if MIN_VERSION_tls(2,1,4) defaultServerParams' :: TLS.ServerParams defaultServerParams' = TLS.defaultParamsServer diff --git a/src/Database/MySQL/Base.hs b/src/Database/MySQL/Base.hs --- a/src/Database/MySQL/Base.hs +++ b/src/Database/MySQL/Base.hs @@ -32,6 +32,8 @@ , defaultConnectInfoMB4 , connect , connectDetail + , connectUnixSocket + , connectUnixSocketDetail , close , ping -- * Direct query diff --git a/src/Database/MySQL/Connection.hs b/src/Database/MySQL/Connection.hs --- a/src/Database/MySQL/Connection.hs +++ b/src/Database/MySQL/Connection.hs @@ -42,6 +42,7 @@ 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) import qualified System.IO.Streams as Stream import qualified System.IO.Streams.TCP as TCP @@ -138,6 +139,46 @@ return (greet, conn) connectWithBufferSize h p bs = TCP.connectSocket h p >>= TCP.socketToConnection bs + write c a = TCP.send c $ Binary.runPut . Binary.put $ a + +-- | Connect to MySQL via a Unix domain socket. +-- +connectUnixSocket :: FilePath -> ConnectInfo -> IO MySQLConn +connectUnixSocket socketPath ci = fmap snd (connectUnixSocketDetail socketPath ci) + +-- | Connect to MySQL via a Unix domain socket with 'Greeting' back, +-- so you can find server's version .etc. +-- +connectUnixSocketDetail :: FilePath -> ConnectInfo -> IO (Greeting, MySQLConn) +connectUnixSocketDetail socketPath (ConnectInfo _host _port db user pass charset) + = bracketOnError open TCP.close go + where + open = bracketOnError + (N.socket N.AF_UNIX N.Stream 0) + N.close + (\sock -> do + N.connect sock (N.SockAddrUnix socketPath) + TCP.socketToConnection bUFSIZE (sock, N.SockAddrUnix socketPath) + ) + 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' + completeAuth is' (write c) pass q plainFullAuth + consumed <- newIORef True + let waitNotMandatoryOK = catch + (void (waitCommandReply is')) -- server will either reply an OK packet + ((\_ -> return ()) :: SomeException -> IO ()) -- or directy close the connection + conn = MySQLConn is' + (write c) + (writeCommand COM_QUIT (write c) >> waitNotMandatoryOK >> TCP.close c) + consumed + return (greet, conn) + write c a = TCP.send c $ Binary.runPut . Binary.put $ a mkAuth :: ByteString -> ByteString -> ByteString -> Word8 -> Greeting -> Auth diff --git a/test/Aeson.hs b/test/Aeson.hs --- a/test/Aeson.hs +++ b/test/Aeson.hs @@ -6,6 +6,7 @@ import Data.ByteString.Builder (Builder, byteString, toLazyByteString, charUtf8, word8) +import Control.Applicative (liftA2) import Control.DeepSeq (NFData(..)) import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific, skipSpace, string) diff --git a/test/AesonBP.hs b/test/AesonBP.hs --- a/test/AesonBP.hs +++ b/test/AesonBP.hs @@ -6,6 +6,7 @@ import Data.ByteString.Builder (Builder, byteString, toLazyByteString, charUtf8, word8) +import Control.Applicative (liftA2) import Data.Bits ((.|.), shiftL) import Data.ByteString (ByteString) import Data.Char (chr) diff --git a/test/Integration.hs b/test/Integration.hs --- a/test/Integration.hs +++ b/test/Integration.hs @@ -8,17 +8,20 @@ import qualified RoundtripBit import qualified RoundtripYear import qualified SelectOne +import qualified UnixSocket main :: IO () main = do - -- Connect briefly to detect the server version, so we can conditionally - -- include tests that only apply to certain servers (e.g. caching_sha2 on MySQL 8.0+). (greet, c) <- connectDetail defaultConnectInfo {ciUser = "testMySQLHaskell", ciDatabase = "testMySQLHaskell"} close c let ver = greetingVersion greet isMySql80 = "8." `B.isPrefixOf` ver || "9." `B.isPrefixOf` ver + + -- Probe for a Unix domain socket (MYSQL_UNIX_SOCKET env var, then common paths). + mSockPath <- UnixSocket.findSocketPath + defaultMain $ testGroup "mysql-integration" $ [ SelectOne.tests , RoundtripBit.tests @@ -28,3 +31,5 @@ -- caching_sha2_password is MySQL 8.0+ only (MariaDB does not support it). -- The sha2 test users are created by the nix CI config for the MySQL 8.0 VM. ++ [ CachingSha2.tests | isMySql80 ] + -- Unix socket tests are included only when a socket file is found. + ++ [ UnixSocket.tests p | Just p <- [mSockPath] ] diff --git a/test/UnixSocket.hs b/test/UnixSocket.hs new file mode 100644 --- /dev/null +++ b/test/UnixSocket.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module UnixSocket (tests, findSocketPath) where + +import qualified Data.ByteString as B +import Database.MySQL.Base +import qualified System.IO.Streams as Stream +import System.Directory (doesFileExist) +import System.Environment (lookupEnv) +import Test.Tasty +import Test.Tasty.HUnit + +-- | Common Unix socket paths for MySQL/MariaDB. +defaultSocketPaths :: [FilePath] +defaultSocketPaths = + [ "/tmp/mysql.sock" -- macOS Homebrew + , "/var/run/mysqld/mysqld.sock" -- Debian/Ubuntu + , "/run/mysqld/mysqld.sock" -- NixOS, Arch + , "/var/lib/mysql/mysql.sock" -- RHEL/CentOS + , "/tmp/mysqld.sock" -- some macOS installs + ] + +-- | Find the MySQL Unix socket path. Checks the @MYSQL_UNIX_SOCKET@ +-- environment variable first, then probes common default locations. +findSocketPath :: IO (Maybe FilePath) +findSocketPath = do + envPath <- lookupEnv "MYSQL_UNIX_SOCKET" + case envPath of + Just p -> do + exists <- doesFileExist p + return $ if exists then Just p else Nothing + Nothing -> firstExisting defaultSocketPaths + where + firstExisting [] = return Nothing + firstExisting (p:ps) = do + exists <- doesFileExist p + if exists then return (Just p) else firstExisting ps + +tests :: FilePath -> TestTree +tests socketPath = testGroup "unix-socket" + [ testCaseSteps "connectUnixSocket: SELECT 1" $ \step -> do + step "connecting via unix socket..." + c <- connectUnixSocket socketPath defaultConnectInfo + { ciUser = "testMySQLHaskell" + , ciDatabase = "testMySQLHaskell" + } + + step "executing SELECT 1..." + (_, is) <- query_ c "SELECT 1" + Just row <- Stream.read is + assertBool "SELECT 1 returns 1" + (row == [MySQLInt32 1] || row == [MySQLInt64 1]) + Stream.skipToEof is + + close c + + , testCaseSteps "connectUnixSocketDetail: returns greeting" $ \step -> do + step "connecting via unix socket with detail..." + (greet, c) <- connectUnixSocketDetail socketPath defaultConnectInfo + { ciUser = "testMySQLHaskell" + , ciDatabase = "testMySQLHaskell" + } + + step "checking greeting version..." + let ver = greetingVersion greet + assertBool "greeting version is not empty" (not $ B.null ver) + + step "executing query to verify connection..." + (_, is) <- query_ c "SELECT 1 + 1" + Just row <- Stream.read is + assertBool "SELECT 1+1 returns 2" + (row == [MySQLInt32 2] || row == [MySQLInt64 2]) + Stream.skipToEof is + + close c + + , testCaseSteps "unix socket: prepared statement roundtrip" $ \step -> do + step "connecting via unix socket..." + c <- connectUnixSocket socketPath defaultConnectInfo + { ciUser = "testMySQLHaskell" + , ciDatabase = "testMySQLHaskell" + } + + step "executing prepared statement..." + stmt <- prepareStmt c "SELECT ? + 1" + (_, is) <- queryStmt c stmt [MySQLInt32 41] + Just row <- Stream.read is + assertBool "41 + 1 = 42" + (row == [MySQLInt32 42] || row == [MySQLInt64 42]) + Stream.skipToEof is + + close c + ]