rocksdb-haskell-jprupp 2.1.7 → 2.2.0

raw patch · 7 files changed

+323/−101 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +20/−0
• rocksdb-haskell-jprupp.cabal +2/−4
• src/Database/RocksDB/Base.hs +11/−4
• src/Database/RocksDB/Internal.hs +15/−6
• src/Database/RocksDB/Iterator.hs +148/−87
• test/Spec.hs +120/−0

@@ -1,3 +1,10 @@+## 2.2.0++ * Move Iterator module to plain IO.+ * Properly manage read options in createSnapshot.+ * Add nix flake for development.+ * API allows manual database lifecycle management.+ ## 2.1.7   * Simplify author name.

@@ -1,2 +1,22 @@ This library provides Haskell bindings to [RocksDB](http://rocksdb.org)++## Development++### Stack++```bash+stack build+stack test+```++### Nix++```bash+nix develop+cabal build all+cabal test all+```++The shell includes GHC 9.8.4, cabal, haskell-language-server, fourmolu,+hlint, and hoogle.

@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.0.+-- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack------ hash: bd91a467d6bd847de202b5a719feec0870396e6f5dcdb305c82ef81b2dbe33be  name:           rocksdb-haskell-jprupp-version:        2.1.7+version:        2.2.0 synopsis:       Haskell bindings for RocksDB description:    See README at <https://github.com/jprupp/rocksdb-haskell#readme> category:       Database, FFI

@@ -18,6 +18,8 @@     , BatchOp (..)     , Range     , ColumnFamily+    , Snapshot+    , ReadOpts      -- * Options     , Config (..)@@ -180,16 +182,21 @@     fst . snd <$> allocate (createSnapshot db) releaseSnapshot  -- | Manually create an unmanaged snapshot.+-- The returned 'DB' has 'readOpts' configured for the snapshot.+-- Use 'releaseSnapshot' to release both the snapshot and its read options. createSnapshot :: MonadIO m => DB -> m (DB, Snapshot) createSnapshot db@DB{rocksDB = db_ptr} = liftIO $ do     snap_ptr <- c_rocksdb_create_snapshot db_ptr-    withReadOpts (Just snap_ptr) $ \read_opts ->-        return (db{readOpts = read_opts}, snap_ptr)+    read_opts <- createReadOpts (Just snap_ptr)+    return (db{readOpts = read_opts}, snap_ptr)  -- | Function to release an unmanaged snapshot.+-- Also releases the read options associated with the snapshot DB. releaseSnapshot :: MonadIO m => (DB, Snapshot) -> m ()-releaseSnapshot (DB{rocksDB = db_ptr}, snap_ptr) =-    liftIO $ c_rocksdb_release_snapshot db_ptr snap_ptr+releaseSnapshot (DB{rocksDB = db_ptr, readOpts = read_opts}, snap_ptr) =+    liftIO $ do+        destroyReadOpts read_opts+        c_rocksdb_release_snapshot db_ptr snap_ptr  -- | Get a DB property. getProperty :: MonadIO m => DB -> Property -> m (Maybe ByteString)

@@ -17,6 +17,8 @@     , withOptions     , withOptionsCF     , withReadOpts+    , createReadOpts+    , destroyReadOpts     , withWriteOpts      -- * Utilities@@ -95,13 +97,20 @@ withReadOpts :: MonadUnliftIO m => Maybe Snapshot -> (ReadOpts -> m a) -> m a withReadOpts maybe_snap_ptr =     bracket-    create_read_opts+    (createReadOpts maybe_snap_ptr)     (liftIO . c_rocksdb_readoptions_destroy)-  where-    create_read_opts = liftIO $ do-        read_opts_ptr <- c_rocksdb_readoptions_create-        forM_ maybe_snap_ptr $ c_rocksdb_readoptions_set_snapshot read_opts_ptr-        return read_opts_ptr++-- | Create read options without bracket management.+-- Caller is responsible for calling 'destroyReadOpts'.+createReadOpts :: MonadIO m => Maybe Snapshot -> m ReadOpts+createReadOpts maybe_snap_ptr = liftIO $ do+    read_opts_ptr <- c_rocksdb_readoptions_create+    forM_ maybe_snap_ptr $ c_rocksdb_readoptions_set_snapshot read_opts_ptr+    return read_opts_ptr++-- | Destroy read options created with 'createReadOpts'.+destroyReadOpts :: MonadIO m => ReadOpts -> m ()+destroyReadOpts = liftIO . c_rocksdb_readoptions_destroy  withWriteOpts :: MonadUnliftIO m => (WriteOpts -> m a) -> m a withWriteOpts =

@@ -1,4 +1,5 @@ {-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TupleSections #-}  -- | -- Module      : Database.RocksDB.Iterator@@ -12,13 +13,17 @@ -- Iterating over key ranges. module Database.RocksDB.Iterator   ( Iterator,+    -- * Bracket-style iteration     withIter,     withIterCF,-    iter,-    iterCF,-    iterator,+    withIterSnap,+    withIterSnapCF,+    -- * Manual iterator management     createIterator,+    createIteratorSnap,     destroyIterator,+    destroyReadOpts,+    -- * Iterator operations     iterEntry,     iterFirst,     iterGetError,@@ -32,6 +37,7 @@   ) where +import Control.Exception (bracket) import Data.ByteString (ByteString) import Data.ByteString qualified as B import Data.ByteString.Unsafe qualified as BU@@ -41,8 +47,6 @@ import Foreign.C.Error (throwErrnoIfNull) import Foreign.C.String (CString) import Foreign.C.Types (CSize)-import UnliftIO-import UnliftIO.Resource  -- | Create 'Iterator' and use it. --@@ -51,78 +55,135 @@ -- however, specify an older 'Snapshot' in the 'ReadOptions'. -- -- Iterator should not be used after computation ends.-withIter :: (MonadUnliftIO m) => DB -> (Iterator -> m a) -> m a-withIter db = withIterCommon db Nothing+withIter :: DB -> (Iterator -> IO a) -> IO a+withIter db = withIterCommon db Nothing Nothing -withIterCF :: (MonadUnliftIO m) => DB -> ColumnFamily -> (Iterator -> m a) -> m a-withIterCF db cf = withIterCommon db (Just cf)+withIterCF :: DB -> ColumnFamily -> (Iterator -> IO a) -> IO a+withIterCF db cf = withIterCommon db Nothing (Just cf) --- | Variation on 'iterator' below.-iter :: (MonadIO m, MonadResource m) => DB -> m Iterator-iter db = iterator db Nothing+-- | Create 'Iterator' on a specific snapshot.+--+-- If 'Nothing' is passed, the iterator creates its own implicit snapshot.+-- If 'Just snapshot' is passed, the iterator uses the provided snapshot,+-- enabling consistent reads across multiple iterators and point queries.+--+-- Iterator should not be used after computation ends.+withIterSnap+    :: DB+    -> Maybe Snapshot+    -> (Iterator -> IO a)+    -> IO a+withIterSnap db msnap = withIterCommon db msnap Nothing -iterCF :: (MonadIO m, MonadResource m) => DB -> ColumnFamily -> m Iterator-iterCF db cf = iterator db (Just cf)+-- | Create 'Iterator' on a column family with a specific snapshot.+--+-- If 'Nothing' is passed for snapshot, the iterator creates its own implicit snapshot.+-- If 'Just snapshot' is passed, the iterator uses the provided snapshot.+withIterSnapCF+    :: DB+    -> Maybe Snapshot+    -> ColumnFamily+    -> (Iterator -> IO a)+    -> IO a+withIterSnapCF db msnap cf = withIterCommon db msnap (Just cf) -withIterCommon ::-  (MonadUnliftIO m) =>-  DB ->-  Maybe ColumnFamily ->-  (Iterator -> m a) ->-  m a-withIterCommon DB {rocksDB = rocks_db, readOpts = read_opts} mcf =-  bracket create_iterator destroy_iterator+withIterCommon+    :: DB+    -> Maybe Snapshot+    -> Maybe ColumnFamily+    -> (Iterator -> IO a)+    -> IO a+withIterCommon DB{rocksDB = rocks_db, readOpts = read_opts} msnap mcf f =+    case msnap of+        Nothing ->+            -- Use DB's readOpts (iterator creates implicit snapshot)+            bracket (create_iterator read_opts) destroy_iterator f+        Just snap ->+            -- Create temporary ReadOpts with the provided snapshot+            bracket create_read_opts destroy_read_opts $ \ro ->+                bracket (create_iterator ro) destroy_iterator f+          where+            create_read_opts = do+                ro <- c_rocksdb_readoptions_create+                c_rocksdb_readoptions_set_snapshot ro snap+                return ro+            destroy_read_opts = c_rocksdb_readoptions_destroy   where-    destroy_iterator = liftIO . c_rocksdb_iter_destroy-    create_iterator = liftIO $-      throwErrnoIfNull "create_iterator" $ case mcf of+    destroy_iterator = c_rocksdb_iter_destroy+    create_iterator ro =+        throwErrnoIfNull "create_iterator" $ case mcf of+            Just cf -> c_rocksdb_create_iterator_cf rocks_db ro cf+            Nothing -> c_rocksdb_create_iterator rocks_db ro++-- | Manually create unmanaged iterator.+createIterator :: DB -> Maybe ColumnFamily -> IO Iterator+createIterator DB{rocksDB = rocks_db, readOpts = read_opts} mcf =+    throwErrnoIfNull "create_iterator" $ case mcf of         Just cf -> c_rocksdb_create_iterator_cf rocks_db read_opts cf         Nothing -> c_rocksdb_create_iterator rocks_db read_opts --- | Iterator is not valid outside of 'ResourceT' context.-iterator ::-  (MonadIO m, MonadResource m) =>-  DB ->-  Maybe ColumnFamily ->-  m Iterator-iterator db mcf =-  snd <$> allocate (createIterator db mcf) destroyIterator+-- | Manually create unmanaged iterator on a specific snapshot.+--+-- If 'Nothing' is passed, behaves like 'createIterator'.+-- If 'Just snapshot' is passed, creates a 'ReadOpts' tied to that snapshot.+--+-- Returns both the 'Iterator' and the 'ReadOpts' that was created.+-- Both must be destroyed: use 'destroyIterator' for the iterator,+-- and 'destroyReadOpts' for the read options.+--+-- For automatic resource management, prefer 'withIterSnap'.+createIteratorSnap+    :: DB+    -> Maybe Snapshot+    -> Maybe ColumnFamily+    -> IO (Iterator, Maybe ReadOpts)+createIteratorSnap db msnap mcf = case msnap of+    Nothing -> (, Nothing) <$> createIterator db mcf+    Just snap -> do+        ro <- c_rocksdb_readoptions_create+        c_rocksdb_readoptions_set_snapshot ro snap+        it <- createIteratorWithOpts db ro mcf+        return (it, Just ro) --- | Manually create unmanaged iterator.-createIterator :: (MonadIO m) => DB -> Maybe ColumnFamily -> m Iterator-createIterator DB {rocksDB = rocks_db, readOpts = read_opts} mcf = liftIO $-  throwErrnoIfNull "create_iterator" $ case mcf of-    Just cf -> c_rocksdb_create_iterator_cf rocks_db read_opts cf-    Nothing -> c_rocksdb_create_iterator rocks_db read_opts+-- | Internal: create iterator with explicit ReadOpts.+createIteratorWithOpts+    :: DB+    -> ReadOpts+    -> Maybe ColumnFamily+    -> IO Iterator+createIteratorWithOpts DB{rocksDB = rocks_db} ro mcf =+    throwErrnoIfNull "create_iterator" $ case mcf of+        Just cf -> c_rocksdb_create_iterator_cf rocks_db ro cf+        Nothing -> c_rocksdb_create_iterator rocks_db ro  -- | Destroy unmanaged iterator.-destroyIterator :: (MonadIO m) => Iterator -> m ()-destroyIterator = liftIO . c_rocksdb_iter_destroy+destroyIterator :: Iterator -> IO ()+destroyIterator = c_rocksdb_iter_destroy  -- | An iterator is either positioned at a key/value pair, or not valid. This -- function returns /true/ iff the iterator is valid.-iterValid :: (MonadIO m) => Iterator -> m Bool-iterValid iter_ptr = liftIO $ do-  x <- c_rocksdb_iter_valid iter_ptr-  return (x /= 0)+iterValid :: Iterator -> IO Bool+iterValid iter_ptr = do+    x <- c_rocksdb_iter_valid iter_ptr+    return (x /= 0)  -- | Position at the first key in the source that is at or past target. The -- iterator is /valid/ after this call iff the source contains an entry that -- comes at or past target.-iterSeek :: (MonadIO m) => Iterator -> ByteString -> m ()-iterSeek iter_ptr key = liftIO $-  BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->-    c_rocksdb_iter_seek iter_ptr key_ptr (intToCSize klen)+iterSeek :: Iterator -> ByteString -> IO ()+iterSeek iter_ptr key =+    BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+        c_rocksdb_iter_seek iter_ptr key_ptr (intToCSize klen)  -- | Position at the first key in the source. The iterator is /valid/ after this -- call iff the source is not empty.-iterFirst :: (MonadIO m) => Iterator -> m ()-iterFirst = liftIO . c_rocksdb_iter_seek_to_first+iterFirst :: Iterator -> IO ()+iterFirst = c_rocksdb_iter_seek_to_first  -- | Position at the last key in the source. The iterator is /valid/ after this -- call iff the source is not empty.-iterLast :: (MonadIO m) => Iterator -> m ()-iterLast = liftIO . c_rocksdb_iter_seek_to_last+iterLast :: Iterator -> IO ()+iterLast = c_rocksdb_iter_seek_to_last  -- | Moves to the next entry in the source. After this call, 'iterValid' is -- /true/ iff the iterator was not positioned at the last entry in the source.@@ -130,8 +191,8 @@ -- If the iterator is not valid, this function does nothing. Note that this is a -- shortcoming of the C API: an 'iterPrev' might still be possible, but we can't -- determine if we're at the last or first entry.-iterNext :: (MonadIO m) => Iterator -> m ()-iterNext iter_ptr = liftIO $ c_rocksdb_iter_next iter_ptr+iterNext :: Iterator -> IO ()+iterNext = c_rocksdb_iter_next  -- | Moves to the previous entry in the source. After this call, 'iterValid' is -- /true/ iff the iterator was not positioned at the first entry in the source.@@ -139,55 +200,55 @@ -- If the iterator is not valid, this function does nothing. Note that this is a -- shortcoming of the C API: an 'iterNext' might still be possible, but we can't -- determine if we're at the last or first entry.-iterPrev :: (MonadIO m) => Iterator -> m ()-iterPrev iter_ptr = liftIO $ c_rocksdb_iter_prev iter_ptr+iterPrev :: Iterator -> IO ()+iterPrev = c_rocksdb_iter_prev  -- | Return the key for the current entry if the iterator is currently -- positioned at an entry, ie. 'iterValid'.-iterKey :: (MonadIO m) => Iterator -> m (Maybe ByteString)-iterKey it = liftIO $ iterString it c_rocksdb_iter_key+iterKey :: Iterator -> IO (Maybe ByteString)+iterKey it = iterString it c_rocksdb_iter_key  -- | Return the value for the current entry if the iterator is currently -- positioned at an entry, ie. 'iterValid'.-iterValue :: (MonadIO m) => Iterator -> m (Maybe ByteString)-iterValue it = liftIO $ iterString it c_rocksdb_iter_value+iterValue :: Iterator -> IO (Maybe ByteString)+iterValue it = iterString it c_rocksdb_iter_value  -- | Return the current entry as a pair, if the iterator is currently positioned -- at an entry, ie. 'iterValid'.-iterEntry :: (MonadIO m) => Iterator -> m (Maybe (ByteString, ByteString))-iterEntry it = liftIO $ do-  mkey <- iterKey it-  mval <- iterValue it-  return $ (,) <$> mkey <*> mval+iterEntry :: Iterator -> IO (Maybe (ByteString, ByteString))+iterEntry it = do+    mkey <- iterKey it+    mval <- iterValue it+    return $ (,) <$> mkey <*> mval  -- | Check for errors -- -- Note that this captures somewhat severe errors such as a corrupted database.-iterGetError :: (MonadIO m) => Iterator -> m (Maybe ByteString)-iterGetError iter_ptr = liftIO $ alloca $ \err_ptr -> do-  poke err_ptr nullPtr-  c_rocksdb_iter_get_error iter_ptr err_ptr-  err_str <- peek err_ptr-  if err_str == nullPtr-    then return Nothing-    else Just <$> BU.unsafePackMallocCString err_str+iterGetError :: Iterator -> IO (Maybe ByteString)+iterGetError iter_ptr = alloca $ \err_ptr -> do+    poke err_ptr nullPtr+    c_rocksdb_iter_get_error iter_ptr err_ptr+    err_str <- peek err_ptr+    if err_str == nullPtr+        then return Nothing+        else Just <$> BU.unsafePackMallocCString err_str  -- -- Internal --  iterString ::-  Iterator ->-  (Iterator -> Ptr CSize -> IO CString) ->-  IO (Maybe ByteString)+    Iterator ->+    (Iterator -> Ptr CSize -> IO CString) ->+    IO (Maybe ByteString) iterString it f = do-  valid <- iterValid it-  if valid-    then alloca $ \len_ptr -> do-      str_ptr <- f it len_ptr-      if str_ptr == nullPtr-        then return Nothing-        else do-          len <- peek len_ptr-          Just <$> B.packCStringLen (str_ptr, cSizeToInt len)-    else return Nothing+    valid <- iterValid it+    if valid+        then alloca $ \len_ptr -> do+            str_ptr <- f it len_ptr+            if str_ptr == nullPtr+                then return Nothing+                else do+                    len <- peek len_ptr+                    Just <$> B.packCStringLen (str_ptr, cSizeToInt len)+        else return Nothing

@@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} +import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Monad import Data.ByteString.Char8 qualified as C import Data.Default (def)@@ -106,3 +107,122 @@           iterNext itr -- But it remembers previous position           iterKey itr `shouldReturn` Just "b"           iterValue itr `shouldReturn` Just "bbb"+    describe "Snapshots" $ do+      it "getCF and iterator see same data during concurrent writes" $ \db -> do+        let cf = head $ columnFamilies db+        -- Initial data+        putCF db cf "key1" "val1"+        putCF db cf "key2" "val2"+        putCF db cf "key3" "val3"++        -- Create snapshot+        (snapDB, snap) <- createSnapshot db++        -- Start writer thread modifying the same keys+        started <- newEmptyMVar+        writerThread <- forkIO $ do+          putMVar started ()+          let loop n+                | n > 100 = pure ()+                | otherwise = do+                    let suffix = C.pack $ "-v" <> show n+                    putCF db cf "key1" ("val1" <> suffix)+                    putCF db cf "key2" ("val2" <> suffix)+                    putCF db cf "key3" ("val3" <> suffix)+                    threadDelay 500+                    loop (n + 1 :: Int)+          loop (0 :: Int)++        takeMVar started+        threadDelay 1000 -- Let writer get going++        -- Read via getCF on snapshot+        v1 <- getCF snapDB cf "key1"+        threadDelay 10000+        v2 <- getCF snapDB cf "key2"+        threadDelay 10000+        v3 <- getCF snapDB cf "key3"++        -- Read via iterator on same snapshot (using the same column family)+        iterEntries <- withIterCF snapDB cf $ \itr -> do+          iterFirst itr+          let collect acc = do+                valid <- iterValid itr+                if valid+                  then do+                    mentry <- iterEntry itr+                    iterNext itr+                    collect (mentry : acc)+                  else pure (reverse acc)+          catMaybes <$> collect []++        -- Clean up+        killThread writerThread+        releaseSnapshot (snapDB, snap)++        -- Verify: getCF and iterator see the same original values+        v1 `shouldBe` Just "val1"+        v2 `shouldBe` Just "val2"+        v3 `shouldBe` Just "val3"+        iterEntries `shouldBe` [("key1", "val1"), ("key2", "val2"), ("key3", "val3")]++      it "withIterSnap sees snapshot data" $ \db -> do+        put db "a" "1"+        put db "b" "2"+        (_, snap) <- createSnapshot db+        -- Modify after snapshot+        put db "a" "modified"+        put db "c" "3"+        -- Iterator with explicit snapshot should see original data+        entries <- withIterSnap db (Just snap) $ \itr -> do+          iterFirst itr+          let collect acc = do+                valid <- iterValid itr+                if valid+                  then do+                    mentry <- iterEntry itr+                    iterNext itr+                    collect (mentry : acc)+                  else pure (reverse acc)+          catMaybes <$> collect []+        entries `shouldBe` [("a", "1"), ("b", "2")]++      it "withIterSnapCF sees snapshot data on column family" $ \db -> do+        let cf = head $ columnFamilies db+        putCF db cf "x" "100"+        putCF db cf "y" "200"+        (_, snap) <- createSnapshot db+        -- Modify after snapshot+        putCF db cf "x" "modified"+        putCF db cf "z" "300"+        -- Iterator with explicit snapshot on CF+        entries <- withIterSnapCF db (Just snap) cf $ \itr -> do+          iterFirst itr+          let collect acc = do+                valid <- iterValid itr+                if valid+                  then do+                    mentry <- iterEntry itr+                    iterNext itr+                    collect (mentry : acc)+                  else pure (reverse acc)+          catMaybes <$> collect []+        entries `shouldBe` [("x", "100"), ("y", "200")]++      it "createIteratorSnap with manual management" $ \db -> do+        put db "m" "10"+        put db "n" "20"+        (_, snap) <- createSnapshot db+        put db "m" "changed"+        -- Manual iterator creation with snapshot+        (itr, mReadOpts) <- createIteratorSnap db (Just snap) Nothing+        iterFirst itr+        k1 <- iterKey itr+        v1 <- iterValue itr+        iterNext itr+        k2 <- iterKey itr+        v2 <- iterValue itr+        destroyIterator itr+        forM_ mReadOpts destroyReadOpts+        (k1, v1) `shouldBe` (Just "m", Just "10")+        (k2, v2) `shouldBe` (Just "n", Just "20")