hwsl2 0.2.0.0 → 0.3.0.1

raw patch · 13 files changed

+406/−253 lines, 13 filesdep +criteriondep +cryptohashdep +paralleldep ~CabalPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, cryptohash, parallel

Dependency ranges changed: Cabal

API changes (from Hackage documentation)

Files

• README.md +18/−2
• hwsl2.cabal +36/−14
• src/Data/Hash/SL2.hs +108/−25
• src/Data/Hash/SL2/Benchmark.hs +21/−0
• src/Data/Hash/SL2/Internal.hs +30/−1
• src/Data/Hash/SL2/Internal/Imports.hs +0/−30
• src/Data/Hash/SL2/Mutable.hs +33/−20
• src/Data/Hash/SL2/Test.hs +43/−15
• src/Data/Hash/SL2/Unsafe.hs +30/−7
• src/gf2p127-inl.h +11/−35
• src/sl2-inl.h +76/−40
• src/tillich-zemor.c +0/−44
• src/tillich-zemor.h +0/−20

@@ -1,2 +1,18 @@-coholos-=======+# Hashing with SL2++An algebraic hash function, inspired by the paper _Hashing with SL2_ by Tillich and Zemor.++The hash function is based on matrix multiplication in the special linear group+of degree 2, over a Galois field of order 2^127, with all computations modulo+the polynomial x^127 + x^63 + 1.++This construction gives some nice properties, which traditional bit-scambling+hash functions don't possess, including it being composable. It holds:++    hash (m1 <> m2) == hash m1 <> hash m2++Following that, the hash function is also parallelisable. If a message `m` can be divided into a list of chunks `cs`, the hash of the message can be calculated in parallel:++    mconcat (parMap rpar hash cs) == hash m++All operations in this package are implemented in a very efficient manner using SSE instructions.

@@ -10,24 +10,29 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.0.0+version:             0.3.0.1  -- A short (one-line) description of the package. synopsis:            Hashing with SL2  -- A longer description of the package. description:-  An algebraic hash function, inspired by the paper "Hashing with SL2" by Tillich and Zemor.+  An algebraic hash function, inspired by the paper /Hashing with SL2/ by Tillich and Zemor.   .   The hash function is based on matrix multiplication in the special linear group   of degree 2, over a Galois field of order 2^127,  with all computations modulo   the polynomial x^127 + x^63 + 1.   .-  This construction gives some nice properties, which traditional "bit-scambling"+  This construction gives some nice properties, which traditional bit-scambling   hash functions don't possess, including it being composable. It holds:   .   > hash (m1 <> m2) == hash m1 <> hash m2   .+  Following that, the hash function is also parallelisable. If a message can be divided+  into a list of chunks, the hash of the message can be calculated in parallel:+  .+  > mconcat (parMap rpar hash chunks)+  .   All operations in this package are implemented in a very efficient manner using SSE instructions.  -- URL for the project homepage or repository.@@ -69,10 +74,10 @@      -- Modules included in this library but not exported.   other-modules:       Data.Hash.SL2.Internal-                       Data.Hash.SL2.Internal.Imports      -- LANGUAGE extensions used by modules in this package.-  other-extensions:    ForeignFunctionInterface+  other-extensions:    ForeignFunctionInterface CApiFFI+                       Safe Trustworthy Unsafe      -- Other library packages from which modules are imported.   build-depends:       base >=4.7 && <4.8, bytestring >=0.10 && <0.11@@ -84,10 +89,10 @@    -- Options for foreign source files.   include-dirs:        src-  c-sources:           src/tillich-zemor.c-  includes:            src/tillich-zemor.h src/sl2-inl.h src/gf2p127-inl.h-  install-includes:    src/tillich-zemor.h src/sl2-inl.h src/gf2p127-inl.h+  includes:            src/sl2-inl.h src/gf2p127-inl.h+  install-includes:    src/sl2-inl.h src/gf2p127-inl.h   cc-options:          -msse2 -msse4.1 -mpclmul+  ghc-options:         -optc-msse2 -optc-msse4.1 -optc-mpclmul      -- Base language which the package is written in.   default-language:    Haskell2010@@ -101,15 +106,32 @@                        Data.Hash.SL2.Mutable                        Data.Hash.SL2.Unsafe                        Data.Hash.SL2.Internal-                       Data.Hash.SL2.Internal.Imports   build-depends:       base >=4.7 && <4.8,-                       Cabal >=1.9.2,+                       Cabal >=1.22.0.0,                        bytestring >=0.10 && <0.11,                        QuickCheck >=2.7 && <2.8,                        quickcheck-properties>=0.1 && <0.2,                        cabal-test-quickcheck>=0.1 && <0.2   include-dirs:        src-  c-sources:           src/tillich-zemor.c-  includes:            src/tillich-zemor.h src/sl2-inl.h src/gf2p127-inl.h-  install-includes:    src/tillich-zemor.h src/sl2-inl.h src/gf2p127-inl.h-  cc-options:          -msse2 -msse4.1 -mpclmul+  includes:            src/sl2-inl.h src/gf2p127-inl.h+  install-includes:    src/sl2-inl.h src/gf2p127-inl.h+  ghc-options:         -optc-msse2 -optc-msse4.1 -optc-mpclmul++benchmark bench+  type:                exitcode-stdio-1.0+  hs-source-dirs:      src+  main-is:             Data/Hash/SL2/Benchmark.hs+  other-modules:       Data.Hash.SL2+                       Data.Hash.SL2.Mutable+                       Data.Hash.SL2.Unsafe+                       Data.Hash.SL2.Internal+  build-depends:       base >=4.7 && <4.8,+                       Cabal >=1.22.0.0,+                       bytestring >=0.10 && <0.11,+                       criterion >=1.0 && <1.1,+                       cryptohash >=0.11 && <0.12,+                       parallel >=3.2 && <3.3+  include-dirs:        src+  includes:            src/sl2-inl.h src/gf2p127-inl.h+  install-includes:    src/sl2-inl.h src/gf2p127-inl.h+  ghc-options:         -rtsopts -threaded -optc-msse2 -optc-msse4.1 -optc-mpclmul

@@ -1,26 +1,51 @@+{-# LANGUAGE Trustworthy #-}+ -- | -- Module     : Data.Hash.SL2 -- License    : MIT -- Maintainer : Sam Rijs <srijs@airpost.net> ----- An algebraic hash function, inspired by the paper "Hashing with SL2" by+-- An algebraic hash function, inspired by the paper /Hashing with SL2/ by -- Tillich and Zemor. -- -- The hash function is based on matrix multiplication in the special linear group -- of degree 2, over a Galois field of order 2^127,  with all computations modulo -- the polynomial x^127 + x^63 + 1. ----- This construction gives some nice properties, which traditional "bit-scambling"+-- This construction gives some nice properties, which traditional bit-scambling -- hash functions don't possess, including it being composable. It holds: -- -- prop> hash (m1 <> m2) == hash m1 <> hash m2 --+-- Following that, the hash function is also parallelisable. If a message @m@ can be divided+-- into a list of chunks @cs@, the hash of the message can be calculated in parallel:+--+-- prop> mconcat (parMap rpar hash cs) == hash m+-- -- All operations in this package are implemented in a very efficient manner using SSE instructions. -- -module Data.Hash.SL2 (Hash, hash, (<+), (+>), (<|), (|>), parse) where+module Data.Hash.SL2+  ( Hash+  -- ** Hashing+  , hash+  , append, prepend+  , foldAppend, foldPrepend+  -- ** Composition+  , unit, concat, concatAll+  -- ** Parsing+  , parse+  -- ** Validation+  , valid, validate+  -- ** Packing+  , pack8, pack16, pack32, pack64+  -- ** Unpacking+  , unpack8, unpack16, unpack32, unpack64+  ) where -import Data.Hash.SL2.Internal+import Prelude hiding (concat)++import Data.Hash.SL2.Internal (Hash) import Data.Hash.SL2.Unsafe import qualified Data.Hash.SL2.Mutable as Mutable @@ -28,6 +53,7 @@  import Data.ByteString (ByteString) +import Data.Word import Data.Monoid import Data.Functor import Data.Foldable (Foldable)@@ -39,37 +65,94 @@   a == b = unsafePerformIO $ unsafeUseAsPtr2 a b Mutable.eq  instance Monoid Hash where-  mempty = fst $ unsafePerformIO $ Mutable.withNew Mutable.unit-  mappend a b = fst $ unsafePerformIO $ Mutable.withNew (unsafeUseAsPtr2 a b . Mutable.concat)+  mempty = unit+  mappend = concat+  mconcat = concatAll --- | /O(n)/ Calculate the hash of the 'ByteString'. Alias for @('mempty' '<+')@.+-- | /O(n)/ Calculate the hash of the 'ByteString'. Alias for @('append' 'unit')@. hash :: ByteString -> Hash-hash = (<+) mempty+hash = append unit  -- | /O(n)/ Append the hash of the 'ByteString' to the existing 'Hash'.--- A significantly faster equivalent of @((. 'hash') . ('<>'))@.-infixl 7 <+-(<+) :: Hash -> ByteString -> Hash-(<+) h s = fst $ unsafePerformIO $ Mutable.withCopy h $ Mutable.append s+-- A significantly faster equivalent of @((. 'hash') . 'concat')@.+append :: Hash -> ByteString -> Hash+append h s = fst $ unsafePerformIO $ Mutable.withCopy h $ Mutable.append s  -- | /O(n)/ Prepend the hash of the 'ByteString' to the existing 'Hash'.--- A significantly faster equivalent of @(('<>') . 'hash')@.-infixr 7 +>-(+>) :: ByteString -> Hash -> Hash-(+>) s h = fst $ unsafePerformIO $ Mutable.withCopy h $ Mutable.prepend s+-- A significantly faster equivalent of @('concat' . 'hash')@.+prepend :: ByteString -> Hash -> Hash+prepend s h = fst $ unsafePerformIO $ Mutable.withCopy h $ Mutable.prepend s  -- | /O(n)/ Append the hash of every 'ByteString' to the existing 'Hash', from left to right.--- A significantly faster equivalent of @('foldl' ('<+'))@.-infixl 7 <|-(<|) :: Foldable t => Hash -> t ByteString -> Hash-(<|) h ss = fst $ unsafePerformIO $ Mutable.withCopy h $ Mutable.foldAppend ss+-- A significantly faster equivalent of @('foldl' 'append')@.+foldAppend :: Foldable t => Hash -> t ByteString -> Hash+foldAppend h ss = fst $ unsafePerformIO $ Mutable.withCopy h $ Mutable.foldAppend ss  -- | /O(n)/ Prepend the hash of every 'ByteString' to the existing 'Hash', from right to left.--- A significantly faster equivalent of @('flip' ('foldr' ('+>')))@.-infixr 7 |>-(|>) :: Foldable t => t ByteString -> Hash -> Hash-(|>) ss h = fst $ unsafePerformIO $ Mutable.withCopy h $ Mutable.foldPrepend ss+-- A significantly faster equivalent of @('flip' ('foldr' 'prepend'))@.+foldPrepend :: Foldable t => t ByteString -> Hash -> Hash+foldPrepend ss h = fst $ unsafePerformIO $ Mutable.withCopy h $ Mutable.foldPrepend ss +-- | /O(1)/ The unit element for concatenation. Alias for 'mempty'.+unit :: Hash+unit = fst $ unsafePerformIO $ unsafeWithNew Mutable.unit++-- | /O(1)/ Concatenate two hashes. Alias for 'mappend'.+concat :: Hash -> Hash -> Hash+concat a b = fst $ unsafePerformIO $ unsafeWithNew (unsafeUseAsPtr2 a b . Mutable.concat)++-- | /O(n)/ Concatenate a list of hashes. Alias for 'mconcat'.+concatAll :: [Hash] -> Hash+concatAll [] = unit+concatAll [h] = h+concatAll (h:hs) = fst $ unsafePerformIO $ Mutable.withCopy h $ \p ->+  mapM_ (flip unsafeUseAsPtr $ Mutable.concat p p) hs+ -- | /O(1)/ Parse the representation generated by 'show'. parse :: String -> Maybe Hash-parse s = (\(h, r) -> h <$ r) $ unsafePerformIO $ Mutable.withNew $ Mutable.unserialize s+parse s = (\(h, r) -> h <$ r) $ unsafePerformIO $ unsafeWithNew $ Mutable.unserialize s++-- | /O(1)/ Check a hash for bit-level validity.+valid :: Hash -> Bool+valid h = unsafePerformIO $ unsafeUseAsPtr h Mutable.valid++-- | /O(1)/ Validate a hash on the bit-level. From @'valid' h == 'True'@ follows @'validate' h == 'Just' h@.+validate :: Hash -> Maybe Hash+validate h | valid h = Just h+validate _ = Nothing++-- | /O(1)/ Pack a list of 64 8-bit words.+pack8 :: [Word8] -> Maybe Hash+pack8 ws | length ws == 64 = validate (unsafePack ws)+pack8 _ = Nothing++-- | /O(1)/ Pack a list of 32 16-bit words.+pack16 :: [Word16] -> Maybe Hash+pack16 ws | length ws == 32 = validate (unsafePack ws)+pack16 _ = Nothing++-- | /O(1)/ Pack a list of 16 32-bit words.+pack32 :: [Word32] -> Maybe Hash+pack32 ws | length ws == 16 = validate (unsafePack ws)+pack32 _ = Nothing++-- | /O(1)/ Pack a list of 8 64-bit words.+pack64 :: [Word64] -> Maybe Hash+pack64 ws | length ws == 8 = validate (unsafePack ws)+pack64 _ = Nothing++-- | /O(1)/ Unpack into list of 64 8-bit words.+unpack8 :: Hash -> [Word8]+unpack8 h = unsafeUnpack h++-- | /O(1)/ Unpack into list of 32 16-bit words.+unpack16 :: Hash -> [Word16]+unpack16 h = unsafeUnpack h++-- | /O(1)/ Unpack into list of 16 32-bit words.+unpack32 :: Hash -> [Word32]+unpack32 h = unsafeUnpack h++-- | /O(1)/ Unpack into list of 8 64-bit words.+unpack64 :: Hash -> [Word64]+unpack64 h = unsafeUnpack h

@@ -0,0 +1,21 @@+import Data.Hash.SL2++import Data.List (foldl')++import Control.Parallel.Strategies++import qualified Data.ByteString as B+import qualified Crypto.Hash.SHA256 as SHA256++import Criterion.Main++bs1M = B.pack $ take (1 * 1024 * 1024) $ cycle [0..255]+bs2M = B.pack $ take (2 * 1024 * 1024) $ cycle [0..255]+bs4M = B.pack $ take (4 * 1024 * 1024) $ cycle [0..255]++main = defaultMain+  [ bench "hwsl2 append" $ whnf (append union) bs4M+  , bench "hwsl2 prepend" $ whnf (flip prepend union) bs4M+  , bench "hwsl2 append parallel" $ whnf (concatAll . (parMap rpar hash)) [bs1M, bs1M, bs1M, bs1M]+  , bench "sha256" $ whnf SHA256.hash bs4M+  ]

@@ -1,8 +1,37 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CApiFFI #-}+ module Data.Hash.SL2.Internal where -import Foreign+import Foreign.Safe+import Foreign.C.Types  newtype Hash = H (ForeignPtr ())  hashSize = 64 :: Int hashLen = 86 :: Int++foreign import capi "sl2-inl.h sl2_valid"+  valid :: Ptr Hash -> IO CInt++foreign import capi "sl2-inl.h sl2_eq"+  eq :: Ptr Hash -> Ptr Hash -> IO CInt++foreign import capi "sl2-inl.h sl2_unit"+  unit :: Ptr Hash -> IO ()++foreign import capi "sl2-inl.h sl2_mul_buf_right"+  append :: Ptr Hash -> Ptr CChar -> CSize -> IO ()++foreign import capi "sl2-inl.h sl2_mul_buf_left"+  prepend :: Ptr Hash -> Ptr CChar -> CSize -> IO ()++foreign import capi "sl2-inl.h sl2_mul"+  concat :: Ptr Hash -> Ptr Hash -> Ptr Hash -> IO ()++foreign import capi "sl2-inl.h sl2_serialize"+  serialize :: Ptr Hash -> Ptr CChar -> IO ()++foreign import capi "sl2-inl.h sl2_unserialize"+  unserialize :: Ptr Hash -> Ptr CChar -> IO ()

@@ -1,30 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}--module Data.Hash.SL2.Internal.Imports where--import Foreign.Ptr-import Foreign.C.Types--import Data.Hash.SL2.Internal--foreign import ccall "tillich-zemor.h tz_hash_eq"-  eq :: Ptr Hash -> Ptr Hash -> IO CInt--foreign import ccall "tillich-zemor.h tz_hash_unit"-  unit :: Ptr Hash -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_append"-  append :: Ptr Hash -> Ptr CChar -> CSize -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_prepend"-  prepend :: Ptr Hash -> Ptr CChar -> CSize -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_concat"-  concat :: Ptr Hash -> Ptr Hash -> Ptr Hash -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_serialize"-  serialize :: Ptr Hash -> Ptr CChar -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_unserialize"-  unserialize :: Ptr Hash -> Ptr CChar -> IO ()-

@@ -1,16 +1,19 @@+{-# LANGUAGE Trustworthy #-}+ module Data.Hash.SL2.Mutable-  ( eq+  ( valid+  , eq   , unit   , concat   , append, prepend   , foldAppend, foldPrepend   , serialize, unserialize-  , withNew, withCopy+  , withUnit, withCopy   ) where  import Prelude hiding (concat) -import Foreign+import Foreign.Safe import Foreign.C.String  import Data.ByteString (ByteString)@@ -18,55 +21,65 @@  import Data.Foldable (Foldable, foldlM, foldrM) -import Data.Hash.SL2.Internal+import Data.Hash.SL2.Internal (Hash, hashLen)+import qualified Data.Hash.SL2.Internal as Internal import Data.Hash.SL2.Unsafe-import qualified Data.Hash.SL2.Internal.Imports as Imports -instance Storable Hash where-  sizeOf = const hashSize-  alignment = const 0-  peek p = fmap fst $ withNew $ \hp -> copyBytes hp (castPtr p) hashSize-  poke p h = unsafeUseAsPtr h $ \hp -> copyBytes (castPtr p) hp hashSize+-- | /O(1)/ Check a hash for bit-level validity.+valid :: Ptr Hash -> IO Bool+{-# INLINE valid #-}+valid h = fmap toBool $ Internal.valid h  -- | /O(1)/ Compare the two hashes for equality. eq :: Ptr Hash -> Ptr Hash -> IO Bool-eq a b = fmap toBool $ Imports.eq a b+{-# INLINE eq #-}+eq a b = fmap toBool $ Internal.eq a b  -- | /O(1)/ Set the 'Hash' to the empty value. unit :: Ptr Hash -> IO ()-unit h = Imports.unit h+{-# INLINE unit #-}+unit h = Internal.unit h  -- | /O(1)/ Concatenate the second and third 'Hash', store the result in the first. concat :: Ptr Hash -> Ptr Hash -> Ptr Hash -> IO ()-concat c a b = Imports.concat c a b+{-# INLINE concat #-}+concat c a b = Internal.concat c a b  -- | /O(n)/ Append the hash of the 'ByteString' to the existing 'Hash'. append :: ByteString -> Ptr Hash -> IO ()-append s p = unsafeUseAsCStringLen s $ \(s', len) -> Imports.append (castPtr p) s' (fromIntegral len)+{-# INLINE append #-}+append s p = unsafeUseAsCStringLen s $ \(s', len) -> Internal.append p s' (fromIntegral len)  -- | /O(n)/ Prepend the hash of the 'ByteString' to the existing 'Hash'. prepend :: ByteString -> Ptr Hash -> IO ()-prepend s p = unsafeUseAsCStringLen s $ \(s', len) -> Imports.prepend (castPtr p) s' (fromIntegral len)+{-# INLINE prepend #-}+prepend s p = unsafeUseAsCStringLen s $ \(s', len) -> Internal.prepend p s' (fromIntegral len)  -- | /O(n)/ Append the hash of every 'ByteString' to the existing 'Hash', from left to right. foldAppend :: Foldable t => t ByteString -> Ptr Hash -> IO ()+{-# INLINE foldAppend #-} foldAppend ss p = foldlM (const $ flip append p) () ss  -- | /O(n)/ Prepend the hash of every 'ByteString' to the existing 'Hash', from right to left. foldPrepend :: Foldable t => t ByteString -> Ptr Hash -> IO ()+{-# INLINE foldPrepend #-} foldPrepend ss p = foldrM (const . flip prepend p) () ss  -- | /O(1)/ Serialize the hash into a url-safe base64 representation. serialize :: Ptr Hash -> IO String-serialize h = allocaBytes hashLen $ \p -> Imports.serialize h p >> peekCStringLen (p, hashLen)+{-# INLINE serialize #-}+serialize h = allocaBytes hashLen $ \p -> Internal.serialize h p >> peekCStringLen (p, hashLen)  -- | /O(1)/ Unserialize the hash from the representation generated by 'serialize'. unserialize :: String -> Ptr Hash -> IO (Maybe ())+{-# INLINE unserialize #-} unserialize s p = withCAStringLen s $ \(s', len) ->-  if len == hashLen then Just `fmap` Imports.unserialize p s' else return Nothing+  if len == hashLen then Just `fmap` Internal.unserialize p s' else return Nothing -withNew :: (Ptr Hash -> IO a) -> IO (Hash, a)-withNew f = mallocForeignPtrBytes hashSize >>= \fp -> (\r -> (H fp, r)) `fmap` withForeignPtr fp (f . castPtr)+withUnit :: (Ptr Hash -> IO a) -> IO (Hash, a)+{-# INLINE withUnit #-}+withUnit f = unsafeWithNew $ \p -> unit p >> f p  withCopy :: Hash -> (Ptr Hash -> IO a) -> IO (Hash, a)-withCopy h f = withNew $ \p -> poke p h >> f p+{-# INLINE withCopy #-}+withCopy h f = unsafeWithNew $ \p -> poke p h >> f p

@@ -1,15 +1,16 @@ module Data.Hash.SL2.Test where +import Prelude hiding (concat)+ import Data.Word  import Data.Hash.SL2-import Data.Hash.SL2.Internal+import Data.Hash.SL2.Internal (Hash) import Data.Hash.SL2.Unsafe  import qualified Data.ByteString as B -import Foreign.ForeignPtr-import Foreign.Storable+import Foreign.Safe  import Test.QuickCheck import Test.QuickCheck.All@@ -23,33 +24,60 @@   arbitrary = fmap B.pack arbitrary  instance Arbitrary Hash where-  arbitrary = fmap unsafePack $ mapM choose (take 64 $ cycle $ replicate 15 (0, 255) ++ [(0, 127)])+  arbitrary = fmap hash arbitrary  tests :: IO [Test] tests = return -  [ testGroup "composition"+  [ testGroup "packing" -    [ testProperty "forms a monoid" $+    [ testProperty "identity 8-bit" $+        \a -> Just a == pack8 (unpack8 a)++    , testProperty "identity 16-bit" $+        \a -> Just a == pack16 (unpack16 a)++    , testProperty "identity 32-bit" $+        \a -> Just a == pack32 (unpack32 a)++    , testProperty "identity 64-bit" $+        \a -> Just a == pack64 (unpack64 a)+    ]++  , testGroup "composition"++    [ testProperty "empty is valid" $+        valid (mempty :: Hash)++    , testProperty "hash is valid" $+        \a -> valid (hash a)++    , testProperty "append is valid" $+        \a b -> valid (hash a <> hash b)++    , testProperty "forms a monoid" $         eq $ prop_Monoid (T :: T Hash) -    , testProperty "is distributive" $+    , testProperty "is distributive (mappend)" $         \a b -> hash (a <> b) == hash a <> hash b +    , testProperty "is distributive (mconcat)" $+        \a b -> hash (a <> b) == mconcat (map hash [a, b])+     ]    , testGroup "append"      [ testGroup "single string" $ -      [ testProperty "equal to ((. hash) . (<>))" $-          \a b -> ((. hash) . (<>)) a b == a <+ b+      [ testProperty "equal to ((. hash) . concat)" $+          \a b -> ((. hash) . concat) a b == a `append` b       ]      , testGroup "multiple strings" $ -      [ testProperty "equal to (foldl (<+))" $-          \a b -> (foldl (<+)) a b == a <| b+      [ testProperty "equal to (foldl append)" $+          \a b -> (foldl append) a b == a `foldAppend` b       ]      ]@@ -58,14 +86,14 @@      [ testGroup "single string" $ -      [ testProperty "equal to ((<>) . hash)" $-          \a b -> ((<>) . hash) a b == a +> b+      [ testProperty "equal to (concat . hash)" $+          \a b -> (concat . hash) a b == a `prepend` b       ]      , testGroup "multiple strings" $ -      [ testProperty "equal to (flip (foldr (+>)))" $-          \a b -> (flip (foldr (+>))) a b == a |> b+      [ testProperty "equal to (flip (foldr prepend)" $+          \a b -> (flip (foldr prepend)) a b == a `foldPrepend` b       ]      ]

@@ -1,19 +1,42 @@-module Data.Hash.SL2.Unsafe (unsafeUseAsPtr, unsafeUseAsPtr2, unsafePack) where+{-# LANGUAGE Unsafe #-} -import Foreign+module Data.Hash.SL2.Unsafe (unsafeUseAsPtr, unsafeUseAsPtr2, unsafeWithNew, unsafePack, unsafeUnpack) where++import Foreign.Safe import System.IO.Unsafe -import Data.Hash.SL2.Internal+import Data.Hash.SL2.Internal (Hash(H), hashSize) +instance Storable Hash where+  sizeOf = const hashSize+  alignment = const 16+  peek p = fmap fst $ unsafeWithNew $ \hp -> copyBytes hp (castPtr p) hashSize+  poke p h = unsafeUseAsPtr h $ \hp -> copyBytes (castPtr p) hp hashSize+ unsafeUseAsPtr :: Hash -> (Ptr Hash -> IO a) -> IO a+{-# INLINE unsafeUseAsPtr #-} unsafeUseAsPtr (H fp) f = withForeignPtr fp (f . castPtr)  unsafeUseAsPtr2 :: Hash -> Hash -> (Ptr Hash -> Ptr Hash -> IO a) -> IO a+{-# INLINE unsafeUseAsPtr2 #-} unsafeUseAsPtr2 a b f = unsafeUseAsPtr a (unsafeUseAsPtr b . f) -unsafePack :: [Word8] -> Hash-unsafePack ws = H $ unsafePerformIO $ do-  fp <- mallocForeignPtrArray0 hashSize+unsafeWithNew :: (Ptr Hash -> IO a) -> IO (Hash, a)+{-# INLINE unsafeWithNew #-}+unsafeWithNew f = mallocForeignPtr >>= \fp -> (\r -> (H (castForeignPtr fp), r)) `fmap` withForeignPtr fp f++unsafePack :: Storable a => [a] -> Hash+unsafePack as@(a:_) = H $ unsafePerformIO $ do+  let len = hashSize `div` sizeOf a+  fp <- mallocForeignPtrArray0 len   withForeignPtr fp $ \p ->-    mapM_ (\(w, off) -> pokeElemOff p off w) (zip ws [0..hashSize-1])+    mapM_ (\(a, off) -> pokeElemOff p off a) (zip as [0..len-1])   return (castForeignPtr fp)++unsafeUnpack :: Storable a => Hash -> [a]+unsafeUnpack h = unsafePerformIO $ unsafeUseAsPtr h $ rec 0+  where rec off _ | off >= hashSize = return []+        rec off p = do+          a <- peekByteOff (castPtr p) off+          r <- rec (off + sizeOf a) p+          return (a : r)

@@ -8,6 +8,11 @@ typedef __m128i gf2p127_t;  static const inline+_Bool gf2p127_valid(const gf2p127_t a) {+  return (_mm_extract_epi64(a, 1) & (UINT64_C(1) << 63)) == 0;+}++static const inline _Bool gf2p127_eq(const gf2p127_t a, const gf2p127_t b) {   _Bool lo = _mm_extract_epi64(a, 0) == _mm_extract_epi64(b, 0);   _Bool hi = _mm_extract_epi64(a, 1) == _mm_extract_epi64(b, 1);@@ -44,19 +49,11 @@   return a; } -static const uint32_t x127[4] = {0, 0, 0, 1 << 31};+static const gf2p127_t *minmax __attribute__((__aligned__(16))) =+  (gf2p127_t *)(uint64_t [4]){0, 0, UINT64_MAX, UINT64_MAX}; -static const inline-gf2p127_t gf2p127_mul_10_left(const gf2p127_t a) {-  // Shift lower and upper halves left by one bit,-  // resembling a multiplication by two.-  gf2p127_t sl = _mm_slli_epi64(a, 1);-  // Check for a x^127 overflow, and add the polynom and carry bit.-  gf2p127_t one = _mm_srli_epi64(_mm_alignr_epi8(a, sl, 8), 63);-  gf2p127_t over = _mm_and_si128(sl, _mm_loadu_si128((const gf2p127_t *)x127));-  gf2p127_t x127x63 = _mm_unpackhi_epi64(over, over);-  return _mm_xor_si128(_mm_xor_si128(sl, one), x127x63);-}+static const gf2p127_t *x127 __attribute__((__aligned__(16))) =+  (gf2p127_t *)(uint32_t [4]){0, 0, 0, 1 << 31};  static const inline gf2p127_t gf2p127_mul_10(const gf2p127_t a) {@@ -65,7 +62,8 @@   gf2p127_t sl = _mm_slli_epi64(a, 1);   // Check for a x^127 overflow, and add the polynom and carry bit.   gf2p127_t one = _mm_srli_epi64(_mm_alignr_epi8(a, sl, 8), 63);-  gf2p127_t x127x63 = _mm_slli_epi64(_mm_unpacklo_epi64(one, one), 63);+  gf2p127_t over = _mm_and_si128(sl, _mm_load_si128(x127));+  gf2p127_t x127x63 = _mm_unpackhi_epi64(over, over);   return _mm_xor_si128(_mm_xor_si128(sl, one), x127x63); } @@ -109,28 +107,6 @@   lo = _mm_xor_si128(lo, _mm_slli_epi64(hi, 63));    return lo;-}--static inline-char *gf2p127_show(char *buf, const gf2p127_t m) {-  __uint128_t a = (__uint128_t)m;-  unsigned int k;-  int n;-  char *str = buf;-  if (a & 1) {-    str += sprintf(str, "1");-  } else {-    str += sprintf(str, "0");-  }-  a >>= 1;-  for (k = 1; k < 128; k++) {-    if (a & 1) {-      n = sprintf(str, " + 2^%i", k);-      str += n;-    }-    a >>= 1;-  }-  return buf; }  static inline

@@ -2,9 +2,21 @@  #include "gf2p127-inl.h" -typedef gf2p127_t sl2_t[2][2];+typedef gf2p127_t sl2_t[2][2] __attribute__((__aligned__(16)));  static inline+_Bool sl2_valid(sl2_t a) {+  gf2p127_t det = gf2p127_add(gf2p127_mul(a[0][0], a[1][1]),+                              gf2p127_mul(a[0][1], a[1][0]));+  return _mm_extract_epi64(det, 0) == 1 &&+         _mm_extract_epi64(det, 1) == 0 &&+         gf2p127_valid(a[0][0]) &&+         gf2p127_valid(a[0][1]) &&+         gf2p127_valid(a[1][0]) &&+         gf2p127_valid(a[1][1]);+}++static inline _Bool sl2_eq(sl2_t a, sl2_t b) {   return gf2p127_eq(a[0][0], b[0][0]) &&          gf2p127_eq(a[0][1], b[0][1]) &&@@ -21,59 +33,83 @@ }  static inline-void sl2_mul_bit_left(sl2_t b, int bit) {+void sl2_mul_bit_left(gf2p127_t *b00, gf2p127_t *b01, gf2p127_t *b10, gf2p127_t *b11, gf2p127_t bits) {   // A: {00 = 10, 01 = 01, 10 = 01, 11 = 00}   // B: {00 = 10, 01 = 11, 10 = 01, 11 = 01}+  gf2p127_t b10_ = *b10;+  gf2p127_t b11_ = *b11;+  *b10 = gf2p127_add(*b00, _mm_and_si128(*b10, bits));+  *b11 = gf2p127_add(*b01, _mm_and_si128(*b11, bits));+  *b00 = gf2p127_add(b10_, gf2p127_mul_10(*b10));+  *b01 = gf2p127_add(b11_, gf2p127_mul_10(*b11));+}++static inline+void sl2_mul_bits_left(gf2p127_t *b00, gf2p127_t *b01, gf2p127_t *b10, gf2p127_t *b11, unsigned char byte) {+  sl2_mul_bit_left(b00, b01, b10, b11, _mm_load_si128(&minmax[(byte >> 0) & 1]));+  sl2_mul_bit_left(b00, b01, b10, b11, _mm_load_si128(&minmax[(byte >> 1) & 1]));+  sl2_mul_bit_left(b00, b01, b10, b11, _mm_load_si128(&minmax[(byte >> 2) & 1]));+  sl2_mul_bit_left(b00, b01, b10, b11, _mm_load_si128(&minmax[(byte >> 3) & 1]));+  sl2_mul_bit_left(b00, b01, b10, b11, _mm_load_si128(&minmax[(byte >> 4) & 1]));+  sl2_mul_bit_left(b00, b01, b10, b11, _mm_load_si128(&minmax[(byte >> 5) & 1]));+  sl2_mul_bit_left(b00, b01, b10, b11, _mm_load_si128(&minmax[(byte >> 6) & 1]));+  sl2_mul_bit_left(b00, b01, b10, b11, _mm_load_si128(&minmax[(byte >> 7) & 1]));+}++static inline+void sl2_mul_buf_left(sl2_t b, unsigned char *buf, size_t n) {   gf2p127_t b00 = b[0][0];-  gf2p127_t b10 = b[1][0];   gf2p127_t b01 = b[0][1];+  gf2p127_t b10 = b[1][0];   gf2p127_t b11 = b[1][1];-  b[0][0] = gf2p127_zero();-  b[0][1] = gf2p127_zero();-  b[1][0] = gf2p127_add(b00, b[bit][0]);-  b[1][1] = gf2p127_add(b01, b[bit][1]);-  b[0][0] = gf2p127_add(b10, gf2p127_mul_10_left(b[1][0]));-  b[0][1] = gf2p127_add(b11, gf2p127_mul_10_left(b[1][1]));+  size_t i;+  for (i = n; i > 0; i--) {+    sl2_mul_bits_left(&b00, &b01, &b10, &b11, buf[i - 1]);+  }+  b[0][0] = b00;+  b[0][1] = b01;+  b[1][0] = b10;+  b[1][1] = b11; }  static inline-void sl2_mul_bits_left(sl2_t b, unsigned char byte) {-  sl2_mul_bit_left(b, (byte >> 0) & 1);-  sl2_mul_bit_left(b, (byte >> 1) & 1);-  sl2_mul_bit_left(b, (byte >> 2) & 1);-  sl2_mul_bit_left(b, (byte >> 3) & 1);-  sl2_mul_bit_left(b, (byte >> 4) & 1);-  sl2_mul_bit_left(b, (byte >> 5) & 1);-  sl2_mul_bit_left(b, (byte >> 6) & 1);-  sl2_mul_bit_left(b, (byte >> 7) & 1);+void sl2_mul_bit_right(gf2p127_t *a00, gf2p127_t *a01, gf2p127_t *a10, gf2p127_t *a11, gf2p127_t bits) {+  // A: {00 = 10, 01 = 01, 10 = 01, 11 = 00}+  // B: {00 = 10, 01 = 11, 10 = 01, 11 = 01}+  gf2p127_t a00_ = *a00;+  gf2p127_t a10_ = *a10;+  *a00 = gf2p127_add(gf2p127_mul_10(*a00), *a01);+  *a10 = gf2p127_add(gf2p127_mul_10(*a10), *a11);+  *a01 = gf2p127_add(a00_, _mm_and_si128(*a00, bits));+  *a11 = gf2p127_add(a10_, _mm_and_si128(*a10, bits)); }  static inline-void sl2_mul_bit_right(sl2_t a, int bit) {-  // A: {00 = 10, 01 = 01, 10 = 01, 11 = 00}-  // B: {00 = 10, 01 = 11, 10 = 01, 11 = 01}-  gf2p127_t a00 = a[0][0];-  gf2p127_t a10 = a[1][0];-  gf2p127_t a01 = a[0][1];-  gf2p127_t a11 = a[1][1];-  a[0][1] = gf2p127_zero();-  a[1][1] = gf2p127_zero();-  a[0][0] = gf2p127_add(gf2p127_mul_10(a00), a01);-  a[1][0] = gf2p127_add(gf2p127_mul_10(a10), a11);-  a[0][1] = gf2p127_add(a00, a[0][!bit]);-  a[1][1] = gf2p127_add(a10, a[1][!bit]);+void sl2_mul_bits_right(gf2p127_t *a00, gf2p127_t *a01, gf2p127_t *a10, gf2p127_t *a11, unsigned char byte) {+  sl2_mul_bit_right(a00, a01, a10, a11, _mm_load_si128(&minmax[(byte >> 7) & 1]));+  sl2_mul_bit_right(a00, a01, a10, a11, _mm_load_si128(&minmax[(byte >> 6) & 1]));+  sl2_mul_bit_right(a00, a01, a10, a11, _mm_load_si128(&minmax[(byte >> 5) & 1]));+  sl2_mul_bit_right(a00, a01, a10, a11, _mm_load_si128(&minmax[(byte >> 4) & 1]));+  sl2_mul_bit_right(a00, a01, a10, a11, _mm_load_si128(&minmax[(byte >> 3) & 1]));+  sl2_mul_bit_right(a00, a01, a10, a11, _mm_load_si128(&minmax[(byte >> 2) & 1]));+  sl2_mul_bit_right(a00, a01, a10, a11, _mm_load_si128(&minmax[(byte >> 1) & 1]));+  sl2_mul_bit_right(a00, a01, a10, a11, _mm_load_si128(&minmax[(byte >> 0) & 1])); }  static inline-void sl2_mul_bits_right(sl2_t a, unsigned char byte) {-  sl2_mul_bit_right(a, (byte >> 7) & 1);-  sl2_mul_bit_right(a, (byte >> 6) & 1);-  sl2_mul_bit_right(a, (byte >> 5) & 1);-  sl2_mul_bit_right(a, (byte >> 4) & 1);-  sl2_mul_bit_right(a, (byte >> 3) & 1);-  sl2_mul_bit_right(a, (byte >> 2) & 1);-  sl2_mul_bit_right(a, (byte >> 1) & 1);-  sl2_mul_bit_right(a, (byte >> 0) & 1);+void sl2_mul_buf_right(sl2_t a, unsigned char *buf, size_t n) {+  gf2p127_t a00 = _mm_load_si128(&a[0][0]);+  gf2p127_t a01 = _mm_load_si128(&a[0][1]);+  gf2p127_t a10 = _mm_load_si128(&a[1][0]);+  gf2p127_t a11 = _mm_load_si128(&a[1][1]);+  size_t i;+  for (i = 0; i < n; i++) {+    sl2_mul_bits_right(&a00, &a01, &a10, &a11, buf[i]);+  }+  a[0][0] = a00;+  a[0][1] = a01;+  a[1][0] = a10;+  a[1][1] = a11; }  static inline

@@ -1,44 +0,0 @@-#include "tillich-zemor.h"-#include "sl2-inl.h"--struct tz_hash_struct {-  sl2_t sl2;-};--int tz_hash_eq(tz_hash_t a, tz_hash_t b) {-  return sl2_eq(a->sl2, b->sl2);-}--void tz_hash_copy(tz_hash_t dst, tz_hash_t src) {-  sl2_copy(dst->sl2, src->sl2);-}--void tz_hash_unit(tz_hash_t h) {-  sl2_unit(h->sl2);-}--void tz_hash_append(tz_hash_t h, unsigned char *buf, size_t n) {-  size_t i;-  for (i = 0; i < n; i++) {-    sl2_mul_bits_right(h->sl2, buf[i]);-  }-}--void tz_hash_prepend(tz_hash_t h, unsigned char *buf, size_t n) {-  size_t i;-  for (i = n; i > 0; i--) {-    sl2_mul_bits_left(h->sl2, buf[i - 1]);-  }-}--void tz_hash_concat(tz_hash_t c, tz_hash_t a, tz_hash_t b) {-  sl2_mul(c->sl2, a->sl2, b->sl2);-}--void tz_hash_serialize(tz_hash_t h, unsigned char buf[86]) {-  sl2_serialize(h->sl2, buf);-}--void tz_hash_unserialize(tz_hash_t h, unsigned char buf[86]) {-  sl2_unserialize(h->sl2, buf);-}

@@ -1,20 +0,0 @@-#pragma once--#include <stddef.h>--#define TZ_HASH_SIZE 64-typedef struct tz_hash_struct *tz_hash_t;--void tz_hash_copy(tz_hash_t dst, tz_hash_t src);--int tz_hash_eq(tz_hash_t a, tz_hash_t b);--void tz_hash_unit(tz_hash_t);--void tz_hash_append(tz_hash_t h, unsigned char *buf, size_t n);-void tz_hash_prepend(tz_hash_t h, unsigned char *buf, size_t n);--void tz_hash_concat(tz_hash_t c, tz_hash_t a, tz_hash_t b);--void tz_hash_serialize(tz_hash_t h, unsigned char str[86]);-void tz_hash_unserialize(tz_hash_t h, unsigned char str[86]);