mysql-haskell 1.1.0 → 1.1.2
raw patch · 15 files changed
+84/−41 lines, 15 filesdep −binary-ieee754PVP ok
version bump matches the API change (PVP)
Dependencies removed: binary-ieee754
API changes (from Hackage documentation)
Files
- ChangeLog.md +17/−2
- mysql-haskell.cabal +1/−2
- src/Data/TLSSetting.hs +4/−2
- src/Database/MySQL/Base.hs +0/−1
- src/Database/MySQL/BinLogProtocol/BinLogEvent.hs +3/−4
- src/Database/MySQL/BinLogProtocol/BinLogMeta.hs +0/−1
- src/Database/MySQL/BinLogProtocol/BinLogValue.hs +3/−5
- src/Database/MySQL/Connection.hs +1/−2
- src/Database/MySQL/Protocol/Auth.hs +1/−2
- src/Database/MySQL/Protocol/ColumnDef.hs +0/−1
- src/Database/MySQL/Protocol/Command.hs +0/−1
- src/Database/MySQL/Protocol/Escape.hs +39/−0
- src/Database/MySQL/Protocol/MySQLValue.hs +6/−8
- src/Database/MySQL/Protocol/Packet.hs +3/−4
- src/System/IO/Streams/TCP.hs +6/−6
ChangeLog.md view
@@ -1,8 +1,23 @@-# Revision history for mysql-pure+# Revision history for mysql-haskell -## 1.1.1 -- TBD+## 1.1.2 -- 2023.08.14 ++ Fix package name of changelog++ Drop support for RC4 chipher which is depracated++ drop dependency on binary-ieee754, which was unused.++ Fix text 2 support, thanks @RikvanToor++## 1.1.1 -- 2023.08.14+ + cleaned up some warnings++ Merge back into mysql-haskell after gaining hackage access.++ Deprecate mysql-pure in favor of old hackage+ since it's only been out for a day this sort off+ stream lines upgrading for most applications.+ Cabal will just figure it out, rather then+ users having to "find" mysql-pure.+ I'll just make a bonus announcement to+ let people not depend on mysql-pure. ## 1.1.0 -- 2023.08.12 There was a bunch of stuff unrelated to mysql
mysql-haskell.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: mysql-haskell-version: 1.1.0+version: 1.1.2 synopsis: pure haskell MySQL driver description: pure haskell MySQL driver. license: BSD-3-Clause@@ -74,7 +74,6 @@ build-depends: base >=4.7 && <4.19.0, binary >=0.8.3 && <0.9,- binary-ieee754 >=0.1.0 && <0.2, blaze-textual >=0.2 && <0.3, bytestring >=0.10.2.0 && <0.12 || ^>=0.12.0, bytestring-lexing >=0.5 && <0.6,
src/Data/TLSSetting.hs view
@@ -45,7 +45,9 @@ makeCAStore MozillaCAStore = makeCAStore . CustomCAStore =<< mozillaCAStorePath makeCAStore (CustomCAStore fp) = do bs <- B.readFile fp- let Right pems = X509.pemParseBS bs+ let pems = case X509.pemParseBS bs of+ Right pms -> pms+ Left err -> error err case mapM (X509.decodeSignedCertificate . X509.pemContent) pems of Right cas -> return (X509.makeCertificateStore cas) Left err -> error err@@ -65,7 +67,7 @@ makeClientParams tca = do caStore <- makeCAStore tca return (TLS.defaultParamsClient "" B.empty)- { TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_all }+ { TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_default } , TLS.clientShared = def { TLS.sharedCAStore = caStore , TLS.sharedValidationCache = def
src/Database/MySQL/Base.hs view
@@ -74,7 +74,6 @@ , module Database.MySQL.Protocol.MySQLValue ) where -import Control.Applicative import Control.Exception (mask, onException, throwIO) import Control.Monad import qualified Data.ByteString.Lazy as L
src/Database/MySQL/BinLogProtocol/BinLogEvent.hs view
@@ -14,7 +14,6 @@ module Database.MySQL.BinLogProtocol.BinLogEvent where -import Control.Applicative import Control.Monad import Control.Monad.Loops (untilM) import Data.Binary@@ -230,7 +229,7 @@ extraLen <- getWord16le void $ getByteString (fromIntegral extraLen - 2) colCnt <- getLenEncInt- let (plen, poffset) = (fromIntegral colCnt + 7) `quotRem` 8+ let (plen, poffset) = (colCnt + 7) `quotRem` 8 pmap <- getPresentMap plen poffset DeleteRowsEvent tid flgs colCnt pmap <$> untilM (getBinLogRow (tmColumnMeta tme) pmap) isEmpty @@ -252,7 +251,7 @@ extraLen <- getWord16le void $ getByteString (fromIntegral extraLen - 2) colCnt <- getLenEncInt- let (plen, poffset) = (fromIntegral colCnt + 7) `quotRem` 8+ let (plen, poffset) = (colCnt + 7) `quotRem` 8 pmap <- getPresentMap plen poffset WriteRowsEvent tid flgs colCnt pmap <$> untilM (getBinLogRow (tmColumnMeta tme) pmap) isEmpty @@ -274,7 +273,7 @@ extraLen <- getWord16le void $ getByteString (fromIntegral extraLen - 2) colCnt <- getLenEncInt- let (plen, poffset) = (fromIntegral colCnt + 7) `quotRem` 8+ let (plen, poffset) = (colCnt + 7) `quotRem` 8 pmap <- getPresentMap plen poffset pmap' <- getPresentMap plen poffset UpdateRowsEvent tid flgs colCnt (pmap, pmap') <$>
src/Database/MySQL/BinLogProtocol/BinLogMeta.hs view
@@ -28,7 +28,6 @@ module Database.MySQL.BinLogProtocol.BinLogMeta where -import Control.Applicative import Data.Binary.Get import Data.Bits import Data.Word
src/Database/MySQL/BinLogProtocol/BinLogValue.hs view
@@ -13,9 +13,7 @@ module Database.MySQL.BinLogProtocol.BinLogValue where -import Control.Applicative import Data.Binary.Get-import Data.Binary.IEEE754 import Data.Binary.Put () import Data.Bits import Data.ByteString (ByteString)@@ -206,7 +204,7 @@ -- following a simple lookup table. -- getBinLogField (BINLOG_TYPE_NEWDECIMAL precision scale) = do- let i = fromIntegral (precision - scale)+ let i = (precision - scale) (ucI, cI) = i `quotRem` digitsPerInteger (ucF, cF) = scale `quotRem` digitsPerInteger ucISize = fromIntegral (ucI `shiftL` 2)@@ -215,7 +213,7 @@ cFSize = fromIntegral (sizeTable `B.unsafeIndex` fromIntegral cF) len = ucISize + cISize + ucFSize + cFSize - buf <- getByteString (fromIntegral len)+ buf <- getByteString len let fb = buf `B.unsafeIndex` 0 sign = if fb .&. 0x80 == 0x80 then 1 else 0 :: Word8@@ -254,7 +252,7 @@ getBinLogField (BINLOG_TYPE_ENUM size) = if | size == 1 -> BinLogEnum . fromIntegral <$> getWord8- | size == 2 -> BinLogEnum . fromIntegral <$> getWord16be+ | size == 2 -> BinLogEnum <$> getWord16be | otherwise -> fail $ "Database.MySQL.BinLogProtocol.BinLogValue: wrong \ \BINLOG_TYPE_ENUM size: " ++ show size
src/Database/MySQL/Connection.hs view
@@ -13,7 +13,6 @@ module Database.MySQL.Connection where -import Control.Applicative import Control.Exception (Exception, bracketOnError, throwIO, catch, SomeException) import Control.Monad@@ -234,7 +233,7 @@ writeCommand :: Command -> (Packet -> IO ()) -> IO () writeCommand a writePacket = let bs = Binary.runPut (putCommand a) in- go (fromIntegral (L.length bs)) 0 bs writePacket+ go (L.length bs) 0 bs writePacket where go len seqN bs writePacket' = do if len < 16777215
src/Database/MySQL/Protocol/Auth.hs view
@@ -16,7 +16,6 @@ module Database.MySQL.Protocol.Auth where -import Control.Applicative import Control.Monad import Data.Binary import Data.Binary.Get@@ -97,7 +96,7 @@ status <- getWord16le capH <- getWord16le let cap = fromIntegral capH `shiftL` 16 .|. fromIntegral capL- authPluginLen <- getWord8 -- this will issue an unused warning, see the notes below+ _authPluginLen <- getWord8 -- this will issue an unused warning, see the notes below skipN 10 -- 10 * 0x00 salt2 <- if (cap .&. CLIENT_SECURE_CONNECTION) == 0 then pure B.empty
src/Database/MySQL/Protocol/ColumnDef.hs view
@@ -16,7 +16,6 @@ module Database.MySQL.Protocol.ColumnDef where -import Control.Applicative import Data.Binary import Data.Binary.Get import Data.Binary.Parser
src/Database/MySQL/Protocol/Command.hs view
@@ -15,7 +15,6 @@ module Database.MySQL.Protocol.Command where -import Control.Applicative import Control.Monad import Data.Binary import Data.Binary.Get
src/Database/MySQL/Protocol/Escape.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-| Module : Database.MySQL.Protocol.Escape@@ -32,6 +33,7 @@ module Database.MySQL.Protocol.Escape where +import Control.Monad (forM_) import Data.ByteString (ByteString) import qualified Data.ByteString.Internal as B import Data.Text (Text)@@ -44,6 +46,7 @@ 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 =@@ -60,6 +63,41 @@ | 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 -- \\++ | 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++ 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)@@ -77,6 +115,7 @@ | c == 92 -> escape 92 marr ix' >> go2 -- \\ | otherwise -> TA.unsafeWrite marr ix' c >> go1+#endif escapeBytes :: ByteString -> ByteString escapeBytes (B.PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \ a ->
src/Database/MySQL/Protocol/MySQLValue.hs view
@@ -34,11 +34,9 @@ ) where import qualified Blaze.Text as Textual-import Control.Applicative import Control.Monad import Data.Binary.Put import Data.Binary.Parser-import Data.Binary.IEEE754 import Data.Bits import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -294,7 +292,7 @@ | t == mySQLTypeLong || t == mySQLTypeInt24 = if isUnsigned then MySQLInt32U <$> getWord32le else MySQLInt32 <$> getInt32le- | t == mySQLTypeYear = MySQLYear . fromIntegral <$> getWord16le+ | t == mySQLTypeYear = MySQLYear <$> getWord16le | t == mySQLTypeLongLong = if isUnsigned then MySQLInt64U <$> getWord64le else MySQLInt64 <$> getInt64le | t == mySQLTypeFloat = MySQLFloat <$> getFloatle@@ -386,7 +384,7 @@ getSecond4 :: Get Pico getSecond4 = realToFrac <$> getWord8 getSecond8 :: Get Pico- getSecond8 = realToFrac <$> do+ getSecond8 = do s <- getInt8' ms <- fromIntegral <$> getWord32le :: Get Int pure $! (realToFrac s + realToFrac ms / 1000000 :: Pico)@@ -402,10 +400,10 @@ | bytes == 2 -> fromIntegral <$> getWord16be | bytes == 3 -> fromIntegral <$> getWord24be | bytes == 4 -> fromIntegral <$> getWord32be- | bytes == 5 -> fromIntegral <$> getWord40be- | bytes == 6 -> fromIntegral <$> getWord48be- | bytes == 7 -> fromIntegral <$> getWord56be- | bytes == 8 -> fromIntegral <$> getWord64be+ | bytes == 5 -> getWord40be+ | bytes == 6 -> getWord48be+ | bytes == 7 -> getWord56be+ | bytes == 8 -> getWord64be | otherwise -> fail $ "Database.MySQL.Protocol.MySQLValue: \ \wrong bit length size: " ++ show bytes {-# INLINE getBits #-}
src/Database/MySQL/Protocol/Packet.hs view
@@ -15,7 +15,6 @@ module Database.MySQL.Protocol.Packet where -import Control.Applicative import Control.Exception (Exception (..), throwIO) import Data.Binary.Parser import Data.Binary.Put@@ -50,7 +49,7 @@ getPacket = do len <- fromIntegral <$> getWord24le seqN <- getWord8- body <- getLazyByteString (fromIntegral len)+ body <- getLazyByteString len return (Packet len seqN body) {-# INLINE getPacket #-} @@ -101,14 +100,14 @@ encodeToPacket seqN payload = let s = encode payload l = L.length s- in Packet (fromIntegral l) seqN s+ in Packet l seqN s {-# INLINE encodeToPacket #-} putToPacket :: Word8 -> Put -> Packet putToPacket seqN payload = let s = runPut payload l = L.length s- in Packet (fromIntegral l) seqN s+ in Packet l seqN s {-# INLINE putToPacket #-} --------------------------------------------------------------------------------
src/System/IO/Streams/TCP.hs view
@@ -81,10 +81,10 @@ return (sock, addr) ) where- resolveAddrInfo host port = do+ resolveAddrInfo host' port' = do -- Partial function here OK, network will throw an exception rather than -- return the empty list here.- (addrInfo:_) <- N.getAddrInfo (Just hints) (Just host) (Just $ show port)+ (addrInfo:_) <- N.getAddrInfo (Just hints) (Just host') (Just $ show port') let family = N.addrFamily addrInfo let socketType = N.addrSocketType addrInfo let protocol = N.addrProtocol addrInfo@@ -107,11 +107,11 @@ is <- S.makeInputStream $ do s <- NB.recv sock bufsiz return $! if B.null s then Nothing else Just s- return (Connection is (send sock) (N.close sock) (sock, addr))+ return (Connection is (send' sock) (N.close sock) (sock, addr)) where- send _ (L.Empty) = return ()- send sock (L.Chunk bs L.Empty) = unless (B.null bs) (NB.sendAll sock bs)- send sock lbs = NL.sendAll sock lbs+ send' _ (L.Empty) = return ()+ send' sock' (L.Chunk bs L.Empty) = unless (B.null bs) (NB.sendAll sock' bs)+ send' sock' lbs = NL.sendAll sock' lbs -- | Connect to server using 'defaultChunkSize'. --