Add caching_sha2_password authentication support (Issue #65)

MySQL 8.0+ defaults to caching_sha2_password instead of mysql_native_password.
This adds support for:
- SHA256 scramble for caching_sha2_password fast auth path
- AuthMoreData (0x01) handling for fast auth success / full auth request
- AuthSwitchRequest (0xFE) handling when server switches auth plugin
- TLS full auth (cleartext password over encrypted connection)
- CLIENT_PLUGIN_AUTH capability flag and plugin name in Auth packet

Plain TCP connections throw an informative AuthException when full auth
is required (RSA not yet implemented). Use TLS or ensure the password
verifier is cached (fast auth path).

Tested against both MariaDB 11.x and MySQL 8.0 in NixOS VM integration
tests.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>

Author: jappeace-sloth

mysql-haskell.cabal

@@ -128,6 +128,7 @@ test-suite test
     QC.Combinator
     QC.Common
     Orphans
+    Sha256Scramble
     TCPStreams
     Word24
 
@@ -168,6 +169,7 @@ test-suite integration
     BinaryRowNew
     BinLog
     BinLogNew
+    CachingSha2
     ExecuteMany
     MysqlTests
     RoundtripBit

nix/ci.nix

@@ -16,7 +16,7 @@ in
       server.succeed("mysql -u root -e \"CREATE USER 'testMySQLHaskell'@'localhost';\"")
       server.succeed("mysql -u root -e \"CREATE DATABASE testMySQLHaskell;\"")
       server.succeed("mysql -u root -e \"GRANT ALL ON testMySQLHaskell.* TO 'testMySQLHaskell'@'localhost';\"")
-      server.succeed("mysql -u root -e \"GRANT BINLOG MONITOR, REPLICATION SLAVE ON *.* TO 'testMySQLHaskell'@'localhost';\"")
+      server.succeed("mysql -u root -e \"GRANT BINLOG MONITOR, REPLICATION SLAVE, CREATE USER ON *.* TO 'testMySQLHaskell'@'localhost';\"")
       print(server.succeed("${package}/bin/integration/integration"))
     '';
     nodes.server = {
@@ -34,4 +34,48 @@ in
       };
     };
   };
+  integrated-checks-mysql80 = pkgs.testers.nixosTest {
+    name = "mysql-haskell-mysql80-test";
+    testScript = ''
+      server.start()
+      server.wait_for_unit("mysql.service")
+      server.wait_until_succeeds("mysql -u root -e 'SELECT 1'")
+
+      server.succeed("mysql -u root -e \"CREATE DATABASE testMySQLHaskell;\"")
+
+      # Main test user (mysql_native_password so existing tests including password change work over plain TCP)
+      server.succeed("mysql -u root -e \"CREATE USER 'testMySQLHaskell'@'localhost' IDENTIFIED WITH mysql_native_password;\"")
+      server.succeed("mysql -u root -e \"GRANT ALL ON testMySQLHaskell.* TO 'testMySQLHaskell'@'localhost';\"")
+      server.succeed("mysql -u root -e \"GRANT REPLICATION SLAVE, REPLICATION CLIENT, CREATE USER ON *.* TO 'testMySQLHaskell'@'localhost';\"")
+
+      # User with caching_sha2_password (MySQL 8.0 default) for SHA256 fast auth test
+      server.succeed("mysql -u root -e \"CREATE USER 'testMySQLHaskellSha2'@'localhost' IDENTIFIED BY 'testPassword123';\"")
+      server.succeed("mysql -u root -e \"GRANT ALL ON testMySQLHaskell.* TO 'testMySQLHaskellSha2'@'localhost';\"")
+
+      # User with mysql_native_password for AuthSwitchRequest test
+      server.succeed("mysql -u root -e \"CREATE USER 'testMySQLHaskellNative'@'localhost' IDENTIFIED WITH mysql_native_password BY 'nativePass123';\"")
+      server.succeed("mysql -u root -e \"GRANT ALL ON testMySQLHaskell.* TO 'testMySQLHaskellNative'@'localhost';\"")
+
+      # Pre-cache the caching_sha2_password verifier by logging in via unix socket
+      server.succeed("mysql -u testMySQLHaskellSha2 -ptestPassword123 -e 'SELECT 1'")
+
+      # Run the full integration test suite (sha2 tests are conditionally included for MySQL 8.0+)
+      print(server.succeed("${package}/bin/integration/integration"))
+    '';
+    nodes.server = {
+      virtualisation.memorySize = 2048;
+      virtualisation.diskSize = 1024;
+      services.mysql = {
+        enable = true;
+        package = pkgs.mysql80;
+        settings.mysqld = {
+          max_allowed_packet = "256M";
+          log_bin = "mysql-bin";
+          server_id = 1;
+          binlog_format = "ROW";
+          default_authentication_plugin = "caching_sha2_password";
+        };
+      };
+    };
+  };
 }

src/Database/MySQL/Connection.hs

@@ -14,7 +14,9 @@ This is an internal module, the 'MySQLConn' type should not directly acessed to
 
 -}
 
-module Database.MySQL.Connection where
+module Database.MySQL.Connection
+    ( module Database.MySQL.Connection
+    ) where
 
 import           Control.Exception               (Exception, bracketOnError,
                                                   throwIO, catch, SomeException)
@@ -124,37 +126,107 @@ connectDetail (ConnectInfo host port db user pass charset)
         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
 
 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)
-
-    sha1 :: ByteString -> ByteString
-    sha1 = BA.convert . (Crypto.hash :: ByteString -> Crypto.Digest Crypto.SHA1)
+        plugin = greetingAuthPlugin greet
+        scambleBuf = scrambleForPlugin plugin salt pass
+    in Auth clientCap clientMaxPacketSize charset user scambleBuf db plugin
+
+-- | 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)

src/Database/MySQL/Protocol/Auth.hs

@@ -122,6 +122,7 @@ data Auth = Auth
     , authName      :: !ByteString
     , authPassword  :: !ByteString
     , authSchema    :: !ByteString
+    , authPlugin    :: !ByteString
     } deriving (Show, Eq)
 
 getAuth :: Get Auth
@@ -131,10 +132,10 @@ getAuth = do
     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 @@ putAuth (Auth cap m c n p s) = do
     putByteString p
     putByteString s
     putWord8 0x00
+    putByteString plugin
+    putWord8 0x00
 
 instance Binary Auth where
     get = getAuth
@@ -182,6 +185,7 @@ clientCap =  CLIENT_LONG_PASSWORD
                 .|. CLIENT_MULTI_STATEMENTS
                 .|. CLIENT_MULTI_RESULTS
                 .|. CLIENT_SECURE_CONNECTION
+                .|. CLIENT_PLUGIN_AUTH
 
 clientMaxPacketSize :: Word32
 clientMaxPacketSize = 0x00ffffff :: Word32

src/Database/MySQL/Protocol/Packet.hs

@@ -71,6 +71,18 @@ isEOF :: Packet -> Bool
 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

src/Database/MySQL/TLS.hs

@@ -17,15 +17,22 @@ module Database.MySQL.TLS (
     , 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 @@ connectDetail (ConnectInfo host port db user pass charset) (cparams, subName) =
                     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

test/CachingSha2.hs

@@ -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
+    ]