packages feed

mysql-haskell 1.4.1 → 1.5.0

raw patch · 21 files changed

+1080/−131 lines, 21 filesdep +arraydep ~cryptondep ~filepathdep ~ramPVP ok

version bump matches the API change (PVP)

Dependencies added: array

Dependency ranges changed: crypton, filepath, ram

API changes (from Hackage documentation)

+ Database.MySQL.Base: resetConnection :: MySQLConn -> IO ()
+ Database.MySQL.BinLog: BinLogChecksum :: Word32 -> BinLogChecksum
+ Database.MySQL.BinLog: BinLogChecksumMismatch :: !BinLogEventType -> !ByteString -> !Word64 -> !BinLogChecksum -> !BinLogChecksum -> BinLogChecksumMismatch
+ Database.MySQL.BinLog: [mismatchActual] :: BinLogChecksumMismatch -> !BinLogChecksum
+ Database.MySQL.BinLog: [mismatchEventType] :: BinLogChecksumMismatch -> !BinLogEventType
+ Database.MySQL.BinLog: [mismatchExpected] :: BinLogChecksumMismatch -> !BinLogChecksum
+ Database.MySQL.BinLog: [mismatchFileName] :: BinLogChecksumMismatch -> !ByteString
+ Database.MySQL.BinLog: [mismatchLogPos] :: BinLogChecksumMismatch -> !Word64
+ Database.MySQL.BinLog: data BinLogChecksumMismatch
+ Database.MySQL.BinLog: decodeBinLogPacket :: Bool -> Bool -> ByteString -> Packet -> IO BinLogPacket
+ Database.MySQL.BinLog: instance GHC.Classes.Eq Database.MySQL.BinLog.BinLogChecksum
+ Database.MySQL.BinLog: instance GHC.Classes.Eq Database.MySQL.BinLog.BinLogChecksumMismatch
+ Database.MySQL.BinLog: instance GHC.Exception.Type.Exception Database.MySQL.BinLog.BinLogChecksumMismatch
+ Database.MySQL.BinLog: instance GHC.Show.Show Database.MySQL.BinLog.BinLogChecksum
+ Database.MySQL.BinLog: instance GHC.Show.Show Database.MySQL.BinLog.BinLogChecksumMismatch
+ Database.MySQL.BinLog: newtype BinLogChecksum
+ Database.MySQL.BinLogProtocol.CRC32: crc32 :: ByteString -> Word32
+ Database.MySQL.Connection: ed25519PublicKey :: ByteString -> Either CryptoError ByteString
+ Database.MySQL.Connection: resetConnection :: MySQLConn -> IO ()
+ Database.MySQL.Connection: scrambleEd25519 :: ByteString -> ByteString -> Either CryptoError ByteString

Files

ChangeLog.md view
@@ -1,5 +1,39 @@ # Revision history for mysql-haskell +## 1.5.0 -- 2026.11.11 ++Security fixes and new functions. A major version because two behaviours+change, described below; no existing export changes its type. A+text or bytes parameter of `query`, `execute` or `executeMany` can no longer+end its string literal under `NO_BACKSLASH_ESCAPES`; the binlog dump checks+every event's CRC32 checksum when `binlog_checksum` is `CRC32`, the default,+and raises `BinLogChecksumMismatch` on a corrupted event it used to decode as+intact; MariaDB accounts identified via ed25519 can log in; and+`makeClientParams'` sends its client certificate, so a `REQUIRE X509` account+can log in. The new `resetConnection` returns a connection's session to that of+a new one without reconnecting, so a pool can hand it to its next user (MySQL+5.7.3 or MariaDB 10.2.4 and newer).++Two behaviours change. A client certificate the server cannot verify now fails+the TLS handshake, where 1.4.1 never sent it. `escapeText` and `escapeBytes`+double a quote and leave control characters as they are, so their output is+only safe between single quotes; the server stores the same values as before+in the default mode, and under `NO_BACKSLASH_ESCAPES` a backslash in a+parameter is still stored twice. On a gbk, big5, sjis, cp932 or gb18030+connection text parameters remain unsafe; use prepared statements there.++* Reset a pooled connection's session without reconnecting+  [#109](https://github.com/winterland1989/mysql-haskell/pull/109)+* Parameters escaped safely under `NO_BACKSLASH_ESCAPES`+  [#110](https://github.com/winterland1989/mysql-haskell/pull/110)+* Binlog event checksums checked instead of skipped+  [#112](https://github.com/winterland1989/mysql-haskell/pull/112)+* MariaDB accounts identified via ed25519 can log in+  [#111](https://github.com/winterland1989/mysql-haskell/pull/111)+* `makeClientParams'` sends its client certificate, so an account created+  `REQUIRE X509` can log in through `Database.MySQL.TLS`+  [#108](https://github.com/winterland1989/mysql-haskell/pull/108)+ ## 1.4.1 -- 2026.11.11  Faster decoding. No type changes beyond one new exception, but one change of
mysql-haskell.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               mysql-haskell-version:            1.4.1+version:            1.5.0 synopsis:           pure haskell MySQL driver description:        pure haskell MySQL driver. license:            BSD-3-Clause@@ -18,6 +18,8 @@   README.md   test/cert/ca-key.pem   test/cert/ca.pem+  test/cert/client-cert.pem+  test/cert/client-key.pem   test/cert/server-cert.pem   test/cert/server-key.pem   test/cert/server-req.pem@@ -72,6 +74,7 @@     Database.MySQL.BinLogProtocol.BinLogEvent     Database.MySQL.BinLogProtocol.BinLogMeta     Database.MySQL.BinLogProtocol.BinLogValue+    Database.MySQL.BinLogProtocol.CRC32     Database.MySQL.Connection     Database.MySQL.Decoder     Database.MySQL.Field@@ -92,6 +95,8 @@   hs-source-dirs:     src   other-modules:      Database.MySQL.Query   build-depends:+    -- The CRC32 table of binlog event checksums.+    array >=0.5 && <0.6,     asn1-encoding >=0.9 && <0.10,     asn1-types >=0.3 && <0.4,     binary >=0.8.3 && <0.9,@@ -145,10 +150,12 @@   other-modules:     Aeson     AesonBP+    BinLogChecksum     BinLogEventCodes     BoundsCheck     DecoderRoundtrip     DirectDecoding+    Ed25519Scramble     FieldRoundtrip     FloatingPointText     HandshakeGolden@@ -162,6 +169,7 @@     ResultCharsets     Sha1Scramble     Sha256Scramble+    StringLiterals     TCPStreams     TextRowDecoding     TypedValue@@ -174,6 +182,7 @@     base16-bytestring >=1.0 && <2.0,     binary >=0.8,     bytestring >=0.10,+    crypton,     deepseq,     directory < 2.0,     filepath < 2.0,@@ -182,6 +191,7 @@     network,     QuickCheck >=2.7 && <3.0,     quickcheck-instances < 1.0,+    ram,     scientific >=0.3.0,     tasty >=0.11 && <2.0,     tasty-expected-failure < 1.0,@@ -218,15 +228,18 @@     MultipleResults     MysqlTests     NonUtf8Results+    ParameterEscaping     PlaceholderLiterals     QueryApi     QueryWithoutResultSet+    ResetConnection     RoundtripBit     RowDecoderQueries     RoundtripYear     SelectOne     TestUser     TextRow+    TLSClientCertificate     TLSConnection     TextRowNew     TypedValue@@ -239,6 +252,7 @@     base,     bytestring >=0.10,     directory,+    filepath,     io-streams,     mysql-haskell,     scientific,@@ -260,6 +274,7 @@   main-is:            IntegrationMariaDB.hs   other-modules:     MariaDBBulk+    MariaDBEd25519     MariaDBExtendedMetadata     QueryApi     TypedValue
src/Data/TLSSetting.hs view
@@ -81,8 +81,10 @@  -- | make a simple tls 'TLS.ClientParams' that will validate server and use tls connection -- while providing client's own certificate as well. suitable for connecting server which--- validate clients.+-- validate clients, such as a MySQL account created with @REQUIRE X509@. --+-- The certificate is sent to every server that asks for one.+-- -- Also only accept v3 certificate. -- makeClientParams' :: FilePath       -- ^ public certificate (X.509 format).@@ -96,14 +98,23 @@     p <- makeClientParams tca     c <- TLS.credentialLoadX509Chain pub certs priv     case c of-        Right c' ->+        Right credential ->             return p-                {   TLS.clientShared = (TLS.clientShared p)-                    {-                        TLS.sharedCredentials = TLS.Credentials [c']+                {   TLS.clientHooks = (TLS.clientHooks p)+                    {   TLS.onCertificateRequest = answerCertificateRequest credential                     }                 }         Left err -> error err++-- | Answers every certificate request with the client's credential.+--+-- Decision: send it whatever certificate types and issuers the server lists,+-- rather than send none on a mismatch, so a credential the server cannot+-- accept fails the handshake instead of failing the login as a vaguer access+-- denied. A client must answer through this hook: tls reads+-- 'TLS.sharedCredentials' on servers only.+answerCertificateRequest :: TLS.Credential -> request -> IO (Maybe TLS.Credential)+answerCertificateRequest credential _request = pure (Just credential)  -- | make a simple tls 'TLS.ServerParams' without validating client's certificate. --
src/Database/MySQL/Base.hs view
@@ -40,6 +40,7 @@     , connectUnixSocketDetail     , close     , ping+    , resetConnection       -- * Direct query     , execute     , executeMany@@ -125,8 +126,11 @@ -- | Execute a MySQL query with parameters which don't return a result-set. -- -- The query may contain placeholders @?@, for filling up parameters, the parameters--- will be escaped before get filled into the query, please DO NOT enable @NO_BACKSLASH_ESCAPES@,--- and you should consider using prepared statement if this's not an one shot query.+-- will be escaped before get filled into the query. Under @NO_BACKSLASH_ESCAPES@+-- a backslash in a parameter is stored twice, and on a gbk, big5, sjis, cp932 or+-- gb18030 connection the escaping is not safe at all, see+-- "Database.MySQL.Protocol.Escape". You should consider using prepared statement+-- if this's not an one shot query, and must on those character sets. -- execute :: QueryParam p => MySQLConn -> Query -> [p] -> IO OK execute conn qry params = execute_ conn (renderParams qry params)
src/Database/MySQL/BinLog.hs view
@@ -19,6 +19,9 @@     , RowBinLogEvent(..)     , decodeRowBinLogEvent     , RowEventDecodeException(..)+    , decodeBinLogPacket+    , BinLogChecksumMismatch(..)+    , BinLogChecksum(..)     -- * helpers     , getLastBinLogTracker     , isCheckSumEnabled@@ -34,20 +37,25 @@ import           Control.Monad import           Data.Binary.Put import           Data.ByteString                           (ByteString)+import qualified Data.ByteString.Char8                     as B8+import qualified Data.ByteString.Lazy                      as L import           Data.IORef                                (IORef, newIORef,                                                             readIORef,                                                             writeIORef)-import           Data.Bits                                 ((.&.))+import           Data.Bits                                 (shiftL, (.&.), (.|.)) import           Data.Text.Encoding                        (encodeUtf8) import           Data.Word import           Database.MySQL.Base import           Database.MySQL.BinLogProtocol.BinLogEvent import           Database.MySQL.BinLogProtocol.BinLogMeta import           Database.MySQL.BinLogProtocol.BinLogValue+import           Database.MySQL.BinLogProtocol.CRC32       (crc32) import           Database.MySQL.Connection import           GHC.Generics                              (Generic)+import           Numeric                                   (showHex) import           System.IO.Streams                         (InputStream) import qualified System.IO.Streams                         as Stream+import qualified Unwitch.Convert.Word8                     as Word8  type SlaveID = Word32 @@ -84,16 +92,17 @@     writeCommand (COM_BINLOG_DUMP initpos 0x00 sid initfn) wp     writeIORef state RowsUnread -    rp <- skipToPacketT (readBinLogPacket checksum needAck is) BINLOG_ROTATE_EVENT+    fref <- newIORef initfn+    rp <- skipToPacketT (readBinLogPacket checksum needAck fref is) BINLOG_ROTATE_EVENT     re <- getFromBinLogPacket getRotateEvent rp-    fref <- newIORef (rFileName re)+    writeIORef fref (rFileName re) -    p <- skipToPacketT (readBinLogPacket checksum needAck is) BINLOG_FORMAT_DESCRIPTION_EVENT+    p <- skipToPacketT (readBinLogPacket checksum needAck fref is) BINLOG_FORMAT_DESCRIPTION_EVENT     replyAck needAck p fref wp     fmt <- getFromBinLogPacket getFormatDescription p      es <- Stream.makeInputStream $ do-        q <- readBinLogPacket checksum needAck is+        q <- readBinLogPacket checksum needAck fref is         case q of             Nothing   -> writeIORef state RepliesRead >> return Nothing             Just q' -> do when (blEventType q' == BINLOG_ROTATE_EVENT) $ do@@ -119,12 +128,140 @@         putWord64le pos         putByteString fn -    readBinLogPacket checksum needAck is' = do+    readBinLogPacket checksum needAck fref' is' = do         p <- readPacket is'-        if  | isOK p -> Just <$> getFromPacket (getBinLogPacket checksum needAck) p+        if  | isOK p -> do+                fileName <- readIORef fref'+                Just <$> decodeBinLogPacket checksum needAck fileName p             | isEOF p -> return Nothing             | isERR p -> decodeFromPacket p >>= throwIO . ERRException             | otherwise -> error ("unkown package" <> show p)++-- | Decode a packet of a binlog dump as 'getBinLogPacket' does with the same+-- two flags, and check the CRC32 checksum of the event in it when the event+-- carries one. 'dumpBinLog' reads every packet this way.+--+-- Throws 'BinLogChecksumMismatch' when the checksum does not match the+-- event's bytes, rather than decode a corrupted event, and+-- 'DecodePacketException' when the packet holds no binlog event. See+-- Note [Binlog event checksums] for which events carry a checksum.+--+-- @since 1.5.0+decodeBinLogPacket :: Bool        -- ^ whether the dump's events carry checksums, as 'isCheckSumEnabled' says+                   -> Bool        -- ^ whether the packet has a semi-sync header+                   -> ByteString  -- ^ the binlog file the dump is reading, for the exception+                   -> Packet+                   -> IO BinLogPacket+decodeBinLogPacket checksum semiAck fileName packet = do+    event <- getFromPacket (getBinLogPacket checksum semiAck) packet+    let eventType = blEventType event+        eventBytes = L.drop (if semiAck then 3 else 1) (pBody packet)+        expected = carriedChecksum eventBytes+        actual = computedChecksum eventType eventBytes+    when (carriesChecksum checksum eventType eventBytes && expected /= actual) $+        throwIO (BinLogChecksumMismatch eventType fileName (blLogPos event) expected actual)+    pure event++-- Decision: an event other than a format description event carries a checksum+-- when the dump's setting says so, the setting 'getBinLogPacket' strips four+-- bytes by. A replica follows the algorithm the last format description event+-- names instead, which differs for a binlog file written while binlog_checksum+-- was NONE; such a file now fails its checks, where it used to lose the last+-- four bytes of each event without a word.++-- | See Note [Binlog event checksums].+carriesChecksum :: Bool -> BinLogEventType -> L.ByteString -> Bool+carriesChecksum checksum eventType eventBytes =+    if eventType == BINLOG_FORMAT_DESCRIPTION_EVENT+        then L.indexMaybe eventBytes (L.length eventBytes - 5) == Just checksumAlgorithmCRC32+        else checksum++-- | @BINLOG_CHECKSUM_ALG_CRC32@, as a format description event names it.+checksumAlgorithmCRC32 :: Word8+checksumAlgorithmCRC32 = 1++-- | The checksum in an event's last four bytes.+carriedChecksum :: L.ByteString -> BinLogChecksum+carriedChecksum eventBytes =+    BinLogChecksum (L.foldr prependByte 0 (L.drop (L.length eventBytes - 4) eventBytes))++prependByte :: Word8 -> Word32 -> Word32+prependByte byte rest = Word8.toWord32 byte .|. (rest `shiftL` 8)++-- | The CRC32 of an event's bytes before its checksum. See+-- Note [Binlog event checksums].+computedChecksum :: BinLogEventType -> L.ByteString -> BinLogChecksum+computedChecksum eventType eventBytes =+    let checked = L.take (L.length eventBytes - 4) eventBytes+    in BinLogChecksum+        (crc32 (if eventType == BINLOG_FORMAT_DESCRIPTION_EVENT then clearInUseFlag checked else checked))++-- | Clear @LOG_EVENT_BINLOG_IN_USE_F@ (0x01) in the low byte of an event's+-- flags, which is its 18th byte.+clearInUseFlag :: L.ByteString -> L.ByteString+clearInUseFlag bytes =+    L.take 17 bytes <> L.map (.&. 0xFE) (L.take 1 (L.drop 17 bytes)) <> L.drop 18 bytes++-- | A binlog event whose CRC32 checksum does not match its bytes, as when it+-- was corrupted between the server's binlog and this client.+--+-- @since 1.5.0+data BinLogChecksumMismatch = BinLogChecksumMismatch+    { mismatchEventType :: !BinLogEventType+    , mismatchFileName  :: !ByteString+      -- ^ The binlog file the dump was reading when the event arrived.+    , mismatchLogPos    :: !Word64+      -- ^ The position after the event that its header gives, as 'blLogPos';+      -- 0 for an event the server makes up for the dump, such as its first+      -- rotate event.+    , mismatchExpected  :: !BinLogChecksum+      -- ^ The checksum the event carries.+    , mismatchActual    :: !BinLogChecksum+      -- ^ The CRC32 of the event's bytes.+    } deriving (Show, Eq)++-- | The CRC32 checksum of a binlog event.+--+-- @since 1.5.0+newtype BinLogChecksum = BinLogChecksum Word32+    deriving (Show, Eq)++instance Exception BinLogChecksumMismatch where+    displayException mismatch =+        "mysql-haskell: the binlog event of type "+        ++ show (binLogEventTypeCode (mismatchEventType mismatch))+        ++ " (" ++ show (mismatchEventType mismatch) ++ ") ending at position "+        ++ show (mismatchLogPos mismatch) ++ " of " ++ B8.unpack (mismatchFileName mismatch)+        ++ " fails its CRC32 checksum: it carries " ++ showChecksum (mismatchExpected mismatch)+        ++ ", its bytes give " ++ showChecksum (mismatchActual mismatch)+        ++ ". The event was corrupted on its way from the server's binlog, so it is not"+        ++ " decoded. If the binlog file was written while binlog_checksum was NONE, its"+        ++ " events have no checksum, and a dump from a server whose binlog_checksum is"+        ++ " now CRC32 cannot read that file."++showChecksum :: BinLogChecksum -> String+showChecksum (BinLogChecksum checksum) =+    let digits = showHex checksum ""+    in "0x" ++ replicate (8 - length digits) '0' ++ digits++{- Note [Binlog event checksums]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+With binlog_checksum = CRC32, MySQL (5.6.1 and up) and MariaDB end each event+with the CRC32 of the event's bytes before it, header and body alike. A+replica checks it over the event as the packet delivers it, not over the+length the event's header gives (MySQL's Log_event_footer::event_checksum_test+on read_event's packet length, MariaDB's event_checksum_test in+sql/rpl_utility.cc), and so does 'decodeBinLogPacket'.++The format description event differs twice. Its checksum is computed with+LOG_EVENT_BINLOG_IN_USE_F cleared, since the server clears that flag in place+when it closes the binlog file, so a check clears it as well. And the byte+before its checksum names the algorithm of the events after it, yet the event+always ends in four checksum bytes; when that byte says off (0), the server+does not recompute them after rewriting the event's position for a dump. A+replica therefore checks a format description event only when its own byte+says CRC32 (1), whatever the dump's setting.+-}  -- | Row based binlog event type. --
+ src/Database/MySQL/BinLogProtocol/CRC32.hs view
@@ -0,0 +1,53 @@+{-|+Module      : Database.MySQL.BinLogProtocol.CRC32+Description : The checksum of binlog events+License     : BSD+Maintainer  : hi@jappie.me+Stability   : experimental+Portability : PORTABLE++The CRC32 that MySQL and MariaDB end each binlog event with when+@binlog_checksum@ is @CRC32@.+-}++module Database.MySQL.BinLogProtocol.CRC32+    ( crc32+    ) where++import           Data.Array.Unboxed    (UArray, listArray, (!))+import           Data.Bits             (complement, shiftR, xor, (.&.))+import qualified Data.ByteString.Lazy  as L+import           Data.Word             (Word32, Word8)+import qualified Unwitch.Convert.Word8 as Word8++-- Decision: our own CRC32, as no dependency has one: crypton and ram offer+-- cryptographic and FNV/SipHash digests only, and zlib, whose Haskell binding+-- exports no crc32 anyway, is not a dependency. The digest package would add+-- a C library for these few lines.++-- | The CRC-32 of IEEE 802.3 and zlib (reflected polynomial 0xEDB88320,+-- initial and final XOR 0xFFFFFFFF): @crc32 "123456789" == 0xCBF43926@.+--+-- @since 1.5.0+crc32 :: L.ByteString -> Word32+crc32 bytes = complement (L.foldl' crc32Step 0xFFFFFFFF bytes)++crc32Step :: Word32 -> Word8 -> Word32+crc32Step crc byte =+    (crc32Table ! ((crc `xor` Word8.toWord32 byte) .&. 0xFF)) `xor` (crc `shiftR` 8)++-- Decision: a UArray indexed by Word32, so a lookup takes the masked CRC as+-- it is. A Vector needs an Int index, and unwitch converts Word32 to Int only+-- as a Maybe, whose Nothing could not happen here but would need handling.++-- | The CRC of each byte value, so that a byte costs one lookup instead of+-- eight shifts.+crc32Table :: UArray Word32 Word32+crc32Table = listArray (0, 255) (map crc32OfByte [0 .. 255])++crc32OfByte :: Word32 -> Word32+crc32OfByte byte = iterate reflectedShift byte !! 8++reflectedShift :: Word32 -> Word32+reflectedShift crc =+    if crc .&. 1 /= 0 then 0xEDB88320 `xor` (crc `shiftR` 1) else crc `shiftR` 1
src/Database/MySQL/Connection.hs view
@@ -37,6 +37,8 @@     , scrambleForPlugin     , scrambleSHA1     , scrambleSHA256+    , scrambleEd25519+    , ed25519PublicKey     , completeAuth     , plainFullAuth     , parseRSAPublicKey@@ -47,6 +49,7 @@     , decodeInputStream     , close     , ping+    , resetConnection     , command     , waitCommandReply     , waitCommandReplys@@ -72,6 +75,8 @@                                                   bracketOnError, fromException,                                                   mask, throwIO, catch, SomeException) import           Control.Monad+import qualified Crypto.ECC.Edwards25519         as Ed+import           Crypto.Error                    (CryptoError, CryptoFailable, eitherCryptoError) import qualified Crypto.Hash                     as Crypto import           Crypto.Hash.Algorithms          (SHA1(..)) import qualified Crypto.Number.Serialize         as Serialize@@ -324,6 +329,70 @@     | plugin == "caching_sha2_password" = scrambleSHA256 salt pass     | otherwise                         = scrambleSHA1 salt pass +-- | The reply to the salt of an AuthSwitchRequest for this plugin.+--+-- Decision: client_ed25519 is dispatched here rather than in+-- 'scrambleForPlugin', whose exported type has no room for the signer's+-- failure. Nothing is lost: MariaDB always greets with mysql_native_password+-- and asks for client_ed25519 only through an AuthSwitchRequest.+switchScramble :: ByteString -> ByteString -> ByteString -> Either CryptoError ByteString+switchScramble plugin salt pass = if+    | plugin == ed25519Plugin -> scrambleEd25519 salt pass+    | otherwise               -> Right (scrambleForPlugin plugin salt pass)++-- | The client plugin a MariaDB account @IDENTIFIED VIA ed25519@ switches to.+ed25519Plugin :: ByteString+ed25519Plugin = "client_ed25519"++-- | The nonce MariaDB's ed25519 plugin sends; libmariadb refuses any other+-- length.+ed25519NonceLength :: Int+ed25519NonceLength = 32++-- | The @client_ed25519@ reply to a nonce: an Ed25519 signature of the nonce,+-- valid for the key 'ed25519PublicKey' derives from the password. An empty+-- password is signed like any other, as libmariadb does. The 'Left' cannot+-- occur: crypton decodes a scalar from up to 64 bytes, and every scalar here+-- comes from a SHA-512 digest.+--+-- @since 1.5.0+scrambleEd25519 :: ByteString -> ByteString -> Either CryptoError ByteString+scrambleEd25519 nonce pass = eitherCryptoError $ do+    let digest = sha512 pass+    secret <- secretScalar digest+    ephemeral <- Ed.scalarDecodeLong (sha512 (B.drop 32 digest <> nonce))+    let commitment = Ed.pointEncode (Ed.toPoint ephemeral) :: ByteString+    challenge <- Ed.scalarDecodeLong (sha512 (B.concat [commitment, publicKey secret, nonce]))+    pure (commitment <> Ed.scalarEncode (Ed.scalarAdd ephemeral (Ed.scalarMul challenge secret)))++-- | The 32-byte public key MariaDB stores for an ed25519 account with this+-- password; @ed25519_password@ and @mysql.global_priv@ show it base64 encoded+-- without the padding. The 'Left' does not occur, as for 'scrambleEd25519'.+--+-- @since 1.5.0+ed25519PublicKey :: ByteString -> Either CryptoError ByteString+ed25519PublicKey pass = eitherCryptoError (publicKey <$> secretScalar (sha512 pass))++-- | The secret scalar of a password's SHA-512 digest. MariaDB's plugin+-- departs from Ed25519 only here: Ed25519 hashes a 32-byte seed, MariaDB the+-- whole password.+secretScalar :: ByteString -> CryptoFailable Ed.Scalar+secretScalar digest = Ed.scalarDecodeLong (B.pack (zipWith clampByte [0 ..] (B.unpack (B.take 32 digest))))++-- | Ed25519's clamping of the secret scalar's bytes, as MariaDB's ref10+-- @crypto_sign_keypair@ does it.+clampByte :: Int -> Word8 -> Word8+clampByte index byte = if+    | index == 0  -> byte .&. 248+    | index == 31 -> (byte .&. 63) .|. 64+    | otherwise   -> byte++publicKey :: Ed.Scalar -> ByteString+publicKey = Ed.pointEncode . Ed.toPoint++sha512 :: ByteString -> ByteString+sha512 = BA.convert . (Crypto.hash :: ByteString -> Crypto.Digest Crypto.SHA512)+ -- | SHA1-based scramble for @mysql_native_password@. scrambleSHA1 :: ByteString -> ByteString -> ByteString scrambleSHA1 salt pass@@ -376,20 +445,29 @@         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+            newSalt' = switchSalt newPlugin (B.drop 1 rest')             seqN = pSeqN p + 1-            responseBody = L.fromStrict scrambled+        when (newPlugin == ed25519Plugin && B.length newSalt' /= ed25519NonceLength)+            (throwIO (UnexpectedPacket p))+        scrambled <- either (throwIO . AuthException . ("signing the client_ed25519 nonce failed: " ++) . show)+            pure (switchScramble newPlugin newSalt' pass)+        let 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) +-- | The salt in the plugin data of an AuthSwitchRequest. The native and+-- SHA-256 scrambles may end in a NUL that is no part of the salt, but+-- MariaDB's ed25519 nonce is random bytes, so a last byte of 0 belongs to it.+switchSalt :: ByteString -> ByteString -> ByteString+switchSalt plugin pluginData = if+    | plugin == ed25519Plugin -> pluginData+    | otherwise -> case B.unsnoc pluginData of+        Just (salt, lastByte) -> if lastByte == 0 then salt else pluginData+        Nothing               -> pluginData+ -- | Full auth handler for plain TCP connections using RSA encryption. -- -- The nonce is captured via partial application at the call site:@@ -500,6 +578,47 @@ ping :: MySQLConn -> IO OK ping = flip command COM_PING +-- | Give the connection's session the state of a new one without reconnecting+-- or authenticating again, so a pool can hand the connection to its next user.+-- It sends COM_RESET_CONNECTION, which needs MySQL 5.7.3 or MariaDB 10.2.4; an+-- older server's refusal raises 'ERRException'.+--+-- The session stays the same one (@CONNECTION_ID()@ and the user do not+-- change), and the server+--+--   * rolls back an open transaction, and releases @LOCK TABLES@ locks and+--     @GET_LOCK@ locks;+--   * drops the session's temporary tables;+--   * sets every user variable to @NULL@;+--   * deallocates every prepared statement, so executing one of their+--     'StmtID's afterwards raises 'ERRException' with code 1243+--     (@ER_UNKNOWN_STMT_HANDLER@), while 'closeStmt' on one is harmless;+--   * sets the session variables, such as @sql_mode@, @time_zone@,+--     @autocommit@ and the transaction isolation level, to their global+--     values, and @LAST_INSERT_ID()@ to 0.+--+-- The current database stays, also one chosen with @USE@ after connecting.+--+-- Two things differ from a new connection, measured on MySQL 8.0.45 and+-- MariaDB 11.4.9. The session's @sql_mode@ loses the @IGNORE_SPACE@ that the+-- handshake adds, so a query with a space after a function name, as in+-- @COUNT (*)@, becomes a syntax error. And MariaDB returns to the character set+-- and collation of 'ciCharset', where MySQL takes the server's global+-- @character_set_client@ and @collation_connection@ (on 8.0 @utf8mb4@ with+-- @utf8mb4_0900_ai_ci@, whichever 'ciCharset' the connection was made with);+-- send @SET NAMES@ after the reset to keep 'ciCharset' on MySQL.+--+-- Like other commands it refuses with 'UnconsumedResultSet' while a result+-- set's rows are unread, and with 'AbandonedReply' after an interrupted reply,+-- whose unread rest would be taken for the reset's reply: such a connection+-- has to be closed, not reset.+--+-- @since 1.5.0+resetConnection :: MySQLConn -> IO ()+resetConnection conn@(MySQLConn is os _ _) = runCommand conn $ do+    writeResetConnection os+    void (waitCommandReply is)+ -------------------------------------------------------------------------------- -- helpers @@ -549,6 +668,12 @@ writeCommand :: Command -> (Packet -> IO ()) -> IO () writeCommand a = writePayload (Binary.runPut (putCommand a)) {-# INLINE writeCommand #-}++-- Decision: COM_RESET_CONNECTION (0x1F) is written here instead of as a+-- 'Command' constructor, because 'Command' is exported and a new constructor+-- would break exhaustive matches on it in code using this library.+writeResetConnection :: (Packet -> IO ()) -> IO ()+writeResetConnection = writePayload (Binary.runPut (Binary.putWord8 0x1F))  -- | Send one command's payload, split into packets as the protocol requires -- for payloads of 16 MiB and more.
src/Database/MySQL/Protocol/Escape.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}  {-| Module      : Database.MySQL.Protocol.Escape@@ -10,30 +9,29 @@ Stability   : experimental Portability : PORTABLE -This module provide escape machinery for bytes and text types.+Escaping for the body of a single-quoted string literal, the form+'Database.MySQL.Protocol.MySQLValue.putTextField' renders text and bytes in.+The result is only safe between single quotes: a double quote is not escaped. -reference: <http://dev.mysql.com/doc/refman/5.7/en/string-literals.html>+A quote is doubled and a backslash escaped with a backslash; every other+character is kept as it is. Under @NO_BACKSLASH_ESCAPES@ the literal reads the+same, except that each backslash is stored twice. -    * Escape Sequence	Character Represented by Sequence-    * \0              	An ASCII NUL (X'00') character-    * \'              	A single quote (“'”) character-    * \"              	A double quote (“"”) character-    * \b              	A backspace character-    * \n              	A newline (linefeed) character-    * \r              	A carriage return character-    * \t              	A tab character-    * \Z              	ASCII 26 (Control+Z); see note following the table-    * \\              	A backslash (“\”) character-    * \%              	A “%” character; see note following the table-    * \_              	A “_” character; see note following the table+Not safe on a connection whose character set lets a multibyte character end+in the backslash byte, 0x5C: gbk, big5, sjis, cp932 and gb18030. There the+escaping backslash can become the second byte of a character, and the+backslash in the data then escapes a quote, so a parameter can end its+literal, with @SET NAMES gbk@ on MySQL 8.0.45 and MariaDB 11.4.9 alike. UTF-8,+the default, and latin1 never put 0x5C inside a character. On those other+character sets, use prepared statements, which send parameters separately. -The @\%@ and @\_@ sequences are used to search for literal instances of @%@ and @_@ in pattern-matching contexts where they would otherwise be interpreted as wildcard characters, so we won't auto escape @%@ or @_@ here.+reference: <https://dev.mysql.com/doc/refman/8.0/en/string-literals.html>  -} -module Database.MySQL.Protocol.Escape where+module Database.MySQL.Protocol.Escape (escapeText, escapeBytes) where -import           Control.Monad            (forM_)+import           Control.Monad.ST         (ST) import           Data.ByteString          (ByteString) import qualified Data.ByteString.Internal as B import           Data.Text                (Text)@@ -45,102 +43,75 @@ import           Foreign.Storable         (peek, poke, pokeByteOff) import           GHC.IO                   (unsafeDupablePerformIO) -escapeText :: Text -> Text-#if MIN_VERSION_text(2,0,0)-escapeText (T.Text arr off len)-    | len <= 0  = T.empty-    | otherwise =-        let (arr', len') =  TA.run2 $ do-                marr <- TA.new (len * 2)-                loop arr (off + len) marr off 0-        in T.Text arr' 0 len'-  where-    escape c marr ix = do-        TA.unsafeWrite marr ix 92-        TA.unsafeWrite marr (ix+1) c--    loop oarr oend marr !ix !ix'-        | ix == oend = return (marr, ix')-        | otherwise  = do-            let c = TA.unsafeIndex oarr ix-                cs = c : [ TA.unsafeIndex oarr (ix+1) | c >= 0xC0 ]-                      ++ [ TA.unsafeIndex oarr (ix+2) | c >= 0xE0 ]-                      ++ [ TA.unsafeIndex oarr (ix+3) | c >= 0xF0 ]-                go2 = loop oarr oend marr (ix+1) (ix'+2)-                goN = do-                  forM_ (zip [0..4] cs) $ \(di,c') -> TA.unsafeWrite marr (ix' + di) c'-                  loop oarr oend marr (ix + length cs) (ix' + length cs)-            if  | c == 0-                    || c == 39-                    || c == 34 -> escape c   marr ix' >> go2 -- \0 \' \"-                | c == 8       -> escape 98  marr ix' >> go2 -- \b-                | c == 10      -> escape 110 marr ix' >> go2 -- \n-                | c == 13      -> escape 114 marr ix' >> go2 -- \r-                | c == 9       -> escape 116 marr ix' >> go2 -- \t-                | c == 26      -> escape 90  marr ix' >> go2 -- \Z-                | c == 92      -> escape 92  marr ix' >> go2 -- \\+-- Decision: escape only the quote, by doubling it, and the backslash, with a+-- backslash: the MySQL manual says only these two must be escaped in a+-- single-quoted literal. Escaping the quote as @\'@ ended the literal under+-- @NO_BACKSLASH_ESCAPES@, and the other escapes mysql_real_escape_string+-- writes (@\0 \n \r \Z \"@) only make logs readable while storing a+-- stray backslash in that mode. test/ParameterEscaping.hs round-trips every+-- byte 0x00 to 0xFF raw on MariaDB and MySQL. See Note [Backslashes without+-- backslash escapes]. -                | otherwise    -> goN-#else-escapeText (T.Text arr off len)-    | len <= 0  = T.empty-    | otherwise =-        let (arr', len') =  TA.run2 $ do-                marr <- TA.new (len * 2)-                loop arr (off + len) marr off 0-        in T.Text arr' 0 len'-  where-    escape c marr ix = do-        TA.unsafeWrite marr ix 92-        TA.unsafeWrite marr (ix+1) c+-- Note [Backslashes without backslash escapes]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- Under @NO_BACKSLASH_ESCAPES@ a backslash is an ordinary character, so+-- @C:\@, rendered as @'C:\\'@, is stored as @C:\\@. Leaving the backslash+-- unescaped is no way out: in the default mode @'C:\'@ escapes its own+-- closing quote. Rendering for the session's mode needs the+-- SERVER_STATUS_NO_BACKSLASH_ESCAPES flag of the server's OK packets, kept+-- per connection. 'Database.MySQL.Connection.MySQLConn' and its+-- 'Database.MySQL.Connection.ReplyState' are exported with their+-- constructors, so a place for that flag changes the API: that waits for a+-- major release. -    loop oarr oend marr !ix !ix'-        | ix == oend = return (marr, ix')-        | otherwise  = do-            let c = TA.unsafeIndex oarr ix-                go1 = loop oarr oend marr (ix+1) (ix'+1)-                go2 = loop oarr oend marr (ix+1) (ix'+2)-            if  | c >= 0xD800 && c <= 0xDBFF  -> do let c2 = TA.unsafeIndex oarr (ix+1)-                                                    TA.unsafeWrite marr ix' c-                                                    TA.unsafeWrite marr (ix'+1) c2-                                                    loop oarr oend marr (ix+2) (ix'+2)-                | c == 0-                    || c == 39-                    || c == 34 -> escape c   marr ix' >> go2 -- \0 \' \"-                | c == 8       -> escape 98  marr ix' >> go2 -- \b-                | c == 10      -> escape 110 marr ix' >> go2 -- \n-                | c == 13      -> escape 114 marr ix' >> go2 -- \r-                | c == 9       -> escape 116 marr ix' >> go2 -- \t-                | c == 26      -> escape 90  marr ix' >> go2 -- \Z-                | c == 92      -> escape 92  marr ix' >> go2 -- \\+-- | Escape text for a single-quoted literal, see the module header.+escapeText :: Text -> Text+escapeText (T.Text array offset len) = if len <= 0+    then T.empty+    else+        let (escaped, escapedLength) = TA.run2 $ do+                target <- TA.new (len * 2)+                escapeUnits array (offset + len) target offset 0+        in T.Text escaped 0 escapedLength -                | otherwise    -> TA.unsafeWrite marr ix' c >> go1-#endif+-- | Copies the code units from @source@ to @sourceEnd@ into @target@, from+-- @targetIndex@ on, doubling quotes and backslashes; it returns @target@ and+-- the index after the last unit written. A unit is a byte of UTF-8 (text 2)+-- or a 16-bit unit of UTF-16 (text 1); neither encoding puts a quote or a+-- backslash inside a longer character, so units can be copied one by one.+escapeUnits :: TA.Array -> Int -> TA.MArray s -> Int -> Int -> ST s (TA.MArray s, Int)+escapeUnits array sourceEnd target !source !targetIndex = if source == sourceEnd+    then return (target, targetIndex)+    else do+        let unit = TA.unsafeIndex array source+        TA.unsafeWrite target targetIndex unit+        if unit == quote || unit == backslash+            then do+                TA.unsafeWrite target (targetIndex + 1) unit+                escapeUnits array sourceEnd target (source + 1) (targetIndex + 2)+            else escapeUnits array sourceEnd target (source + 1) (targetIndex + 1) +-- | Escape bytes for a single-quoted literal, see the module header. escapeBytes :: ByteString -> ByteString escapeBytes (B.PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \ a ->     B.createUptoN (len * 2) $ \ b -> do-        b' <- loop (a `plusPtr` s) (a `plusPtr` s `plusPtr` len) b+        b' <- escapeByteRange (a `plusPtr` s) (a `plusPtr` s `plusPtr` len) b         return (b' `minusPtr` b)-  where-    escape :: Word8 -> Ptr Word8 -> IO (Ptr Word8)-    escape c p = do-        poke p 92-        pokeByteOff p 1 c-        return (p `plusPtr` 2) -    loop !a aend !b-        | a == aend = return b-        | otherwise = do-            c <- peek a-            if  | c == 0-                    || c == 39-                    || c == 34 -> escape c   b >>= loop (a `plusPtr` 1) aend -- \0 \' \"-                | c == 8       -> escape 98  b >>= loop (a `plusPtr` 1) aend -- \b-                | c == 10      -> escape 110 b >>= loop (a `plusPtr` 1) aend -- \n-                | c == 13      -> escape 114 b >>= loop (a `plusPtr` 1) aend -- \r-                | c == 9       -> escape 116 b >>= loop (a `plusPtr` 1) aend -- \t-                | c == 26      -> escape 90  b >>= loop (a `plusPtr` 1) aend -- \Z-                | c == 92      -> escape 92  b >>= loop (a `plusPtr` 1) aend -- \\+-- | Copies the bytes from @source@ to @sourceEnd@ to @target@, doubling+-- quotes and backslashes; it returns the address after the last byte written.+escapeByteRange :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)+escapeByteRange !source sourceEnd !target = if source == sourceEnd+    then return target+    else do+        byte <- peek source+        poke target byte+        if byte == quote || byte == backslash+            then do+                pokeByteOff target 1 byte+                escapeByteRange (source `plusPtr` 1) sourceEnd (target `plusPtr` 2)+            else escapeByteRange (source `plusPtr` 1) sourceEnd (target `plusPtr` 1) -                | otherwise    -> poke b c >> loop (a `plusPtr` 1) aend (b `plusPtr` 1)+quote, backslash :: Num unit => unit+quote = 0x27+backslash = 0x5C
src/Database/MySQL/Query.hs view
@@ -75,8 +75,8 @@ -- quotes are read with MySQL's default escaping, where a backslash escapes -- the next character; under @NO_BACKSLASH_ESCAPES@ a string ending in a -- backslash, such as @\'C:\\\'@, looks unterminated, so the placeholders--- after it are missed. That mode breaks the escaping of the rendered values--- as well.+-- after it are missed. In that mode a backslash in a rendered value is+-- stored twice, see "Database.MySQL.Protocol.Escape". -- -- Throws 'WrongParamsCount' when the number of placeholders and parameters -- differ.
+ test/BinLogChecksum.hs view
@@ -0,0 +1,95 @@+-- | The CRC32 checksum that ends each binlog event when binlog_checksum is+-- CRC32, which the decoder used to drop unchecked, decoding a corrupted event+-- as if it were intact.+module BinLogChecksum (tests) where++import           Control.Exception                    (try)+import           Data.Bits                            (xor)+import qualified Data.ByteString                      as B+import qualified Data.ByteString.Base16               as Base16+import qualified Data.ByteString.Lazy                 as L+import           Data.Word                            (Word32)+import           Database.MySQL.BinLog+import           Database.MySQL.BinLogProtocol.CRC32  (crc32)+import           Database.MySQL.Protocol.Packet+import           Test.Tasty+import           Test.Tasty.HUnit++tests :: TestTree+tests = testGroup "binlog checksums"+    [ testCase "CRC32 matches the IEEE/zlib check values" $ do+        assertChecksum "check string" 0xCBF43926 (crc32 "123456789")+        assertChecksum "empty" 0x00000000 (crc32 "")+        assertChecksum "pangram" 0x414FA339 (crc32 "The quick brown fox jumps over the lazy dog")+        assertChecksum "every byte value" 0x29058C73 (crc32 (L.pack [0 .. 255]))+    , testCase "an intact event decodes" $ do+        xid <- mysqlXidEvent+        event <- decodeBinLogPacket True False fileName (eventPacket xid)+        assertEqual "body" (L.fromStrict (B.take 8 (B.drop 19 xid))) (blBody event)+    , testCase "an event with one byte flipped raises BinLogChecksumMismatch" $ do+        xid <- mysqlXidEvent+        decoded <- try (decodeBinLogPacket True False fileName (eventPacket (flipByte 20 xid)))+        assertEqual "mismatch"+            (Left (BinLogChecksumMismatch BINLOG_XID_EVENT fileName 3125+                (BinLogChecksum 0x73C5F461) (BinLogChecksum 0xD5B2FFD5)))+            (blEventType <$> decoded)+    , testCase "a format description event with the binlog-in-use flag set decodes" $ do+        description <- mysqlFormatDescription+        event <- decodeBinLogPacket True False fileName (eventPacket description)+        assertEqual "event type" BINLOG_FORMAT_DESCRIPTION_EVENT (blEventType event)+    , testCase "a corrupted format description event raises BinLogChecksumMismatch" $ do+        description <- mysqlFormatDescription+        decoded <- try (decodeBinLogPacket True False fileName (eventPacket (flipByte 23 description)))+        assertEqual "mismatch"+            (Left (BinLogChecksumMismatch BINLOG_FORMAT_DESCRIPTION_EVENT fileName 126+                (BinLogChecksum 0xBEB97E09) (BinLogChecksum 0xD8DB7FA5)))+            (blEventType <$> decoded)+    , testCase "a format description event naming no checksum algorithm is not checked" $ do+        description <- mysqlFormatDescription+        let algorithmOff = B.length description - 5+        event <- decodeBinLogPacket True False fileName (eventPacket (flipByte algorithmOff description))+        assertEqual "event type" BINLOG_FORMAT_DESCRIPTION_EVENT (blEventType event)+    , testCase "the semi-sync header is not part of the checksummed event" $ do+        xid <- mysqlXidEvent+        let body = L.fromStrict ("\x00\xEF\x01" <> xid)+        event <- decodeBinLogPacket True True fileName (Packet (L.length body) 1 body)+        assertEqual "semi-sync ack" True (blSemiAck event)+    , testCase "events of a dump without checksums are not checked" $ do+        xid <- mysqlXidEvent+        event <- decodeBinLogPacket False False fileName (eventPacket (flipByte 20 xid))+        assertEqual "event type" BINLOG_XID_EVENT (blEventType event)+    ]++assertChecksum :: String -> Word32 -> Word32 -> Assertion+assertChecksum = assertEqual++fileName :: B.ByteString+fileName = "mysql-bin.000001"++-- | An event as COM_BINLOG_DUMP streams it, after the OK byte.+eventPacket :: B.ByteString -> Packet+eventPacket event = Packet (L.length body) 1 body+  where+    body = L.fromStrict (B.cons 0x00 event)++flipByte :: Int -> B.ByteString -> B.ByteString+flipByte index bytes =+    B.take index bytes <> B.map (`xor` 0x01) (B.take 1 (B.drop index bytes)) <> B.drop (index + 1) bytes++-- | An XID event that MySQL 8.0.45 wrote, checksum included.+mysqlXidEvent :: IO B.ByteString+mysqlXidEvent = fromHex "e8baf46a10010000001f000000350c00000000250000000000000061f4c573"++-- | The format description event that MySQL 8.0.45 wrote at the start of its+-- binlog file, with LOG_EVENT_BINLOG_IN_USE_F set as the open file holds it.+mysqlFormatDescription :: IO B.ByteString+mysqlFormatDescription = fromHex+    "e5baf46a0f010000007a0000007e00000001000400382e302e34350000000000000000\+    \000000000000000000000000000000000000000000000000000000000000000000000000\+    \e5baf46a13000d0008000000000400040000006200041a08000000080808020000000a0a\+    \0a2a2a001234000a280001097eb9be"++fromHex :: B.ByteString -> IO B.ByteString+fromHex hex = case Base16.decode hex of+    Left failure -> assertFailure ("a test event is not hex: " ++ failure)+    Right bytes -> pure bytes
+ test/Ed25519Scramble.hs view
@@ -0,0 +1,96 @@+-- | MariaDB's ed25519 authentication, checked against MariaDB's own answers:+-- the keys its server stores and the signatures its client library sends.+module Ed25519Scramble (tests) where++import           Control.Exception              (try)+import qualified Crypto.PubKey.Ed25519          as Ed25519+import           Crypto.Error                   (eitherCryptoError)+import           Data.Binary.Put                (putByteString, putWord8)+import qualified Data.ByteArray.Encoding        as Encoding+import qualified Data.ByteString                as B+import qualified Data.ByteString.Base16         as Base16+import qualified Data.ByteString.Char8          as BC+import qualified Data.ByteString.Lazy           as L+import           Data.IORef                     (modifyIORef', newIORef, readIORef)+import           Database.MySQL.Connection      (UnexpectedPacket (..), completeAuth,+                                                 ed25519PublicKey, scrambleEd25519)+import           Database.MySQL.Protocol.Packet (Packet (..), putToPacket)+import qualified System.IO.Streams              as Stream+import           Test.QuickCheck.Instances      ()+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck++hex :: String -> IO B.ByteString+hex = either (assertFailure . ("not hex: " ++)) pure . Base16.decode . BC.pack++-- | The key as MariaDB shows it: base64 without its one padding character.+mariadbKey :: B.ByteString -> B.ByteString+mariadbKey = B.dropWhileEnd (== 0x3D) . Encoding.convertToBase Encoding.Base64++-- | What the server sends when an account needs client_ed25519.+authSwitch :: B.ByteString -> Packet+authSwitch nonce = putToPacket 2 $ do+    putWord8 0xFE+    putByteString "client_ed25519"+    putWord8 0+    putByteString nonce++okPacket :: Packet+okPacket = putToPacket 4 (putByteString "\x00\x00\x00\x02\x00\x00\x00")++-- | The packets 'completeAuth' writes while answering an AuthSwitchRequest for+-- this nonce, and whether it refused the request.+answerSwitch :: B.ByteString -> B.ByteString -> IO ([Packet], Either UnexpectedPacket ())+answerSwitch nonce pass = do+    written <- newIORef []+    replies <- Stream.fromList [okPacket]+    outcome <- try $ completeAuth replies (\p -> modifyIORef' written (p :)) pass (authSwitch nonce)+        (\_ _ _ _ -> assertFailure "ed25519 asked for full authentication")+    sent <- readIORef written+    pure (reverse sent, outcome)++newtype Nonce = Nonce B.ByteString deriving Show++instance Arbitrary Nonce where+    arbitrary = Nonce . B.pack <$> vectorOf 32 arbitrary++-- | MariaDB's server checks a reply with standard Ed25519 verification, so+-- every reply must pass it for the key MariaDB stores.+verifiesAsEd25519 :: B.ByteString -> Nonce -> Property+verifiesAsEd25519 pass (Nonce nonce) =+    either (\failure -> counterexample (show failure) False) property $ do+        key <- ed25519PublicKey pass >>= eitherCryptoError . Ed25519.publicKey+        signature <- scrambleEd25519 nonce pass >>= eitherCryptoError . Ed25519.signature+        pure (Ed25519.verify key nonce signature)++tests :: TestTree+tests = testGroup "ed25519 scramble"+    [ testCase "public keys are the ones MariaDB stores" $ do+        -- From MariaDB 11.4.9's mysql-test/suite/plugins/r/auth_ed25519.result+        -- and its ed25519_password(); the last is the account nix/ci.nix makes.+        mariadbKey <$> ed25519PublicKey "foo" @?= Right "vubFBzIrapbfHct1/J72dnUryz5VS7lA6XHH8sIx4TI"+        mariadbKey <$> ed25519PublicKey "foobar" @?= Right "qv2mG6HWCuy32Slb5xhV4THStewNz2VINVPbgk+XAJ8"+        mariadbKey <$> ed25519PublicKey "foo bar" @?= Right "Y5fV74JAVRMOK2cdnUsYS+WW9sXaaL/o+6WGKOgqnzc"+        mariadbKey <$> ed25519PublicKey "secret" @?= Right "ZIgUREUg5PVgQ6LskhXmO+eZLS0nC8be6HPjYWR4YJY"+        mariadbKey <$> ed25519PublicKey "ed25519Pass123" @?= Right "j2VKy3t+tdtEQXXes18uKRvK1XL9crguh3AregMR6kk"+      -- Signatures from ma_crypto_sign of mariadb-connector-c 3.3.5's ref10.+    , testCase "an AuthSwitchRequest is answered with libmariadb's signature, a nonce ending in 0 included" $ do+        nonce <- hex "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f00"+        signature <- hex "0c9e13ccd52e9dbb7957836f1c48ae216bf28da17c4b027f93534b0e5a348917\+                         \0096c63db819a35af8a62c976faa5bc436cb047911dcb3d28301cd07d5cd8303"+        (sent, outcome) <- answerSwitch nonce "ed25519Pass123"+        sent @?= [Packet 64 3 (L.fromStrict signature)]+        either (\(UnexpectedPacket p) -> assertFailure ("refused " ++ show p)) pure outcome+    , testCase "signature of another password and nonce" $ do+        nonce <- hex "ffeeddccbbaa99887766554433221100ffeeddccbbaa99887766554433221100"+        signature <- hex "c0999e2c61f2fe2d679307b2b236930e1efc3680e43d4bb2b46f4250d6e11d55\+                         \047e75a777f4db9d60aa3ab64eebb3197a827df920f5c852bdd7be70ba0d6e0c"+        scrambleEd25519 nonce "secret" @?= Right signature+    , testCase "a nonce that is not 32 bytes is refused unsigned, as libmariadb does" $ do+        let request = authSwitch (B.replicate 20 7)+        (sent, outcome) <- answerSwitch (B.replicate 20 7) "ed25519Pass123"+        sent @?= []+        either (\(UnexpectedPacket p) -> p @?= request) (\() -> assertFailure "the nonce was accepted") outcome+    , testProperty "every reply verifies as Ed25519 under the stored key" verifiesAsEd25519+    ]
test/Integration.hs view
@@ -13,6 +13,7 @@ import qualified LargeRows import qualified Latin1Results import qualified NonUtf8Results+import qualified ParameterEscaping import qualified PlaceholderLiterals import qualified UnsignedInsertId import qualified ZeroDateRoundtrip@@ -20,10 +21,12 @@ import qualified MysqlTests import           QueryApi import qualified QueryWithoutResultSet+import qualified ResetConnection import qualified RoundtripBit import qualified RoundtripYear import qualified RowDecoderQueries import qualified SelectOne+import qualified TLSClientCertificate import qualified TLSConnection import qualified UnixSocket @@ -52,9 +55,11 @@         , BinLogRowEvents.tests         , CABundle.tests         , ZeroDateRoundtrip.typedDecoderTests+        , ResetConnection.tests         ]         -- binlog_transaction_compression is MySQL 8.0.20+ only.         ++ [ BinLogRowEvents.compressedTransactionTests | isMySql80 ]+        ++ maybe [] (pure . TLSClientCertificate.tests) mTlsCaPath         ++ map (apiTests isMySql80 mSockPath mTlsCaPath) queryApis         -- The typed decoders give a date a 'Day' cannot hold as an error instead         -- of a value to write back, which 'ZeroDateRoundtrip.typedDecoderTests' checks.@@ -71,6 +76,7 @@     , FloatingPoint.tests api     , LargeRows.tests api     , PlaceholderLiterals.tests api+    , ParameterEscaping.tests api     , Latin1Results.tests api     , AbandonedReplies.tests api     ]
test/IntegrationMariaDB.hs view
@@ -6,6 +6,7 @@ import           System.Environment (lookupEnv) import           Test.Tasty (defaultMain, testGroup) import qualified MariaDBBulk+import qualified MariaDBEd25519 import qualified MariaDBExtendedMetadata import qualified UnixSocket @@ -16,4 +17,5 @@     defaultMain $ testGroup "mariadb-integration"         [ MariaDBExtendedMetadata.tests socketPath caPath         , MariaDBBulk.tests+        , MariaDBEd25519.tests socketPath caPath         ]
test/Main.hs view
@@ -6,6 +6,8 @@ import qualified JSON import qualified Sha1Scramble import qualified Sha256Scramble+import qualified Ed25519Scramble+import qualified StringLiterals import qualified Word24 import qualified TCPStreams import qualified BoundsCheck@@ -15,6 +17,7 @@ import qualified DecoderRoundtrip import qualified FloatingPointText import qualified HandshakeGolden+import qualified BinLogChecksum import qualified BinLogEventCodes import qualified PacketClassification import qualified Placeholders@@ -38,6 +41,7 @@          ]       , Sha1Scramble.tests       , Sha256Scramble.tests+      , Ed25519Scramble.tests       , BoundsCheck.tests       , FieldRoundtrip.tests       , TextRowDecoding.tests@@ -47,7 +51,9 @@       , HandshakeGolden.tests       , PacketClassification.tests       , Placeholders.tests+      , StringLiterals.tests       , ZeroDates.tests       , ResultCharsets.tests       , BinLogEventCodes.tests+      , BinLogChecksum.tests       ]
+ test/MariaDBEd25519.hs view
@@ -0,0 +1,44 @@+-- | Logins as an account identified via MariaDB's ed25519 plugin, which+-- nix/ci.nix creates in the MariaDB VM. The server greets with+-- mysql_native_password and switches the client to client_ed25519 once it+-- knows the account.+module MariaDBEd25519 (tests) where++import           Database.MySQL.Base+import qualified Database.MySQL.TLS  as TLS+import qualified System.IO.Streams   as Stream+import           Test.Tasty+import           Test.Tasty.HUnit++ed25519ConnectInfo :: ConnectInfo+ed25519ConnectInfo = defaultConnectInfo+    { ciUser = "testMySQLHaskellEd25519"+    , ciPassword = "ed25519Pass123"+    , ciDatabase = "testMySQLHaskell"+    }++-- | The account the server authenticated, so a login that fell back to some+-- other account would not pass.+assertEd25519Account :: MySQLConn -> Assertion+assertEd25519Account conn = do+    (_, rows) <- query_ conn "SELECT CURRENT_USER()"+    users <- Stream.toList rows+    users @?= [[MySQLText "testMySQLHaskellEd25519@localhost"]]+    close conn++tests :: Maybe FilePath -> Maybe FilePath -> TestTree+tests socketPath caPath = testGroup "ed25519 authentication" $+    [ testCase "logs in over TCP" $+        connect ed25519ConnectInfo >>= assertEd25519Account+    ]+    ++ maybe [] (pure . unixSocketTest) socketPath+    ++ maybe [] (pure . tlsTest) caPath++unixSocketTest :: FilePath -> TestTree+unixSocketTest path = testCase "logs in over a Unix socket" $+    connectUnixSocket path ed25519ConnectInfo >>= assertEd25519Account++tlsTest :: FilePath -> TestTree+tlsTest caPath = testCase "logs in over TLS" $ do+    cparams <- TLS.makeClientParams (TLS.CustomCAStore caPath)+    TLS.connect ed25519ConnectInfo (cparams, "Winter") >>= assertEd25519Account
+ test/ParameterEscaping.hs view
@@ -0,0 +1,99 @@+-- | Values that 'query', 'execute' and 'executeMany' render into the query+-- text, read back under the default sql_mode and under NO_BACKSLASH_ESCAPES.+-- In that mode a backslash is an ordinary character, so a quote escaped as+-- backslash-quote used to end the string literal and let the rest of the+-- value run as SQL.+module ParameterEscaping (tests) where++import qualified Data.ByteString     as B+import           Data.Text           (Text)+import qualified Data.Text           as T+import           Data.Word           (Word8)+import           Database.MySQL.Base+import           QueryApi+import qualified System.IO.Streams   as Stream+import           Test.Tasty+import           Test.Tasty.HUnit+import           TestUser            (withTestConnection)++tests :: QueryApi -> TestTree+tests api = testGroup "parameters rendered into the query text"+    [ testGroup "NO_BACKSLASH_ESCAPES"+        [ testCase "a quote in a query parameter does not end the literal" $+            withUsers $ \c -> do+                (_, rows) <- apiQuery api (ColumnCount 2) c+                    "SELECT name, secret FROM escaping_users WHERE name = ?"+                    [One (MySQLText endsLiteral)]+                found <- Stream.toList rows+                assertEqual "rows matching the name" [] found+        , testCase "a quote in an executeMany parameter does not end the literal" $+            withUsers $ \c -> do+                oks <- executeMany c+                    "UPDATE escaping_users SET secret = 'changed' WHERE name = ?"+                    [[MySQLText endsLiteral]]+                assertEqual "rows changed" 0 (sum (map okAffectedRows oks))+        , testCase "text with quotes and control characters round-trips" $+            withTestConnection $ \c -> do+                setNoBackslashEscapes c+                assertTextRoundTrip api c (T.filter (/= '\\') trickyText)+        , testCase "every byte but the backslash round-trips" $+            withTestConnection $ \c -> do+                setNoBackslashEscapes c+                assertBytesRoundTrip api c (B.filter (/= backslash) everyByte)+        ]+    , testGroup "default sql_mode"+        [ testCase "text with quotes, backslashes and control characters round-trips" $+            withTestConnection $ \c -> assertTextRoundTrip api c trickyText+        , testCase "every byte round-trips" $+            withTestConnection $ \c -> assertBytesRoundTrip api c everyByte+        ]+    ]++-- | A name that matches every row once its quote ends the string literal.+endsLiteral :: Text+endsLiteral = "nobody' OR 1=1 #"++-- | Ends in a backslash, which in the default mode escapes the closing quote+-- unless it is escaped itself.+trickyText :: Text+trickyText = "it's \"quoted\" '' \\' \\\\ \0 \n \r \t \b \SUB % _ \252nic\246de \128512 \\"++everyByte :: B.ByteString+everyByte = B.pack [minBound .. maxBound]++backslash :: Word8+backslash = 0x5C++-- | A connection under NO_BACKSLASH_ESCAPES with one row in @escaping_users@+-- whose name is not 'endsLiteral'.+withUsers :: (MySQLConn -> IO a) -> IO a+withUsers run = withTestConnection $ \c -> do+    _ <- execute_ c "CREATE TEMPORARY TABLE escaping_users (name VARCHAR(64), secret VARCHAR(64))"+    _ <- execute_ c "INSERT INTO escaping_users VALUES ('alice', 'hunter2')"+    setNoBackslashEscapes c+    run c++setNoBackslashEscapes :: MySQLConn -> IO ()+setNoBackslashEscapes c = do+    _ <- execute_ c "SET SESSION sql_mode = 'NO_BACKSLASH_ESCAPES'"+    pure ()++-- | Inserts with 'execute' and selects with the value in the WHERE clause, so+-- both the stored value and the literal compared against it must be exact.+assertTextRoundTrip :: QueryApi -> MySQLConn -> Text -> Assertion+assertTextRoundTrip api c text = do+    _ <- execute_ c "CREATE TEMPORARY TABLE escaping_text (value VARCHAR(255) CHARACTER SET utf8mb4)"+    _ <- execute c "INSERT INTO escaping_text VALUES (?)" [MySQLText text]+    (_, rows) <- apiQuery api (ColumnCount 1) c "SELECT value FROM escaping_text WHERE value = ?"+        [One (MySQLText text)]+    found <- Stream.toList rows+    assertEqual "rows read back" [[MySQLText text]] found++assertBytesRoundTrip :: QueryApi -> MySQLConn -> B.ByteString -> Assertion+assertBytesRoundTrip api c bytes = do+    _ <- execute_ c "CREATE TEMPORARY TABLE escaping_bytes (value VARBINARY(512))"+    _ <- execute c "INSERT INTO escaping_bytes VALUES (?)" [MySQLBytes bytes]+    (_, rows) <- apiQuery api (ColumnCount 1) c "SELECT value FROM escaping_bytes WHERE value = ?"+        [One (MySQLBytes bytes)]+    found <- Stream.toList rows+    assertEqual "rows read back" [[MySQLBytes bytes]] found
+ test/ResetConnection.hs view
@@ -0,0 +1,64 @@+-- | 'resetConnection' gives a connection the session of a new one, so a pool+-- can hand it to its next user.+module ResetConnection (tests) where++import           Control.Exception   (try)+import           Control.Monad       (void)+import           Data.Word           (Word16)+import           Database.MySQL.Base+import qualified System.IO.Streams   as Stream+import           Test.Tasty+import           Test.Tasty.HUnit+import           TestUser            (withTestConnection)++tests :: TestTree+tests = testGroup "resetConnection"+    [ testCase "a user variable is NULL afterwards" $+        withTestConnection $ \c -> do+            void (execute_ c "SET @reset_probe = 42")+            resetConnection c+            selectAll c "SELECT @reset_probe" >>= assertEqual "the variable" [[MySQLNull]]+    , testCase "a temporary table is gone afterwards" $+        withTestConnection $ \c -> do+            void (execute_ c "CREATE TEMPORARY TABLE reset_connection_temporary (x INT)")+            resetConnection c+            -- ER_NO_SUCH_TABLE+            assertRefused 1146 (selectAll c "SELECT x FROM reset_connection_temporary")+    , testCase "an uncommitted insert is rolled back" $+        withTestConnection $ \c -> do+            void (execute_ c "DROP TABLE IF EXISTS reset_connection_rollback")+            void (execute_ c "CREATE TABLE reset_connection_rollback (x INT) ENGINE=InnoDB")+            void (execute_ c "START TRANSACTION")+            void (execute_ c "INSERT INTO reset_connection_rollback VALUES (1)")+            resetConnection c+            selectAll c "SELECT COUNT(*) FROM reset_connection_rollback"+                >>= assertEqual "rows in the table" [[MySQLInt64 0]]+            void (execute_ c "DROP TABLE reset_connection_rollback")+    , testCase "a statement prepared before it is refused by the server" $+        withTestConnection $ \c -> do+            stmt <- prepareStmt c "SELECT 'prepared'"+            resetConnection c+            -- ER_UNKNOWN_STMT_HANDLER+            assertRefused 1243 (queryStmt c stmt [] >>= Stream.toList . snd)+            selectAll c "SELECT 'next'" >>= assertEqual "the next query's rows" [[MySQLText "next"]]+    , testCase "with rows unread it refuses instead of reading a row as its reply" $+        withTestConnection $ \c -> do+            void (execute_ c "SET @reset_probe = 42")+            (_, unread) <- query_ c "SELECT 'row' UNION ALL SELECT 'row'"+            refused <- try (resetConnection c)+            case refused of+                Left UnconsumedResultSet -> pure ()+                Right () -> assertFailure "resetConnection read a row packet as its reply"+            Stream.skipToEof unread+            selectAll c "SELECT @reset_probe" >>= assertEqual "the session kept its state" [[MySQLInt64 42]]+    ]++selectAll :: MySQLConn -> Query -> IO [[MySQLValue]]+selectAll c q = query_ c q >>= Stream.toList . snd++assertRefused :: Show a => Word16 -> IO a -> Assertion+assertRefused code action = do+    outcome <- try action+    case outcome of+        Left (ERRException err) -> assertEqual ("error " ++ show (errMsg err)) code (errCode err)+        Right answer -> assertFailure ("the server answered " ++ show answer)
+ test/StringLiterals.hs view
@@ -0,0 +1,99 @@+-- | Text and bytes rendered into the query text as single-quoted string+-- literals, read back the way the server's lexer reads them, with and+-- without NO_BACKSLASH_ESCAPES.+module StringLiterals (tests) where++import           Data.ByteString                    (ByteString)+import qualified Data.ByteString                    as B+import qualified Data.ByteString.Lazy               as L+import           Data.Maybe                         (isJust)+import           Data.Text                          (Text)+import qualified Data.Text                          as T+import qualified Data.Text.Encoding                 as T+import           Data.Word                          (Word8)+import           Database.MySQL.Base+import           Test.QuickCheck                    (Gen, arbitrary, elements,+                                                     forAll, frequency, listOf)+import           Test.Tasty+import           Test.Tasty.HUnit                   (testCase, (@?=))+import           Test.Tasty.QuickCheck              (testProperty, (===))++tests :: TestTree+tests = testGroup "string literals"+    [ testCase "a quote and a backslash are doubled, other characters kept" $+        rendered (MySQLText "it's\n\"C:\\\"") @?= "'it''s\n\"C:\\\\\"'"+    , testGroup "default sql_mode"+        [ testProperty "bytes read back exactly" $ forAll genBytes $ \bytes ->+            readLiteral BackslashEscapes (rendered (MySQLBytes bytes)) === Just bytes+        , testProperty "text reads back exactly" $ forAll genText $ \text ->+            readLiteral BackslashEscapes (rendered (MySQLText text)) === Just (T.encodeUtf8 text)+        ]+    , testGroup "NO_BACKSLASH_ESCAPES"+        [ testProperty "bytes end the literal at its closing quote" $ forAll genBytes $ \bytes ->+            isJust (readLiteral NoBackslashEscapes (rendered (MySQLBytes bytes)))+        , testProperty "text ends the literal at its closing quote" $ forAll genText $ \text ->+            isJust (readLiteral NoBackslashEscapes (rendered (MySQLText text)))+        , testProperty "bytes without a backslash read back exactly" $+            forAll (B.filter (/= backslash) <$> genBytes) $ \bytes ->+                readLiteral NoBackslashEscapes (rendered (MySQLBytes bytes)) === Just bytes+        , testProperty "text without a backslash reads back exactly" $+            forAll (T.filter (/= '\\') <$> genText) $ \text ->+                readLiteral NoBackslashEscapes (rendered (MySQLText text)) === Just (T.encodeUtf8 text)+        ]+    ]++rendered :: MySQLValue -> ByteString+rendered value = L.toStrict (fromQuery (renderParams "?" [value]))++data BackslashMode = BackslashEscapes | NoBackslashEscapes++-- | The value the server reads from a whole single-quoted literal, following+-- <https://dev.mysql.com/doc/refman/8.0/en/string-literals.html>; Nothing+-- when the literal ends before the input does, or not at all. Reading bytes+-- is exact for UTF-8, where a quote or backslash byte never belongs to a+-- longer character.+readLiteral :: BackslashMode -> ByteString -> Maybe ByteString+readLiteral mode literal = case B.unpack literal of+    [] -> Nothing+    open : body -> if open == quote then B.pack <$> readBody mode body else Nothing++readBody :: BackslashMode -> [Word8] -> Maybe [Word8]+readBody mode body = case body of+    [] -> Nothing+    byte : rest -> if+        | byte == quote -> case rest of+            [] -> Just []+            next : afterNext ->+                if next == quote then (quote :) <$> readBody mode afterNext else Nothing+        | byte == backslash -> case mode of+            NoBackslashEscapes -> (backslash :) <$> readBody mode rest+            BackslashEscapes -> case rest of+                [] -> Nothing+                escaped : afterEscaped -> (escapedBytes escaped ++) <$> readBody mode afterEscaped+        | otherwise -> (byte :) <$> readBody mode rest++-- | What a backslash followed by this byte stands for in the default mode.+escapedBytes :: Word8 -> [Word8]+escapedBytes escaped = case lookup escaped escapeSequences of+    Just meaning -> [meaning]+    Nothing -> if escaped == 0x25 || escaped == 0x5F then [backslash, escaped] else [escaped]++-- | @\\0 \\b \\n \\r \\t \\Z@; @\\%@ and @\\_@ keep their backslash, any other+-- escaped byte stands for itself.+escapeSequences :: [(Word8, Word8)]+escapeSequences = [(0x30, 0), (0x62, 8), (0x6E, 10), (0x72, 13), (0x74, 9), (0x5A, 26)]++quote, backslash :: Word8+quote = 0x27+backslash = 0x5C++-- | Half the bytes are ones the escaping or the lexer treats specially.+genBytes :: Gen ByteString+genBytes = B.pack <$> listOf (frequency+    [(1, elements (B.unpack (T.encodeUtf8 (T.pack specialCharacters)))), (1, arbitrary)])++genText :: Gen Text+genText = T.pack <$> listOf (frequency [(1, elements specialCharacters), (1, arbitrary)])++specialCharacters :: String+specialCharacters = "\0\b\t\n\r\SUB\"%'\\_"
+ test/TLSClientCertificate.hs view
@@ -0,0 +1,40 @@+-- | Logging in as an account that requires a client certificate, which+-- 'makeClientParams'' loaded but never sent before 1.5.0.+module TLSClientCertificate (tests) where++import           Control.Exception     (bracket_)+import           Database.MySQL.Base+import qualified Database.MySQL.TLS    as TLS+import           Database.MySQL.TLS    (makeClientParams', TrustedCAStore(..))+import qualified System.IO.Streams     as Stream+import           System.FilePath       (replaceFileName)+import           Test.Tasty+import           Test.Tasty.HUnit+import           TestUser              (withTestConnection)++-- | The certificate and key sit next to the CA at @caPath@, which signed them.+tests :: FilePath -> TestTree+tests caPath = testCase "an account requiring a client certificate logs in" $+    withTestConnection $ \admin -> bracket_+        (execute_ admin createCertificateUser)+        (execute_ admin "DROP USER 'tlsClientCert'@'localhost'") $ do+            params <- makeClientParams'+                (replaceFileName caPath "client-cert.pem")+                []+                (replaceFileName caPath "client-key.pem")+                (CustomCAStore caPath)+            conn <- TLS.connect certificateConnectInfo (params, "Winter")+            (_, rows) <- query_ conn "SELECT CURRENT_USER()"+            loggedInAs <- Stream.toList rows+            close conn+            loggedInAs @?= [[MySQLText "tlsClientCert@localhost"]]++-- | The subject is the one test/cert/client-cert.pem carries, so only that+-- certificate opens the account.+createCertificateUser :: Query+createCertificateUser =+    "CREATE USER 'tlsClientCert'@'localhost' IDENTIFIED WITH mysql_native_password \+    \REQUIRE SUBJECT '/O=mysql-haskell/CN=testClientCert'"++certificateConnectInfo :: ConnectInfo+certificateConnectInfo = defaultConnectInfo { ciUser = "tlsClientCert", ciDatabase = "" }
+ test/cert/client-cert.pem view
@@ -0,0 +1,21 @@+-----BEGIN CERTIFICATE-----+MIIDczCCAlugAwIBAgIBAjANBgkqhkiG9w0BAQsFADBWMQswCQYDVQQGEwJDTjET+MBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50ZXJuZXQgV2lkZ2l0cyBQ+dHkgTHRkMQ8wDQYDVQQDDAZXaW50ZXIwIBcNMjYxMTExMTg0OTQ0WhgPMjEyNjEw+MTgxODQ5NDRaMDExFjAUBgNVBAoMDW15c3FsLWhhc2tlbGwxFzAVBgNVBAMMDnRl+c3RDbGllbnRDZXJ0MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAtQgI+BhdPpmgBCHYsE+S8ooknz3zZKzqjoU6MVG9uTlJJs7/gKMR1yK7FMQbA042Vzzuz+Z90rUiXe/w37CVPZJttTsQmxkqC6TQ1JXWOH9fbU8SpTibaYz1SntX7p4sThavX0+CEWvsP2qkUy1x+b+pJueFQDF/sKNNmO20nasjin9XBbmm1W0E/iF3/ONVjVLwuE4+Rf9vCLO1sMW7an45FRSpq3UjXGxT/uWYrNbkuH00Xn2AyGRi3Y4sjtq4eLfcCOoG+c7lCU6YG3JNpW2wg3E5aU1l5+F6/GNFFxAL6v0HvBVLUrBzl4FAwEA4xeFGhHJQA+t6KzrhHNRXAhvVmBgwIDAQABo28wbTAJBgNVHRMEAjAAMAsGA1UdDwQEAwIHgDAT+BgNVHSUEDDAKBggrBgEFBQcDAjAdBgNVHQ4EFgQUtTY22oCrl28tpaNsocAm9sre+kcowHwYDVR0jBBgwFoAUKPd42SHy3KvNAywQqKtUDWKVVkAwDQYJKoZIhvcNAQEL+BQADggEBAFFu6BGMSo+nW8F10teuJJ80DH3QlslGrgQ99FOlIclk/gCM/Qf+Y0tG+wOrbYpd2Y5kc/FFFPp2NS9LpbgrvaKKmHnfdw/RcvtNqnnAcNk/tfcNxyBG87abE+C1d3p4N78uafV3MZMjHMGYKX4/yQSfYd5wgI3FAoP0FVTNLR1lduimN/HKY0Jdqh+jkg8xr/DOae0Z9JbdtsVpr6qHDwOnveQjEfddu2q2T+pzlDNkAVUTTilYKr0PSaJ++6KiybDpn2H3a4ZZf14pVGTCAji6DyBjTtbGGDZywmHYbiG/PYV+huYbyOurJkTh+TL5XD03iaChi7lTi+ZU2j07NNgHbVmk=+-----END CERTIFICATE-----
+ test/cert/client-key.pem view
@@ -0,0 +1,27 @@+-----BEGIN RSA PRIVATE KEY-----+MIIEpAIBAAKCAQEAtQgIBhdPpmgBCHYsE+S8ooknz3zZKzqjoU6MVG9uTlJJs7/g+KMR1yK7FMQbA042VzzuzZ90rUiXe/w37CVPZJttTsQmxkqC6TQ1JXWOH9fbU8SpT+ibaYz1SntX7p4sThavX0CEWvsP2qkUy1x+b+pJueFQDF/sKNNmO20nasjin9XBbm+m1W0E/iF3/ONVjVLwuE4Rf9vCLO1sMW7an45FRSpq3UjXGxT/uWYrNbkuH00Xn2A+yGRi3Y4sjtq4eLfcCOoGc7lCU6YG3JNpW2wg3E5aU1l5+F6/GNFFxAL6v0HvBVLU+rBzl4FAwEA4xeFGhHJQAt6KzrhHNRXAhvVmBgwIDAQABAoIBAAIbjNRdUx0R2uk5+TvwQTq3pwN/miTS6owsOug2Fmpgo1xjTpA11dBWZC0yt0nLkFBlsjYMpDQcQz87S+X9jU9BNCvG+0ODAH1QNuoysGLKANdp80KfLRgGfxiV5QkvKD7kfrgyLRhOEfouu8+I+Wm59IMycNe1e9IXpKCiK9cmFezWm6Jmd8nyXBk9JnrhkQvRWP6dHY01c4bWLUW+fZqF47naM2gwe5f3PxhiGF3MWyb2R8z82dgRpQH+tL7GY6Q4OW1XdzVgj994+zXT+MH2dhV0IuEKYxbLYG8L9Pr5rDj0VJ+ljcclkJEm/w56nyfdoyCUoAowzZASNPNxV+tJkgaykCgYEA3+XZGNYnAHN8CfnooPfWMA7uudcTtqwcn9p7xiV6PayRMQbYrlCD+/uhBh3TynO27bKB9EdIlOKM4XeFALcKmkY+/6gG+3quZ5G00bO519Mm0Q+TSOU/K++v1qa6yf22MJe/oP880ovky2jXMpXsg/SqQ1zY2nAqstJov75wjg//UCgYEAzvzF+4v1UFIfccYoRkjZDvQDVJ/u9FFAgCfK90LGOzYdn3y413JIrFHUxZ3tshGn7kaJF+RWJ0fIz38xaTWzLs1oegsyU4ti6jjzUxP+4hy+2qw8nHPMLP9Lltpt7AgvZtIKjV+xsFzwklu5pUKMTy87iUbh/qyI8cV1YE7jKCraJcCgYEA0XsWnOM4yHZEVn0ohvp6+vqop91xgyGfNvE5JwgEslumPSqSSNL2GUgfxz4++ss7GrgKWIgdQ5eXohgWK64WU+HNq2/3U0pNc++/akt0qAuE/DxkYf3plmW2Cgoi93vWay5/j11fBcr3fM0RkvWsvW+U7rB0Bk5agjIDKmqPOYUxcUCgYAuJ+OgqEjVgy4/C0C7z+nu/X6KufIB05QxY7W8+Ebv8TNN2ywErvFRq7W8k2jrqlA+K/BpiTIAZPf4UcNZPId36QKgvCn/I8EF8r6nZ+zaovpUHNAvOwsuhYc/jlmwpmqbjP7ZYuCflcO6/FLzrkm9ytZgzrl5WdsMlHoNe8+lh9i5QKBgQCMrstELUEbNeKsIpd1XpUMFSK6A1xmgQr73F5HWossN27tYcn0lxpj+zjSk5eVlWfSzoHArPSvcCwbbbykVmsd0OrvC2TEL9TArKJyxZo069TFSsgYWHYlc+zHFW8l4dpy0Li43tg/CxxqyKBPlm2wIVmTj2nU/hLVXnlhgqaTqlMw==+-----END RSA PRIVATE KEY-----