diff options
Diffstat (limited to 'main')
| -rw-r--r-- | main/Test.hs | 9 | ||||
| -rw-r--r-- | main/Test/Service.hs | 9 |
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 () |