Test: commands working with custom shared state

2 files changed, 48 insertions, 0 deletions

diff --git a/main/Test.hs b/main/Test.hs
index 1e1546c..bb3bcba 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -28,6 +28,8 @@ import Data.Text.IO qualified as T
 import Data.Typeable
 import Data.UUID.Types qualified as U
 
+import GHC.TypeLits
+
 import Network.Socket
 
 import System.IO
@@ -57,6 +59,7 @@ import Erebos.Storage.Merge
 import Erebos.Sync
 
 import Test.Service
+import Test.State
 
 
 data TestState = TestState
@@ -344,6 +347,8 @@ commands =
     , ( "local-state-wait", cmdLocalStateWait )
     , ( "shared-state-get", cmdSharedStateGet )
     , ( "shared-state-wait", cmdSharedStateWait )
+    , ( "shared-state-val-get", cmdSharedStateValGet )
+    , ( "shared-state-val-set", cmdSharedStateValSet )
     , ( "watch-local-identity", cmdWatchLocalIdentity )
     , ( "watch-shared-identity", cmdWatchSharedIdentity )
     , ( "update-local-identity", cmdUpdateLocalIdentity )
@@ -876,6 +881,25 @@ cmdSharedStateGet = do
 cmdSharedStateWait :: Command
 cmdSharedStateWait = localStateWaitHelper "shared-state-wait" (lsShared . headObject)
 
+cmdSharedStateValGet :: Command
+cmdSharedStateValGet = do
+    [ stid ] <- asks tiParams
+    h <- getOrLoadHead
+    case someSymbolVal $ T.unpack stid of
+        SomeSymbol (_ :: Proxy tid) -> do
+            let value = lookupSharedValueH @(CustomSharedState tid) h
+            cmdOut $ unwords $ "shared-state-val-get" : T.unpack stid : map (BC.unpack . showRef . storedRef) (customStateComponents value)
+
+cmdSharedStateValSet :: Command
+cmdSharedStateValSet = do
+    stid : trefs <- asks tiParams
+    st <- asks tiStorage
+    Just refs <- liftIO $ fmap sequence $ mapM (readRef st . encodeUtf8) trefs
+    case someSymbolVal $ T.unpack stid of
+        SomeSymbol (_ :: Proxy tid) -> do
+            updateLocalState_ $ updateSharedState_ $ \_ -> do
+                return $ CustomSharedState @tid $ map wrappedLoad refs
+
 cmdWatchLocalIdentity :: Command
 cmdWatchLocalIdentity = do
     h <- getOrLoadHead
diff --git a/main/Test/State.hs b/main/Test/State.hs
new file mode 100644
index 0000000..3ef1558
--- /dev/null
+++ b/main/Test/State.hs
@@ -0,0 +1,24 @@
+module Test.State (
+    CustomSharedState(..),
+) where
+
+import Data.Proxy
+
+import GHC.TypeLits
+
+import Erebos.Object
+import Erebos.State
+import Erebos.Storage.Merge
+
+
+data CustomSharedState (tid :: Symbol) = CustomSharedState
+    { customStateComponents :: StoredTips Object
+    }
+
+instance Mergeable (CustomSharedState tid) where
+    type Component (CustomSharedState tid) = Object
+    toComponents = customStateComponents
+    mergeSorted = CustomSharedState
+
+instance KnownSymbol tid => SharedType (CustomSharedState tid) where
+    sharedTypeID _ = mkSharedTypeID (symbolVal @tid Proxy)