From 52c874ab42cd266d1b26ce1c045fcaf8eb410b32 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 7 Oct 2024 22:17:40 +0200
Subject: Handle unknown object type
Changelog: Handle unknown object type
---
src/Erebos/Storage.hs | 8 +++++++-
1 file changed, 7 insertions(+), 1 deletion(-)
(limited to 'src/Erebos')
diff --git a/src/Erebos/Storage.hs b/src/Erebos/Storage.hs
index 2e60f4e..65210f9 100644
--- a/src/Erebos/Storage.hs
+++ b/src/Erebos/Storage.hs
@@ -226,6 +226,7 @@ copyObject' :: forall c c'. (StorageCompleteness c, StorageCompleteness c') => S
copyObject' _ (Blob bs) = return $ return $ Blob bs
copyObject' st (Rec rs) = fmap Rec . sequence <$> mapM (\( n, item ) -> fmap ( n, ) <$> copyRecItem' st item) rs
copyObject' _ ZeroObject = return $ return ZeroObject
+copyObject' _ (UnknownObject otype content) = return $ return $ UnknownObject otype content
copyRef :: forall c c' m. (StorageCompleteness c, StorageCompleteness c', MonadIO m) => Storage' c' -> Ref' c -> m (LoadResult c (Ref' c'))
copyRef st ref' = liftIO $ returnLoadResult <$> copyRef' st ref'
@@ -247,6 +248,7 @@ data Object' c
= Blob ByteString
| Rec [(ByteString, RecItem' c)]
| ZeroObject
+ | UnknownObject ByteString ByteString
deriving (Show)
type Object = Object' Complete
@@ -271,6 +273,7 @@ serializeObject = \case
Rec rec -> let cnt = BL.fromChunks $ concatMap (uncurry serializeRecItem) rec
in BL.fromChunks [BC.pack "rec ", BC.pack (show $ BL.length cnt), BC.singleton '\n'] `BL.append` cnt
ZeroObject -> BL.empty
+ UnknownObject otype cnt -> BL.fromChunks [ otype, BC.singleton ' ', BC.pack (show $ B.length cnt), BC.singleton '\n', cnt ]
-- |Serializes and stores object data without ony dependencies, so is safe only
-- if all the referenced objects are already stored or reference is partial.
@@ -329,7 +332,7 @@ unsafeDeserializeObject st bytes =
_ | otype == BC.pack "blob" -> return $ Blob content
| otype == BC.pack "rec" -> maybe (throwError $ "Malformed record item ")
(return . Rec) $ sequence $ map parseRecLine $ mergeCont [] $ BC.lines content
- | otherwise -> throwError $ "Unknown object type"
+ | otherwise -> return $ UnknownObject otype content
_ -> throwError $ "Malformed object"
where splitObjPrefix line = do
[otype, tlen] <- return $ BLC.words line
@@ -610,6 +613,7 @@ class Storable a => ZeroStorable a where
data Store = StoreBlob ByteString
| StoreRec (forall c. StorageCompleteness c => Storage' c -> [IO [(ByteString, RecItem' c)]])
| StoreZero
+ | StoreUnknown ByteString ByteString
evalStore :: StorageCompleteness c => Storage' c -> Store -> IO (Ref' c)
evalStore st = unsafeStoreObject st <=< evalStoreObject st
@@ -618,6 +622,7 @@ evalStoreObject :: StorageCompleteness c => Storage' c -> Store -> IO (Object' c
evalStoreObject _ (StoreBlob x) = return $ Blob x
evalStoreObject s (StoreRec f) = Rec . concat <$> sequence (f s)
evalStoreObject _ StoreZero = return ZeroObject
+evalStoreObject _ (StoreUnknown otype content) = return $ UnknownObject otype content
newtype StoreRecM c a = StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a)
deriving (Functor, Applicative, Monad)
@@ -652,6 +657,7 @@ instance Storable Object where
Rec xs' <- copyObject st (Rec xs)
return xs'
store' ZeroObject = StoreZero
+ store' (UnknownObject otype content) = StoreUnknown otype content
load' = loadCurrentObject
--
cgit v1.2.3