Backport haskell#10316: Remove hashable dependency (haskell#10536)

* Remove hashable dependency (haskell#10316)

Co-authored-by: Artem Pelenitsyn <[email protected]>
(cherry picked from commit 5aaf8ea)

# Conflicts:
#	cabal.bootstrap.project
#	cabal.release.project

* fixup! conflicts

---------

Co-authored-by: Jasper Van der Jeugt <[email protected]>
Co-authored-by: Artem Pelenitsyn <[email protected]>
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Author: 3 people

cabal-install/cabal-install.cabal

@@ -231,7 +231,6 @@ library
         edit-distance >= 0.2.2 && < 0.3,
         exceptions >= 0.10.4   && < 0.11,
         filepath   >= 1.4.0.0  && < 1.6,
-        hashable   >= 1.0      && < 1.6,
         HTTP       >= 4000.1.5 && < 4000.5,
         mtl        >= 2.0      && < 2.4,
         network-uri >= 2.6.0.2 && < 2.7,
@@ -431,7 +430,6 @@ test-suite long-tests
         containers,
         directory,
         filepath,
-        hashable,
         mtl,
         network-uri >= 2.6.2.0 && <2.7,
         random,

cabal-install/src/Distribution/Client/FileMonitor.hs

@@ -35,7 +35,6 @@ import Prelude ()
 
 import Data.Binary.Get (runGetOrFail)
 import qualified Data.ByteString.Lazy as BS
-import qualified Data.Hashable as Hashable
 import qualified Data.Map.Strict as Map
 
 import Control.Exception
@@ -51,6 +50,7 @@ import qualified Control.Monad.State as State
 import Control.Monad.Trans (MonadIO, liftIO)
 
 import Distribution.Client.Glob
+import Distribution.Client.HashValue
 import Distribution.Client.Utils (MergeResult (..), mergeBy)
 import Distribution.Compat.Time
 import Distribution.Simple.FileMonitor.Types
@@ -83,8 +83,6 @@ data MonitorStateFileSet
 instance Binary MonitorStateFileSet
 instance Structured MonitorStateFileSet
 
-type Hash = Int
-
 -- | The state necessary to determine whether a monitored file has changed.
 --
 -- This covers all the cases of 'MonitorFilePath' except for globs which is
@@ -107,7 +105,7 @@ data MonitorStateFileStatus
   | -- | cached file mtime
     MonitorStateFileModTime !ModTime
   | -- | cached mtime and content hash
-    MonitorStateFileHashed !ModTime !Hash
+    MonitorStateFileHashed !ModTime !HashValue
   | MonitorStateDirExists
   | -- | cached dir mtime
     MonitorStateDirModTime !ModTime
@@ -961,21 +959,21 @@ buildMonitorStateGlobRel
 -- updating a file monitor the set of files is the same or largely the same so
 -- we can grab the previously known content hashes with their corresponding
 -- mtimes.
-type FileHashCache = Map FilePath (ModTime, Hash)
+type FileHashCache = Map FilePath (ModTime, HashValue)
 
 -- | We declare it a cache hit if the mtime of a file is the same as before.
-lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe Hash
+lookupFileHashCache :: FileHashCache -> FilePath -> ModTime -> Maybe HashValue
 lookupFileHashCache hashcache file mtime = do
   (mtime', hash) <- Map.lookup file hashcache
   guard (mtime' == mtime)
   return hash
 
 -- | Either get it from the cache or go read the file
-getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO Hash
+getFileHash :: FileHashCache -> FilePath -> FilePath -> ModTime -> IO HashValue
 getFileHash hashcache relfile absfile mtime =
   case lookupFileHashCache hashcache relfile mtime of
     Just hash -> return hash
-    Nothing -> readFileHash absfile
+    Nothing -> readFileHashValue absfile
 
 -- | Build a 'FileHashCache' from the previous 'MonitorStateFileSet'. While
 -- in principle we could preserve the structure of the previous state, given
@@ -998,7 +996,7 @@ readCacheFileHashes monitor =
       collectAllFileHashes singlePaths
         `Map.union` collectAllGlobHashes globPaths
 
-    collectAllFileHashes :: [MonitorStateFile] -> Map FilePath (ModTime, Hash)
+    collectAllFileHashes :: [MonitorStateFile] -> Map FilePath (ModTime, HashValue)
     collectAllFileHashes singlePaths =
       Map.fromList
         [ (fpath, (mtime, hash))
@@ -1010,15 +1008,15 @@ readCacheFileHashes monitor =
             singlePaths
         ]
 
-    collectAllGlobHashes :: [MonitorStateGlob] -> Map FilePath (ModTime, Hash)
+    collectAllGlobHashes :: [MonitorStateGlob] -> Map FilePath (ModTime, HashValue)
     collectAllGlobHashes globPaths =
       Map.fromList
         [ (fpath, (mtime, hash))
         | MonitorStateGlob _ _ _ gstate <- globPaths
         , (fpath, (mtime, hash)) <- collectGlobHashes "" gstate
         ]
 
-    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, Hash))]
+    collectGlobHashes :: FilePath -> MonitorStateGlobRel -> [(FilePath, (ModTime, HashValue))]
     collectGlobHashes dir (MonitorStateGlobDirs _ _ _ entries) =
       [ res
       | (subdir, fstate) <- entries
@@ -1043,13 +1041,13 @@ probeFileModificationTime root file mtime = do
   unless unchanged (somethingChanged file)
 
 -- | Within the @root@ directory, check if @file@ has its 'ModTime' and
--- 'Hash' is the same as @mtime@ and @hash@, short-circuiting if it is
+-- 'HashValue' is the same as @mtime@ and @hash@, short-circuiting if it is
 -- different.
 probeFileModificationTimeAndHash
   :: FilePath
   -> FilePath
   -> ModTime
-  -> Hash
+  -> HashValue
   -> ChangedM ()
 probeFileModificationTimeAndHash root file mtime hash = do
   unchanged <-
@@ -1092,28 +1090,22 @@ checkModificationTimeUnchanged root file mtime =
     return (mtime == mtime')
 
 -- | Returns @True@ if, inside the @root@ directory, @file@ has the
--- same 'ModTime' and 'Hash' as @mtime and @chash@.
+-- same 'ModTime' and 'HashValue' as @mtime and @chash@.
 checkFileModificationTimeAndHashUnchanged
   :: FilePath
   -> FilePath
   -> ModTime
-  -> Hash
+  -> HashValue
   -> IO Bool
 checkFileModificationTimeAndHashUnchanged root file mtime chash =
   handleIOException False $ do
     mtime' <- getModTime (root </> file)
     if mtime == mtime'
       then return True
       else do
-        chash' <- readFileHash (root </> file)
+        chash' <- readFileHashValue (root </> file)
         return (chash == chash')
 
--- | Read a non-cryptographic hash of a @file@.
-readFileHash :: FilePath -> IO Hash
-readFileHash file =
-  withBinaryFile file ReadMode $ \hnd ->
-    evaluate . Hashable.hash =<< BS.hGetContents hnd
-
 -- | Given a directory @dir@, return @Nothing@ if its 'ModTime'
 -- is the same as @mtime@, and the new 'ModTime' if it is not.
 checkDirectoryModificationTime :: FilePath -> ModTime -> IO (Maybe ModTime)

cabal-install/src/Distribution/Client/ProjectConfig.hs

@@ -96,6 +96,7 @@ import Distribution.Client.GlobalFlags
   ( RepoContext (..)
   , withRepoContext'
   )
+import Distribution.Client.HashValue
 import Distribution.Client.HttpUtils
   ( HttpTransport
   , configureTransport
@@ -185,6 +186,10 @@ import Distribution.Types.PackageVersionConstraint
 import Distribution.Types.SourceRepo
   ( RepoType (..)
   )
+import Distribution.Utils.Generic
+  ( toUTF8BS
+  , toUTF8LBS
+  )
 import Distribution.Utils.NubList
   ( fromNubList
   )
@@ -203,11 +208,9 @@ import Control.Exception (handle)
 import Control.Monad.Trans (liftIO)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Hashable as Hashable
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Numeric (showHex)
 
 import Network.URI
   ( URI (..)
@@ -1655,7 +1658,7 @@ localFileNameForRemoteTarball :: URI -> FilePath
 localFileNameForRemoteTarball uri =
   mangleName uri
     ++ "-"
-    ++ showHex locationHash ""
+    ++ showHashValue locationHash
   where
     mangleName =
       truncateString 10
@@ -1665,15 +1668,15 @@ localFileNameForRemoteTarball uri =
         . dropTrailingPathSeparator
         . uriPath
 
-    locationHash :: Word
-    locationHash = fromIntegral (Hashable.hash (uriToString id uri ""))
+    locationHash :: HashValue
+    locationHash = hashValue (toUTF8LBS (uriToString id uri ""))
 
 -- | The name to use for a local file or dir for a remote 'SourceRepo'.
 -- This is deterministic based on the source repo identity details, and
 -- intended to produce non-clashing file names for different repos.
 localFileNameForRemoteRepo :: SourceRepoList -> FilePath
 localFileNameForRemoteRepo SourceRepositoryPackage{srpType, srpLocation} =
-  mangleName srpLocation ++ "-" ++ showHex locationHash ""
+  mangleName srpLocation ++ "-" ++ showHashValue locationHash
   where
     mangleName =
       truncateString 10
@@ -1682,9 +1685,10 @@ localFileNameForRemoteRepo SourceRepositoryPackage{srpType, srpLocation} =
         . dropTrailingPathSeparator
 
     -- just the parts that make up the "identity" of the repo
-    locationHash :: Word
+    locationHash :: HashValue
     locationHash =
-      fromIntegral (Hashable.hash (show srpType, srpLocation))
+      hashValue $
+        LBS.fromChunks [toUTF8BS srpLocation, toUTF8BS (show srpType)]
 
 -- | Truncate a string, with a visual indication that it is truncated.
 truncateString :: Int -> String -> String

cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs

@@ -32,7 +32,7 @@ tests :: Int -> [TestTree]
 tests mtimeChange =
   [ testGroup
       "Structured hashes"
-      [ testCase "MonitorStateFile" $ structureHash (Proxy :: Proxy MonitorStateFile) @?= Fingerprint 0xe4108804c34962f6 0x06e94f8fc9e48e13
+      [ testCase "MonitorStateFile" $ structureHash (Proxy :: Proxy MonitorStateFile) @?= Fingerprint 0xe1339b9dcfdfe19d 0x9135a5f30da7ca82
       , testCase "MonitorStateGlob" $ structureHash (Proxy :: Proxy MonitorStateGlob) @?= Fingerprint fingerprintStateGlob1 fingerprintStateGlob2
       , testCase "MonitorStateFileSet" $ structureHash (Proxy :: Proxy MonitorStateFileSet) @?= Fingerprint fingerprintStateFileSet1 fingerprintStateFileSet2
       ]
@@ -88,10 +88,10 @@ tests mtimeChange =
       Windows -> expectFailBecause msg
       _ -> id
     fingerprintStateGlob1, fingerprintStateGlob2, fingerprintStateFileSet1, fingerprintStateFileSet2 :: Word64
-    fingerprintStateGlob1 = 0x8d6292a27f48ab78
-    fingerprintStateGlob2 = 0xa69393cf17cb6c71
-    fingerprintStateFileSet1 = 0x441fcb5eaf403013
-    fingerprintStateFileSet2 = 0x129db82bba47f56f
+    fingerprintStateGlob1 = 0x1f9edda22b7e8de6
+    fingerprintStateGlob2 = 0xda1d085c9fc6f5db
+    fingerprintStateFileSet1 = 0x00ac4a0df546905d
+    fingerprintStateFileSet2 = 0x5b2b2df018b1fa83
 
 -- Check the file system behaves the way we expect it to
 

cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs

@@ -10,7 +10,6 @@ import Prelude ()
 
 import Control.Arrow ((&&&))
 import Data.Either (lefts)
-import Data.Hashable (Hashable (..))
 import Data.List (groupBy, isInfixOf)
 
 import Text.Show.Pretty (parseValue, valToStr)
@@ -20,7 +19,7 @@ import Test.QuickCheck.Instances.Cabal ()
 import Test.Tasty (TestTree)
 
 import Distribution.Types.Flag (FlagName)
-import Distribution.Utils.ShortText (ShortText)
+import Distribution.Utils.ShortText (ShortText, fromShortText)
 
 import Distribution.Client.Setup (defaultMaxBackjumps)
 
@@ -47,7 +46,8 @@ import Distribution.Version
 
 import UnitTests.Distribution.Solver.Modular.DSL
 import UnitTests.Distribution.Solver.Modular.QuickCheck.Utils
-  ( testPropertyWithSeed
+  ( ArbitraryOrd (..)
+  , testPropertyWithSeed
   )
 
 tests :: [TestTree]
@@ -223,6 +223,9 @@ newtype VarOrdering = VarOrdering
   { unVarOrdering :: Variable P.QPN -> Variable P.QPN -> Ordering
   }
 
+instance Arbitrary VarOrdering where
+  arbitrary = VarOrdering <$> arbitraryCompare
+
 solve
   :: EnableBackjumping
   -> FineGrainedConflicts
@@ -618,22 +621,18 @@ instance Arbitrary OptionalStanza where
   shrink BenchStanzas = [TestStanzas]
   shrink TestStanzas = []
 
--- Randomly sorts solver variables using 'hash'.
--- TODO: Sorting goals with this function is very slow.
-instance Arbitrary VarOrdering where
-  arbitrary = do
-    f <- arbitrary :: Gen (Int -> Int)
-    return $ VarOrdering (comparing (f . hash))
-
-instance Hashable pn => Hashable (Variable pn)
-instance Hashable a => Hashable (P.Qualified a)
-instance Hashable P.PackagePath
-instance Hashable P.Qualifier
-instance Hashable P.Namespace
-instance Hashable OptionalStanza
-instance Hashable FlagName
-instance Hashable PackageName
-instance Hashable ShortText
+instance ArbitraryOrd pn => ArbitraryOrd (Variable pn)
+instance ArbitraryOrd a => ArbitraryOrd (P.Qualified a)
+instance ArbitraryOrd P.PackagePath
+instance ArbitraryOrd P.Qualifier
+instance ArbitraryOrd P.Namespace
+instance ArbitraryOrd OptionalStanza
+instance ArbitraryOrd FlagName
+instance ArbitraryOrd PackageName
+instance ArbitraryOrd ShortText where
+  arbitraryCompare = do
+    strc <- arbitraryCompare
+    pure $ \l r -> strc (fromShortText l) (fromShortText r)
 
 deriving instance Generic (Variable pn)
 deriving instance Generic (P.Qualified a)