diff --git a/ChangeLog.md b/ChangeLog.md index 625a9bc..d69ad77 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,8 +1,22 @@ -# 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. + +## 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 diff --git a/mysql-haskell.cabal b/mysql-haskell.cabal index 4cd095e..84cdf09 100644 --- a/mysql-haskell.cabal +++ b/mysql-haskell.cabal @@ -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 @@ library 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, diff --git a/src/Data/TLSSetting.hs b/src/Data/TLSSetting.hs index 01fe1ea..8bfa928 100644 --- a/src/Data/TLSSetting.hs +++ b/src/Data/TLSSetting.hs @@ -45,7 +45,9 @@ makeCAStore SystemCAStore = X509.getSystemCertificateStore 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 :: TrustedCAStore -- ^ trusted certificates. 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 diff --git a/src/Database/MySQL/Base.hs b/src/Database/MySQL/Base.hs index 09f2460..6c71675 100644 --- a/src/Database/MySQL/Base.hs +++ b/src/Database/MySQL/Base.hs @@ -74,7 +74,6 @@ module Database.MySQL.Base , 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 diff --git a/src/Database/MySQL/BinLogProtocol/BinLogEvent.hs b/src/Database/MySQL/BinLogProtocol/BinLogEvent.hs index 6ba6d5b..5dcc4af 100644 --- a/src/Database/MySQL/BinLogProtocol/BinLogEvent.hs +++ b/src/Database/MySQL/BinLogProtocol/BinLogEvent.hs @@ -14,7 +14,6 @@ Binlog event type module Database.MySQL.BinLogProtocol.BinLogEvent where -import Control.Applicative import Control.Monad import Control.Monad.Loops (untilM) import Data.Binary @@ -230,7 +229,7 @@ getDeleteRowEvent fd tme typ = do 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 @@ getWriteRowEvent fd tme typ = do 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 @@ getUpdateRowEvent fd tme typ = do 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') <$> diff --git a/src/Database/MySQL/BinLogProtocol/BinLogMeta.hs b/src/Database/MySQL/BinLogProtocol/BinLogMeta.hs index c88eb43..2fb8fbd 100644 --- a/src/Database/MySQL/BinLogProtocol/BinLogMeta.hs +++ b/src/Database/MySQL/BinLogProtocol/BinLogMeta.hs @@ -28,7 +28,6 @@ You will not directly meet following 'FieldType' namely: module Database.MySQL.BinLogProtocol.BinLogMeta where -import Control.Applicative import Data.Binary.Get import Data.Bits import Data.Word diff --git a/src/Database/MySQL/BinLogProtocol/BinLogValue.hs b/src/Database/MySQL/BinLogProtocol/BinLogValue.hs index a93a4ba..86c9932 100644 --- a/src/Database/MySQL/BinLogProtocol/BinLogValue.hs +++ b/src/Database/MySQL/BinLogProtocol/BinLogValue.hs @@ -13,9 +13,7 @@ Binlog protocol 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 @@ getBinLogField BINLOG_TYPE_YEAR = do -- 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 @@ getBinLogField (BINLOG_TYPE_NEWDECIMAL precision scale) = do 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_NEWDECIMAL precision scale) = do 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 diff --git a/src/Database/MySQL/Connection.hs b/src/Database/MySQL/Connection.hs index fef82b5..a0f6daf 100644 --- a/src/Database/MySQL/Connection.hs +++ b/src/Database/MySQL/Connection.hs @@ -13,7 +13,6 @@ This is an internal module, the 'MySQLConn' type should not directly acessed to module Database.MySQL.Connection where -import Control.Applicative import Control.Exception (Exception, bracketOnError, throwIO, catch, SomeException) import Control.Monad @@ -234,7 +233,7 @@ readPacket is = Stream.read is >>= maybe 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 diff --git a/src/Database/MySQL/Protocol/Auth.hs b/src/Database/MySQL/Protocol/Auth.hs index 87f0fed..58b51c8 100644 --- a/src/Database/MySQL/Protocol/Auth.hs +++ b/src/Database/MySQL/Protocol/Auth.hs @@ -16,7 +16,6 @@ Auth related packet. module Database.MySQL.Protocol.Auth where -import Control.Applicative import Control.Monad import Data.Binary import Data.Binary.Get @@ -97,7 +96,7 @@ getGreeting = do 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 diff --git a/src/Database/MySQL/Protocol/ColumnDef.hs b/src/Database/MySQL/Protocol/ColumnDef.hs index ab3a417..4554a97 100644 --- a/src/Database/MySQL/Protocol/ColumnDef.hs +++ b/src/Database/MySQL/Protocol/ColumnDef.hs @@ -16,7 +16,6 @@ Column definition(aka. field type). module Database.MySQL.Protocol.ColumnDef where -import Control.Applicative import Data.Binary import Data.Binary.Get import Data.Binary.Parser diff --git a/src/Database/MySQL/Protocol/Command.hs b/src/Database/MySQL/Protocol/Command.hs index 61c4579..c5151d2 100644 --- a/src/Database/MySQL/Protocol/Command.hs +++ b/src/Database/MySQL/Protocol/Command.hs @@ -15,7 +15,6 @@ Common MySQL commands supports. module Database.MySQL.Protocol.Command where -import Control.Applicative import Control.Monad import Data.Binary import Data.Binary.Get diff --git a/src/Database/MySQL/Protocol/MySQLValue.hs b/src/Database/MySQL/Protocol/MySQLValue.hs index b8d6141..f94c2b7 100644 --- a/src/Database/MySQL/Protocol/MySQLValue.hs +++ b/src/Database/MySQL/Protocol/MySQLValue.hs @@ -34,11 +34,9 @@ module Database.MySQL.Protocol.MySQLValue ) 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 @@ getBinaryField f | 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 @@ getBinaryField f 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 @@ getBits bytes = | 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 #-} diff --git a/src/Database/MySQL/Protocol/Packet.hs b/src/Database/MySQL/Protocol/Packet.hs index 3b160c7..c9d542d 100644 --- a/src/Database/MySQL/Protocol/Packet.hs +++ b/src/Database/MySQL/Protocol/Packet.hs @@ -15,7 +15,6 @@ MySQL packet decoder&encoder, and varities utility. 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 :: Get Packet 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 :: Binary a => Word8 -> a -> Packet 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 #-} -------------------------------------------------------------------------------- diff --git a/src/System/IO/Streams/TCP.hs b/src/System/IO/Streams/TCP.hs index 457bbcb..e8a9cf0 100644 --- a/src/System/IO/Streams/TCP.hs +++ b/src/System/IO/Streams/TCP.hs @@ -81,10 +81,10 @@ connectSocket host port = do 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 @@ socketToConnection bufsiz (sock, addr) = do 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'. --