Permalink
Browse files

Volatile db

  • Loading branch information...
kderme committed Feb 11, 2019
1 parent 1f02c90 commit 5f951efa15f20c25e4e1050e870d0774a1db73e9
@@ -82,6 +82,11 @@ library
Ouroboros.Storage.ImmutableDB.Util
Ouroboros.Storage.Util
Ouroboros.Storage.Util.ErrorHandling
Ouroboros.Storage.VolatileDB
Ouroboros.Storage.VolatileDB.Api
Ouroboros.Storage.VolatileDB.Impl
Ouroboros.Storage.VolatileDB.Types
Ouroboros.Storage.VolatileDB.Util
Ouroboros.Storage.IO

default-language: Haskell2010
@@ -259,14 +264,19 @@ test-suite test-storage
Test.Ouroboros.Storage.FS.StateMachine
Test.Ouroboros.Storage.ImmutableDB
Test.Ouroboros.Storage.ImmutableDB.Sim
Test.Ouroboros.Storage.VolatileDB
Test.Ouroboros.Storage.VolatileDB.Model
Test.Ouroboros.Storage.VolatileDB.StateMachine
Test.Util.RefEnv
build-depends: base,
ouroboros-network,
ouroboros-consensus,
io-sim-classes,

bifunctors,
binary,
bytestring,
cereal,
containers,
directory,
exceptions,
@@ -105,7 +105,7 @@ instance (MonadFork (SimFS m) , MonadSTM m) => MonadSTM (SimFS m) where
readTBQueue = lift . readTBQueue
writeTBQueue q = lift . writeTBQueue q
#if MIN_VERSION_stm(2,5,0)
lengthTBQueue = lift . lengthTBQueue
-- lengthTBQueue = lift . lengthTBQueue
#endif

simHasFS :: forall m. MonadSTM m => ErrorHandling FsError m -> HasFS (SimFS m)
@@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -18,10 +18,13 @@ module Ouroboros.Storage.Util.ErrorHandling (
, liftErrNewtype
, liftErrReader
, liftErrState
, monadCatch
) where

import Control.Exception (Exception)
import qualified Control.Exception as E
import Control.Monad.Catch (MonadCatch)
import qualified Control.Monad.Catch as C
import Control.Monad.Except (ExceptT, MonadError)
import qualified Control.Monad.Except as M
import Control.Monad.Reader (ReaderT (..), runReaderT)
@@ -105,3 +108,9 @@ liftErrState _ ErrorHandling{..} = ErrorHandling{
catchError (runStateT act st) $ \e ->
runStateT (handler e) st
}

monadCatch :: (MonadCatch m, Exception e) => ErrorHandling e m
monadCatch = ErrorHandling {
throwError = C.throwM
, catchError = C.catch
}
@@ -0,0 +1,7 @@
module Ouroboros.Storage.VolatileDB
( module Ouroboros.Storage.VolatileDB.Api
, module Ouroboros.Storage.VolatileDB.Impl
) where

import Ouroboros.Storage.VolatileDB.Api
import Ouroboros.Storage.VolatileDB.Impl
@@ -0,0 +1,35 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Ouroboros.Storage.VolatileDB.Api
( VolatileDB(..)
, withDB

, module Ouroboros.Storage.VolatileDB.Types
) where

import Control.Monad.Catch (MonadMask, bracket)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)

import GHC.Stack (HasCallStack)

import Ouroboros.Storage.VolatileDB.Types

-- | Open the database using the given function, perform the given action
-- using the database, and closes the database using its 'closeDB' function,
-- in case of success or when an exception was raised.
withDB :: (HasCallStack, MonadMask m)
=> m (VolatileDB slotId m)
-- ^ How to open the database
-> (VolatileDB slotId m -> m a)
-- ^ Action to perform using the database
-> m a
withDB openDB = bracket openDB closeDB

data VolatileDB slotId m = VolatileDB {
closeDB :: HasCallStack => m ()
, isOpen :: HasCallStack => m Bool
, getBlock :: HasCallStack => slotId -> m (Maybe ByteString)
, putBlock :: HasCallStack => slotId -> Builder -> m ()
, garbageCollect :: HasCallStack => slotId -> m ()
}
Oops, something went wrong.

0 comments on commit 5f951ef

Please sign in to comment.