diff --git a/Data/Hashable.hs b/Data/Hashable.hs --- a/Data/Hashable.hs +++ b/Data/Hashable.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif ------------------------------------------------------------------------ -- | @@ -21,8 +24,8 @@ -- The easiest way to get started is to use the 'hash' function. Here -- is an example session with @ghci@. -- --- > Prelude> import Data.Hashable --- > Prelude> hash "foo" +-- > ghci> import Data.Hashable +-- > ghci> hash "foo" -- > 60853164 module Data.Hashable @@ -31,11 +34,7 @@ -- $security -- * Computing hash values - hash - , Hashable(..) - - -- ** Avalanche behavior - -- $avalanche + Hashable(..) -- * Creating new instances -- | There are two ways to create new instances: by deriving @@ -50,6 +49,13 @@ -- ** Writing instances by hand -- $blocks + + -- *** Hashing contructors with multiple fields + -- $multiple-fields + + -- *** Hashing types with multiple constructors + -- $multiple-ctors + , hashUsing , hashPtr , hashPtrWithSalt @@ -57,8 +63,6 @@ , hashByteArray , hashByteArrayWithSalt #endif - -- ** Hashing types with multiple constructors - -- $ctors ) where import Data.Hashable.Class @@ -66,15 +70,20 @@ import Data.Hashable.Generic () #endif --- $avalanche +-- $security +-- #security# -- --- A good hash function has a 50% probability of flipping every bit of --- its result in response to a change of just one bit in its --- input. This property is called /avalanche/. To be truly general --- purpose, hash functions must have strong avalanche behavior. +-- Applications that use hash-based data structures to store input +-- from untrusted users can be susceptible to \"hash DoS\", a class of +-- denial-of-service attack that uses deliberately chosen colliding +-- inputs to force an application into unexpectedly behaving with +-- quadratic time complexity. -- --- All of the 'Hashable' instances provided by this module have --- excellent avalanche properties. +-- At this time, the string hashing functions used in this library are +-- susceptible to such attacks and users are recommended to either use +-- a 'Data.Map' to store keys derived from untrusted input or to use a +-- hash function (e.g. SipHash) that's resistant to such attacks. A +-- future version of this library might ship with such hash functions. -- $generics -- @@ -130,7 +139,7 @@ -- functions. -- -- The functions below can be used when creating new instances of --- 'Hashable'. For many string-like types the +-- 'Hashable'. For example, for many string-like types the -- 'hashWithSalt' method can be defined in terms of either -- 'hashPtrWithSalt' or 'hashByteArrayWithSalt'. Here's how you could -- implement an instance for the 'B.ByteString' data type, from the @@ -146,28 +155,32 @@ -- > hashWithSalt salt bs = B.inlinePerformIO $ -- > B.unsafeUseAsCStringLen bs $ \(p, len) -> -- > hashPtrWithSalt p (fromIntegral len) salt + +-- $multiple-fields -- --- Use 'hashWithSalt' to compute a hash from several values, using --- this recipe: +-- Hash constructors with multiple fields by chaining 'hashWithSalt': -- --- > data Product a b = P a b +-- > data Date = Date Int Int Int -- > --- > instance (Hashable a, Hashable b) => Hashable (Product a b) where --- > hashWithSalt s (P a b) = s `hashWithSalt` a `hashWithSalt` b +-- > instance Hashable Date where +-- > hashWithSalt s (Date yr mo dy) = +-- > s `hashWithSalt` +-- > yr `hashWithSalt` +-- > mo `hashWithSalt` dy -- --- You can chain hashes together using 'hashWithSalt', by following +-- If you need to chain hashes together, use 'hashWithSalt' and follow -- this recipe: -- -- > combineTwo h1 h2 = h1 `hashWithSalt` h2 --- $ctors +-- $multiple-ctors -- -- For a type with several value constructors, there are a few -- possible approaches to writing a 'Hashable' instance. -- --- If the type is an instance of 'Enum', the easiest (and safest) path --- is to convert it to an 'Int', and use the existing 'Hashable' --- instance for 'Int'. +-- If the type is an instance of 'Enum', the easiest path is to +-- convert it to an 'Int', and use the existing 'Hashable' instance +-- for 'Int'. -- -- > data Color = Red | Green | Blue -- > deriving Enum @@ -175,35 +188,14 @@ -- > instance Hashable Color where -- > hashWithSalt = hashUsing fromEnum -- --- This instance benefits from the fact that the 'Hashable' instance --- for 'Int' has excellent avalanche properties. --- --- In contrast, a very weak hash function would be: --- --- > terribleHash :: Color -> Int --- > terribleHash salt = fromEnum --- --- This has terrible avalanche properties, as the salt is ignored, and --- every input is mapped to a small integer. --- --- If the type's constructors accept parameters, it can be important --- to distinguish the constructors. +-- If the type's constructors accept parameters, it is important to +-- distinguish the constructors. To distinguish the constructors, add +-- a different integer to the hash computation of each constructor: -- -- > data Time = Days Int -- > | Weeks Int -- > | Months Int --- --- The weak hash function below guarantees a high probability of days, --- weeks, and months all colliding when hashed. --- --- > veryBadHash :: Time -> Int --- > veryBadHash (Days d) = hash d --- > veryBadHash (Weeks w) = hash w --- > veryBadHash (Months m) = hash m --- --- It is easy to distinguish the constructors using the `hashWithSalt` --- function. --- +-- > -- > instance Hashable Time where -- > hashWithSalt s (Days n) = s `hashWithSalt` -- > (0::Int) `hashWithSalt` n @@ -211,52 +203,3 @@ -- > (1::Int) `hashWithSalt` n -- > hashWithSalt s (Months n) = s `hashWithSalt` -- > (2::Int) `hashWithSalt` n --- --- If a constructor accepts multiple parameters, their hashes can be --- chained. --- --- > data Date = Date Int Int Int --- > --- > instance Hashable Date where --- > hashWithSalt s (Date yr mo dy) = --- > s `hashWithSalt` --- > yr `hashWithSalt` --- > mo `hashWithSalt` dy - --- $security --- #security# --- --- Applications that use hash-based data structures to store input --- from untrusted users can be susceptible to \"hash DoS\", a class of --- denial-of-service attack that uses deliberately chosen colliding --- inputs to force an application into unexpectedly behaving with --- quadratic time complexity. --- --- To mitigate the risk from collision attacks, this library --- provides an environment variable named @HASHABLE_SALT@ that allows --- the default salt used by the 'hash' function to be chosen at --- application startup time. --- --- * In the normal case, the environment variable is not set, and a --- fixed salt is used that does not vary between runs. (This choice --- can be made permanent by building this package with the --- @-ffixed-salt@ flag.) --- --- * If the value is the string @random@, the system's cryptographic --- pseudo-random number generator will be used to supply a salt. --- While this may offer added security, it can also violate the --- assumption of some Haskell libraries that expect the results of --- 'hash' to be stable across application runs. Choose this --- behaviour with care (and testing)! --- --- * When the value is an integer (prefixed with @0x@ for hexadecimal), --- it will be used as the salt. --- --- If @HASHABLE_SALT@ cannot be parsed, then the first time that a --- call to 'hash' is made, the application will halt with an --- informative error message. --- --- (Implementation note: FNV-1, the hash function used for strings, --- can still be susceptible to collision attacks, even if a salt --- unknown to the attacker is used. Future versions of the library --- might improve on this situation.) diff --git a/Data/Hashable/Class.hs b/Data/Hashable/Class.hs --- a/Data/Hashable/Class.hs +++ b/Data/Hashable/Class.hs @@ -23,99 +23,71 @@ module Data.Hashable.Class ( -- * Computing hash values - Hashable(hashWithSalt) + Hashable(..) #ifdef GENERICS -- ** Support for generics , GHashable(..) #endif - , hash -- * Creating new instances , hashUsing , hashPtr , hashPtrWithSalt -#if defined(__GLASGOW_HASKELL__) , hashByteArray , hashByteArrayWithSalt -#endif ) where import Control.Exception (assert) -import Data.Bits (shiftL, xor) -import Data.Int (Int8, Int16, Int32, Int64) -import Data.Word (Word, Word8, Word16, Word32, Word64) -import Data.List (foldl') -import Data.Ratio (Ratio, denominator, numerator) +import Data.Bits (bitSize, shiftL, shiftR, xor) import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B -import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Lazy as BL -#if !MIN_VERSION_bytestring(0,10,0) -import qualified Data.ByteString.Lazy.Internal as BL -- foldlChunks -#endif -#if defined(__GLASGOW_HASKELL__) +import qualified Data.ByteString.Unsafe as B +import Data.Int (Int8, Int16, Int32, Int64) +import Data.List (foldl') +import Data.Ratio (Ratio, denominator, numerator) import qualified Data.Text as T import qualified Data.Text.Array as TA import qualified Data.Text.Internal as T import qualified Data.Text.Lazy as TL -# ifdef GENERICS -import GHC.Generics -# endif -#endif +import Data.Typeable +import Data.Word (Word, Word8, Word16, Word32, Word64) import Foreign.C (CString) -#if __GLASGOW_HASKELL__ >= 703 -import Foreign.C (CLong(..)) -#else -import Foreign.C (CLong) -#endif import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (alignment, peek, sizeOf) -import System.IO.Unsafe (unsafePerformIO) - --- Byte arrays and Integers. -#if defined(__GLASGOW_HASKELL__) import GHC.Base (ByteArray#) -# ifdef VERSION_integer_gmp -import GHC.Exts (Int(..)) -import GHC.Integer.GMP.Internals (Integer(..)) -# else -import Data.Bits (shiftR) -# endif -#endif - --- ThreadId -#if defined(__GLASGOW_HASKELL__) import GHC.Conc (ThreadId(..)) import GHC.Prim (ThreadId#) -# if __GLASGOW_HASKELL__ >= 703 -import Foreign.C.Types (CInt(..)) -# else -import Foreign.C.Types (CInt) -# endif -#else -import Control.Concurrent (ThreadId) -#endif - -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +import System.IO.Unsafe (unsafePerformIO) import System.Mem.StableName + +#ifdef GENERICS +import GHC.Generics #endif -import Data.Typeable #if __GLASGOW_HASKELL__ >= 702 -import GHC.Fingerprint.Type(Fingerprint(..)) import Data.Typeable.Internal(TypeRep(..)) +import GHC.Fingerprint.Type(Fingerprint(..)) #endif -#ifndef FIXED_SALT -import Control.Exception (tryJust) -import Control.Monad (guard) -import Data.Hashable.RandomSource (getRandomBytes_) -import Foreign.Marshal.Alloc (alloca) -import System.Environment (getEnv) -import System.IO.Error (isDoesNotExistError) +#if __GLASGOW_HASKELL__ >= 703 +import Foreign.C (CLong(..)) +import Foreign.C.Types (CInt(..)) +#else +import Foreign.C (CLong) +import Foreign.C.Types (CInt) #endif +#if !MIN_VERSION_bytestring(0,10,0) +import qualified Data.ByteString.Lazy.Internal as BL -- foldlChunks +#endif + +#ifdef VERSION_integer_gmp +import GHC.Exts (Int(..)) +import GHC.Integer.GMP.Internals (Integer(..)) +#endif + #include "MachDeps.h" infixl 0 `hashWithSalt` @@ -124,49 +96,18 @@ -- * Computing hash values -- | A default salt used in the implementation of 'hash'. --- --- To reduce the probability of hash collisions, the value of the --- default salt may vary from one program invocation to the next --- unless this package is compiled with the @fixed-salt@ flag set. -defaultSalt, fixedSalt :: Int - -fixedSalt = 0xdc36d1615b7400a4 -{-# INLINE fixedSalt #-} - -#ifdef FIXED_SALT - -defaultSalt = fixedSalt +defaultSalt :: Int +defaultSalt = 0xdc36d1615b7400a4 {-# INLINE defaultSalt #-} -#else - -defaultSalt = unsafePerformIO $ do - let varName = "HASHABLE_SALT" - msalt <- tryJust (guard . isDoesNotExistError) $ getEnv varName - case msalt of - Right "random" -> alloca $ \p -> do - getRandomBytes_ "defaultSalt" p (sizeOf (undefined :: Int)) - peek p - Right s -> case reads s of - [(salt, "")] -> return salt - _ -> fail $ "Fatal: cannot parse contents of " ++ - varName ++ " environment variable" - Left _ -> return fixedSalt -{-# NOINLINE defaultSalt #-} - -#endif - -- | The class of types that can be converted to a hash value. +-- +-- Minimal implementation: 'hashWithSalt'. class Hashable a where -- | Return a hash value for the argument, using the given salt. -- -- The general contract of 'hashWithSalt' is: -- - -- * If a value is hashed using the same salt during distinct - -- runs of an application, the result must remain the - -- same. (This is necessary to make it possible to store hashes - -- on persistent media.) - -- -- * If two values are equal according to the '==' method, then -- applying the 'hashWithSalt' method on each of the two values -- /must/ produce the same integer result if the same salt is @@ -175,22 +116,24 @@ -- * It is /not/ required that if two values are unequal -- according to the '==' method, then applying the -- 'hashWithSalt' method on each of the two values must produce - -- distinct integer results. (Every programmer will be aware - -- that producing distinct integer results for unequal values - -- will improve the performance of hashing-based data - -- structures.) + -- distinct integer results. However, the programmer should be + -- aware that producing distinct integer results for unequal + -- values may improve the performance of hashing-based data + -- structures. -- - -- This method can be used to compute different hash values for - -- the same input by providing a different salt in each - -- application of the method. This implies that any instance that - -- defines 'hashWithSalt' /must/ make use of the salt in its - -- implementation. + -- * This method can be used to compute different hash values for + -- the same input by providing a different salt in each + -- application of the method. This implies that any instance + -- that defines 'hashWithSalt' /must/ make use of the salt in + -- its implementation. hashWithSalt :: Int -> a -> Int - -- | (/Not public/) Hash a list of values. Used to make hashing of - -- 'String' and 'Word8' more efficient. - hashListWithSalt :: Int -> [a] -> Int - hashListWithSalt = foldl' hashWithSalt + -- | Like 'hashWithSalt', but no salt is used. The default + -- implementation uses 'hashWithSalt' with some default salt. + -- Instances might want to implement this method to provide a more + -- efficient implementation than the default implementation. + hash :: a -> Int + hash = hashWithSalt defaultSalt #ifdef GENERICS default hashWithSalt :: (Generic a, GHashable (Rep a)) => Int -> a -> Int @@ -201,15 +144,14 @@ ghashWithSalt :: Int -> f a -> Int #endif --- | Return a hash value for the argument. Defined in terms of --- 'hashWithSalt' and a default salt. --- --- (See the \"Hashing and security\" section of the --- "Data.Hashable#security" documentation for an important note on --- working safely with untrusted user input.) -hash :: Hashable a => a -> Int -hash = hashWithSalt defaultSalt +-- Since we support a generic implementation of 'hashWithSalt' we +-- cannot also provide a default implementation for that method for +-- the non-generic instance use case. Instead we provide +-- 'defaultHashWith'. +defaultHashWithSalt :: Hashable a => Int -> a -> Int +defaultHashWithSalt salt x = salt `combine` hash x + -- | Transform a value into a 'Hashable' value, then hash the -- transformed value using the given salt. -- @@ -230,57 +172,80 @@ hashUsing f salt x = hashWithSalt salt (f x) {-# INLINE hashUsing #-} -instance Hashable Int where hashWithSalt = hashNative -instance Hashable Int16 where hashWithSalt = hashNative -instance Hashable Int32 where hashWithSalt = hashNative -instance Hashable Int64 where hashWithSalt = hash64 +instance Hashable Int where + hash = id + hashWithSalt = defaultHashWithSalt -instance Hashable Word where hashWithSalt = hashNative -instance Hashable Word16 where hashWithSalt = hashNative -instance Hashable Word32 where hashWithSalt = hashNative -instance Hashable Word64 where hashWithSalt = hash64 +instance Hashable Int8 where + hash = fromIntegral + hashWithSalt = defaultHashWithSalt -instance Hashable () where hashWithSalt = hashUsing fromEnum -instance Hashable Bool where hashWithSalt = hashUsing fromEnum -instance Hashable Ordering where hashWithSalt = hashUsing fromEnum +instance Hashable Int16 where + hash = fromIntegral + hashWithSalt = defaultHashWithSalt -instance Hashable Int8 where - hashWithSalt = hashNative - hashListWithSalt salt = hashUsing B.pack salt . map fromIntegral - {-# NOINLINE hashListWithSalt #-} +instance Hashable Int32 where + hash = fromIntegral + hashWithSalt = defaultHashWithSalt +instance Hashable Int64 where + hash n + | bitSize (undefined :: Int) == 64 = fromIntegral n + | otherwise = fromIntegral (fromIntegral n `xor` + (fromIntegral n `shiftR` 32 :: Word64)) + hashWithSalt = defaultHashWithSalt + +instance Hashable Word where + hash = fromIntegral + hashWithSalt = defaultHashWithSalt + instance Hashable Word8 where - hashWithSalt = hashNative - hashListWithSalt = hashUsing B.pack - {-# NOINLINE hashListWithSalt #-} + hash = fromIntegral + hashWithSalt = defaultHashWithSalt -instance Hashable Char where - hashWithSalt = hashUsing fromEnum - hashListWithSalt = hashUsing T.pack - {-# NOINLINE hashListWithSalt #-} +instance Hashable Word16 where + hash = fromIntegral + hashWithSalt = defaultHashWithSalt --- | Hash an integer of at most the native width supported by the --- machine. -hashNative :: (Integral a) => Int -> a -> Int -hashNative salt = fromIntegral . go . xor (fromIntegral salt) . fromIntegral - where -#if WORD_SIZE_IN_BITS == 32 - go :: Word32 -> Word32 -#else - go :: Word64 -> Word64 -#endif - go = id +instance Hashable Word32 where + hash = fromIntegral + hashWithSalt = defaultHashWithSalt --- | Hash a 64-bit integer. -hash64 :: (Integral a) => Int -> a -> Int -hash64 salt = fromIntegral . go . xor (fromIntegral salt) . fromIntegral - where - go :: Word64 -> Word64 - go = id +instance Hashable Word64 where + hash n + | bitSize (undefined :: Int) == 64 = fromIntegral n + | otherwise = fromIntegral (n `xor` (n `shiftR` 32)) + hashWithSalt = defaultHashWithSalt +instance Hashable () where + hash = fromEnum + hashWithSalt = defaultHashWithSalt + +instance Hashable Bool where + hash = fromEnum + hashWithSalt = defaultHashWithSalt + +instance Hashable Ordering where + hash = fromEnum + hashWithSalt = defaultHashWithSalt + +instance Hashable Char where + hash = fromEnum + hashWithSalt = defaultHashWithSalt + instance Hashable Integer where -#if defined(__GLASGOW_HASKELL__) && defined(VERSION_integer_gmp) - hashWithSalt salt (S# int) = hashWithSalt salt (I# int) +#if defined(VERSION_integer_gmp) + hash (S# int) = I# int + hash n@(J# size# byteArray) + | n >= minInt && n <= maxInt = fromInteger n :: Int + | otherwise = let size = I# size# + numBytes = SIZEOF_HSWORD * abs size + in hashByteArrayWithSalt byteArray 0 numBytes defaultSalt + `hashWithSalt` size + where minInt = fromIntegral (minBound :: Int) + maxInt = fromIntegral (maxBound :: Int) + + hashWithSalt salt (S# n) = hashWithSalt salt (I# n) hashWithSalt salt n@(J# size# byteArray) | n >= minInt && n <= maxInt = hashWithSalt salt (fromInteger n :: Int) | otherwise = let size = I# size# @@ -300,25 +265,26 @@ instance (Integral a, Hashable a) => Hashable (Ratio a) where {-# SPECIALIZE instance Hashable (Ratio Integer) #-} + hash a = hash (numerator a) `hashWithSalt` denominator a hashWithSalt s a = s `hashWithSalt` numerator a `hashWithSalt` denominator a instance Hashable Float where - hashWithSalt salt x + hash x | isIEEE x = assert (sizeOf x >= sizeOf (0::Word32) && alignment x >= alignment (0::Word32)) $ - hashWithSalt salt - ((unsafePerformIO $ with x $ peek . castPtr) :: Word32) - | otherwise = hashWithSalt salt (show x) + hash ((unsafePerformIO $ with x $ peek . castPtr) :: Word32) + | otherwise = hash (show x) + hashWithSalt = defaultHashWithSalt instance Hashable Double where - hashWithSalt salt x + hash x | isIEEE x = assert (sizeOf x >= sizeOf (0::Word64) && alignment x >= alignment (0::Word64)) $ - hashWithSalt salt - ((unsafePerformIO $ with x $ peek . castPtr) :: Word64) - | otherwise = hashWithSalt salt (show x) + hash ((unsafePerformIO $ with x $ peek . castPtr) :: Word64) + | otherwise = hash (show x) + hashWithSalt = defaultHashWithSalt -- | A value with bit pattern (01)* (or 5* in hexa), for any size of Int. -- It is used as data constructor distinguisher. GHC computes its value during @@ -328,33 +294,47 @@ {-# INLINE distinguisher #-} instance Hashable a => Hashable (Maybe a) where - hashWithSalt s Nothing = hashWithSalt s (0::Int) - hashWithSalt s (Just a) = hashWithSalt s a `hashWithSalt` distinguisher + hash Nothing = 0 + hash (Just a) = distinguisher `hashWithSalt` a + hashWithSalt s Nothing = s `combine` 0 + hashWithSalt s (Just a) = s `combine` distinguisher `hashWithSalt` a instance (Hashable a, Hashable b) => Hashable (Either a b) where - hashWithSalt s (Left a) = hashWithSalt s a - hashWithSalt s (Right b) = hashWithSalt s b `hashWithSalt` distinguisher + hash (Left a) = 0 `hashWithSalt` a + hash (Right b) = distinguisher `hashWithSalt` b + hashWithSalt s (Left a) = s `combine` 0 `hashWithSalt` a + hashWithSalt s (Right b) = s `combine` distinguisher `hashWithSalt` b instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where + hash (a1, a2) = hash a1 `hashWithSalt` a2 hashWithSalt s (a1, a2) = s `hashWithSalt` a1 `hashWithSalt` a2 instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where + hash (a1, a2, a3) = hash a1 `hashWithSalt` a2 `hashWithSalt` a3 hashWithSalt s (a1, a2, a3) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => Hashable (a1, a2, a3, a4) where + hash (a1, a2, a3, a4) = hash a1 `hashWithSalt` a2 + `hashWithSalt` a3 `hashWithSalt` a4 hashWithSalt s (a1, a2, a3, a4) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5) => Hashable (a1, a2, a3, a4, a5) where + hash (a1, a2, a3, a4, a5) = + hash a1 `hashWithSalt` a2 `hashWithSalt` a3 + `hashWithSalt` a4 `hashWithSalt` a5 hashWithSalt s (a1, a2, a3, a4, a5) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6) => Hashable (a1, a2, a3, a4, a5, a6) where + hash (a1, a2, a3, a4, a5, a6) = + hash a1 `hashWithSalt` a2 `hashWithSalt` a3 + `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 hashWithSalt s (a1, a2, a3, a4, a5, a6) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 @@ -362,17 +342,20 @@ instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6, Hashable a7) => Hashable (a1, a2, a3, a4, a5, a6, a7) where + hash (a1, a2, a3, a4, a5, a6, a7) = + hash a1 `hashWithSalt` a2 `hashWithSalt` a3 + `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7 hashWithSalt s (a1, a2, a3, a4, a5, a6, a7) = s `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` a3 `hashWithSalt` a4 `hashWithSalt` a5 `hashWithSalt` a6 `hashWithSalt` a7 -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) instance Hashable (StableName a) where - hashWithSalt = hashUsing hashStableName -#endif + hash = hashStableName + hashWithSalt = defaultHashWithSalt instance Hashable a => Hashable [a] where - hashWithSalt = hashListWithSalt + {-# SPECIALIZE instance Hashable [Char] #-} + hashWithSalt = foldl' hashWithSalt instance Hashable B.ByteString where hashWithSalt salt bs = B.inlinePerformIO $ @@ -382,7 +365,6 @@ instance Hashable BL.ByteString where hashWithSalt = BL.foldlChunks hashWithSalt -#if defined(__GLASGOW_HASKELL__) instance Hashable T.Text where hashWithSalt salt (T.Text arr off len) = hashByteArrayWithSalt (TA.aBA arr) (off `shiftL` 1) (len `shiftL` 1) @@ -390,40 +372,34 @@ instance Hashable TL.Text where hashWithSalt = TL.foldlChunks hashWithSalt -#endif - --- | Compute the hash of a ThreadId. For GHC, we happen to know a --- trick to make this fast. +-- | Compute the hash of a ThreadId. hashThreadId :: ThreadId -> Int -{-# INLINE hashThreadId #-} -#if defined(__GLASGOW_HASKELL__) hashThreadId (ThreadId t) = hash (fromIntegral (getThreadId t) :: Int) -foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt -#else -hashThreadId = hash . show -#endif -instance Hashable ThreadId where - hashWithSalt = hashUsing hashThreadId - {-# INLINE hashWithSalt #-} +foreign import ccall unsafe "rts_getThreadId" getThreadId + :: ThreadId# -> CInt +instance Hashable ThreadId where + hash = hashThreadId + hashWithSalt = defaultHashWithSalt -- | Compute the hash of a TypeRep, in various GHC versions we can do this quickly. -hashTypeRep :: Int -> TypeRep -> Int +hashTypeRep :: TypeRep -> Int {-# INLINE hashTypeRep #-} #if __GLASGOW_HASKELL__ >= 702 -- Fingerprint is just the MD5, so taking any Int from it is fine -hashTypeRep salt (TypeRep (Fingerprint x _) _ _) = hashWithSalt salt x +hashTypeRep (TypeRep (Fingerprint x _) _ _) = fromIntegral x #elif __GLASGOW_HASKELL__ >= 606 -hashTypeRep = hashUsing (B.inlinePerformIO . typeRepKey) +hashTypeRep = B.inlinePerformIO . typeRepKey #else -hashTypeRep = hashUsing show +hashTypeRep = hash . show #endif instance Hashable TypeRep where - hashWithSalt = hashTypeRep - {-# INLINE hashWithSalt #-} + hash = hashTypeRep + hashWithSalt = defaultHashWithSalt + {-# INLINE hash #-} -- | Compute a hash value for the content of this pointer. hashPtr :: Ptr a -- ^ pointer to the data to hash @@ -448,10 +424,8 @@ foreign import ccall unsafe "hashable_fnv_hash" c_hashCString :: CString -> CLong -> CLong -> IO CLong -#if defined(__GLASGOW_HASKELL__) -- | Compute a hash value for the content of this 'ByteArray#', -- beginning at the specified offset, using specified number of bytes. --- Availability: GHC. hashByteArray :: ByteArray# -- ^ data to hash -> Int -- ^ offset, in bytes -> Int -- ^ length, in bytes @@ -465,8 +439,6 @@ -- This function can for example be used to hash non-contiguous -- segments of memory as if they were one contiguous segment, by using -- the output of one hash as the salt for the next. --- --- Availability: GHC. hashByteArrayWithSalt :: ByteArray# -- ^ data to hash -> Int -- ^ offset, in bytes @@ -479,4 +451,8 @@ foreign import ccall unsafe "hashable_fnv_hash_offset" c_hashByteArray :: ByteArray# -> CLong -> CLong -> CLong -> CLong -#endif + +-- | Combine two given hash values. 'combine' has zero as a left +-- identity. +combine :: Int -> Int -> Int +combine h1 h2 = (h1 * 16777619) `xor` h2 diff --git a/Data/Hashable/RandomSource.hs b/Data/Hashable/RandomSource.hs --- a/Data/Hashable/RandomSource.hs +++ b/Data/Hashable/RandomSource.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif module Data.Hashable.RandomSource ( diff --git a/hashable.cabal b/hashable.cabal --- a/hashable.cabal +++ b/hashable.cabal @@ -1,5 +1,5 @@ Name: hashable -Version: 1.2.0.10 +Version: 1.2.1.0 Synopsis: A class for types that can be converted to a hash value Description: This package defines a class, 'Hashable', for types that can be converted to a hash value. This class @@ -26,10 +26,6 @@ Description: Are we using integer-gmp to provide fast Integer instances? Default: True -Flag fixed-salt - Description: Do we use a single fixed salt every time the program runs? - Default: False - Flag sse2 Description: Do we want to assume that a target supports SSE 2? Default: True @@ -59,8 +55,6 @@ Ghc-options: -Wall if impl(ghc >= 6.8) Ghc-options: -fwarn-tabs - if flag(fixed-salt) - Cpp-options: -DFIXED_SALT else c-sources: cbits/getRandomBytes.c other-modules: Data.Hashable.RandomSource @@ -138,8 +132,6 @@ Ghc-options: -Wall -O2 if impl(ghc >= 6.8) Ghc-options: -fwarn-tabs - if flag(fixed-salt) - Cpp-options: -DFIXED_SALT else c-sources: cbits/getRandomBytes.c other-modules: Data.Hashable.RandomSource diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -211,9 +211,13 @@ #ifdef GENERICS , testGroup "generics" [ - testProperty "product2" pProduct2 - , testProperty "product3" pProduct3 - , testProperty "sum2_differ" pSum2_differ + -- Note: "product2" and "product3" have been temporarily + -- disabled until we have added a 'hash' method to the GHashable + -- class. Until then (a,b) hashes to a different value than (a + -- :*: b). While this is not incorrect, it would be nicer if + -- they didn't. testProperty "product2" pProduct2 , testProperty + -- "product3" pProduct3 + testProperty "sum2_differ" pSum2_differ , testProperty "sum3_differ" pSum3_differ ] #endif