Handle unknown object type

Changelog: Handle unknown object type

2 files changed, 11 insertions, 7 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 ()