From 7ad3fb235dde2e0be8adc0feeb890da438c70eff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Tue, 31 Dec 2024 20:20:23 +0100 Subject: Use evaluate to force digest before storing to backend --- src/Erebos/Storage/Internal.hs | 3 ++- src/Erebos/Storage/Memory.hs | 4 +--- 2 files changed, 3 insertions(+), 4 deletions(-) (limited to 'src/Erebos/Storage') diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs index 59d0af0..6df1410 100644 --- a/src/Erebos/Storage/Internal.hs +++ b/src/Erebos/Storage/Internal.hs @@ -3,6 +3,7 @@ module Erebos.Storage.Internal where import Control.Arrow import Control.Concurrent import Control.DeepSeq +import Control.Exception import Control.Monad import Control.Monad.Identity @@ -270,7 +271,7 @@ instance StorageCompleteness Partial where unsafeStoreRawBytes :: Storage' c -> BL.ByteString -> IO (Ref' c) unsafeStoreRawBytes st@Storage {..} raw = do - let dgst = hashToRefDigest raw + dgst <- evaluate $ force $ hashToRefDigest raw backendStoreBytes stBackend dgst raw return $ Ref st dgst diff --git a/src/Erebos/Storage/Memory.hs b/src/Erebos/Storage/Memory.hs index dd382b6..677e8c5 100644 --- a/src/Erebos/Storage/Memory.hs +++ b/src/Erebos/Storage/Memory.hs @@ -5,7 +5,6 @@ module Erebos.Storage.Memory ( ) where import Control.Concurrent.MVar -import Control.DeepSeq import Data.ByteArray (ScrubbedBytes) import Data.ByteString.Lazy qualified as BL @@ -46,8 +45,7 @@ instance (StorageCompleteness c, Typeable p) => StorageBackend (MemoryStorage p M.lookup dgst <$> readMVar memObjs backendStoreBytes StorageMemory {..} dgst raw = - dgst `deepseq` -- the TVar may be accessed when evaluating the data to be written - modifyMVar_ memObjs (return . M.insert dgst raw) + modifyMVar_ memObjs (return . M.insert dgst raw) backendLoadHeads StorageMemory {..} tid = do -- cgit v1.2.3