From dfddb65ad1abf5ba4171be42d303850ebbc363ee Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 27 Aug 2023 19:54:37 +0200
Subject: Storage: make sure new head object is in appropriate storage

---
 src/Storage.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'src')

diff --git a/src/Storage.hs b/src/Storage.hs
index 93a34c5..d5d14e3 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -433,9 +433,10 @@ storeHead st obj = liftIO $ do
     return $ Head hid stored
 
 replaceHead :: forall a m. (HeadType a, MonadIO m) => Head a -> Stored a -> m (Either (Maybe (Head a)) (Head a))
-replaceHead prev@(Head hid pobj) stored = liftIO $ do
+replaceHead prev@(Head hid pobj) stored' = liftIO $ do
     let st = headStorage prev
         tid = headTypeID @a Proxy
+    stored <- copyStored st stored'
     case stBacking st of
          StorageDir { dirPath = spath } -> do
              let filename = headPath spath tid hid
-- 
cgit v1.2.3