Handle unknown object type

Changelog: Handle unknown object type

5 files changed, 81 insertions, 8 deletions

diff --git a/main/Test.hs b/main/Test.hs
index 2155e09..741ffe8 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -309,7 +309,8 @@ cmdLoad = do
     st <- asks tiStorage
     [ tref ] <- asks tiParams
     Just ref <- liftIO $ readRef st $ encodeUtf8 tref
-    header : content <- return $ BL.lines $ lazyLoadBytes ref
+    let obj = load @Object ref
+    header : content <- return $ BL.lines $ serializeObject obj
     cmdOut $ "load-type " <> T.unpack (decodeUtf8 $ BL.toStrict header)
     forM_ content $ \line -> do
         cmdOut $ "load-line " <> T.unpack (decodeUtf8 $ BL.toStrict line)
@@ -455,8 +456,10 @@ cmdStartServer = do
         , someService @SyncService Proxy
         , someService @ChatroomService Proxy
         , someServiceAttr $ (defaultServiceAttributes Proxy)
-            { testMessageReceived = \otype len sref ->
-                liftIO $ outLine out $ unwords ["test-message-received", otype, len, sref]
+            { testMessageReceived = \obj otype len sref -> do
+                liftIO $ do
+                    void $ store (headStorage h) obj
+                    outLine out $ unwords ["test-message-received", otype, len, sref]
             }
         ]
 
diff --git a/main/Test/Service.hs b/main/Test/Service.hs
index 1018e0d..3e6eb83 100644
--- a/main/Test/Service.hs
+++ b/main/Test/Service.hs
@@ -14,7 +14,7 @@ import Erebos.Storage
 data TestMessage = TestMessage (Stored Object)
 
 data TestMessageAttributes = TestMessageAttributes
-    { testMessageReceived :: String -> String -> String -> ServiceHandler TestMessage ()
+    { testMessageReceived :: Object -> String -> String -> String -> ServiceHandler TestMessage ()
     }
 
 instance Storable TestMessage where
@@ -25,12 +25,13 @@ instance Service TestMessage where
     serviceID _ = mkServiceID "cb46b92c-9203-4694-8370-8742d8ac9dc8"
 
     type ServiceAttributes TestMessage = TestMessageAttributes
-    defaultServiceAttributes _ = TestMessageAttributes (\_ _ _ -> return ())
+    defaultServiceAttributes _ = TestMessageAttributes (\_ _ _ _ -> return ())
 
     serviceHandler smsg = do
         let TestMessage sobj = fromStored smsg
-        case map BL.unpack $ BL.words $ BL.takeWhile (/='\n') $ serializeObject $ fromStored sobj of
+            obj = fromStored sobj
+        case map BL.unpack $ BL.words $ BL.takeWhile (/='\n') $ serializeObject obj of
             [otype, len] -> do
                 cb <- asks $ testMessageReceived . svcAttributes
-                cb otype len (show $ refDigest $ storedRef sobj)
+                cb obj otype len (show $ refDigest $ storedRef sobj)
             _ -> return ()
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
 
diff --git a/test/network.test b/test/network.test
index efd508f..6f16f7d 100644
--- a/test/network.test
+++ b/test/network.test
@@ -380,3 +380,44 @@ test Reconnection:
 					guard (done == "done")
 
 				expect /test-message-received blob [0-9]+ $message/
+
+
+test SendUnknownObjectType:
+	let refpat = /blake2#[0-9a-f]*/
+
+	spawn as p1
+	spawn as p2
+
+	with p1:
+		send "create-identity Device1"
+		send "start-server"
+	with p2:
+		send "create-identity Device2"
+		send "start-server"
+
+	expect from p1:
+		/peer 1 addr ${p2.node.ip} 29665/
+		/peer 1 id Device2/
+	expect from p2:
+		/peer 1 addr ${p1.node.ip} 29665/
+		/peer 1 id Device1/
+
+	with p1:
+		send:
+			"store test-unknown"
+			"TEST"
+			""
+		expect /store-done ($refpat)/ capture r1
+
+		send "test-message-send 1 $r1"
+		expect /test-message-send done/
+
+		with p2:
+			expect /test-message-received test-unknown [0-9]+ $r1/
+
+			send "load $r1"
+			expect /load-type test-unknown 5/
+			expect /load-line TEST/
+			local:
+				expect /load-(.*)/ capture done
+				guard (done == "done")
diff --git a/test/storage.test b/test/storage.test
index 3d898b1..2a53bb8 100644
--- a/test/storage.test
+++ b/test/storage.test
@@ -474,3 +474,25 @@ test LocalStateKeepUnknown:
 		local:
 			expect /load-(.*)/ capture done
 			guard (done == "done")
+
+
+test UnknownObjectType:
+	let refpat = /blake2#[0-9a-f]*/
+
+	spawn as p
+	spawn as p2 on p.node
+
+	with p:
+		send:
+			"store test-unknown"
+			"TEST"
+			""
+		expect /store-done ($refpat)/ capture r1
+
+		with p2:
+			send "load $r1"
+			expect /load-type test-unknown 5/
+			expect /load-line TEST/
+			local:
+				expect /load-(.*)/ capture done
+				guard (done == "done")