diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2023-08-27 19:54:37 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-08-30 20:53:55 +0200 |
| commit | dfddb65ad1abf5ba4171be42d303850ebbc363ee (patch) | |
| tree | 8964285209f5c8d671b214cde77619bc526a8f94 | |
| parent | 4c2e86ddd75f0e655fcb21aa8597dc71ce5330be (diff) | |
Storage: make sure new head object is in appropriate storage
| -rw-r--r-- | src/Storage.hs | 3 |
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 |