diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,25 @@ +Copyright (c) 2013 Boris Sukholitko +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. The names of the authors may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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/Database/PureCDB.hs b/Database/PureCDB.hs new file mode 100644 --- /dev/null +++ b/Database/PureCDB.hs @@ -0,0 +1,154 @@ +-- | +-- Module : Database.CDB +-- Copyright : (c) Boris Sukholitko 2013 +-- +-- License : BSD3 +-- +-- A library for reading and writing CDB (Constant Database) files. +-- +-- CDB files are immutable key-value stores, designed for extremely fast and +-- memory-efficient construction and lookup. They can be as large as 4GB, and +-- at no point in their construction or use must all data be loaded into +-- memory. CDB files can contain multiple values for a given key. +-- +-- For more information on the CDB file format, please see: +-- +-- +-- Here's how you make new CDB file: +-- +-- > import qualified Data.ByteString.Char8 as B +-- > import Database.PureCDB +-- > +-- > makeIt :: IO () +-- > makeIt = makeCDB (do +-- > addBS (B.pack "foo") (B.pack "bar") +-- > addBS (B.pack "foo") (B.pack "baz")) "foo.cdb" +-- +-- You can later use it as in: +-- +-- > getIt :: IO [ByteString] +-- > getIt = do +-- > f <- openCDB "foo.cdb" +-- > getBS f (B.pack "foo") +-- > closeCDB "foo.cdb" +-- > +-- +-- @getIt@ returns [ \"bar\", \"baz\" ] in unspecified order. +-- +-- Note that @pure-cdb@ works on strict 'ByteString''s only for now. + +{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-} +module Database.PureCDB ( + -- * Writing interface + WriteCDB, makeCDB, addBS + + -- * Reading interface + , ReadCDB, openCDB, closeCDB, getBS) where + +import Data.Word +import System.IO +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as B +import Data.Binary.Get +import Data.Binary.Put +import qualified Data.Vector as V +import qualified Data.Vector.Generic.Mutable as MV +import Control.Applicative +import Control.Monad.State +import System.Directory +import Control.Monad.ST +import Database.PureCDB.Internal + +data HashState = HashState { hsCount :: !Word32, hsPairs :: ![(Word32, Word32)] } +data WriteState = WriteState { wsHandle :: Handle, wsTOC :: !(V.Vector HashState) } + +-- | Write context monad transformer. +newtype WriteCDB m a = WriteCDB (StateT WriteState m a) + deriving (Functor, Monad, Applicative, MonadTrans, MonadIO) + +readWordPairs :: Handle -> Int -> IO [(Word32, Word32)] +readWordPairs ioh sz = do + bs <- BL.hGet ioh sz + return $ runGet (mapM (const go) [ 1 .. sz `div` 8 ]) bs + where go = (,) <$> getWord32le <*> getWord32le + +-- | Opens CDB database. +openCDB :: FilePath -> IO ReadCDB +openCDB fp = do + ioh <- openBinaryFile fp ReadMode + hSetBuffering ioh NoBuffering + wps <- readWordPairs ioh 2048 + let v = V.fromList $ map (uncurry TOCHash) wps + return $ ReadCDB ioh v + +-- | Closes the database. +closeCDB :: ReadCDB -> IO () +closeCDB (ReadCDB ioh _) = hClose ioh + +getRecord :: Handle -> Word32 -> IO (B.ByteString, B.ByteString) +getRecord ioh sk = do + hSeek ioh AbsoluteSeek (fromIntegral sk) + [(ksz, vsz)] <- readWordPairs ioh 8 + k <- B.hGet ioh $ fromIntegral ksz + v <- B.hGet ioh $ fromIntegral vsz + return (k, v) + +-- | Fetches key from the database. +getBS :: ReadCDB -> B.ByteString -> IO [B.ByteString] +getBS r@(ReadCDB ioh _) bs = do + hSeek ioh AbsoluteSeek (fromIntegral $ hpos + slot * 8) + wps <- readWordPairs ioh (fromIntegral $ (hlen - slot) * 8) + let pairs = filter ((== h) . fst) $ takeWhile ((/= 0) . snd) wps + kvs <- mapM (getRecord ioh . snd) pairs + return $ map snd $ filter ((bs ==) . fst) kvs + where (TOCHash hpos hlen, h) = tocFind r bs + slot = hashSlot h hlen + +updateTOC :: V.Vector HashState -> B.ByteString -> Word32 -> V.Vector HashState +updateTOC vec key cur = runST $ do + v <- V.unsafeThaw vec + hs <- MV.read v i + MV.write v i (HashState (cnt hs) (pairs hs)) + V.unsafeFreeze v + where hsh = cdbHash key + cnt hs = hsCount hs + 1 + i = tocIndex hsh + pairs hs = (hsh, cur):hsPairs hs + +-- | Adds key and value to the CDB database. +addBS :: MonadIO m => B.ByteString -> B.ByteString -> WriteCDB m () +addBS key val = WriteCDB $ do + st <- get + cur <- liftIO $ hTell (wsHandle st) + liftIO $ BL.hPut (wsHandle st) buf + put $ st { wsTOC = updateTOC (wsTOC st) key (fromIntegral cur) } + where buf = runPut $ do + putWord32le $ fromIntegral $ B.length key + putWord32le $ fromIntegral $ B.length val + putByteString key + putByteString val + +writePairs :: Handle -> [(Word32, Word32)] -> IO () +writePairs ioh pairs = BL.hPut ioh buf where + buf = runPut $ mapM_ one pairs + one (a, b) = putWord32le a >> putWord32le b + +writeOneHash :: Handle -> HashState -> IO (Word32, Word32) +writeOneHash ioh (HashState cnt pairs) = do + cur <- hTell ioh + writePairs ioh $ V.toList vec + return (fromIntegral cur, fromIntegral $ V.length vec) + where vec = createHashVector (1 + cnt * 2) (0, 0) pairs + +-- | Runs WriteCDB monad transformer to make the database. +makeCDB :: MonadIO m => WriteCDB m a -> FilePath -> m a +makeCDB (WriteCDB m) fp = do + ioh <- liftIO $ openBinaryFile (fp ++ ".tmp") WriteMode + liftIO $ hSeek ioh AbsoluteSeek 2048 + (res, st) <- runStateT m $ WriteState ioh $ V.replicate 256 (HashState 0 []) + tocs <- liftIO $ mapM (writeOneHash ioh) $ V.toList $ wsTOC st + liftIO $ hSeek ioh AbsoluteSeek 0 + liftIO $ writePairs ioh tocs + liftIO $ hClose ioh + liftIO $ renameFile (fp ++ ".tmp") fp + return res diff --git a/Database/PureCDB/Internal.hs b/Database/PureCDB/Internal.hs new file mode 100644 --- /dev/null +++ b/Database/PureCDB/Internal.hs @@ -0,0 +1,46 @@ +module Database.PureCDB.Internal where + +import System.IO +import qualified Data.Vector as V +import Data.Word +import qualified Data.ByteString as B +import Data.Bits +import qualified Data.IntMap as I +import Data.List (foldl') + +data TOCHash = TOCHash { hPosition :: Word32, hLength :: Word32 } deriving (Show) + +-- | Read handle for the database. +data ReadCDB = ReadCDB { rHandle :: Handle, rTOC :: V.Vector TOCHash } + +cdbHash :: B.ByteString -> Word32 +cdbHash = B.foldl' go 5381 where go h c = ((h `shiftL` 5) + h) `xor` (fromIntegral c) + +tocIndex :: Integral a => a -> Int +tocIndex h = fromIntegral $ h `mod` 256 + +tocFind :: ReadCDB -> B.ByteString -> (TOCHash, Word32) +tocFind (ReadCDB _ vec) bs = (vec V.! tocIndex h, h) where h = cdbHash bs + +layoutHash :: Int -> I.IntMap [a] -> Maybe [(Int, a)] +layoutHash sz = test . concat . foldl' go [] . I.toList where + go l@(((li, _):_):_) p = (one li p):l + go [] p = [one (-1) p] + go ([]:_) _ = error "layoutHash: found empty list" + one lastIdx (idx, as) = reverse $ zip [ (max idx $ lastIdx + 1) .. ] as + test [] = Just [] + test l@(x:_) = if fst x >= sz then Nothing else Just l + +coalesceHash :: Integral a => a -> [(a, b)] -> I.IntMap [(a, b)] +coalesceHash hlen = foldl' go I.empty where + go im (a, b) = I.insertWith (++) (fromIntegral $ hashSlot a hlen) [(a, b)] im + +createHashVector :: Integral a => a -> (a, b) -> [(a, b)] -> V.Vector (a, b) +createHashVector sz start l = maybe (createHashVector next start l) vec hsh + where vec ups = V.replicate (fromIntegral sz) start V.// ups + hsh = layoutHash (fromIntegral sz) $ coalesceHash sz l + next = 1 + sz + (sz `div` 3) + +hashSlot :: Integral a => a -> a -> a +hashSlot h hlen = (h `div` 256) `mod` hlen + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,7 @@ +pure-cdb is another (first being hs-cdb) Haskell library to read and write CDB files. + +For more information on the CDB file format, please consult: +http://cr.yp.to/cdb.html + +For more documentation please see: +http://hackage.haskell.org/package/pure-cdb diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/pure-cdb.cabal b/pure-cdb.cabal new file mode 100644 --- /dev/null +++ b/pure-cdb.cabal @@ -0,0 +1,54 @@ +Name: pure-cdb +Version: 0.1 +License: BSD3 +License-File: COPYING +Category: Database +Synopsis: Another pure-haskell CDB (Constant Database) implementation +Description: + A library for reading and writing CDB (Constant Database) files. + . + CDB files are immutable key-value stores, designed for extremely fast and memory-efficient + construction and lookup. They can be as large as 4GB, and at no point in their construction + or use must all data be loaded into memory. CDB files can contain multiple values for a + given key. + . + For more information on the CDB file format, please see: + . + Please note, that there is another pure Haskell CDB library on Hackage: + , using memory mapped bytestrings for IO. + It served as an inspiration for this package. + +Cabal-Version: >= 1.10 +Build-Type: Simple +Author: Boris Sukholitko +Copyright: Boris Sukholitko +Maintainer: Boris Sukholitko +homepage: https://github.com/bosu/pure-cdb +Stability: Experimental + +Extra-Source-Files: + t/foo.cdb + README + +Library + GHC-Options: -Wall + Build-Depends: base (< 5), vector, binary, bytestring, containers, mtl, directory + Default-Language: Haskell2010 + exposed-modules: Database.PureCDB, Database.PureCDB.Internal + +test-suite Test + type: exitcode-stdio-1.0 + build-depends: base, test-simple, pure-cdb, vector, mtl, bytestring, containers, Unixutils + ghc-options: -Wall + hs-source-dirs: t + main-is: Test.hs + Default-Language: Haskell2010 + +test-suite Words + type: exitcode-stdio-1.0 + build-depends: base, pure-cdb, Unixutils, bytestring + ghc-options: -Wall + hs-source-dirs: t + main-is: Words.hs + Default-Language: Haskell2010 + diff --git a/t/Test.hs b/t/Test.hs new file mode 100644 --- /dev/null +++ b/t/Test.hs @@ -0,0 +1,47 @@ +{-# OPTIONS -fno-warn-unused-do-bind #-} +module Main(main) where + +import Test.Simple +import Database.PureCDB +import qualified Data.Vector as V +import Control.Monad.Trans (liftIO) +import qualified Data.ByteString.Char8 as B +import qualified Data.IntMap as I +import System.Unix.Directory (withTemporaryDirectory) +import Database.PureCDB.Internal + +main :: IO () +main = withTemporaryDirectory "/tmp/pure_cdb_XXXXXXX" $ \td -> testSimpleMain $ do + plan 13 + r <- liftIO $ openCDB "t/foo.cdb" + is (V.findIndex ((> 0) . hLength) $ rTOC r) (Just 163) + is ((cdbHash foo) `mod` 256) 163 + is (hPosition $ fst $ tocFind r foo) (hPosition $ rTOC r V.! 163) + + v <- liftIO $ getBS r foo + is (map B.unpack v) [ "bar" ] + + is (layoutHash 2 $ I.fromList [ (1, [ 'a', 'b' ]) ]) Nothing + is (layoutHash 2 $ I.fromList [ (0, [ 'a', 'b' ]) ]) + $ Just $ reverse [ (0, 'a'), (1, 'b') ] + is (layoutHash 4 $ I.fromList [ (1, [ 'a', 'b' ]), (2, ['c']) ]) + $ Just $ reverse [ (1, 'a'), (2, 'b'), (3, 'c') ] + is (layoutHash 4 $ I.fromList [ (1, [ 'a', 'b' ]), (2, ['c', 'd']) ]) Nothing + + is (coalesceHash (4 :: Int) [(259, 'a'), (263, 'b')]) + $ I.fromList [ (1, [ (263, 'b'), (259, 'a') ]) ] + is (createHashVector 4 (0 :: Int, 'O') [(259, 'a'), (263, 'b')]) + $ V.fromList [(0,'O'),(263,'b'),(259,'a'),(0,'O')] + is (createHashVector 2 (0 :: Int, 'O') [(259, 'a'), (263, 'b')]) + $ V.fromList [(0,'O'),(263,'b'),(259,'a')] + is (createHashVector 1 (0 :: Int, 'O') [(259, 'a'), (263, 'b')]) + $ V.fromList [(0,'O'),(263,'b'),(259,'a')] + + liftIO $ makeCDB (addBS foo (B.pack "baz")) (td ++ "/j.out") + r2 <- liftIO $ openCDB $ td ++ "/j.out" + + v2 <- liftIO $ getBS r2 foo + is (map B.unpack v2) [ "baz" ] + liftIO $ closeCDB r2 + liftIO $ closeCDB r + where foo = B.pack "foo" diff --git a/t/Words.hs b/t/Words.hs new file mode 100644 --- /dev/null +++ b/t/Words.hs @@ -0,0 +1,10 @@ +module Main (main) where + +import Database.PureCDB +import qualified Data.ByteString.Char8 as B +import System.Unix.Directory (withTemporaryDirectory) + +main :: IO () +main = withTemporaryDirectory "/tmp/pure_cdb_XXXXXXX" $ \td -> do + ls <- B.lines `fmap` B.readFile "/usr/share/dict/words" + makeCDB (mapM_ (\s -> addBS s s) ls) (td ++ "/j.out") diff --git a/t/foo.cdb b/t/foo.cdb new file mode 100644 Binary files /dev/null and b/t/foo.cdb differ