graninas/Hydra
1
1
Fork 0
mirror of https://github.com/graninas/Hydra.git synced 2024-11-28 13:02:50 +03:00
Code Issues Projects Releases Wiki Activity

- Fixes and changes in KV DB integration.

Browse Source
This commit is contained in:
Alexander Granin 2019-10-01 00:25:58 +07:00
parent 7b970968bd
commit 7d6b1ac44e
10 changed files with 85 additions and 302 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
app/astro/Astro/Catalogue.hs
View File

@ -13,12 +13,13 @@ import Astro.Lens
import Astro.KVDB.Entities.Meteor
import Astro.KVDB.Entities.DBs
withCatalogueDB :: AppState -> L.KVDBL CatalogueDB a -> L.LangL a
withCatalogueDB st = L.withKVDB (st ^. catalogueDB)
loadMeteorsCount :: AppState -> L.LangL Int
loadMeteorsCount st = do
eCount <- withCatalogueDB st $ L.load' meteorsCountKey
eCount <- withCatalogueDB st $ L.load meteorsCountKey
case eCount of
Left err -> do
L.logError ("Failed to get meteors count: " <> show err)
@ -35,7 +36,7 @@ dynamicsMonitor st = do
initState :: AppConfig -> L.AppL AppState
initState cfg = do
eCatalogueDB <- L.initKVDB
$ D.RocksConfig @CatalogueDB "/tmp/hydra/catalogue" True False
$ D.RocksDBConfig @CatalogueDB "/tmp/hydra/catalogue" True False
catalogueDB <- case eCatalogueDB of
Right db -> pure db

7
src/Hydra/Core/Domain/KVDB.hs
View File

@ -5,6 +5,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveAnyClass #-}
module Hydra.Core.Domain.KVDB where
@ -19,12 +20,12 @@ import Hydra.Core.Domain.DB
data KVDBConfig db
= RedisConfig
| RocksConfig
| RocksDBConfig
{ _path :: FilePath
, _createIfMissing :: Bool
, _errorIfExists :: Bool
}
deriving (Show, Generic)
deriving (Show, Read, Ord, Eq, Generic, ToJSON, FromJSON)
type KVDBKey = ByteString
type KVDBValue = ByteString
@ -61,5 +62,5 @@ fromDBValueJSON = A.decode . LBS.fromStrict
-- TODO: RedisConfig
getKVDBName :: forall db. DB db => KVDBConfig db -> FilePath
getKVDBName (RocksConfig path _ _) = path </> getDBName @db
getKVDBName (RocksDBConfig path _ _) = path </> getDBName @db
getKVDBName RedisConfig = getDBName @db

10
src/Hydra/Core/KVDB/Impl/RocksDB.hs
View File

@ -16,10 +16,12 @@ writeOpts = Rocks.defaultWriteOptions
get :: Rocks.DB -> D.KVDBKey -> IO (D.DBResult D.KVDBValue)
get db key = do
mbVal <- Rocks.get db Rocks.defaultReadOptions key
pure $ case mbVal of
Nothing -> Left $ D.DBError D.KeyNotFound $ show key
Just val -> Right val
-- TODO: exception safety
eMbVal <- try $ Rocks.get db Rocks.defaultReadOptions key
pure $ case eMbVal of
Left (err :: SomeException) -> Left $ D.DBError D.SystemError $ show err
Right Nothing -> Left $ D.DBError D.KeyNotFound $ show key
Right (Just val) -> Right val
put :: Rocks.DB -> D.KVDBKey -> D.KVDBValue -> IO (D.DBResult ())
put db key val = do

89
src/Hydra/Core/KVDB/Language.hs
View File

@ -15,19 +15,24 @@ data KVDBF next where
Save :: D.KVDBKey -> D.KVDBValue -> (D.DBResult () -> next) -> KVDBF next
Load :: D.KVDBKey -> (D.DBResult D.KVDBValue -> next) -> KVDBF next
makeFunctorInstance ''KVDBF
type KVDBL db = Free KVDBF
save'
save' :: D.KVDBKey -> D.KVDBValue -> KVDBL db (D.DBResult ())
save' dbkey dbval = liftF $ Save dbkey dbval id
load' :: D.KVDBKey -> KVDBL db (D.DBResult D.KVDBValue)
load' dbkey = liftF $ Load dbkey id
save
:: forall src entity db
. D.DBEntity db entity
=> D.AsKeyEntity entity src
=> D.AsValueEntity entity src
=> src
-> KVDBL db (D.DBResult ())
save' src = liftF $ Save dbkey dbval id
save src = save' dbkey dbval
where
k :: D.KeyEntity entity
k = D.toKeyEntity src
@ -36,15 +41,15 @@ save' src = liftF $ Save dbkey dbval id
dbkey = D.toDBKey k
dbval = D.toDBValue v
load'
load
:: forall entity dst db
. D.DBEntity db entity
=> D.AsValueEntity entity dst
=> Show (D.KeyEntity entity)
=> D.KeyEntity entity
-> KVDBL db (D.DBResult dst)
load' key = do
eRawVal <- liftF $ Load (D.toDBKey key) id
load key = do
eRawVal <- load' (D.toDBKey key)
pure $ case eRawVal of
Left err -> Left err
Right val -> maybe (decodingErr val) (Right . D.fromValueEntity) $ mbE val
@ -55,75 +60,3 @@ load' key = do
$ D.DBError D.DecodingFailed
$ "Failed to decode entity, k: "
<> show key <> ", v: " <> show val
-- putEntity'
-- :: forall entity db src
-- . D.RawDBEntity db entity
-- => D.ToDBKey entity src
-- => D.ToDBValue entity src
-- => src
-- -> KVDBL db (D.DBResult ())
-- putEntity' src = let
-- rawKey = D.toRawDBKey @db @entity $ D.toDBKey src
-- rawVal = D.toRawDBValue @db @entity $ D.toDBValue src
-- in putValue rawKey rawVal
--
-- -- | Gets a typed entity from the corresponding DB.
-- getEntity
-- :: forall entity db
-- . (FromJSON (D.DBValue entity), D.RawDBEntity db entity, Typeable (D.DBValue entity))
-- => D.DBKey entity
-- -> KVDBL db (D.DBResult (D.DBE entity))
-- getEntity dbKey = do
-- let rawKey = D.toRawDBKey @db dbKey
-- let proxyVal = error "Don't call me, I'm Proxy" :: D.DBValue entity
-- eRawVal <- getValue rawKey
-- case eRawVal of
-- Left err -> pure $ Left err
-- Right rawVal -> case D.fromRawDBValue @db rawVal of
-- Nothing -> pure $ Left $ D.DBError D.InvalidType ("Expected type: " <> show (typeOf proxyVal)
-- <> ". Raw key: <" <> decodeUtf8 rawKey <> ">. Raw data: <" <> decodeUtf8 rawVal <> ">")
-- Just dbVal -> pure $ Right (dbKey, dbVal)
--
-- -- | Gets a typed value from the corresponding DB.
-- getValue
-- :: (FromJSON (D.DBValue entity), D.RawDBEntity db entity, Typeable (D.DBValue entity))
-- => D.DBKey entity
-- -> KVDBL db (D.DBResult (D.DBValue entity))
-- getValue dbKey = do
-- eEntity <- getEntity dbKey
-- pure $ eEntity >>= Right . snd
--
-- -- | Gets a typed value from the corresponding DB.
-- getValue'
-- :: (FromJSON (D.DBValue entity), D.RawDBEntity db entity, Typeable (D.DBValue entity))
-- => D.ToDBKey entity src
-- => src
-- -> KVDBL db (D.DBResult (D.DBValue entity))
-- getValue' src = do
-- eEntity <- getEntity $ D.toDBKey src
-- pure $ eEntity >>= Right . snd
--
-- -- | Gets a typed value from the corresponding DB.
-- -- The difference from @getValue@ is that it forgets about DB errors.
-- findValue
-- :: (FromJSON (D.DBValue entity), D.RawDBEntity db entity, Typeable (D.DBValue entity))
-- => D.DBKey entity
-- -> KVDBL db (Maybe (D.DBValue entity))
-- findValue key = do
-- eVal <- getValue key
-- pure $ either (const Nothing) Just eVal
--
-- -- | Gets a typed value from the corresponding DB.
-- -- The difference from @getValue'@ is that it forgets about DB errors.
-- findValue'
-- :: (FromJSON (D.DBValue entity), D.RawDBEntity db entity, Typeable (D.DBValue entity))
-- => D.ToDBKey entity src
-- => src
-- -> KVDBL db (D.DBResult (Maybe (D.DBValue entity)))
-- findValue' src = do
-- eVal <- getValue' src
-- case eVal of
-- Left (D.DBError D.KeyNotFound _) -> pure $ Right Nothing
-- Left err -> pure $ Left err
-- Right val -> pure $ Right $ Just val

25
src/Hydra/Core/KVDB/Redis/Language.hs Normal file
View File

@ -0,0 +1,25 @@
-- "hedis" library has significant design flaws which prevent it
-- from being abstracted properly.
-- 1. `Queued` & `RedisTx` is a misconception. Cannot be abstracted.
-- 2. Context monads offer a particular design (mtl) and do not allow
-- or make it very hard to use another design.
-- 3. The design of transactions forces you to know that `Queued` is `Applicative`, `Monad`, etc.
-- which is an unnecessary accidental complexity from the library.
-- It may look nice and seem finely fitable to the hedis architecture
-- but it's neither testable nor abstractable.
-- This module does not abstract hedis / Redis but provides a raw access to the implementation.
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Hydra.Core.KVDB.Redis.Language where
import Hydra.Prelude
import qualified Hydra.Core.Domain.DB as D
import qualified Hydra.Core.Domain.KVDB as D
import qualified Database.Redis as Redis

2
src/Hydra/Core/KVDBRuntime.hs
View File

@ -29,7 +29,7 @@ initRocksDB'
-> D.KVDBConfig db
-> String
-> IO (D.DBResult (D.DBHandle db))
initRocksDB' rocksDBsVars cfg@(D.RocksConfig _ createIfMiss errorIfErr) dbname = do
initRocksDB' rocksDBsVars cfg@(D.RocksDBConfig _ createIfMiss errorIfErr) dbname = do
rocksDBs <- atomically $ takeTMVar rocksDBsVars
let dbPath = D.getKVDBName cfg
eDb <- try $ Rocks.open dbPath $ initRocksOptions createIfMiss errorIfErr

2
src/Hydra/Core/Lang/Language.hs
View File

@ -84,7 +84,7 @@ instance L.ControlFlow LangL where
evalKVDB :: forall db a. D.DB db => D.DBHandle db -> L.KVDBL db a -> LangL a
evalKVDB conn script = liftF $ EvalKVDB conn script id
evalKVDB handle script = liftF $ EvalKVDB handle script id
withKVDB :: forall db a. D.DB db => D.DBHandle db -> L.KVDBL db a -> LangL a
withKVDB = evalKVDB

2
src/Hydra/Framework/App/Interpreter.hs
View File

@ -21,7 +21,7 @@ langRunner :: R.CoreRuntime -> Impl.LangRunner L.LangL
langRunner coreRt = Impl.LangRunner (Impl.runLangL coreRt)
initKVDB' :: forall db. D.DB db => R.CoreRuntime -> D.KVDBConfig db -> String -> IO (D.DBResult (D.DBHandle db))
initKVDB' coreRt cfg@(D.RocksConfig _ _ _) dbName =
initKVDB' coreRt cfg@(D.RocksDBConfig _ _ _) dbName =
R.initRocksDB' (coreRt ^. RLens.rocksDBs) cfg dbName
initKVDB' coreRt cfg@(D.RedisConfig) dbName =
R.initRedisDB' (coreRt ^. RLens.redisConns) cfg dbName

2
src/Hydra/Framework/App/Language.hs
View File

@ -23,7 +23,7 @@ data AppF next where
-- A new connection will be created and stored.
-- No need to explicitly close the connections.
-- They will be closed automatically on the program finish.
InitKVDB :: D.DB db => D.KVDBConfig db -> String -> (D.DBResult (D.DBHandle db) -> next) -> AppF next
InitKVDB :: D.DB db => D.KVDBConfig db -> D.DBName -> (D.DBResult (D.DBHandle db) -> next) -> AppF next
-- TODO: add explicit deinit.
-- DeinitKVDB :: D.DB db => D.DBHandle db -> (D.DBResult Bool -> next) -> AppF next

243
test/spec/Hydra/Tests/Integration/KVDBSpec.hs
View File

@ -14,240 +14,61 @@ import Test.Hspec
import Hydra.TestData
-- data AppData = AppData
-- { _kBlocksDB :: D.Storage KBlocksDB
-- , _kBlocksMetaDB :: D.Storage KBlocksMetaDB
-- }
--
-- makeFieldsNoPrefix ''AppData
--
-- putKBlockMetaApp :: D.KBlock -> D.DBConfig KBlocksMetaDB -> L.AppDefinitionL (Either D.DBError ())
-- putKBlockMetaApp kBlock cfg = do
-- let k = D.toDBKey @KBlockMetaEntity kBlock
-- let v = D.toDBValue @KBlockMetaEntity kBlock
-- eDB <- L.scenario $ L.initDatabase cfg
-- case eDB of
-- Left err -> pure $ Left err
-- Right db -> L.scenario
-- $ L.withDatabase db
-- $ L.putEntity k v
--
-- getKBlockMetaApp :: D.DBKey KBlockMetaEntity -> D.DBConfig KBlocksMetaDB -> L.AppDefinitionL (Either D.DBError (D.DBValue KBlockMetaEntity))
-- getKBlockMetaApp k cfg = do
-- eDB <- L.scenario $ L.initDatabase cfg
-- case eDB of
-- Left err -> pure $ Left err
-- Right db -> L.scenario $ L.withDatabase db $ L.getValue k
--
-- putGetKBlockMetaApp :: FilePath -> L.AppDefinitionL (Either D.DBError Bool)
-- putGetKBlockMetaApp dbPath = do
-- let dbOpts = D.DBOptions
-- { D._createIfMissing = True
-- , D._errorIfExists = True
-- }
-- let cfg :: D.DBConfig KBlocksMetaDB = D.DBConfig dbPath dbOpts
-- eDB <- L.scenario $ L.initDatabase cfg
-- case eDB of
-- Left err -> pure $ Left err
-- Right db -> L.scenario $ L.withDatabase db $ do
-- eRes <- L.putEntity kBlock1MetaKey kBlock1MetaValue
-- case eRes of
-- Left err -> pure $ Left err
-- Right _ -> do
-- eVal <- L.getValue kBlock1MetaKey
-- pure $ eVal >>= (\val2 -> Right (kBlock1MetaValue == val2))
--
-- kBlock1 :: D.KBlock
-- kBlock1 = D.KBlock
-- { D._time = 0
-- , D._prevHash = D.genesisHash
-- , D._number = 1
-- , D._nonce = 0
-- , D._solver = D.genesisHash
-- }
--
-- kBlock2 :: D.KBlock
-- kBlock2 = D.KBlock
-- { D._time = 1
-- , D._prevHash = D.toHash kBlock1
-- , D._number = 2
-- , D._nonce = 2
-- , D._solver = D.genesisHash
-- }
--
-- kBlock3 :: D.KBlock
-- kBlock3 = D.KBlock
-- { D._time = 3
-- , D._prevHash = D.toHash kBlock2
-- , D._number = 3
-- , D._nonce = 3
-- , D._solver = D.genesisHash
-- }
--
-- kBlock1MetaKey :: D.DBKey KBlockMetaEntity
-- kBlock1MetaKey = D.toDBKey kBlock1
--
-- kBlock1MetaValue :: D.DBValue KBlockMetaEntity
-- kBlock1MetaValue = D.toDBValue kBlock1
--
-- kBlock2MetaKey :: D.DBKey KBlockMetaEntity
-- kBlock2MetaKey = D.toDBKey kBlock2
--
-- kBlock2MetaValue :: D.DBValue KBlockMetaEntity
-- kBlock2MetaValue = D.toDBValue kBlock2
--
-- kBlock3MetaKey :: D.DBKey KBlockMetaEntity
-- kBlock3MetaKey = D.toDBKey kBlock3
--
-- kBlock3MetaValue :: D.DBValue KBlockMetaEntity
-- kBlock3MetaValue = D.toDBValue kBlock3
dbInitApp :: forall db. D.DB db => D.KVDBConfig db -> L.AppL (D.DBResult ())
dbInitApp cfg = do
eDB <- L.initKVDB cfg
pure $ eDB >> Right ()
-- withCatalogueDB :: AppState -> L.KVDBL CatalogueDB a -> L.LangL a
-- withCatalogueDB st = L.withKVDB (st ^. catalogueDB)
spec :: Spec
spec = do
unstableTest $ fastTest $ describe "Redis KV DB tests" $ do
dbTestPath <- runIO $ mkTestPath "db_test"
let cfg1 = D.RedisConfig @CatalogueDB
let cfg2 = D.RedisConfig @CatalogueDB
let kvdbPath1 = D.getKVDBName cfg1
let kvdbPath2 = D.getKVDBName cfg2
describe "Database creation tests" $ do
it "DB is missing, create, errorIfExists False, no errors expected" $ withRedisDbAbsence kvdbPath1 $ do
eRes <- evalApp $ dbInitApp cfg1
eRes `shouldBe` Right ()
it "DB is missing, create, errorIfExists True, no errors expected" $ withRedisDbAbsence kvdbPath2 $ do
eRes <- evalApp $ dbInitApp cfg2
eRes `shouldBe` Right ()
it "DB is present, create, errorIfExists False, no errors expected" $ withRedisDbPresence kvdbPath1 $ do
eRes <- evalApp $ dbInitApp cfg1
eRes `shouldBe` Right ()
it "DB is present, create, errorIfExists False, errors expected" $ withRedisDbPresence kvdbPath2 $ do
eRes <- evalApp $ dbInitApp cfg2
eRes `shouldBe` Left (D.DBError D.SystemError ("user error (open: Invalid argument: "
+| kvdbPath2 |+ ": exists (error_if_exists is true))"))
-- unstableTest $ fastTest $ describe "Rocks KV DB tests" $ do
-- unstableTest $ fastTest $ describe "Redis KV DB tests" $ do
-- dbTestPath <- runIO $ mkTestPath "db_test"
-- let cfg1 = D.RocksConfig @CatalogueDB dbTestPath True False
-- let cfg2 = D.RocksConfig @CatalogueDB dbTestPath True True
-- let cfg1 = D.RedisConfig @CatalogueDB
-- let cfg2 = D.RedisConfig @CatalogueDB
-- let kvdbPath1 = D.getKVDBName cfg1
-- let kvdbPath2 = D.getKVDBName cfg2
--
-- describe "Database creation tests" $ do
-- it "DB is missing, create, errorIfExists False, no errors expected" $ withRocksDbAbsence kvdbPath1 $ do
-- it "DB is missing, create, errorIfExists False, no errors expected" $ withRedisDbAbsence kvdbPath1 $ do
-- eRes <- evalApp $ dbInitApp cfg1
-- eRes `shouldBe` Right ()
--
-- it "DB is missing, create, errorIfExists True, no errors expected" $ withRocksDbAbsence kvdbPath2 $ do
-- it "DB is missing, create, errorIfExists True, no errors expected" $ withRedisDbAbsence kvdbPath2 $ do
-- eRes <- evalApp $ dbInitApp cfg2
-- eRes `shouldBe` Right ()
--
-- it "DB is present, create, errorIfExists False, no errors expected" $ withRocksDbPresence kvdbPath1 $ do
-- it "DB is present, create, errorIfExists False, no errors expected" $ withRedisDbPresence kvdbPath1 $ do
-- eRes <- evalApp $ dbInitApp cfg1
-- eRes `shouldBe` Right ()
--
-- it "DB is present, create, errorIfExists False, errors expected" $ withRocksDbPresence kvdbPath2 $ do
-- it "DB is present, create, errorIfExists False, errors expected" $ withRedisDbPresence kvdbPath2 $ do
-- eRes <- evalApp $ dbInitApp cfg2
-- eRes `shouldBe` Left (D.DBError D.SystemError ("user error (open: Invalid argument: "
-- +| kvdbPath2 |+ ": exists (error_if_exists is true))"))
-- describe "DB Entities tests" $ do
-- it "ToDBKey test" $
-- kBlock1MetaKey `shouldBe` KBlockMetaKey (kBlock1 ^. Lens.prevHash)
--
-- it "ToDBValue test" $
-- kBlock1MetaValue `shouldBe` KBlockMetaValue 1
--
-- it "RawDBEntity test" $
-- D.toRawDBKey @KBlocksMetaDB kBlock1MetaKey `shouldBe` D.fromStringHash (kBlock1 ^. Lens.prevHash)
--
-- it "Parse RawDBValue test" $ do
-- let dbValueRaw = D.toRawDBValue @KBlocksMetaDB kBlock1MetaValue
-- D.fromRawDBValue @KBlocksMetaDB dbValueRaw `shouldBe` Just kBlock1MetaValue
--
-- it "Different objects => different keys and values" $ do
-- kBlock1MetaKey `shouldNotBe` kBlock2MetaKey
-- kBlock1MetaValue `shouldNotBe` kBlock2MetaValue
-- D.toRawDBKey @KBlocksMetaDB kBlock1MetaKey `shouldNotBe` D.toRawDBKey @KBlocksMetaDB kBlock2MetaKey
-- D.toRawDBValue @KBlocksMetaDB kBlock1MetaValue `shouldNotBe` D.toRawDBValue @KBlocksMetaDB kBlock2MetaValue
--
-- describe "Database usage tests" $ do
-- it "Write and Read KBlock Meta" $ withDbAbsence dbPath $ do
-- eRes <- evalApp $ putGetKBlockMetaApp dbPath
-- eRes `shouldBe` Right True
--
-- it "Write and Read KBlock1 Meta in separate runs" $ withDbAbsence dbPath $ do
-- eInitialized <- evalApp $ dbInitApp cfg1
-- eInitialized `shouldBe` Right ()
--
-- eStoreResult <- evalApp $ putKBlockMetaApp kBlock1 cfg1
-- eStoreResult `shouldBe` Right ()
--
-- eValue <- evalApp $ getKBlockMetaApp kBlock1MetaKey cfg1
-- eValue `shouldBe` Right kBlock1MetaValue
--
-- it "Write and Read KBlock2 Meta in separate runs" $ withDbAbsence dbPath $ do
-- eInitialized <- evalApp $ dbInitApp cfg1
-- eInitialized `shouldBe` Right ()
--
-- eStoreResult <- evalApp $ putKBlockMetaApp kBlock2 cfg1
-- eStoreResult `shouldBe` Right ()
--
-- eValue <- evalApp $ getKBlockMetaApp kBlock2MetaKey cfg1
-- eValue `shouldBe` Right kBlock2MetaValue
--
-- it "Write and Read KBlock3 Meta in separate runs" $ withDbAbsence dbPath $ do
-- eInitialized <- evalApp $ dbInitApp cfg1
-- eInitialized `shouldBe` Right ()
--
-- eStoreResult <- evalApp $ putKBlockMetaApp kBlock3 cfg1
-- eStoreResult `shouldBe` Right ()
--
-- eValue <- evalApp $ getKBlockMetaApp kBlock3MetaKey cfg1
-- eValue `shouldBe` Right kBlock3MetaValue
--
-- it "Read unexisting KBlock Meta" $ withDbPresence dbPath $ do
-- eInitialized <- evalApp $ dbInitApp cfg1
-- eInitialized `shouldBe` Right ()
--
-- eValue <- evalApp $ getKBlockMetaApp kBlock1MetaKey cfg1
-- eValue `shouldBe` Left (D.DBError D.KeyNotFound (show $ D.fromStringHash $ kBlock1 ^. Lens.prevHash))
--
-- it "Write one, read another (unexisting) KBlock Meta" $ withDbPresence dbPath $ do
-- eInitialized <- evalApp $ dbInitApp cfg1
-- eInitialized `shouldBe` Right ()
--
-- eStoreResult <- evalApp $ putKBlockMetaApp kBlock1 cfg1
-- eStoreResult `shouldBe` Right ()
--
-- eValue <- evalApp $ getKBlockMetaApp kBlock2MetaKey cfg1
-- eValue `shouldBe` Left (D.DBError D.KeyNotFound (show $ D.fromStringHash $ kBlock2 ^. Lens.prevHash))
--
-- it "Write two entities, read both" $ withDbPresence dbPath $ do
-- eInitialized <- evalApp $ dbInitApp cfg1
-- eInitialized `shouldBe` Right ()
--
-- eStoreResult1 <- evalApp $ putKBlockMetaApp kBlock1 cfg1
-- eStoreResult1 `shouldBe` Right ()
--
-- eStoreResult2 <- evalApp $ putKBlockMetaApp kBlock2 cfg1
-- eStoreResult2 `shouldBe` Right ()
--
-- eValue1 <- evalApp $ getKBlockMetaApp kBlock1MetaKey cfg1
-- eValue1 `shouldBe` Right kBlock1MetaValue
--
-- eValue2 <- evalApp $ getKBlockMetaApp kBlock2MetaKey cfg1
-- eValue2 `shouldBe` Right kBlock2MetaValue
unstableTest $ fastTest $ describe "Rocks KV DB tests" $ do
dbTestPath <- runIO $ mkTestPath "db_test"
let cfg1 = D.RocksDBConfig @CatalogueDB dbTestPath True False
let cfg2 = D.RocksDBConfig @CatalogueDB dbTestPath True True
let kvdbPath1 = D.getKVDBName cfg1
let kvdbPath2 = D.getKVDBName cfg2
describe "Database creation tests" $ do
it "DB is missing, create, errorIfExists False, no errors expected" $ withRocksDbAbsence kvdbPath1 $ do
eRes <- evalApp $ dbInitApp cfg1
eRes `shouldBe` Right ()
it "DB is missing, create, errorIfExists True, no errors expected" $ withRocksDbAbsence kvdbPath2 $ do
eRes <- evalApp $ dbInitApp cfg2
eRes `shouldBe` Right ()
it "DB is present, create, errorIfExists False, no errors expected" $ withRocksDbPresence kvdbPath1 $ do
eRes <- evalApp $ dbInitApp cfg1
eRes `shouldBe` Right ()
it "DB is present, create, errorIfExists False, errors expected" $ withRocksDbPresence kvdbPath2 $ do
eRes <- evalApp $ dbInitApp cfg2
eRes `shouldBe` Left (D.DBError D.SystemError ("user error (open: Invalid argument: "
+| kvdbPath2 |+ ": exists (error_if_exists is true))"))