Fix most warnings

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

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,

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

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

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') <$>

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

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
 

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

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

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

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

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 #-}

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 #-}
 
 --------------------------------------------------------------------------------

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'.
 --