From 52c874ab42cd266d1b26ce1c045fcaf8eb410b32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Mon, 7 Oct 2024 22:17:40 +0200 Subject: Handle unknown object type Changelog: Handle unknown object type --- main/Test.hs | 9 ++++++--- main/Test/Service.hs | 9 +++++---- src/Erebos/Storage.hs | 8 +++++++- test/network.test | 41 +++++++++++++++++++++++++++++++++++++++++ test/storage.test | 22 ++++++++++++++++++++++ 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") -- cgit v1.2.3