Test: commands working with custom shared state

4 files changed, 75 insertions, 0 deletions

diff --git a/erebos.cabal b/erebos.cabal
index 75364c5..82e9157 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -205,6 +205,7 @@ executable erebos
         Terminal
         Test
         Test.Service
+        Test.State
         Version
         Version.Git
         WebSocket
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)
diff --git a/test/state.et b/test/state.et
new file mode 100644
index 0000000..ab8703d
--- /dev/null
+++ b/test/state.et
@@ -0,0 +1,26 @@
+module state
+
+import common
+
+test SharedStateLocal:
+    spawn as p
+    with p:
+        send "create-identity Device Owner"
+        expect /create-identity-done ref $refpat extref ($refpat).*/ capture device
+        send "identity-info $device"
+        expect /identity-info ref $device base $refpat owner ($refpat).*/ capture owner
+
+        send "shared-state-val-get 0c6c1fe0-f2d7-4891-926b-c332449f7871"
+        expect /shared-state-val-get 0c6c1fe0-f2d7-4891-926b-c332449f7871 $owner/
+
+        for i in [ 1 .. 10 ]:
+            send:
+                "store rec"
+                "i:i $i"
+                ""
+            expect /store-done ($refpat)/ capture r
+
+            send "shared-state-val-set ffffffff-0000-0000-0000-000000000001 $r"
+
+            send "shared-state-val-get ffffffff-0000-0000-0000-000000000001"
+            expect /shared-state-val-get ffffffff-0000-0000-0000-000000000001 $r/