diff options
Diffstat (limited to 'src/Erebos/Storage')
| -rw-r--r-- | src/Erebos/Storage/Head.hs | 1 | ||||
| -rw-r--r-- | src/Erebos/Storage/Monad.hs | 37 |
2 files changed, 38 insertions, 0 deletions
diff --git a/src/Erebos/Storage/Head.hs b/src/Erebos/Storage/Head.hs index 343669a..7e38af8 100644 --- a/src/Erebos/Storage/Head.hs +++ b/src/Erebos/Storage/Head.hs @@ -36,6 +36,7 @@ import Erebos.Object.Internal import Erebos.Storable.Internal import Erebos.Storage.Backend import Erebos.Storage.Internal +import Erebos.Storage.Monad import Erebos.UUID qualified as U diff --git a/src/Erebos/Storage/Monad.hs b/src/Erebos/Storage/Monad.hs new file mode 100644 index 0000000..6af3ae1 --- /dev/null +++ b/src/Erebos/Storage/Monad.hs @@ -0,0 +1,37 @@ +module Erebos.Storage.Monad ( + MonadStorage(..), + mloadKey, +) where + +import Control.Monad.Except +import Control.Monad.Reader + +import Erebos.Error +import Erebos.Object.Internal +import Erebos.Storable.Internal +import Erebos.Storage.Key + + +class Monad m => MonadStorage m where + getStorage :: m Storage + mstore :: Storable a => a -> m (Stored a) + + default mstore :: MonadIO m => Storable a => a -> m (Stored a) + mstore x = do + st <- getStorage + wrappedStore st x + + mstoreKey :: KeyPair sec pub => sec -> m () + default mstoreKey :: (KeyPair sec pub, MonadIO m) => sec -> m () + mstoreKey = liftIO . storeKey + + mloadKeyMb :: KeyPair sec pub => Stored pub -> m (Maybe sec) + default mloadKeyMb :: (KeyPair sec pub, MonadIO m) => Stored pub -> m (Maybe sec) + mloadKeyMb = loadKeyMb + +mloadKey :: (KeyPair sec pub, MonadStorage m, MonadError e m, FromErebosError e) => Stored pub -> m sec +mloadKey pub = maybe (throwOtherError $ "secret key not found for " <> show (storedRef pub)) return =<< mloadKeyMb pub + + +instance MonadIO m => MonadStorage (ReaderT Storage m) where + getStorage = ask |