From 9d2671dc19bdc46d1f0fc976813cb9d63e34c71e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 23 Feb 2024 22:21:51 +0100
Subject: Test message service for sending arbitrary data

---
 main/Test/Service.hs | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)
 create mode 100644 main/Test/Service.hs

(limited to 'main/Test/Service.hs')

diff --git a/main/Test/Service.hs b/main/Test/Service.hs
new file mode 100644
index 0000000..1018e0d
--- /dev/null
+++ b/main/Test/Service.hs
@@ -0,0 +1,36 @@
+module Test.Service (
+    TestMessage(..),
+    TestMessageAttributes(..),
+) where
+
+import Control.Monad.Reader
+
+import Data.ByteString.Lazy.Char8 qualified as BL
+
+import Erebos.Network
+import Erebos.Service
+import Erebos.Storage
+
+data TestMessage = TestMessage (Stored Object)
+
+data TestMessageAttributes = TestMessageAttributes
+    { testMessageReceived :: String -> String -> String -> ServiceHandler TestMessage ()
+    }
+
+instance Storable TestMessage where
+    store' (TestMessage msg) = store' msg
+    load' = TestMessage <$> load'
+
+instance Service TestMessage where
+    serviceID _ = mkServiceID "cb46b92c-9203-4694-8370-8742d8ac9dc8"
+
+    type ServiceAttributes TestMessage = TestMessageAttributes
+    defaultServiceAttributes _ = TestMessageAttributes (\_ _ _ -> return ())
+
+    serviceHandler smsg = do
+        let TestMessage sobj = fromStored smsg
+        case map BL.unpack $ BL.words $ BL.takeWhile (/='\n') $ serializeObject $ fromStored sobj of
+            [otype, len] -> do
+                cb <- asks $ testMessageReceived . svcAttributes
+                cb otype len (show $ refDigest $ storedRef sobj)
+            _ -> return ()
-- 
cgit v1.2.3