diff --git a/optimal-blocks.cabal b/optimal-blocks.cabal --- a/optimal-blocks.cabal +++ b/optimal-blocks.cabal @@ -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 diff --git a/src/Algorithm/OptimalBlocks.hs b/src/Algorithm/OptimalBlocks.hs --- a/src/Algorithm/OptimalBlocks.hs +++ b/src/Algorithm/OptimalBlocks.hs @@ -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 diff --git a/src/Algorithm/OptimalBlocks/BuzzHash.hs b/src/Algorithm/OptimalBlocks/BuzzHash.hs --- a/src/Algorithm/OptimalBlocks/BuzzHash.hs +++ b/src/Algorithm/OptimalBlocks/BuzzHash.hs @@ -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