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/Storage.hs')

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