optimal-blocks 0.0.1 → 0.1.0

raw patch · 3 files changed

+129/−39 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• optimal-blocks.cabal +1/−1
• src/Algorithm/OptimalBlocks.hs +34/−13
• src/Algorithm/OptimalBlocks/BuzzHash.hs +94/−25

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                optimal-blocks-version:             0.0.1+version:             0.1.0 synopsis:            Optimal Block boundary determination for rsync-like behaviours -- description:          homepage:            https://github.com/tsuraan/optimal-blocks

@@ -8,18 +8,21 @@ ( Blocks(..) , ChunkConfig(..) , OptimalBlock(..)+, Algorithm(..) , chop+, split , defaultConfig , sizedBitmask ) where  import qualified Data.Vector.Unboxed as V+import qualified Data.ByteString as ByteString import Data.ByteString ( ByteString, length, splitAt) import Data.Word ( Word64 ) import Data.Bits ( (.&.), shiftL ) import Control.DeepSeq ( NFData(..) ) -import Algorithm.OptimalBlocks.BuzzHash ( hashes )+import Algorithm.OptimalBlocks.BuzzHash ( hashes, split, slowSplit )  import Prelude hiding ( length, splitAt ) @@ -34,8 +37,10 @@ data Blocks = Blocks                { blocksOptimal :: [OptimalBlock]               , blocksRemain  :: ByteString-              } deriving ( Show )+              } deriving ( Eq, Show ) +data Algorithm = Reference | Old | New deriving ( Eq, Ord, Show )+ -- | Parameters to the chop function. 'windowSize' is how many bytes wide the -- hashing window is. 'blockSize' is the target size of each generated block. -- Actual blocks will be larger or smaller, but on average, blocks will be@@ -43,13 +48,14 @@ data ChunkConfig = ChunkConfig                    { windowSize :: Int                    , blockSize  :: Int+                   , chunkAlg   :: Algorithm                    } deriving ( Show )  {-| This is an alias of 'chop'' that uses a window size of 128 bytes and a  desired block size of 256KiB.  -} defaultConfig :: ChunkConfig-defaultConfig = ChunkConfig 128 $ 256*kb+defaultConfig = ChunkConfig 128 (256*kb) New   where   kb = 1024 @@ -66,6 +72,21 @@ chop :: ChunkConfig -- ^ chopping parameters      -> ByteString  -- ^ ByteString to chop      -> Blocks+chop (ChunkConfig win bksz alg) bs | alg == New || alg == Reference =+  let target = toEnum bksz :: Float+      bits   = fromEnum $ 0.5 + logBase 2 target+  in go bits [] bs+  where+  go bits accum rest =+    let fn     = case alg of New       -> split+                             Reference -> slowSplit+                             _         -> error "I already checked this above"+    in case fn win bits rest of+      (complete, remain) | ByteString.null complete ->+        Blocks (map OptimalBlock $ reverse accum) remain+      (complete, remain) ->+        go bits (complete:accum) remain+ chop cfg bs   | length bs < winSz = Blocks [] bs   | otherwise = go@@ -75,21 +96,21 @@         locs   = V.map (+winSz) $ V.findIndices (\h -> mask == (mask .&. h))                                                 hashed         lens   = V.zipWith (-) locs (V.cons 0 locs)-        (end, rlist, _) = V.foldl' split (bs, [], 0) lens+        (end, rlist, _) = V.foldl' doSplit (bs, [], 0) lens     in Blocks (map OptimalBlock $ reverse rlist) end    mask :: Word64   mask = sizedBitmask desiredSz -  -- Split is a little bit complicated. The goal here is that split will never-  -- give a chunk of data smaller than winSz. The reason for this is that we're-  -- scanning for winSz-length chunks of data whose hashes meet a pattern; if-  -- data chunks smaller than winSz are returned, they don't have well-defined-  -- winSz-sized hashes, and we don't want that.-  split :: (ByteString, [ByteString], Int)-        -> Int-        -> (ByteString, [ByteString], Int)-  split (b, ls, add) loc+  -- doSplit is a little bit complicated. The goal here is that split will+  -- never give a chunk of data smaller than winSz. The reason for this is that+  -- we're scanning for winSz-length chunks of data whose hashes meet a+  -- pattern; if data chunks smaller than winSz are returned, they don't have+  -- well-defined winSz-sized hashes, and we don't want that.+  doSplit :: (ByteString, [ByteString], Int)+          -> Int+          -> (ByteString, [ByteString], Int)+  doSplit (b, ls, add) loc     | add+loc < winSz = (b, ls, add+loc)     | otherwise =         let (h, t) = splitAt (add+loc) b

@@ -6,31 +6,97 @@  module Algorithm.OptimalBlocks.BuzzHash ( hashes+, split+, slowSplit , Hash(..) , init , roll , h ) where -import qualified Data.ByteString as BS+import qualified Data.ByteString as ByteString import qualified Data.Vector.Unboxed as VU-import Data.Vector.Unboxed ( Vector, generate, (!), empty, constructN, unsafeLast, null )-import Data.ByteString ( ByteString, pack, length )+import Data.Bits              ( (.&.), rotateL, shiftL, xor )+import Data.ByteString        ( ByteString, pack, length ) import Data.ByteString.Unsafe ( unsafeTake, unsafeIndex )-import Data.Word ( Word8, Word64 )-import Data.Bits ( rotateL, xor )+import Data.Vector.Unboxed    ( Vector, generate, (!), empty, constructN, unsafeLast, null )+import Data.Word              ( Word8, Word64 )  import Algorithm.OptimalBlocks.SipHash ( hashByteString )  import Prelude hiding ( init, length, null, rem ) +type WindowSize = Int+type BlockShift = Int++-- | Split up a ByteString into a complete block and a remainder. If no break+-- point is found in the given string, the first element of the resulting pair+-- will be empty.+split :: WindowSize -- ^ How many bytes to use when generating the pattern hash+      -> BlockShift -- ^ log2 of the desired block size+      -> ByteString -- ^ The ByteString to split+      -> (ByteString, ByteString)+split win _shift bytes | ByteString.length bytes <= win =+  (ByteString.empty, bytes)+split win shift bytes = go 0 (hash0 $ unsafeTake win bytes)+  where+  go !start !hash | mask == (hash .&. mask) =+    ByteString.splitAt (start + win) bytes+  go !start !_hash | start == end =+    (ByteString.empty, bytes)+  go !start !hash =+    -- 8-byte window:+    -- hash of 0 1 2 3 4 5 6 7+    -- rolls into+    -- hash of   1 2 3 4 5 6 7 8+    -- by removing the value at "start" and adding in the value at "start+win"+    let !old = unsafeIndex bytes start+        !new = unsafeIndex bytes (start + win)+        !hh' = roll win hash old new+    in go (start+1) hh'++  -- 8-byte window, 10 bytes of data, rolls like+  -- [01234567]89  (start = 0)+  -- 0[12345678]9  (start = 1)+  -- 01[23456789]  (start = 2)+  -- we are done when start = (length bytes) - win (2, here)+  end = ByteString.length bytes - win++  mask = (1 `shiftL` shift) - 1++-- | Same thing as 'split', but actually calculates the hash of every window+-- explicitly. This is really slow, and is only used to validate the results of+-- 'split'+slowSplit :: WindowSize -- ^ How many bytes to use for pattern search+          -> BlockShift -- ^ log2 of the desired block size+          -> ByteString -- ^ The ByteString to split+          -> (ByteString, ByteString)+slowSplit win _shift bytes | ByteString.length bytes <= win =+  (ByteString.empty, bytes)+slowSplit win shift bytes = go 0+  where+  go start =+    let tl   = ByteString.drop start bytes+        bs   = ByteString.take win tl+        hash = hash0 bs+    in if ByteString.length bs < win+        then (ByteString.empty, bytes)+        else if mask == (mask .&. hash)+              then ByteString.splitAt (start + win) bytes+              else go (start+1)++  mask = (1 `shiftL` shift) - 1+ {-| Determine the hash of every 'len' sequence of bytes in the given  'ByteString'. Because this uses BuzzHash, a rolling hash, this runs in @O(n)@  time dependent on the length of 'bs', and independent of 'len'.   This will generate @(length bs - len + 1)@ 64-bit hashes.++ This function really doesn't serve any purpose anymore, and is just kept+ around as a sanity check for the much faster 'split' function.  -}-hashes :: Int         -- ^ How many bytes to put into each hash+hashes :: WindowSize  -- ^ How many bytes to put into each hash        -> ByteString  -- ^ The 'ByteString' to calculate hashes of.        -> Vector Word64 hashes len bs @@ -41,15 +107,17 @@   upd v     | null v    = currentVal $ init $ unsafeTake len bs     | otherwise =-        let prevH = {-# SCC hash_last #-} Hash len $ unsafeLast v-            old8  = unsafeIndex bs (VU.length v - 1)-            new8  = unsafeIndex bs (len + VU.length v - 1)-        in {-# SCC current_roll #-} currentVal $ roll prevH old8 new8+        let !prevH = {-# SCC hash_last #-} Hash len $ unsafeLast v+            !vlen  = VU.length v - 1+            !old8  = unsafeIndex bs vlen+            !new8  = unsafeIndex bs (len + vlen)+            !rollV = roll (windowLength prevH) (currentVal prevH) old8 new8+        in rollV  {-| A representation of a hash that allows rolling hashes to be easily  calculated.  -}-data Hash = Hash { windowLength :: !Int+data Hash = Hash { windowLength :: !WindowSize                  , currentVal   :: !Word64                  }             deriving ( Show )@@ -59,9 +127,12 @@  supports efficient slices on its own.  -} init :: ByteString -> Hash-init bs =-  let hash = BS.foldl upd 0 bs-  in Hash (length bs) hash+init bs = Hash (length bs) (hash0 bs)++{-| Calculate the actual hash of the given ByteString.+ -}+hash0 :: ByteString -> Word64+hash0 bs = ByteString.foldl upd 0 bs   where   upd :: Word64 -> Word8 -> Word64   upd hsh w8 = (hsh `rotateL` 1) `xor` (h w8)@@ -74,25 +145,23 @@  sequence of bytes one would manually track the first and last byte of each  window on the 'ByteString'. 'hashes' does this for you...  -}-roll :: Hash -> Word8 -> Word8 -> Hash-roll hsh old new =-  let rem = {-# SCC roll_rem #-} (h old) `rotateL` (windowLength hsh)-      add = {-# SCC roll_add #-} h new-      skh = {-# SCC roll_skh #-} (currentVal hsh) `rotateL` 1-  in {-# SCC roll_hsh #-} hsh { currentVal = rem `xor` add `xor` skh }+roll :: WindowSize -> Word64 -> Word8 -> Word8 -> Word64+roll !winsz !hsh !old !new =+  let !rem = {- {-# SCC roll_rem #-} -} (h old) `rotateL` winsz+      !add = {- {-# SCC roll_add #-} -} h new+      !skh = {- {-# SCC roll_skh #-} -} hsh `rotateL` 1+  in {-# SCC roll_hsh #-} rem `xor` add `xor` skh {-# INLINE roll #-}  {-| Upgrade an 8-bit word to a 64-bit one that is very "different" from all  the other possible 8-bit words. This library uses SipHash to do this.  -} h :: Word8 -> Word64-h w = let a = {-# SCC h_a #-} hs-          b = {-# SCC h_fromEnum #-} fromEnum w-          c = {-# SCC h_lookup #-} a ! b-      in c--- h = (hs !) . fromEnum+h = (hs !) . fromEnum {-# INLINE h #-} +{- |A pre-calculated array of hashes of bytes.+ -} hs :: Vector Word64 hs = generate 256 fn   where