fastcdc (empty) → 0.0.0

raw patch · 4 files changed

+261/−0 lines, 4 filesdep +basedep +bv-littledep +bytestring

Dependencies added: base, bv-little, bytestring, conduit, fastcdc, gearhash

Files

LICENSE +29/−0
fastcdc.cabal +78/−0
fastcdc/Main.hs +17/−0
src/Data/Conduit/Algorithms/FastCDC.hs +137/−0

+ LICENSE view

@@ -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.

+ fastcdc.cabal view

@@ -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

+ fastcdc/Main.hs view

@@ -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

+ src/Data/Conduit/Algorithms/FastCDC.hs view

@@ -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