diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown new file mode 100644 --- /dev/null +++ b/CHANGELOG.markdown @@ -0,0 +1,19 @@ +1.1 +--- +* Parameterize `Hash32/64/128` types by the type of their hashed source data, + to enforce legitimate equality comparisons of hashes. +* Add `StableHashable` for distinguishing types with respect to their hashes + across platforms and programs. + +1.0 +--- +* Added a `mix64` method, in use in, `Word/Int64` `ByteString` types and `P.ByteArray` +* `Hash` renamed `HashState` and roll clarified in docs +* `instance Hashable` of `Float` and `Double` now use `mix32` and `mix64` respectively. +* Implemented 64-bit and 128-bit siphash +* Instances up to 15-tuples. Now web scale! + +0.1.0.2 +--- +* (initial release) + diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs --- a/benchmarks/Main.hs +++ b/benchmarks/Main.hs @@ -22,8 +22,8 @@ import qualified Data.Hashable as Their instance NFData FNV32 where rnf = rnf . fnv32 -instance NFData Hash32 where rnf = rnf . hashWord32 -instance NFData Hash64 where rnf = rnf . hashWord64 +instance NFData (Hash32 a) where rnf = rnf . hashWord32 +instance NFData (Hash64 a) where rnf = rnf . hashWord64 -- BASELINE for list instances: -- a fused foldl' equivalent -- NOTE ~ 2x faster than Unfolded on 7.10 diff --git a/hashabler.cabal b/hashabler.cabal --- a/hashabler.cabal +++ b/hashabler.cabal @@ -1,6 +1,6 @@ name: hashabler -version: 1.0 -synopsis: Principled, cross-platform & extensible hashing of types, including an implementation of the FNV-1a and SipHash algorithms. +version: 1.1 +synopsis: Principled, portable & extensible hashing of data and types, including an implementation of the FNV-1a and SipHash algorithms. description: This package is a rewrite of the @hashable@ library by Milan Straka and Johan Tibell, having the following goals: @@ -23,8 +23,9 @@ match the way we hash strings here. . /Versioning/: Except for instances where we specifically note that we make - no promise of consistency, changes to hash values entail a major version - number bump. + no promise of consistency, changes to hash values (and consequently changes + to @StableHashable@ values, where applicable) entail a major version number + bump. homepage: https://github.com/jberryman/hashabler @@ -44,6 +45,7 @@ , tests/Vectors/generated/*.ByteString.out.FNV32 , tests/Vectors/generated/P.ByteArray.out.FNV32 , tests/Vectors/generated/*.Text.out.FNV32 + , CHANGELOG.markdown source-repository head type: git diff --git a/src/Data/Hashabler.hs b/src/Data/Hashabler.hs --- a/src/Data/Hashabler.hs +++ b/src/Data/Hashabler.hs @@ -20,7 +20,9 @@ -} -- * Hash Functions - -- | Hashes of different widths. + -- | Hashes of different widths. We tag these hash types with the types of + -- the data they were produced from so that e.g. we get a sensible 'Eq' + -- instance. Hash32(..), Hash64(..), Hash128(..) -- ** Hashing with the SipHash algorithm @@ -84,6 +86,10 @@ In the future we may offer a way to derive instances like this automatically. -} , mixConstructor + + + -- * Stable \"hashes\" of Types + , StableHashable(..), TypeHash(..), typeHashOf, typeHashOfProxy -- * Implementing new hash functions , HashState(..) diff --git a/src/Data/Hashabler/Internal.hs b/src/Data/Hashabler/Internal.hs --- a/src/Data/Hashabler/Internal.hs +++ b/src/Data/Hashabler/Internal.hs @@ -1,5 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash , UnliftedFFITypes #-} module Data.Hashabler.Internal where @@ -240,11 +242,11 @@ -- HASHABLE CLASS AND INSTANCES ------------------------------------- -newtype Hash32 = Hash32 { hashWord32 :: Word32 } +newtype Hash32 a = Hash32 { hashWord32 :: Word32 } deriving (Show, Read, Eq) -newtype Hash64 = Hash64 { hashWord64 :: Word64 } +newtype Hash64 a = Hash64 { hashWord64 :: Word64 } deriving (Show, Read, Eq) -data Hash128 = Hash128 { hashWord128_0 :: !Word64, hashWord128_1 :: !Word64 } +data Hash128 a = Hash128 { hashWord128_0 :: !Word64, hashWord128_1 :: !Word64 } deriving (Show, Read, Eq) @@ -254,11 +256,12 @@ -- -- We try to ensure that bytes are extracted from values in a way that is -- portable across architectures (where possible), and straightforward to --- replicate on other platforms and in other languages. Exceptions are --- __NOTE__-ed in instance docs. +-- replicate on other platforms and in other languages. Portable instances are +-- also instances of 'StableHashable', and non-portable instances are +-- __NOTE__-ed in instance docs here as well. -- --- See the section <#principled "Defining Hashable instances"> for details of what we expect --- from instances. +-- See the section <#principled "Defining Hashable instances"> for details of +-- what we expect from instances. class Hashable a where -- | Add the bytes from the second argument into the hash, producing a new -- hash value. This is essentially a left fold of the methods of @@ -305,7 +308,7 @@ -- most to least significant. mix64 :: h -> Word64 -> h - -- Hash functions are likely to take individually bytes, or chunks of 32 or + -- Hash functions are likely to take individual bytes, or chunks of 32 or -- 64 bits, so I think these defaults make sense. {-# INLINE mix16 #-} mix16 h = \wd16-> @@ -370,7 +373,7 @@ -- @ -- hashFNV32 = 'Hash32' . fnv32 . 'hash' 'fnvOffsetBasis32' -- @ -hashFNV32 :: Hashable a=> a -> Hash32 +hashFNV32 :: Hashable a=> a -> Hash32 a {-# INLINE hashFNV32 #-} hashFNV32 = Hash32 . fnv32 . hash fnvOffsetBasis32 @@ -390,7 +393,7 @@ -- @ -- hashFNV64 = 'Hash64' . fnv64 . 'hash' 'fnvOffsetBasis64' -- @ -hashFNV64 :: Hashable a=> a -> Hash64 +hashFNV64 :: Hashable a=> a -> Hash64 a {-# INLINE hashFNV64 #-} hashFNV64 = Hash64 . fnv64 . hash fnvOffsetBasis64 @@ -855,13 +858,15 @@ instance Hashable (StableName a) where {-# INLINE hash #-} hash h = \x-> hash h $ hashStableName x - + -- | The (now deprecated) @versionTags@ field is ignored, and we follow the -- 'Eq' instance which does not ignore trailing zeros. instance Hashable Version where {-# INLINE hash #-} hash h = \x-> hash h $ versionBranch x +-- | __NOTE__: No promise of stability across runs or platforms. Implemented via +-- 'hashUnique'. instance Hashable Unique where {-# INLINE hash #-} hash h = \x-> hash h $ hashUnique x @@ -893,7 +898,7 @@ {-# INLINE hash #-} hash h Nothing = mixConstructor 0 h hash h (Just a) = mixConstructor 1 $ hash h a - + instance (Hashable a, Hashable b) => Hashable (Either a b) where {-# INLINE hash #-} hash h = either (mx 0) (mx 1) where @@ -915,7 +920,7 @@ instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where {-# INLINE hash #-} hash h (a,b) = h `hash` a `hash` b - + instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where {-# INLINE hash #-} hash h (a,b,c) = h `hash` a `hash` b `hash` c @@ -967,6 +972,160 @@ instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e, Hashable f, Hashable g, Hashable h, Hashable i, Hashable j, Hashable k, Hashable l, Hashable m, Hashable n, Hashable o)=> Hashable (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where {-# INLINE hash #-} hash hsh (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = hsh `hash` a `hash` b `hash` c `hash` d `hash` e `hash` f `hash` g `hash` h `hash` i `hash` j `hash` k `hash` l `hash` m `hash` n `hash` o + + + +-- | A value that uniquely identifies a 'StableHashable' type. This serves to +-- both version a type with respect to its 'Hashable' instance, and distinguish +-- types from each other (similar to 'TypeRep') across program runs, platforms +-- and library versions. +newtype TypeHash a = TypeHash { typeHashWord :: Word64 } + deriving (Eq, Read, Show, Bits) + +-- > typeHashOf _ = typeHash +typeHashOf :: StableHashable a=> a -> TypeHash a +typeHashOf _ = typeHash + +-- > typeHashOfProxy _ = typeHash +typeHashOfProxy :: StableHashable a=> proxy a -> TypeHash a +typeHashOfProxy _ = typeHash + +-- | Types whose hashes can be compared across platforms. This is somewhat like +-- a limited, but cross-platform 'Typeable'. +-- +-- Instances are expected to be universally-unique, and should be generated +-- randomly. Type parameters can be hashed together using 'xor', like: +-- +-- > instance (StableHashable b) => StableHashable (A b) where +-- > typeHash = TypeHash $ 530184177609460980 `xor` (typeHashWord (typeHash :: TypeHash b)) +-- +-- When 'Hashable' instances change, the 'TypeHash' must be changed to a new +-- random value. This lets us \"version\" a set of hashes; if we store a +-- 'TypeHash' along with a set of hashes in program /A/, in program /B/ we can +-- compare the stored value with our own 'TypeHash' and verify that hashes we +-- generate in program /B/ can be meaningfully compared. +-- +-- Note, obviously this doesn't ensure that values were hashed with the same +-- hashing algorithm, and you should come up with your own means to serialize +-- that information if you need to. +class Hashable a=> StableHashable a where + typeHash :: TypeHash a + +-- | The value here depends on whether we're on a 32 or 64-bit platform. See +-- also the instance documentation for 'Hashable'. +instance StableHashable Int where +# if WORD_SIZE_IN_BITS == 32 + typeHash = TypeHash 14906715774445347101 +# else + typeHash = TypeHash 13382803217769822997 +# endif +-- | The value here depends on whether we're on a 32 or 64-bit platform. See +-- also the instance documentation for 'Hashable'. +instance StableHashable Word where +# if WORD_SIZE_IN_BITS == 32 + typeHash = TypeHash 10996918434311873249 +# else + typeHash = TypeHash 943142231655442729 +# endif + +instance StableHashable Integer where + typeHash = TypeHash $ 96690694942656444 + +#ifdef MIN_VERSION_integer_gmp +# if MIN_VERSION_integer_gmp(1,0,0) +instance StableHashable BigNat where + typeHash = TypeHash $ 2111364012200171327 +# endif +#endif +#if MIN_VERSION_base(4,8,0) +instance StableHashable Natural where + typeHash = TypeHash $ 11915819290390802320 +instance StableHashable Void where + typeHash = TypeHash $ 13639848524738715571 +#endif + +instance (Integral a, StableHashable a) => StableHashable (Ratio a) where + typeHash = TypeHash $ 330184177609460989 `xor` (typeHashWord (typeHash :: TypeHash a)) +instance StableHashable Float where + typeHash = TypeHash $ 7785239337948379302 +instance StableHashable Double where + typeHash = TypeHash $ 12403185125095650454 +instance StableHashable Int8 where + typeHash = TypeHash $ 17471749136236681265 +instance StableHashable Int16 where + typeHash = TypeHash $ 14440046210595456836 +instance StableHashable Int32 where + typeHash = TypeHash $ 13431688382274668720 +instance StableHashable Int64 where + typeHash = TypeHash $ 14806970576519879451 +instance StableHashable Word8 where + typeHash = TypeHash $ 6643259480050182665 +instance StableHashable Word16 where + typeHash = TypeHash $ 3765569608911963661 +instance StableHashable Word32 where + typeHash = TypeHash $ 6402686280864807547 +instance StableHashable Word64 where + typeHash = TypeHash $ 14652873008202722152 +instance StableHashable B.ByteString where + typeHash = TypeHash $ 171314019417081845 +instance StableHashable BL.ByteString where + typeHash = TypeHash $ 10099361054646539018 +#if MIN_VERSION_bytestring(0,10,4) +instance StableHashable BSh.ShortByteString where + typeHash = TypeHash $ 15680327781389053206 +#endif +instance StableHashable T.Text where + typeHash = TypeHash $ 14746544807555826150 +instance StableHashable TL.Text where + typeHash = TypeHash $ 10657741718622626930 +instance StableHashable P.ByteArray where + typeHash = TypeHash $ 9976019413528454024 +instance StableHashable Char where + typeHash = TypeHash $ 4949001641339870281 +instance StableHashable Version where + typeHash = TypeHash $ 702645064027678737 +instance StableHashable Bool where + typeHash = TypeHash $ 2172478990419421580 +instance StableHashable Ordering where + typeHash = TypeHash $ 9293112338546135338 +instance StableHashable a => StableHashable [a] where + typeHash = TypeHash $ 8959911929979074606 `xor` (typeHashWord (typeHash :: TypeHash a)) +instance StableHashable a => StableHashable (Maybe a) where + typeHash = TypeHash $ 17404804613103585388 `xor` (typeHashWord (typeHash :: TypeHash a)) +instance (StableHashable a, StableHashable b) => StableHashable (Either a b) where + typeHash = TypeHash $ 2275317158072284048 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) +instance StableHashable () where + typeHash = TypeHash $ 6095166973227743591 +instance (StableHashable a, StableHashable b) => StableHashable (a, b) where + typeHash = TypeHash $ 12071780118071628513 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) +instance (StableHashable a, StableHashable b, StableHashable c) => StableHashable (a, b, c) where + typeHash = TypeHash $ 4618299809208311661 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d) => StableHashable (a, b, c, d) where + typeHash = TypeHash $ 2134528412514930125 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e) => StableHashable (a, b, c, d, e) where + typeHash = TypeHash $ 6145113094462899758 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f) => StableHashable (a, b, c, d, e, f) where + typeHash = TypeHash $ 44771254230381456 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g) => StableHashable (a, b, c, d, e, f, g) where + typeHash = TypeHash $ 9917360176431723073 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g, StableHashable h) => StableHashable (a, b, c, d, e, f, g, h) where + typeHash = TypeHash $ 2303481052083416811 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) `xor` (typeHashWord (typeHash :: TypeHash h)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g, StableHashable h, StableHashable i)=> StableHashable (a, b, c, d, e, f, g, h, i) where + typeHash = TypeHash $ 6307505215888440984 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) `xor` (typeHashWord (typeHash :: TypeHash h)) `xor` (typeHashWord (typeHash :: TypeHash i)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g, StableHashable h, StableHashable i, StableHashable j)=> StableHashable (a, b, c, d, e, f, g, h, i, j) where + typeHash = TypeHash $ 16862409449834578942 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) `xor` (typeHashWord (typeHash :: TypeHash h)) `xor` (typeHashWord (typeHash :: TypeHash i)) `xor` (typeHashWord (typeHash :: TypeHash j)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g, StableHashable h, StableHashable i, StableHashable j, StableHashable k)=> StableHashable (a, b, c, d, e, f, g, h, i, j, k) where + typeHash = TypeHash $ 12571504671032409264 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) `xor` (typeHashWord (typeHash :: TypeHash h)) `xor` (typeHashWord (typeHash :: TypeHash i)) `xor` (typeHashWord (typeHash :: TypeHash j)) `xor` (typeHashWord (typeHash :: TypeHash k)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g, StableHashable h, StableHashable i, StableHashable j, StableHashable k, StableHashable l)=> StableHashable (a, b, c, d, e, f, g, h, i, j, k, l) where + typeHash = TypeHash $ 18057402240390888799 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) `xor` (typeHashWord (typeHash :: TypeHash h)) `xor` (typeHashWord (typeHash :: TypeHash i)) `xor` (typeHashWord (typeHash :: TypeHash j)) `xor` (typeHashWord (typeHash :: TypeHash k)) `xor` (typeHashWord (typeHash :: TypeHash l)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g, StableHashable h, StableHashable i, StableHashable j, StableHashable k, StableHashable l, StableHashable m)=> StableHashable (a, b, c, d, e, f, g, h, i, j, k, l, m) where + typeHash = TypeHash $ 1509508551579382043 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) `xor` (typeHashWord (typeHash :: TypeHash h)) `xor` (typeHashWord (typeHash :: TypeHash i)) `xor` (typeHashWord (typeHash :: TypeHash j)) `xor` (typeHashWord (typeHash :: TypeHash k)) `xor` (typeHashWord (typeHash :: TypeHash l)) `xor` (typeHashWord (typeHash :: TypeHash m)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g, StableHashable h, StableHashable i, StableHashable j, StableHashable k, StableHashable l, StableHashable m, StableHashable n)=> StableHashable (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where + typeHash = TypeHash $ 17220521008040723494 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) `xor` (typeHashWord (typeHash :: TypeHash h)) `xor` (typeHashWord (typeHash :: TypeHash i)) `xor` (typeHashWord (typeHash :: TypeHash j)) `xor` (typeHashWord (typeHash :: TypeHash k)) `xor` (typeHashWord (typeHash :: TypeHash l)) `xor` (typeHashWord (typeHash :: TypeHash m)) `xor` (typeHashWord (typeHash :: TypeHash n)) +instance (StableHashable a, StableHashable b, StableHashable c, StableHashable d, StableHashable e, StableHashable f, StableHashable g, StableHashable h, StableHashable i, StableHashable j, StableHashable k, StableHashable l, StableHashable m, StableHashable n, StableHashable o)=> StableHashable (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where + typeHash = TypeHash $ 17803228377227705691 `xor` (typeHashWord (typeHash :: TypeHash a)) `xor` (typeHashWord (typeHash :: TypeHash b)) `xor` (typeHashWord (typeHash :: TypeHash c)) `xor` (typeHashWord (typeHash :: TypeHash d)) `xor` (typeHashWord (typeHash :: TypeHash e)) `xor` (typeHashWord (typeHash :: TypeHash f)) `xor` (typeHashWord (typeHash :: TypeHash g)) `xor` (typeHashWord (typeHash :: TypeHash h)) `xor` (typeHashWord (typeHash :: TypeHash i)) `xor` (typeHashWord (typeHash :: TypeHash j)) `xor` (typeHashWord (typeHash :: TypeHash k)) `xor` (typeHashWord (typeHash :: TypeHash l)) `xor` (typeHashWord (typeHash :: TypeHash m)) `xor` (typeHashWord (typeHash :: TypeHash n)) `xor` (typeHashWord (typeHash :: TypeHash o)) + + -- WISHLIST: -- - :: Word64 -> (Word32,Word32) for 32-bit machines. diff --git a/src/Data/Hashabler/SipHash.hs b/src/Data/Hashabler/SipHash.hs --- a/src/Data/Hashabler/SipHash.hs +++ b/src/Data/Hashabler/SipHash.hs @@ -166,7 +166,7 @@ -- -- This function is fast on 64-bit machines, and provides very good hashing -- properties and protection against hash flooding attacks. -siphash64 :: Hashable a => SipKey -> a -> Hash64 +siphash64 :: Hashable a => SipKey -> a -> Hash64 a {-# INLINE siphash64 #-} siphash64 (k0,k1) = \a-> runIdentity $ do let v0 = 0x736f6d6570736575 @@ -214,7 +214,7 @@ -- -- This function is fast on 64-bit machines, and provides very good hashing -- properties and protection against hash flooding attacks. -siphash128 :: Hashable a => SipKey -> a -> Hash128 +siphash128 :: Hashable a => SipKey -> a -> Hash128 a {-# INLINE siphash128 #-} siphash128 (k0,k1) = \a-> runIdentity $ do let v0 = 0x736f6d6570736575 diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -107,6 +107,12 @@ unless (null failures) $ print failures >> error "Got some failures in checkGeneratedVectors!" + +untag64 :: Hash64 a -> Hash64 b +untag64 (Hash64 x) = Hash64 x +untag32 :: Hash32 a -> Hash32 b +untag32 (Hash32 x) = Hash32 x + -- check all codepaths in siphash 'hash' instance, and make sure we're not -- dropping any input bytes in some way. Sufficient to check siphash64 here, as -- all share the Hash instance implementation. @@ -127,27 +133,28 @@ , 0x08091011FF131415 , 0x0809101112FF1415 , 0x080910111213FF15 , 0x08091011121314FF ] :: [Word64] uniqueHashes = concat [ - [siphash64 siphashKey (w8,w64) | w8 <- w8s, w64 <- w64s ] - , [siphash64 siphashKey (w16,w64) | w16 <- w16s,w64 <- w64s ] - , [siphash64 siphashKey (w16,w8,w64) | w16 <- w16s,w8 <- w8s,w64 <- w64s ] - , [siphash64 siphashKey (w32,w64) | w32 <- w32s,w64 <- w64s ] - , [siphash64 siphashKey (w8,w32,w64) | w8 <- w8s,w32 <- w32s,w64 <- w64s ] - , [siphash64 siphashKey (w8,w32,w32) | w8 <- w8s,w32 <- w32s ] - , [siphash64 siphashKey (w32,w16,w64) | w32 <- w32s,w16 <- w16s,w64 <- w64s ] - , [siphash64 siphashKey (w32,w16,w32) | w32 <- w32s,w16 <- w16s ] - , [siphash64 siphashKey (w8,w16,w32,w64) | w8 <- w8s,w16 <- w16s,w32 <- w32s,w64 <- w64s ] - , [siphash64 siphashKey (w8,w16,w32,w32) | w8 <- w8s,w16 <- w16s,w32 <- w32s ] - , [siphash64 siphashKey (w8,w16,w32,w16) | w8 <- w8s,w32 <- w32s,w16 <- w16s ] + map untag64 [siphash64 siphashKey (w8,w64) | w8 <- w8s, w64 <- w64s ] + , map untag64 [siphash64 siphashKey (w16,w64) | w16 <- w16s,w64 <- w64s ] + , map untag64 [siphash64 siphashKey (w16,w8,w64) | w16 <- w16s,w8 <- w8s,w64 <- w64s ] + , map untag64 [siphash64 siphashKey (w32,w64) | w32 <- w32s,w64 <- w64s ] + , map untag64 [siphash64 siphashKey (w8,w32,w64) | w8 <- w8s,w32 <- w32s,w64 <- w64s ] + , map untag64 [siphash64 siphashKey (w8,w32,w32) | w8 <- w8s,w32 <- w32s ] + , map untag64 [siphash64 siphashKey (w32,w16,w64) | w32 <- w32s,w16 <- w16s,w64 <- w64s ] + , map untag64 [siphash64 siphashKey (w32,w16,w32) | w32 <- w32s,w16 <- w16s ] + , map untag64 [siphash64 siphashKey (w8,w16,w32,w64) | w8 <- w8s,w16 <- w16s,w32 <- w32s,w64 <- w64s ] + , map untag64 [siphash64 siphashKey (w8,w16,w32,w32) | w8 <- w8s,w16 <- w16s,w32 <- w32s ] + , map untag64 [siphash64 siphashKey (w8,w16,w32,w16) | w8 <- w8s,w32 <- w32s,w16 <- w16s ] ] identicalHashes = [ - siphash64 siphashKey (0x01 :: Word8, 0x02 :: Word8, 0x03 :: Word8, 0x04 :: Word8, 0x05 :: Word8, 0x06 :: Word8, 0x07 :: Word8, 0x08 :: Word8, 0xDEADBEED :: Word32) - , siphash64 siphashKey (0x0102 :: Word16, 0x03 :: Word8, 0x04 :: Word8, 0x0506 :: Word16, 0x07 :: Word8, 0x08 :: Word8, 0xDEADBEED :: Word32) - , siphash64 siphashKey (0x01 :: Word8, 0x02030405 :: Word32, 0x06 :: Word8, 0x07 :: Word8, 0x08 :: Word8, 0xDEADBEED :: Word32) - , siphash64 siphashKey (0x01020304 :: Word32, 0x05060708 :: Word32, 0xDEADBEED :: Word32) - , siphash64 siphashKey (0x0102030405060708 :: Word64, 0xDEADBEED :: Word32) + untag64 $ siphash64 siphashKey (0x01 :: Word8, 0x02 :: Word8, 0x03 :: Word8, 0x04 :: Word8, 0x05 :: Word8, 0x06 :: Word8, 0x07 :: Word8, 0x08 :: Word8, 0xDEADBEED :: Word32) + , untag64 $ siphash64 siphashKey (0x0102 :: Word16, 0x03 :: Word8, 0x04 :: Word8, 0x0506 :: Word16, 0x07 :: Word8, 0x08 :: Word8, 0xDEADBEED :: Word32) + , untag64 $ siphash64 siphashKey (0x01 :: Word8, 0x02030405 :: Word32, 0x06 :: Word8, 0x07 :: Word8, 0x08 :: Word8, 0xDEADBEED :: Word32) + , untag64 $ siphash64 siphashKey (0x01020304 :: Word32, 0x05060708 :: Word32, 0xDEADBEED :: Word32) + , untag64 $ siphash64 siphashKey (0x0102030405060708 :: Word64, 0xDEADBEED :: Word32) ] + -- Helpers for below: bytesFloat :: Float -> (Word8,Word8,Word8,Word8) {-# INLINE bytesFloat #-} @@ -176,8 +183,8 @@ error $ "bytesDouble: "++(show dbl)++" /= "++(show dblBytes) test "Bool" $ - unless (hashFNV32 (fromBool True :: Word8) == hashFNV32 True - && hashFNV32 (fromBool False :: Word8) == hashFNV32 False) $ + unless (hashFNV32 (fromBool True :: Word8) == (untag32 $ hashFNV32 True) + && hashFNV32 (fromBool False :: Word8) == (untag32 $ hashFNV32 False)) $ error "Bool instance not sensible" @@ -223,31 +230,31 @@ == (Hash32 $ mixConstructorFNV32 signByte $ hashWord32 (if magWord64 > fromIntegral (maxBound :: Word32) then hashFNV32 magWord64 - else hashFNV32 (fromIntegral magWord64 :: Word32)) + else untag32 $ hashFNV32 (fromIntegral magWord64 :: Word32)) ) -- FNV32 test vectors provide basic sanity for word/int instances. Here -- just make sure Word and Int types are equivalent. quickCheckErr 1000 $ \(Large word8)-> let int8 = fromIntegral (word8 :: Word8) :: Int8 - in hashFNV32 word8 == hashFNV32 int8 + in hashFNV32 word8 == (untag32 $ hashFNV32 int8) quickCheckErr 1000 $ \(Large word16)-> let int16 = fromIntegral (word16 :: Word16) :: Int16 - in hashFNV32 word16 == hashFNV32 int16 + in hashFNV32 word16 == (untag32 $ hashFNV32 int16) quickCheckErr 1000 $ \(Large word32)-> let int32 = fromIntegral (word32 :: Word32) :: Int32 - in hashFNV32 word32 == hashFNV32 int32 + in hashFNV32 word32 == (untag32 $ hashFNV32 int32) quickCheckErr 1000 $ \(Large word64)-> let int64 = fromIntegral (word64 :: Word64) :: Int64 - in hashFNV32 word64 == hashFNV32 int64 + in hashFNV32 word64 == (untag32 $ hashFNV32 int64) -- And for machine-dependenat Word/Int check equivalence to Int/Word32 when -- in 32-bit range, else (only relevant on 64-bit machines) to Int/Word64: quickCheckErr 1000 $ \(Large word)-> hashFNV32 (word :: Word) == (if word > fromIntegral (maxBound :: Word32) - then hashFNV32 (fromIntegral word :: Int64) - else hashFNV32 (fromIntegral word :: Int32)) + then untag32 $ hashFNV32 (fromIntegral word :: Int64) + else untag32 $ hashFNV32 (fromIntegral word :: Int32)) # if MIN_VERSION_base(4,8,0) -- Check documented 32-bit chunked, big-endian order hashing of Natural: @@ -257,7 +264,7 @@ testSane = (length bytesBE) `mod` 4 == 0 in testSane && (hashFNV32 nat) == - (hashFNV32 bytesBE) -- against instance [Word8] + (untag32 $ hashFNV32 bytesBE) -- against instance [Word8] flip forAll checkNat $ do let maxWidth = 100 -- nibbles @@ -276,7 +283,7 @@ bsStrict = B.pack wd8s bsLazyChunked = BL.fromChunks $ map B.pack $ chunk chunkSize wd8s in (hashFNV32 bsStrict) == - (hashFNV32 bsLazyChunked) + (untag32 $ hashFNV32 bsLazyChunked) flip forAll checkBS $ do let maxBytes = 1000*1000 bs <- growingElements [1..maxBytes] @@ -290,7 +297,7 @@ bsStrict = T.pack cs bsLazyChunked = TL.fromChunks $ map T.pack $ chunk chunkSize cs in (hashFNV32 bsStrict) == - (hashFNV32 bsLazyChunked) + (untag32 $ hashFNV32 bsLazyChunked) flip forAll checkBS $ do let maxBytes = 1000*1000 bs <- growingElements [1..maxBytes] @@ -305,7 +312,7 @@ bsStrict = B.pack wd8s bsShort = BSh.pack wd8s in (hashFNV32 bsStrict) == - (hashFNV32 bsShort) + (untag32 $ hashFNV32 bsShort) flip forAll checkBS $ do let maxBytes = 1000*1000 growingElements [1..maxBytes] @@ -317,7 +324,7 @@ let wd8s = take bs $ iterate (+1) 0 bsStrict = B.pack wd8s in (hashFNV32 bsStrict) == - (hashFNV32 wd8s) + (untag32 $ hashFNV32 wd8s) flip forAll checkBS $ do let maxBytes = 1000*1000 growingElements [1..maxBytes] @@ -328,7 +335,7 @@ let wd8s = take bs $ iterate (+1) 0 byteArr = packByteArray wd8s in (hashFNV32 byteArr) == - (hashFNV32 wd8s) + (untag32 $ hashFNV32 wd8s) flip forAll checkBA $ do let maxBytes = 1000*1000 growingElements [1..maxBytes] @@ -342,7 +349,7 @@ b = B.take takeVal $ B.drop dropVal $ B.pack wd8s l = take takeVal $ drop dropVal $ wd8s in (hashFNV32 b) == - (hashFNV32 l) + (untag32 $ hashFNV32 l) flip forAll checkBS $ do let maxBytes = 1000*1000 bs <- growingElements [1..maxBytes] @@ -358,7 +365,7 @@ let t = T.pack $ map (toEnum . clean . getLarge) largeCs clean = (`mod` fromEnum (maxBound :: Char)) bs = T.encodeUtf16BE t - in (hashFNV32 t) == (hashFNV32 bs) + in (hashFNV32 t) == (untag32 $ hashFNV32 bs) flip forAll checkBS $ do let maxChars = 1000 w <- growingElements [1..maxChars] @@ -375,7 +382,7 @@ -- code points: quickCheckErr 1000 $ \sDirty -> let s = map T.safe sDirty - in (hashFNV32 $ T.pack s) == hashFNV32 s + in (hashFNV32 $ T.pack s) == (untag32 $ hashFNV32 s) -- checking collisions in an ad hoc way; we especially care about our sum -- types with fixed shape. TODO improve; also this is slower than necessary