diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2020, Gregor Kleen +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/fastcdc.cabal b/fastcdc.cabal new file mode 100644 --- /dev/null +++ b/fastcdc.cabal @@ -0,0 +1,78 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.7. +-- +-- see: https://github.com/sol/hpack + +name: fastcdc +version: 0.0.0 +synopsis: An implementation of FastCDC, a content-defined chunking algorithm based on the Gear hash rolling hash algorithm +homepage: https://github.com/gkleen/fastcdc#readme +bug-reports: https://github.com/gkleen/fastcdc/issues +author: Gregor Kleen +maintainer: aethoago@141.li +copyright: 2022 Gregor Kleen +license: BSD3 +license-file: LICENSE +build-type: Simple + +source-repository head + type: git + location: https://github.com/gkleen/fastcdc + subdir: fastcdc + +flag pedantic + manual: True + default: False + +library + exposed-modules: + Data.Conduit.Algorithms.FastCDC + other-modules: + Paths_fastcdc + hs-source-dirs: + src + default-extensions: + NoImplicitPrelude + other-extensions: + BangPatterns + PatternGuards + RecordWildCards + ScopedTypeVariables + DeriveGeneric + DeriveDataTypeable + ghc-options: -Wall + build-depends: + base >=4.7 && <5 + , bv-little >=1.1 && <2 + , bytestring ==0.10.* + , conduit ==1.3.* + , gearhash >=0.0 && <2 + if flag(pedantic) + ghc-options: -Werror + default-language: Haskell2010 + +executable fastcdc + main-is: Main.hs + hs-source-dirs: + fastcdc + default-extensions: + NoImplicitPrelude + other-extensions: + BangPatterns + PatternGuards + RecordWildCards + ScopedTypeVariables + DeriveGeneric + DeriveDataTypeable + ghc-options: -Wall + build-depends: + base >=4.7 && <5 + , bv-little >=1.1 && <2 + , bytestring ==0.10.* + , conduit ==1.3.* + , fastcdc + , gearhash >=0.0 && <2 + if flag(pedantic) + ghc-options: -Werror + default-language: Haskell2010 diff --git a/fastcdc/Main.hs b/fastcdc/Main.hs new file mode 100644 --- /dev/null +++ b/fastcdc/Main.hs @@ -0,0 +1,17 @@ +module Main + ( main + ) where + +import Prelude +import Data.Conduit +import qualified Data.Conduit.Combinators as C +import Data.Conduit.Algorithms.FastCDC + +import qualified Data.ByteString as ByteString +import Data.Maybe + + +main :: IO () +main = runConduit $ C.stdin .| fastCDC params .| C.map ByteString.length .| C.print + where params = fromMaybe (error "Could not recommend FastCDC Params") + $ recommendFastCDCParameters 13 64 diff --git a/src/Data/Conduit/Algorithms/FastCDC.hs b/src/Data/Conduit/Algorithms/FastCDC.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conduit/Algorithms/FastCDC.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Data.Conduit.Algorithms.FastCDC + ( fastCDC + , FastCDCParameters(fastCDCMinBlockSize, fastCDCMaxBlockSize, fastCDCNormalBlockSize, fastCDCMaskSmallBits, fastCDCMaskLargeBits, fastCDCGearHashTable) + , fastCDCParameters, recommendFastCDCParameters + ) where + +import Prelude +import Data.Conduit +import Data.Digest.GearHash + +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString + +import qualified Data.BitVector.LittleEndian as BitVector +import Data.Bits + +import Numeric.Natural (Natural) + +import GHC.Generics (Generic) +import Data.Typeable (Typeable) + +import Control.Monad (guard) + +import Data.Ratio ((%)) + + +data FastCDCParameters = FastCDCParameters + { fastCDCMinBlockSize + , fastCDCMaxBlockSize + , fastCDCNormalBlockSize :: !Int + , fastCDCMaskSmallBits + , fastCDCMaskLargeBits :: !Int + , fastCDCWindowSize :: !Int + , fastCDCGearHashTable :: !GearHashTable + } deriving (Eq, Ord, Show, Generic, Typeable) + +fastCDCParameters :: Int -- ^ Minimum block size + -> Int -- ^ Normal block size + -> Int -- ^ Maximum block size + -> Int -- ^ Mask popcount to generate normal sized chunks + -> Int -- ^ Mask popcount to generate small chunks + -> GearHashTable + -> Maybe FastCDCParameters +fastCDCParameters fastCDCMinBlockSize fastCDCNormalBlockSize fastCDCMaxBlockSize fastCDCMaskSmallBits fastCDCMaskLargeBits fastCDCGearHashTable = do + fastCDCWindowSize <- gearHashTableHashLength fastCDCGearHashTable + guard $ fastCDCMinBlockSize >= 0 + guard $ fastCDCMinBlockSize <= fastCDCNormalBlockSize + guard $ fastCDCMaxBlockSize >= fastCDCNormalBlockSize + guard $ fastCDCMaxBlockSize > 0 + guard $ fastCDCMaskSmallBits <= fastCDCMaskLargeBits + guard $ fastCDCMaskLargeBits <= fastCDCWindowSize + return FastCDCParameters{..} + +recommendFastCDCParameters :: Int -- ^ @log2@ of target average block size + -> Int -- ^ Rolling hash window size + -> Maybe FastCDCParameters +recommendFastCDCParameters targetMaskSize windowSize = fastCDCParameters minBlockSize normalBlockSize maxBlockSize maskSmallBits maskLargeBits =<< defaultGearHashTableFor windowSize + where + minBlockSize = floor $ normalBlockSize % 4 + maxBlockSize = normalBlockSize * 8 + normalBlockSize = 2 ^ targetMaskSize + maskSmallBits = max 0 $ targetMaskSize - 2 + maskLargeBits = targetMaskSize + 2 + + +fastCDC :: forall m. + Monad m + => FastCDCParameters + -> ConduitT ByteString ByteString m () +fastCDC FastCDCParameters{..} = conduitGo ByteString.empty $ hashInitWith fastCDCGearHashTable + where + conduitGo :: ByteString -- ^ Chunk accumulator + -> GearHashState + -> ConduitT ByteString ByteString m () + conduitGo acc hState = do + nextChunk <- await + case nextChunk of + Nothing -> yield acc + Just nextChunk' -> go acc hState nextChunk' >>= uncurry conduitGo + + go :: forall i. + ByteString -- ^ Chunk accumulator + -> GearHashState + -> ByteString -- ^ Input + -> ConduitT i ByteString m (ByteString, GearHashState) -- ^ Return new chunk accumulator + go acc hState inpBS + | ByteString.null inpBS = return (acc, hState) + | accLength < fastCDCMinBlockSize + , (inpBSIgnore, inpBS') <- ByteString.splitAt (fastCDCMinBlockSize - accLength) inpBS + = go (acc <> inpBSIgnore) hState inpBS' + where accLength = ByteString.length acc + go acc hState inpBS + | breakPos >= inpLength = return (acc <> inpBS, hState3) + | otherwise = do + yield $ acc <> inpPrefix + go ByteString.empty hState3 inpSuffix + where + (breakPos, hState3) = go' hState 0 + (inpPrefix, inpSuffix) = ByteString.splitAt breakPos inpBS + + go' :: GearHashState -> Int -> (Int, GearHashState) + go' hState' ix + | ix >= inpLength + = (inpLength, hState') + | ix >= fastCDCMaxBlockSize' + = (fastCDCMaxBlockSize', hState') + | otherwise = case compare ix fastCDCNormalBlockSize' of + LT | not $ testMask hVal maskLarge + -> go' hState'' $ succ ix + _ | not $ testMask hVal maskSmall + -> go' hState'' $ succ ix + _ -> (ix, hState'') + where + hState'' = hashUpdate (ByteString.index inpBS ix) hState' + hVal = hashFinalize hState'' + + inpLength = ByteString.length inpBS + accLength = ByteString.length acc + fastCDCMaxBlockSize' = fastCDCMaxBlockSize - accLength + fastCDCNormalBlockSize' = fastCDCNormalBlockSize - accLength + + maskSmall, maskLarge :: BitVector + !maskSmall = mkMask fastCDCMaskSmallBits + !maskLarge = mkMask fastCDCMaskLargeBits + + mkMask :: Int -> BitVector + mkMask maskSize = BitVector.fromNumber (fromIntegral fastCDCWindowSize) ((pred $ 1 `shift` maskSize) `shiftL` (fastCDCWindowSize - maskSize) :: Natural) + + testMask :: BitVector -> BitVector -> Bool + testMask v mask = BitVector.isZeroVector $ v .&. mask