hwsl2 0.1.1.4 → 0.2.0.0

raw patch · 9 files changed

+204/−139 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• dist/build/testStub/testStub-tmp/testStub.hs +1/−1
• hwsl2.cabal +12/−3
• src/Data/Hash/SL2.hs +52/−0
• src/Data/Hash/SL2/Internal.hs +3/−131
• src/Data/Hash/SL2/Internal/Imports.hs +30/−0
• src/Data/Hash/SL2/Mutable.hs +72/−0
• src/Data/Hash/SL2/Test.hs +14/−3
• src/Data/Hash/SL2/Unsafe.hs +19/−0
• src/gf2p127-inl.h +1/−1

@@ -1,5 +1,5 @@ module Main ( main ) where-import Distribution.Simple.Test ( stubMain )+import Distribution.Simple.Test.LibV09 ( stubMain ) import Data.Hash.SL2.Test ( tests ) main :: IO () main = stubMain tests

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.1.4+version:             0.2.0.0  -- A short (one-line) description of the package. synopsis:            Hashing with SL2@@ -64,12 +64,15 @@ library   -- Modules exported by the library.   exposed-modules:     Data.Hash.SL2+                       Data.Hash.SL2.Mutable+                       Data.Hash.SL2.Unsafe      -- 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, EmptyDataDecls+  other-extensions:    ForeignFunctionInterface      -- Other library packages from which modules are imported.   build-depends:       base >=4.7 && <4.8, bytestring >=0.10 && <0.11@@ -77,6 +80,8 @@   -- Directories containing source files.   hs-source-dirs:      src +  ghc-options:         -fwarn-unused-imports+   -- Options for foreign source files.   include-dirs:        src   c-sources:           src/tillich-zemor.c@@ -92,7 +97,11 @@   type:                detailed-0.9   hs-source-dirs:      src   test-module:         Data.Hash.SL2.Test-  other-modules:       Data.Hash.SL2.Internal+  other-modules:       Data.Hash.SL2+                       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,                        bytestring >=0.10 && <0.11,

@@ -21,3 +21,55 @@ module Data.Hash.SL2 (Hash, hash, (<+), (+>), (<|), (|>), parse) where  import Data.Hash.SL2.Internal+import Data.Hash.SL2.Unsafe+import qualified Data.Hash.SL2.Mutable as Mutable++import System.IO.Unsafe++import Data.ByteString (ByteString)++import Data.Monoid+import Data.Functor+import Data.Foldable (Foldable)++instance Show Hash where+  show h = unsafePerformIO $ unsafeUseAsPtr h Mutable.serialize++instance Eq Hash where+  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)++-- | /O(n)/ Calculate the hash of the 'ByteString'. Alias for @('mempty' '<+')@.+hash :: ByteString -> Hash+hash = (<+) mempty++-- | /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++-- | /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++-- | /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++-- | /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++-- | /O(1)/ Parse the representation generated by 'show'.+parse :: String -> Maybe Hash+parse s = (\(h, r) -> h <$ r) $ unsafePerformIO $ Mutable.withNew $ Mutable.unserialize s

@@ -1,136 +1,8 @@-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}- module Data.Hash.SL2.Internal where -import Prelude hiding (concat)- import Foreign-import Foreign.Ptr-import Foreign.C.Types-import Foreign.C.String-import Foreign.Marshal.Array-import Foreign.Marshal.Utils-import Foreign.ForeignPtr-import System.IO.Unsafe -import Data.ByteString (ByteString)-import Data.ByteString.Unsafe--import Data.Monoid-import Data.Functor-import Data.Foldable (Foldable, foldlM, foldrM)---- Datatypes--data Gf2p127 = Gf2p127-  !Word8 !Word8 !Word8 !Word8-  !Word8 !Word8 !Word8 !Word8-  !Word8 !Word8 !Word8 !Word8-  !Word8 !Word8 !Word8 !Word8--data SL2 = SL2 !Gf2p127 !Gf2p127 !Gf2p127 !Gf2p127---- Foreign Imports--foreign import ccall "tillich-zemor.h tz_hash_eq"-  tzHashEq :: Ptr SL2 -> Ptr SL2 -> IO CInt--foreign import ccall "tillich-zemor.h tz_hash_unit"-  tzHashUnit :: Ptr SL2 -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_append"-  tzHashAppend :: Ptr SL2 -> Ptr CChar -> CSize -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_prepend"-  tzHashPrepend :: Ptr SL2 -> Ptr CChar -> CSize -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_concat"-  tzHashConcat :: Ptr SL2 -> Ptr SL2 -> Ptr SL2 -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_serialize"-  tzHashSerialize :: Ptr SL2 -> Ptr CChar -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_unserialize"-  tzHashUnserialize :: Ptr SL2 -> Ptr CChar -> IO ()---- Mutable Helpers--append :: ByteString -> Ptr SL2 -> IO ()-append s p = unsafeUseAsCStringLen s $ \(s', len) -> tzHashAppend p s' (fromIntegral len)--prepend :: ByteString -> Ptr SL2 -> IO ()-prepend s p = unsafeUseAsCStringLen s $ \(s', len) -> tzHashPrepend p s' (fromIntegral len)---- | Opaque representation of a 512 bit hash.-newtype Hash = H (ForeignPtr SL2)---- Foreign Pointer Helpers--tzHashSize = 64-tzHashLen = 86--withHashPtr :: Hash -> (Ptr SL2 -> IO a) -> IO a-withHashPtr (H fp) = withForeignPtr fp--withHashPtr2 :: Hash -> Hash -> (Ptr SL2 -> Ptr SL2 -> IO a) -> IO a-withHashPtr2 a b f = withHashPtr a (withHashPtr b . f)--withHashPtrNew :: (Ptr SL2 -> IO a) -> IO (Hash, a)-withHashPtrNew f = mallocForeignPtrBytes tzHashSize >>= \fp -> (\r -> (H fp, r)) <$> withForeignPtr fp f--withHashPtrCopy :: Hash -> (Ptr SL2 -> IO a) -> IO (Hash, a)-withHashPtrCopy h f = withHashPtr h $ \hp -> withHashPtrNew $ \hp' -> copyBytes hp' hp tzHashSize >> f hp'--fromBytes :: [Word8] -> Hash-fromBytes ws = H $ unsafePerformIO $ do-  fp <- mallocForeignPtrArray0 64-  withForeignPtr fp $ \p ->-    mapM_ (\(w, off) -> pokeElemOff p off w) (zip ws [0..63])-  return (castForeignPtr fp)---- Instances--instance Show Hash where-  show h = unsafePerformIO $ allocaBytes tzHashLen $ \p -> withHashPtr h (flip tzHashSerialize p) >> peekCStringLen (p, tzHashLen)--instance Eq Hash where-  a == b = toBool $ unsafePerformIO $ withHashPtr2 a b tzHashEq--instance Monoid Hash where-  mempty = fst $ unsafePerformIO $ withHashPtrNew tzHashUnit-  mappend a b = fst $ unsafePerformIO $ withHashPtrNew (withHashPtr2 a b . tzHashConcat)---- Interface---- | /O(n)/ Calculate the hash of the 'ByteString'. Alias for @('mempty' '<+')@.-hash :: ByteString -> Hash-hash = (<+) mempty---- | /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 $ withHashPtrCopy h $ 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 $ withHashPtrCopy h $ 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 $ withHashPtrCopy h $ \hp -> foldlM (\p s -> p <$ append s p) hp 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 $ withHashPtrCopy h $ \hp -> foldrM (\s p -> p <$ prepend s p) hp ss+newtype Hash = H (ForeignPtr ()) --- | /O(1)/ Parse the representation generated by 'show'.-parse :: String -> Maybe Hash-parse s = (\(h, r) -> h <$ r) $ unsafePerformIO $ withHashPtrNew $ \hp -> withCAStringLen s $ \(s', len) ->-  if len == tzHashLen then Just <$> tzHashUnserialize hp s' else return Nothing+hashSize = 64 :: Int+hashLen = 86 :: Int

@@ -0,0 +1,30 @@+{-# 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 ()+

@@ -0,0 +1,72 @@+module Data.Hash.SL2.Mutable+  ( eq+  , unit+  , concat+  , append, prepend+  , foldAppend, foldPrepend+  , serialize, unserialize+  , withNew, withCopy+  ) where++import Prelude hiding (concat)++import Foreign+import Foreign.C.String++import Data.ByteString (ByteString)+import Data.ByteString.Unsafe++import Data.Foldable (Foldable, foldlM, foldrM)++import Data.Hash.SL2.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)/ Compare the two hashes for equality.+eq :: Ptr Hash -> Ptr Hash -> IO Bool+eq a b = fmap toBool $ Imports.eq a b++-- | /O(1)/ Set the 'Hash' to the empty value.+unit :: Ptr Hash -> IO ()+unit h = Imports.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++-- | /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)++-- | /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)++-- | /O(n)/ Append the hash of every 'ByteString' to the existing 'Hash', from left to right.+foldAppend :: Foldable t => t ByteString -> Ptr Hash -> IO ()+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 ()+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)++-- | /O(1)/ Unserialize the hash from the representation generated by 'serialize'.+unserialize :: String -> Ptr Hash -> IO (Maybe ())+unserialize s p = withCAStringLen s $ \(s', len) ->+  if len == hashLen then Just `fmap` Imports.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)++withCopy :: Hash -> (Ptr Hash -> IO a) -> IO (Hash, a)+withCopy h f = withNew $ \p -> poke p h >> f p

@@ -1,7 +1,11 @@ module Data.Hash.SL2.Test where  import Data.Word++import Data.Hash.SL2 import Data.Hash.SL2.Internal+import Data.Hash.SL2.Unsafe+ import qualified Data.ByteString as B  import Foreign.ForeignPtr@@ -19,13 +23,20 @@   arbitrary = fmap B.pack arbitrary  instance Arbitrary Hash where-  arbitrary = fmap fromBytes $ mapM choose (take 64 $ cycle $ replicate 15 (0, 255) ++ [(0, 127)])+  arbitrary = fmap unsafePack $ mapM choose (take 64 $ cycle $ replicate 15 (0, 255) ++ [(0, 127)])  tests :: IO [Test] tests = return -  [ testProperty "Monoid" $-      eq $ prop_Monoid (T :: T Hash)+  [ testGroup "composition"++    [ testProperty "forms a monoid" $+        eq $ prop_Monoid (T :: T Hash)++    , testProperty "is distributive" $+        \a b -> hash (a <> b) == hash a <> hash b++    ]    , testGroup "append" 

@@ -0,0 +1,19 @@+module Data.Hash.SL2.Unsafe (unsafeUseAsPtr, unsafeUseAsPtr2, unsafePack) where++import Foreign+import System.IO.Unsafe++import Data.Hash.SL2.Internal++unsafeUseAsPtr :: Hash -> (Ptr Hash -> IO a) -> IO a+unsafeUseAsPtr (H fp) f = withForeignPtr fp (f . castPtr)++unsafeUseAsPtr2 :: Hash -> Hash -> (Ptr Hash -> Ptr Hash -> IO a) -> IO a+unsafeUseAsPtr2 a b f = unsafeUseAsPtr a (unsafeUseAsPtr b . f)++unsafePack :: [Word8] -> Hash+unsafePack ws = H $ unsafePerformIO $ do+  fp <- mallocForeignPtrArray0 hashSize+  withForeignPtr fp $ \p ->+    mapM_ (\(w, off) -> pokeElemOff p off w) (zip ws [0..hashSize-1])+  return (castForeignPtr fp)

@@ -53,7 +53,7 @@   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(x127));+  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); }