Storage: make sure new head object is in appropriate storage

1 files changed, 2 insertions, 1 deletions

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