keyvaluehash (empty) → 0.1.0.0

raw patch · 4 files changed

+324/−0 lines, 4 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, derive, directory, filepath, hashable

Files

LICENSE +30/−0
Setup.hs +2/−0
keyvaluehash.cabal +20/−0
src/Database/KeyValueHash.hs +272/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2012, Eyal Lotem++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Eyal Lotem nor the names of other+      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+OWNER 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ keyvaluehash.cabal view

@@ -0,0 +1,20 @@+name:                keyvaluehash+version:             0.1.0.0+synopsis:            Pure Haskell key/value store implementation+-- description:         +license:             BSD3+license-file:        LICENSE+author:              Eyal Lotem+maintainer:          eyal.lotem@gmail.com+-- copyright:           +category:            Database+build-type:          Simple+cabal-version:       >=1.8++library+  hs-Source-Dirs:      src+  exposed-modules:     Database.KeyValueHash+  -- other-modules:       +  build-depends:       base >=4.5 && <10, filepath, directory, bytestring, hashable, binary, derive+  ghc-options:         -O2 -Wall+  ghc-prof-options:    -Wall -auto-all -caf-all -rtsopts

+ src/Database/KeyValueHash.hs view

@@ -0,0 +1,272 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell, DeriveDataTypeable #-}+module Database.KeyValueHash+  ( Key, Value+  , Size, mkSize, sizeLinear+  , HashFunction, stdHash, mkHashFunc+  , Database, createDatabase, openDatabase+  , readKey, writeKey, deleteKey+  ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (when)+import Data.Binary (Binary(..))+import Data.Binary.Get (runGet)+import Data.Binary.Put (runPut)+import Data.Derive.Binary(makeBinary)+import Data.DeriveTH(derive)+import Data.Hashable (Hashable, hash)+import Data.Monoid (mconcat)+import Data.Typeable (Typeable)+import Data.Word (Word8, Word32, Word64)+import System.FilePath ((</>))+import qualified Control.Exception as Exc+import qualified Data.ByteString as SBS+import qualified Data.ByteString.Lazy as LBS+import qualified System.Directory as Directory+import qualified System.IO as IO++-- of any length, but long values may be less efficiently handled+type Key = SBS.ByteString+type Value = SBS.ByteString++newtype Size = Size {+  sizeLog :: Word8+  }++sizeLinear :: Size -> Word64+sizeLinear = (2^) . sizeLog++instance Show Size where+  show (Size x) = "sz" ++ show x++mkSize :: Word64 -> Size+mkSize = Size . (ceiling :: Double -> Word8) . logBase 2 . fromIntegral++data HashFunction = HashFunction+  { hfHash :: Key -> Size -> Word64+  , hfName :: String+  }++-- Must not use 0-value because it is used as an invalid value ptr+cap :: Word64 -> Size -> Word64+cap val size = val `mod` (sizeLinear size)++mkHashFunc :: String -> (Key -> Word64) -> HashFunction+mkHashFunc name f = HashFunction+  { hfName = name+  , hfHash = cap . f+  }++stdHash :: HashFunction+stdHash = mkHashFunc "Hashable" (fromIntegral . hash)++data Database = Database+  { _dbPath :: FilePath -- directory container+  , dbSize :: Size+  , dbHashFunc :: HashFunction+  , dbKeysHandle :: IO.Handle+  , dbValuesHandle :: IO.Handle+  }++data FileRange = FileRange+  { _frOffset :: Word64+  , _frSize :: Word64+  }+derive makeBinary ''FileRange++type ValuePtr = Word64 -- offset in values file+type KeyPtr = Word64 -- index in key file++type KeyRecord = ValuePtr++data ValueHeader = ValueHeader+  { vhNextCollision :: ValuePtr+  , vhKeySize :: Word32+  , vhValueSize :: Word32+  }+derive makeBinary ''ValueHeader++atVhNextCollision :: (ValuePtr -> ValuePtr) -> ValueHeader -> ValueHeader+atVhNextCollision f v = v { vhNextCollision = f (vhNextCollision v) }++encode :: Binary a => a -> SBS.ByteString+encode = strictify . runPut . put++decode :: Binary a => SBS.ByteString -> a+decode = runGet get . lazify++binaryPutSize :: Binary a => a -> Word64+binaryPutSize = fromIntegral . SBS.length . encode++-- Make a fake KeyRecord because Binary doesn't have a calcSize+-- operation (TODO: Use my own combinators for fixed-size records)+keyRecordSize :: Word64+keyRecordSize = binaryPutSize (0 :: KeyRecord)++valueHeaderSize :: Word64+valueHeaderSize = binaryPutSize $ ValueHeader 0 0 0++makeFileName :: String -> FilePath -> HashFunction -> Size -> FilePath+makeFileName prefix path func size =+  path </> concat [prefix, hfName func, "_", show size]++keysFileName :: FilePath -> HashFunction -> Size -> FilePath+keysFileName = makeFileName "keys"++valuesFileName :: FilePath -> HashFunction -> Size -> FilePath+valuesFileName = makeFileName "values"++data FileAlreadyExists = FileAlreadyExists String deriving (Show, Typeable)+instance Exc.Exception FileAlreadyExists+assertNotExists :: FilePath -> IO ()+assertNotExists fileName = do+  de <- Directory.doesDirectoryExist fileName+  fe <- Directory.doesFileExist fileName+  when (de || fe) $ Exc.throwIO (FileAlreadyExists fileName)++createDatabase :: FilePath -> HashFunction -> Size -> IO Database+createDatabase path func size = do+  Directory.createDirectory path+  keysHandle <- mkHandle keysFileName+  IO.hSetFileSize keysHandle . fromIntegral $ sizeLinear size * keyRecordSize+  valuesHandle <- mkHandle valuesFileName+  -- Offset 0 in the values file is used as invalid, so just write a useless 16-byte+  SBS.hPut valuesHandle $ SBS.replicate 16 0+  return $ Database path size func keysHandle valuesHandle+  where+    mkHandle f = do+      let fileName = f path func size+      assertNotExists fileName+      IO.openFile fileName IO.ReadWriteMode++openDatabase :: FilePath -> HashFunction -> Size -> IO Database+openDatabase path func size =+  Database path size func <$> mkHandle keysFileName <*> mkHandle valuesFileName+  where+    mkHandle f = IO.openFile (f path func size) IO.ReadWriteMode++hashKey :: Database -> Key -> KeyPtr+hashKey db key = hfHash (dbHashFunc db) key (dbSize db)++invalidValuePtr :: ValuePtr+invalidValuePtr = 0++keyFileOffset :: KeyPtr -> Word64+keyFileOffset = (* keyRecordSize)++keyFileRange :: KeyPtr -> FileRange+keyFileRange i = FileRange (keyFileOffset i) keyRecordSize++readFileRange :: IO.Handle -> FileRange -> IO SBS.ByteString+readFileRange handle (FileRange offset size) = do+  IO.hSeek handle IO.AbsoluteSeek $ fromIntegral offset+  SBS.hGet handle $ fromIntegral size++decodeFileRange :: Binary a => IO.Handle -> FileRange -> IO a+decodeFileRange handle rng = decode <$> readFileRange handle rng++writeFileRange :: IO.Handle -> Word64 -> SBS.ByteString -> IO ()+writeFileRange handle offset bs = do+  IO.hSeek handle IO.AbsoluteSeek $ fromIntegral offset+  SBS.hPut handle bs++strictify :: LBS.ByteString -> SBS.ByteString+strictify = SBS.concat . LBS.toChunks++lazify :: SBS.ByteString -> LBS.ByteString+lazify = LBS.fromChunks . (: [])++data ValuePtrRef = ValuePtrRef+  { vprVal :: ValuePtr+  , vprSet :: ValuePtr -> IO ()+  }++hashValuePtrRef :: Database -> Key -> IO ValuePtrRef+hashValuePtrRef db key = do+  valuePtr <-+    decodeFileRange (dbKeysHandle db) $ keyFileRange keyPtr+  return ValuePtrRef+    { vprVal = valuePtr+    , vprSet = writeFileRange (dbKeysHandle db) (keyFileOffset keyPtr) . encode+    }+    where+      keyPtr = hashKey db key++valueKeyRange :: ValuePtr -> ValueHeader -> FileRange+valueKeyRange valuePtr header =+  FileRange (valuePtr + valueHeaderSize) . fromIntegral $ vhKeySize header++valueDataRange :: ValuePtr -> ValueHeader -> FileRange+valueDataRange valuePtr header =+  FileRange (valuePtr + valueHeaderSize + fromIntegral (vhKeySize header)) . fromIntegral $+  vhValueSize header++findKey :: Database -> Key -> IO (Maybe (ValuePtrRef, ValueHeader))+findKey db key =+  find =<< hashValuePtrRef db key+  where+    find valuePtrRef+      | vprVal valuePtrRef == invalidValuePtr = return Nothing+      | otherwise = do+        valueHeader <-+          decodeFileRange (dbValuesHandle db)+          (FileRange (vprVal valuePtrRef) valueHeaderSize)+        vKey <-+          readFileRange (dbValuesHandle db) $+          valueKeyRange (vprVal valuePtrRef) valueHeader+        if key == vKey+          then return $ Just (valuePtrRef, valueHeader)+          else find $ nextCollisionRef (vprVal valuePtrRef) valueHeader+    nextCollisionRef valuePtr valueHeader = ValuePtrRef+        { vprVal = vhNextCollision valueHeader+        , vprSet =+          writeFileRange (dbValuesHandle db)+          valuePtr . encode . flip (atVhNextCollision . const) valueHeader+        }++readKey :: Database -> Key -> IO (Maybe Value)+readKey db key = do+  mValueRange <- findKey db key+  case mValueRange of+    Nothing -> return Nothing+    Just (valuePtrRef, valueHeader) ->+      Just <$>+      readFileRange (dbValuesHandle db)+      (valueDataRange (vprVal valuePtrRef) valueHeader)++appendNewValue :: Database -> ValuePtr -> Key -> Value -> IO ValuePtr+appendNewValue db nextCollision key val = do+  valuePtr <- fromIntegral <$> IO.hFileSize (dbValuesHandle db)+  let+    headerStr = encode ValueHeader+      { vhKeySize = fromIntegral $ SBS.length key+      , vhValueSize = fromIntegral $ SBS.length val+      , vhNextCollision = nextCollision+      }+  writeFileRange (dbValuesHandle db) valuePtr $ mconcat [headerStr, key, val]+  return valuePtr++writeKey :: Database -> Key -> Value -> IO ()+writeKey db key value = do+  mResult <- findKey db key+  case mResult of+    Just (valuePtrRef, valueHeader) ->+      -- The old value now becomes unreachable+      setValue valuePtrRef $ vhNextCollision valueHeader+    Nothing -> do+      hashAnchor <- hashValuePtrRef db key+      setValue hashAnchor $ vprVal hashAnchor+  where+    setValue ref nextCollision =+      vprSet ref =<< appendNewValue db nextCollision key value++deleteKey :: Database -> Key -> IO ()+deleteKey db key = do+  mResult <- findKey db key+  case mResult of+    Just (valuePtrRef, valueHeader) ->+      -- The old value now becomes unreachable+      vprSet valuePtrRef $ vhNextCollision valueHeader+    Nothing ->+      -- TODO: Throw exception?+      return ()