packages feed

hwsl2 0.1.1.3 → 0.1.1.4

raw patch · 5 files changed

+224/−120 lines, 5 filesdep +Cabaldep +QuickCheckdep +cabal-test-quickcheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: Cabal, QuickCheck, cabal-test-quickcheck, quickcheck-properties

API changes (from Hackage documentation)

- Data.Hash.SL2: instance Eq Hash
- Data.Hash.SL2: instance Monoid Hash
- Data.Hash.SL2: instance Show Hash

Files

+ dist/build/testStub/testStub-tmp/testStub.hs view
@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test ( stubMain )+import Data.Hash.SL2.Test ( tests )+main :: IO ()+main = stubMain tests
hwsl2.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.1.3+version:             0.1.1.4  -- A short (one-line) description of the package. synopsis:            Hashing with SL2@@ -66,7 +66,7 @@   exposed-modules:     Data.Hash.SL2      -- Modules included in this library but not exported.-  -- other-modules:       +  other-modules:       Data.Hash.SL2.Internal      -- LANGUAGE extensions used by modules in this package.   other-extensions:    ForeignFunctionInterface, EmptyDataDecls@@ -86,4 +86,21 @@      -- Base language which the package is written in.   default-language:    Haskell2010-  +++test-suite test+  type:                detailed-0.9+  hs-source-dirs:      src+  test-module:         Data.Hash.SL2.Test+  other-modules:       Data.Hash.SL2.Internal+  build-depends:       base >=4.7 && <4.8,+                       Cabal >=1.9.2,+                       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
src/Data/Hash/SL2.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}- -- | -- Module     : Data.Hash.SL2 -- License    : MIT@@ -22,118 +20,4 @@  module Data.Hash.SL2 (Hash, hash, (<+), (+>), (<|), (|>), parse) 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---- Foreign Imports--foreign import ccall "tillich-zemor.h tz_hash_eq"-  tzHashEq :: Ptr () -> Ptr () -> IO CInt--foreign import ccall "tillich-zemor.h tz_hash_unit"-  tzHashUnit :: Ptr () -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_append"-  tzHashAppend :: Ptr () -> Ptr CChar -> CSize -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_prepend"-  tzHashPrepend :: Ptr () -> Ptr CChar -> CSize -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_concat"-  tzHashConcat :: Ptr () -> Ptr () -> Ptr () -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_serialize"-  tzHashSerialize :: Ptr () -> Ptr CChar -> IO ()--foreign import ccall "tillich-zemor.h tz_hash_unserialize"-  tzHashUnserialize :: Ptr () -> Ptr CChar -> IO ()---- Mutable Helpers--append :: ByteString -> Ptr () -> IO ()-append s p = unsafeUseAsCStringLen s $ \(s', len) -> tzHashAppend p s' (fromIntegral len)--prepend :: ByteString -> Ptr () -> IO ()-prepend s p = unsafeUseAsCStringLen s $ \(s', len) -> tzHashPrepend p s' (fromIntegral len)---- | Opaque representation of a 512 bit hash.-newtype Hash = H (ForeignPtr ())---- Foreign Pointer Helpers--tzHashSize = 64-tzHashLen = 86--withHashPtr :: Hash -> (Ptr () -> IO a) -> IO a-withHashPtr (H fp) = withForeignPtr fp--withHashPtr2 :: Hash -> Hash -> (Ptr () -> Ptr () -> IO a) -> IO a-withHashPtr2 a b f = withHashPtr a (withHashPtr b . f)--withHashPtrNew :: (Ptr () -> IO a) -> IO (Hash, a)-withHashPtrNew f = mallocForeignPtrBytes tzHashSize >>= \fp -> (\r -> (H fp, r)) <$> withForeignPtr fp f--withHashPtrCopy :: Hash -> (Ptr () -> IO a) -> IO (Hash, a)-withHashPtrCopy h f = withHashPtr h $ \hp -> withHashPtrNew $ \hp' -> copyBytes hp' hp tzHashSize >> f hp'---- 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 @(flip ('<>') . '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 @('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---- | /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+import Data.Hash.SL2.Internal
+ src/Data/Hash/SL2/Internal.hs view
@@ -0,0 +1,136 @@+{-# 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++-- | /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
+ src/Data/Hash/SL2/Test.hs view
@@ -0,0 +1,62 @@+module Data.Hash.SL2.Test where++import Data.Word+import Data.Hash.SL2.Internal+import qualified Data.ByteString as B++import Foreign.ForeignPtr+import Foreign.Storable++import Test.QuickCheck+import Test.QuickCheck.All+import Test.QuickCheck.Property.Monoid++import Distribution.TestSuite.QuickCheck++import Data.Monoid++instance Arbitrary B.ByteString where+  arbitrary = fmap B.pack arbitrary++instance Arbitrary Hash where+  arbitrary = fmap fromBytes $ 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 "append"++    [ testGroup "single string" $++      [ testProperty "equal to ((. hash) . (<>))" $+          \a b -> ((. hash) . (<>)) a b == a <+ b+      ]++    , testGroup "multiple strings" $++      [ testProperty "equal to (foldl (<+))" $+          \a b -> (foldl (<+)) a b == a <| b+      ]++    ]++  , testGroup "prepend"++    [ testGroup "single string" $++      [ testProperty "equal to ((<>) . hash)" $+          \a b -> ((<>) . hash) a b == a +> b+      ]++    , testGroup "multiple strings" $++      [ testProperty "equal to (flip (foldr (+>)))" $+          \a b -> (flip (foldr (+>))) a b == a |> b+      ]++    ]++  ]