diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-02-09 09:48:34 +0100 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-02-09 20:53:59 +0100 |
| commit | 3ab6a143f95dad46cee526b709a2687bb28e985b (patch) | |
| tree | 0fc3bb709ee9fbdf24d291cd4d68d0578ce06c80 | |
| parent | f6051eb3ebe2c50cdcde44abf6d071f0b5bdbb8f (diff) | |
| -rw-r--r-- | src/Erebos/Object/Internal.hs | 8 | ||||
| -rw-r--r-- | src/Erebos/Storage/Backend.hs | 5 | ||||
| -rw-r--r-- | src/Erebos/Storage/Internal.hs | 8 |
3 files changed, 13 insertions, 8 deletions
diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs index 1e65321..45fd924 100644 --- a/src/Erebos/Object/Internal.hs +++ b/src/Erebos/Object/Internal.hs @@ -47,6 +47,8 @@ module Erebos.Object.Internal ( ) where import Control.Applicative +import Control.DeepSeq +import Control.Exception import Control.Monad import Control.Monad.Except import Control.Monad.Reader @@ -201,6 +203,12 @@ storeObject = unsafeStoreObject storeRawBytes :: PartialStorage -> BL.ByteString -> IO PartialRef storeRawBytes = unsafeStoreRawBytes +unsafeStoreRawBytes :: Storage' c -> BL.ByteString -> IO (Ref' c) +unsafeStoreRawBytes st@Storage {..} raw = do + dgst <- evaluate $ force $ hashToRefDigest raw + backendStoreBytes stBackend dgst raw + return $ Ref st dgst + serializeRecItem :: ByteString -> RecItem' c -> [ByteString] serializeRecItem name (RecEmpty) = [name, BC.pack ":e", BC.singleton ' ', BC.singleton '\n'] serializeRecItem name (RecInt x) = [name, BC.pack ":i", BC.singleton ' ', BC.pack (show x), BC.singleton '\n'] diff --git a/src/Erebos/Storage/Backend.hs b/src/Erebos/Storage/Backend.hs index 59097b6..07bd63e 100644 --- a/src/Erebos/Storage/Backend.hs +++ b/src/Erebos/Storage/Backend.hs @@ -9,6 +9,8 @@ module Erebos.Storage.Backend ( Complete, Partial, Storage, PartialStorage, newStorage, + withStorageBackend, + refDigestBytes, WatchID, startWatchID, nextWatchID, @@ -30,6 +32,9 @@ newStorage stBackend = do stRefRoots <- newMVar =<< HT.new return Storage {..} +withStorageBackend :: Storage' c -> (forall bck. (StorageBackend bck, BackendCompleteness bck ~ c) => bck -> IO a) -> IO a +withStorageBackend Storage {..} f = f stBackend + refDigestBytes :: RefDigest -> ByteString refDigestBytes = BA.convert diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs index db211bb..70a69b4 100644 --- a/src/Erebos/Storage/Internal.hs +++ b/src/Erebos/Storage/Internal.hs @@ -15,7 +15,6 @@ module Erebos.Storage.Internal ( StorageBackend(..), Complete, Partial, - unsafeStoreRawBytes, ioLoadBytesFromStorage, Generation(..), @@ -26,7 +25,6 @@ module Erebos.Storage.Internal ( import Control.Arrow import Control.Concurrent import Control.DeepSeq -import Control.Exception import Control.Monad.Identity import Crypto.Hash @@ -275,12 +273,6 @@ instance StorageCompleteness Partial where returnLoadResult = id ioLoadBytes (Ref st dgst) = maybe (Left dgst) Right <$> ioLoadBytesFromStorage st dgst -unsafeStoreRawBytes :: Storage' c -> BL.ByteString -> IO (Ref' c) -unsafeStoreRawBytes st@Storage {..} raw = do - dgst <- evaluate $ force $ hashToRefDigest raw - backendStoreBytes stBackend dgst raw - return $ Ref st dgst - ioLoadBytesFromStorage :: Storage' c -> RefDigest -> IO (Maybe BL.ByteString) ioLoadBytesFromStorage Storage {..} dgst = backendLoadBytes stBackend dgst >>= \case |