summaryrefslogtreecommitdiff
path: root/src/Storage.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-08-27 19:54:37 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-08-30 20:53:55 +0200
commitdfddb65ad1abf5ba4171be42d303850ebbc363ee (patch)
tree8964285209f5c8d671b214cde77619bc526a8f94 /src/Storage.hs
parent4c2e86ddd75f0e655fcb21aa8597dc71ce5330be (diff)
Storage: make sure new head object is in appropriate storage
Diffstat (limited to 'src/Storage.hs')
-rw-r--r--src/Storage.hs3
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