From dfddb65ad1abf5ba4171be42d303850ebbc363ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= 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(-) 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