mysql-haskell 1.1.8 → 1.2.0

raw patch · 15 files changed

+467/−68 lines, 15 filesdep ~basedep ~bytestringdep ~io-streamsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, io-streams, text, time, vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +17/−1
• mysql-haskell.cabal +39/−10
• src/Database/MySQL/Connection.hs +96/−24
• src/Database/MySQL/Protocol/Auth.hs +6/−2
• src/Database/MySQL/Protocol/MySQLValue.hs +4/−7
• src/Database/MySQL/Protocol/Packet.hs +12/−0
• src/Database/MySQL/TLS.hs +30/−7
• test/CachingSha2.hs +59/−0
• test/Integration.hs +30/−0
• test/Main.hs +2/−6
• test/MysqlTests.hs +14/−11
• test/RoundtripBit.hs +46/−0
• test/RoundtripYear.hs +53/−0
• test/SelectOne.hs +25/−0
• test/Sha256Scramble.hs +34/−0

@@ -1,6 +1,22 @@ # Revision history for mysql-haskell -## 1.1.8 +## 1.2.0 -- 2026.03.07++ Add support for  caching_sha2_password authentiation.++## 1.1.9 -- 2026.03.07++ Fix binary protocol error 1210 on modern MySQL/MariaDB:+  `MYSQL_TYPE_BIT` and `MYSQL_TYPE_YEAR` are not valid parameter types+  for `COM_STMT_EXECUTE`. Send `MySQLBit` as `MYSQL_TYPE_LONGLONG`+  (unsigned, little-endian) and `MySQLYear` as `MYSQL_TYPE_SHORT`+  (unsigned, 2-byte integer) instead.++ Fix `MySQLYear` binary encoding: was sending a length-encoded string+  which caused data misalignment for all subsequent parameters.++ Fix version detection for MariaDB 10+/11+ (fractional seconds support).++ Fix CI: enable binary logging and grant binlog privileges for+  integration tests on MariaDB.++ Add roundtrip integration tests for `MySQLBit` and `MySQLYear`.++## 1.1.8 + bump constraints  ## 1.1.7 -- 2025.08.23 

@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               mysql-haskell-version:            1.1.8+version:            1.2.0 synopsis:           pure haskell MySQL driver description:        pure haskell MySQL driver. license:            BSD-3-Clause@@ -123,20 +123,13 @@   other-modules:     Aeson     AesonBP-    BinaryRow-    BinaryRowNew-    BinLog-    BinLogNew-    ExecuteMany     JSON-    MysqlTests     QC.ByteString     QC.Combinator     QC.Common     Orphans+    Sha256Scramble     TCPStreams-    TextRow-    TextRowNew     Word24    hs-source-dirs:     test@@ -154,9 +147,9 @@     quickcheck-instances < 1.0,     scientific >=0.3.0,     tasty >=0.11 && <2.0,+    tasty-expected-failure < 1.0,     tasty-hunit < 1.0,     tasty-quickcheck >=0.8 && < 1.0,-    tasty-expected-failure  < 1.0,     text,     time,     unordered-containers < 1.0,@@ -167,6 +160,42 @@     OverloadedStrings    ghc-options:        -threaded ++test-suite integration+  type:               exitcode-stdio-1.0+  main-is:            Integration.hs+  other-modules:+    BinaryRow+    BinaryRowNew+    BinLog+    BinLogNew+    CachingSha2+    ExecuteMany+    MysqlTests+    RoundtripBit+    RoundtripYear+    SelectOne+    TextRow+    TextRowNew++  hs-source-dirs:     test+  build-depends:+    base,+    bytestring >=0.10,+    io-streams,+    mysql-haskell,+    tasty >=0.11 && <2.0,+    tasty-hunit < 1.0,+    text,+    time,+    vector++  default-extensions:+    MultiWayIf+    OverloadedStrings++  ghc-options:        -threaded+  default-language:   Haskell2010  benchmark binary-parsers-bench   import: common-options

@@ -14,7 +14,9 @@  -} -module Database.MySQL.Connection where+module Database.MySQL.Connection+    ( module Database.MySQL.Connection+    ) where  import           Control.Exception               (Exception, bracketOnError,                                                   throwIO, catch, SomeException)@@ -124,18 +126,16 @@         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 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)-        else TCP.close c >> decodeFromPacket q >>= throwIO . ERRException+        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)      connectWithBufferSize h p bs = TCP.connectSocket h p >>= TCP.socketToConnection bs     write c a = TCP.send c $ Binary.runPut . Binary.put $ a@@ -143,18 +143,90 @@ 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 charset user scambleBuf db-  where-    scramble :: ByteString -> ByteString -> ByteString-    scramble salt pass'-        | B.null pass' = B.empty-        | otherwise   = B.pack (B.zipWith xor sha1pass withSalt)-        where sha1pass = sha1 pass'-              withSalt = sha1 (salt `B.append` sha1 sha1pass)+        plugin = greetingAuthPlugin greet+        scambleBuf = scrambleForPlugin plugin salt pass+    in Auth clientCap clientMaxPacketSize charset user scambleBuf db plugin -    sha1 :: ByteString -> ByteString-    sha1 = BA.convert . (Crypto.hash :: ByteString -> Crypto.Digest Crypto.SHA1)+-- | Dispatch scramble based on the authentication plugin name.+scrambleForPlugin :: ByteString -> ByteString -> ByteString -> ByteString+scrambleForPlugin plugin salt pass+    | plugin == "caching_sha2_password" = scrambleSHA256 salt pass+    | otherwise                         = scrambleSHA1 salt pass++-- | SHA1-based scramble for @mysql_native_password@.+scrambleSHA1 :: ByteString -> ByteString -> ByteString+scrambleSHA1 salt pass+    | B.null pass = B.empty+    | otherwise   = B.pack (B.zipWith xor sha1pass withSalt)+    where sha1pass = sha1 pass+          withSalt = sha1 (salt `B.append` sha1 sha1pass)+          sha1 :: ByteString -> ByteString+          sha1 = BA.convert . (Crypto.hash :: ByteString -> Crypto.Digest Crypto.SHA1)++-- | SHA256-based scramble for @caching_sha2_password@.+-- XOR(SHA256(password), SHA256(SHA256(SHA256(password)) + nonce))+scrambleSHA256 :: ByteString -> ByteString -> ByteString+scrambleSHA256 salt pass+    | B.null pass = B.empty+    | otherwise   = B.pack (B.zipWith xor sha256pass withSalt)+    where sha256pass = sha256 pass+          withSalt   = sha256 (sha256 sha256pass `B.append` salt)+          sha256 :: ByteString -> ByteString+          sha256 = BA.convert . (Crypto.hash :: ByteString -> Crypto.Digest Crypto.SHA256)++-- | Handle multi-step authentication after sending the initial auth response.+--+-- This handles OK, ERR, AuthMoreData (0x01), and AuthSwitchRequest (0xFE).+-- The @fullAuth@ callback is invoked when the server requests full authentication+-- (e.g., cleartext password over TLS).+completeAuth :: InputStream Packet       -- ^ packet input stream+             -> (Packet -> IO ())        -- ^ packet writer+             -> ByteString               -- ^ password+             -> Packet                   -- ^ the first response packet from server+             -> (Word8 -> ByteString -> (Packet -> IO ()) -> InputStream Packet -> IO ())+                                         -- ^ full auth callback (seqN, password, writer, input)+             -> IO ()+completeAuth is writePacket pass p fullAuth+    | isOK p  = return ()+    | isERR p = decodeFromPacket p >>= throwIO . ERRException+    | isAuthMoreData p = do+        let body = L.toStrict (pBody p)+        case B.index body 1 of+            0x03 -> do  -- fast auth success, read the final OK+                ok <- readPacket is+                if isOK ok+                    then return ()+                    else decodeFromPacket ok >>= throwIO . ERRException+            0x04 -> do  -- full auth required+                fullAuth (pSeqN p + 1) pass writePacket is+            _    -> throwIO (UnexpectedPacket p)+    | isAuthSwitch p = do+        -- Parse AuthSwitchRequest: 0xFE, plugin name (NUL), salt+        let body = L.toStrict (pBody p)+            rest = B.drop 1 body  -- skip 0xFE+            (newPlugin, rest') = B.break (== 0) rest+            newSalt = B.drop 1 rest'  -- skip NUL; trailing NUL may or may not be present+            -- Remove trailing NUL from salt if present+            newSalt' = if not (B.null newSalt) && B.last newSalt == 0+                       then B.init newSalt+                       else newSalt+            scrambled = scrambleForPlugin newPlugin newSalt' pass+            seqN = pSeqN p + 1+            responseBody = L.fromStrict scrambled+            responsePacket = Packet (fromIntegral (B.length scrambled)) seqN responseBody+        writePacket responsePacket+        q <- readPacket is+        completeAuth is writePacket pass q fullAuth+    | otherwise = throwIO (UnexpectedPacket p)++-- | Full auth handler for plain TCP connections: throws an error because+-- caching_sha2_password full authentication requires a secure connection.+plainFullAuth :: Word8 -> ByteString -> (Packet -> IO ()) -> InputStream Packet -> IO ()+plainFullAuth _ _ _ _ =+    throwIO $ AuthException "caching_sha2_password full authentication requires a TLS connection. Use Database.MySQL.TLS to connect, or ensure the password verifier is cached (fast auth path)."++data AuthException = AuthException String deriving (Typeable, Show)+instance Exception AuthException  -- | A specialized 'decodeInputStream' here for speed decodeInputStream :: InputStream ByteString -> IO (InputStream Packet)

@@ -122,6 +122,7 @@     , authName      :: !ByteString     , authPassword  :: !ByteString     , authSchema    :: !ByteString+    , authPlugin    :: !ByteString     } deriving (Show, Eq)  getAuth :: Get Auth@@ -131,10 +132,10 @@     c <- getWord8     skipN 23     n <- getByteStringNul-    return $ Auth a m c n B.empty B.empty+    return $ Auth a m c n B.empty B.empty B.empty  putAuth :: Auth -> Put-putAuth (Auth cap m c n p s) = do+putAuth (Auth cap m c n p s plugin) = do     putWord32le cap     putWord32le m     putWord8 c@@ -144,6 +145,8 @@     putByteString p     putByteString s     putWord8 0x00+    putByteString plugin+    putWord8 0x00  instance Binary Auth where     get = getAuth@@ -182,6 +185,7 @@                 .|. CLIENT_MULTI_STATEMENTS                 .|. CLIENT_MULTI_RESULTS                 .|. CLIENT_SECURE_CONNECTION+                .|. CLIENT_PLUGIN_AUTH  clientMaxPacketSize :: Word32 clientMaxPacketSize = 0x00ffffff :: Word32

@@ -130,14 +130,14 @@ putParamMySQLType (MySQLInt64        _)  = putFieldType mySQLTypeLongLong >> putWord8 0x00 putParamMySQLType (MySQLFloat        _)  = putFieldType mySQLTypeFloat    >> putWord8 0x00 putParamMySQLType (MySQLDouble       _)  = putFieldType mySQLTypeDouble   >> putWord8 0x00-putParamMySQLType (MySQLYear         _)  = putFieldType mySQLTypeYear     >> putWord8 0x80+putParamMySQLType (MySQLYear         _)  = putFieldType mySQLTypeShort    >> putWord8 0x80 putParamMySQLType (MySQLDateTime     _)  = putFieldType mySQLTypeDateTime >> putWord8 0x00 putParamMySQLType (MySQLTimeStamp    _)  = putFieldType mySQLTypeTimestamp>> putWord8 0x00 putParamMySQLType (MySQLDate         _)  = putFieldType mySQLTypeDate     >> putWord8 0x00 putParamMySQLType (MySQLTime       _ _)  = putFieldType mySQLTypeTime     >> putWord8 0x00 putParamMySQLType (MySQLBytes        _)  = putFieldType mySQLTypeBlob     >> putWord8 0x00 putParamMySQLType (MySQLGeometry     _)  = putFieldType mySQLTypeGeometry >> putWord8 0x00-putParamMySQLType (MySQLBit          _)  = putFieldType mySQLTypeBit      >> putWord8 0x00+putParamMySQLType (MySQLBit          _)  = putFieldType mySQLTypeLongLong >> putWord8 0x80 putParamMySQLType (MySQLText         _)  = putFieldType mySQLTypeString   >> putWord8 0x00 putParamMySQLType MySQLNull              = putFieldType mySQLTypeNull     >> putWord8 0x00 @@ -424,9 +424,7 @@ putBinaryField (MySQLInt64      n) = putInt64le n putBinaryField (MySQLFloat      x) = putFloatle x putBinaryField (MySQLDouble     x) = putDoublele x-putBinaryField (MySQLYear       n) = putLenEncBytes . L.toStrict . BB.toLazyByteString $-                                        Textual.integral n  -- this's really weird, it's not documented anywhere-                                                            -- we must encode year into string in binary mode!+putBinaryField (MySQLYear       n) = putWord16le n putBinaryField (MySQLTimeStamp (LocalTime date time)) = do putWord8 11    -- always put full                                                            putBinaryDay date                                                            putBinaryTime' time@@ -440,8 +438,7 @@                                         putBinaryTime t putBinaryField (MySQLGeometry bs)  = putLenEncBytes bs putBinaryField (MySQLBytes  bs)    = putLenEncBytes bs-putBinaryField (MySQLBit    word)  = do putWord8 8     -- always put full-                                        putWord64be word+putBinaryField (MySQLBit    word)  = putWord64le word putBinaryField (MySQLText    t)    = putLenEncBytes (T.encodeUtf8 t) putBinaryField MySQLNull           = return () 

@@ -71,6 +71,18 @@ isEOF p = L.index (pBody p) 0 == 0xFE {-# INLINE isEOF #-} +-- | Is this an AuthMoreData packet? (first byte 0x01)+-- Used during authentication handshake for caching_sha2_password.+isAuthMoreData :: Packet -> Bool+isAuthMoreData p = L.index (pBody p) 0 == 0x01+{-# INLINE isAuthMoreData #-}++-- | Is this an AuthSwitchRequest packet? (first byte 0xFE)+-- Same marker as EOF but used in authentication context.+isAuthSwitch :: Packet -> Bool+isAuthSwitch p = L.index (pBody p) 0 == 0xFE+{-# INLINE isAuthSwitch #-}+ -- | Is there more packet to be read? -- --  https://dev.mysql.com/doc/internals/en/status-flags.html

@@ -17,15 +17,22 @@     , module Data.TLSSetting     ) where -import           Control.Exception              (bracketOnError, throwIO)+import           Control.Exception              (bracketOnError, throwIO, catch, SomeException)+import           Control.Monad                  (void) import qualified Data.Binary                    as Binary import qualified Data.Binary.Put                as Binary+import           Data.ByteString                (ByteString)+import qualified Data.ByteString                as B+import qualified Data.ByteString.Lazy           as L+import           Data.Word                      (Word8) 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.Command import           Database.MySQL.Protocol.Packet+import           System.IO.Streams               (InputStream) import qualified Network.TLS                    as TLS import qualified System.IO.Streams.TCP          as TCP import qualified Data.Connection                as TCP@@ -63,13 +70,29 @@                     let auth = mkAuth db user pass charset greet                     write tc (encodeToPacket 2 auth)                     q <- readPacket tlsIs'-                    if isOK q-                    then do-                        consumed <- newIORef True-                        let conn = MySQLConn tlsIs' (write tc) (TCP.close tc) consumed-                        return (greet, conn)-                    else TCP.close c >> decodeFromPacket q >>= throwIO . ERRException+                    completeAuth tlsIs' (write tc) pass q tlsFullAuth+                    consumed <- newIORef True+                    let waitNotMandatoryOK = catch+                            (void (waitCommandReply tlsIs'))+                            ((\ _ -> return ()) :: SomeException -> IO ())+                        conn = MySQLConn tlsIs' (write tc)+                            (writeCommand COM_QUIT (write tc) >> waitNotMandatoryOK >> TCP.close tc)+                            consumed+                    return (greet, conn)             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++-- | Full auth handler for TLS connections: sends the cleartext password+-- as a NUL-terminated packet, which MySQL accepts over encrypted connections.+tlsFullAuth :: Word8 -> ByteString -> (Packet -> IO ()) -> InputStream Packet -> IO ()+tlsFullAuth seqN pass writePacket is = do+    let payload = pass `B.append` "\0"+        body = L.fromStrict payload+        pkt = Packet (fromIntegral (B.length payload)) seqN body+    writePacket pkt+    q <- readPacket is+    if isOK q+        then return ()+        else decodeFromPacket q >>= throwIO . ERRException

@@ -0,0 +1,59 @@+{-# LANGUAGE ScopedTypeVariables #-}++module CachingSha2 (tests) where++import Database.MySQL.Base+import qualified System.IO.Streams as Stream+import Test.Tasty+import Test.Tasty.HUnit++-- | These tests exercise two different authentication paths in 'completeAuth'.+-- Both tests connect and run @SELECT 1@, but the server-side auth protocol+-- differs based on which MySQL user is used. The users are created in+-- @nix/ci.nix@ (integrated-checks-mysql80) with different auth plugins:+--+-- * @testMySQLHaskellSha2@ — created with @caching_sha2_password@ (the MySQL 8.0+--   default). The client sends a SHA256 scramble, the server responds with+--   AuthMoreData (0x01, byte 2 = 0x03) indicating fast auth success.+--   The CI script pre-caches the verifier via a unix socket login so the+--   fast path is guaranteed.+--+-- * @testMySQLHaskellNative@ — created with @mysql_native_password@. The server+--   advertises @caching_sha2_password@ in its Greeting, so the client initially+--   sends a SHA256 scramble. The server then responds with AuthSwitchRequest+--   (0xFE) telling the client to re-authenticate using @mysql_native_password@+--   with a new salt. The client re-scrambles with SHA1 and sends the response.+tests :: TestTree+tests = testGroup "caching_sha2_password"+    [ testCaseSteps "SHA256 fast auth" $ \step -> do+        step "connecting as testMySQLHaskellSha2 (caching_sha2_password)..."+        (_, c) <- connectDetail defaultConnectInfo+            { ciUser = "testMySQLHaskellSha2"+            , ciPassword = "testPassword123"+            , 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 "AuthSwitchRequest handling (mysql_native_password on sha2 server)" $ \step -> do+        step "connecting as testMySQLHaskellNative (mysql_native_password)..."+        (_, c) <- connectDetail defaultConnectInfo+            { ciUser = "testMySQLHaskellNative"+            , ciPassword = "nativePass123"+            , 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+    ]

@@ -0,0 +1,30 @@+module Main (main) where++import qualified Data.ByteString as B+import           Database.MySQL.Base+import           Test.Tasty (defaultMain, testGroup)+import qualified CachingSha2+import qualified MysqlTests+import qualified RoundtripBit+import qualified RoundtripYear+import qualified SelectOne++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+    defaultMain $ testGroup "mysql-integration" $+        [ SelectOne.tests+        , RoundtripBit.tests+        , RoundtripYear.tests+        , MysqlTests.tests+        ]+        -- 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 ]

@@ -4,7 +4,7 @@ import qualified QC.Combinator as Combinator import Test.Tasty (defaultMain, testGroup) import qualified JSON-import qualified MysqlTests+import qualified Sha256Scramble import qualified Word24 import qualified TCPStreams @@ -17,15 +17,11 @@       , testGroup "combinator" Combinator.tests       , testGroup "JSON" jsonTests       ],-      testGroup "mysql" [-          -- TODO figure out how to run the tests that need a mysql-          -- db-          -- MysqlTests.tests-      ],       testGroup "word24"          Word24.tests       , testGroup "tcp-streams"          [            TCPStreams.tests          ]+      , Sha256Scramble.tests       ]

@@ -27,9 +27,11 @@     (greet, c) <- connectDetail defaultConnectInfo {ciUser = "testMySQLHaskell", ciDatabase = "testMySQLHaskell"}      let ver = greetingVersion greet-        isNew = "5.6" `B.isPrefixOf` ver-                || "5.7" `B.isPrefixOf` ver  -- from MySQL 5.6.4 and up-                                             -- TIME, DATETIME, and TIMESTAMP support fractional seconds+        isOld = "5.0" `B.isPrefixOf` ver+                || "5.1" `B.isPrefixOf` ver+                || "5.5" `B.isPrefixOf` ver+        isNew = not isOld  -- MySQL 5.6+ and MariaDB 10+ support fractional seconds+                           -- in TIME, DATETIME, and TIMESTAMP columns       execute_ c "DROP TABLE IF EXISTS test"@@ -118,23 +120,24 @@      close c -    (greet, c) <- connectDetail defaultConnectInfo {ciUser = "testMySQLHaskell", ciDatabase = "testMySQLHaskell"}-    execute_ c "SET PASSWORD = PASSWORD('123456abcdefg???')"+    step "testing password change"+    (_, c) <- connectDetail defaultConnectInfo {ciUser = "testMySQLHaskell", ciDatabase = "testMySQLHaskell"}+    -- ALTER USER works on both MariaDB and MySQL 8.0 (SET PASSWORD = PASSWORD('...') was removed in MySQL 8.0)+    execute_ c "ALTER USER 'testMySQLHaskell'@'localhost' IDENTIFIED BY '123456abcdefg???'"     close c -    let loginFailMsg = "ERRException (ERR {errCode = 1045, errState = \"28000\", \-            \errMsg = \"Access denied for user 'testMySQLHaskell'@'localhost' (using password: YES)\"})"--    (greet, c) <- connectDetail+    (_, c) <- connectDetail         defaultConnectInfo {ciUser = "testMySQLHaskell", ciDatabase = "testMySQLHaskell", ciPassword = "123456abcdefg???"}-    execute_ c "SET PASSWORD = PASSWORD('')"+    execute_ c "ALTER USER 'testMySQLHaskell'@'localhost' IDENTIFIED BY ''"     close c      catch         (void $ connectDetail                     defaultConnectInfo                         {ciUser = "testMySQLHaskell", ciDatabase = "testMySQLHaskell", ciPassword = "wrongPassWord"})-        (\ (e :: ERRException) -> assertEqual "wrong password should fail to login" (show e) loginFailMsg)+        (\ (e :: ERRException) -> do+            let ERRException err = e+            assertEqual "wrong password should fail with error 1045" 1045 (errCode err))    where     resetTestTable c = do

@@ -0,0 +1,46 @@+module RoundtripBit (tests) where++import Database.MySQL.Base+import qualified System.IO.Streams as Stream+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests = testCaseSteps "roundtrip MySQLBit" $ \step -> do+    (_, c) <- connectDetail defaultConnectInfo+        { ciUser = "testMySQLHaskell"+        , ciDatabase = "testMySQLHaskell"+        }++    execute_ c "CREATE TEMPORARY TABLE test_bit (__id INT, __val BIT(16))"+    execute_ c "INSERT INTO test_bit VALUES (1, NULL)"++    step "roundtrip MySQLBit via binary protocol"+    updStmt <- prepareStmt c "UPDATE test_bit SET __val = ? WHERE __id = 1"+    selStmt <- prepareStmt c "SELECT __val FROM test_bit WHERE __id = 1"++    let bitVal = 43744 -- 0b1010101011100000+    executeStmt c updStmt [MySQLBit bitVal]++    (_, is) <- queryStmt c selStmt []+    Just [v] <- Stream.read is+    Stream.skipToEof is+    assertEqual "MySQLBit roundtrips through BIT(16)" (MySQLBit bitVal) v++    step "roundtrip MySQLBit zero"+    executeStmt c updStmt [MySQLBit 0]++    (_, is2) <- queryStmt c selStmt []+    Just [v2] <- Stream.read is2+    Stream.skipToEof is2+    assertEqual "MySQLBit 0 roundtrips" (MySQLBit 0) v2++    step "roundtrip MySQLBit max for BIT(16)"+    executeStmt c updStmt [MySQLBit 65535]++    (_, is3) <- queryStmt c selStmt []+    Just [v3] <- Stream.read is3+    Stream.skipToEof is3+    assertEqual "MySQLBit 65535 roundtrips" (MySQLBit 65535) v3++    close c

@@ -0,0 +1,53 @@+module RoundtripYear (tests) where++import Database.MySQL.Base+import qualified System.IO.Streams as Stream+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests = testCaseSteps "roundtrip MySQLYear" $ \step -> do+    (_, c) <- connectDetail defaultConnectInfo+        { ciUser = "testMySQLHaskell"+        , ciDatabase = "testMySQLHaskell"+        }++    execute_ c "CREATE TEMPORARY TABLE test_year (__id INT, __val YEAR(4))"+    execute_ c "INSERT INTO test_year VALUES (1, NULL)"++    step "roundtrip MySQLYear via binary protocol"+    updStmt <- prepareStmt c "UPDATE test_year SET __val = ? WHERE __id = 1"+    selStmt <- prepareStmt c "SELECT __val FROM test_year WHERE __id = 1"++    executeStmt c updStmt [MySQLYear 1999]++    (_, is) <- queryStmt c selStmt []+    Just [v] <- Stream.read is+    Stream.skipToEof is+    assertEqual "MySQLYear 1999 roundtrips" (MySQLYear 1999) v++    step "roundtrip MySQLYear min (1901)"+    executeStmt c updStmt [MySQLYear 1901]++    (_, is2) <- queryStmt c selStmt []+    Just [v2] <- Stream.read is2+    Stream.skipToEof is2+    assertEqual "MySQLYear 1901 roundtrips" (MySQLYear 1901) v2++    step "roundtrip MySQLYear max (2155)"+    executeStmt c updStmt [MySQLYear 2155]++    (_, is3) <- queryStmt c selStmt []+    Just [v3] <- Stream.read is3+    Stream.skipToEof is3+    assertEqual "MySQLYear 2155 roundtrips" (MySQLYear 2155) v3++    step "roundtrip MySQLYear zero"+    executeStmt c updStmt [MySQLYear 0]++    (_, is4) <- queryStmt c selStmt []+    Just [v4] <- Stream.read is4+    Stream.skipToEof is4+    assertEqual "MySQLYear 0 roundtrips" (MySQLYear 0) v4++    close c

@@ -0,0 +1,25 @@+{-# LANGUAGE ScopedTypeVariables #-}++module SelectOne (tests) where++import Database.MySQL.Base+import qualified System.IO.Streams as Stream+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests = testCaseSteps "select 1" $ \step -> do+    step "connecting..."+    (_, c) <- connectDetail defaultConnectInfo+        { ciUser = "testMySQLHaskell"+        , ciDatabase = "testMySQLHaskell"+        }++    step "executing SELECT 1..."+    (_, is) <- query_ c "SELECT 1"+    Just row <- Stream.read is+    -- MySQL 8.0 returns MySQLInt64 for integer literals, older versions return MySQLInt32+    assertBool "SELECT 1 returns 1" (row == [MySQLInt32 1] || row == [MySQLInt64 1])+    Stream.skipToEof is++    close c

@@ -0,0 +1,34 @@+module Sha256Scramble (tests) where++import qualified Data.ByteString as B+import           Database.MySQL.Connection (scrambleSHA256)+import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "SHA256 Scramble"+    [ testCase "empty password returns empty" $ do+        let result = scrambleSHA256 "some_salt" ""+        assertEqual "empty password" B.empty result++    , testCase "non-empty password returns 32 bytes" $ do+        let result = scrambleSHA256 "12345678901234567890" "password"+        assertEqual "scramble length" 32 (B.length result)++    , testCase "different salts produce different scrambles" $ do+        let r1 = scrambleSHA256 "salt1_______________" "password"+            r2 = scrambleSHA256 "salt2_______________" "password"+        assertBool "different salts should produce different results" (r1 /= r2)++    , testCase "different passwords produce different scrambles" $ do+        let salt = "12345678901234567890"+            r1 = scrambleSHA256 salt "password1"+            r2 = scrambleSHA256 salt "password2"+        assertBool "different passwords should produce different results" (r1 /= r2)++    , testCase "scramble is deterministic" $ do+        let salt = "12345678901234567890"+            r1 = scrambleSHA256 salt "testPassword123"+            r2 = scrambleSHA256 salt "testPassword123"+        assertEqual "same inputs produce same output" r1 r2+    ]