summaryrefslogtreecommitdiff
path: root/src/Test.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Test.hs')
-rw-r--r--src/Test.hs23
1 files changed, 23 insertions, 0 deletions
diff --git a/src/Test.hs b/src/Test.hs
index df36556..9c5319b 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -30,6 +30,7 @@ import Network
import Pairing
import PubKey
import Service
+import Set
import State
import Storage
import Storage.Internal (unsafeStoreRawBytes)
@@ -179,6 +180,8 @@ commands :: [(Text, Command)]
commands = map (T.pack *** id)
[ ("store", cmdStore)
, ("stored-roots", cmdStoredRoots)
+ , ("stored-set-add", cmdStoredSetAdd)
+ , ("stored-set-list", cmdStoredSetList)
, ("create-identity", cmdCreateIdentity)
, ("start-server", cmdStartServer)
, ("watch-local-identity", cmdWatchLocalIdentity)
@@ -207,6 +210,26 @@ cmdStoredRoots = do
Just ref <- liftIO $ readRef st (encodeUtf8 tref)
cmdOut $ "stored-roots" ++ concatMap ((' ':) . show . refDigest . storedRef) (storedRoots $ wrappedLoad @Object ref)
+cmdStoredSetAdd :: Command
+cmdStoredSetAdd = do
+ st <- asks tiStorage
+ (item, set) <- asks tiParams >>= liftIO . mapM (readRef st . encodeUtf8) >>= \case
+ [Just iref, Just sref] -> return (wrappedLoad iref, loadSet @[Stored Object] sref)
+ [Just iref] -> return (wrappedLoad iref, emptySet)
+ _ -> fail "unexpected parameters"
+ set' <- storeSetAdd st [item] set
+ cmdOut $ "stored-set-add" ++ concatMap ((' ':) . show . refDigest . storedRef) (toComponents set')
+
+cmdStoredSetList :: Command
+cmdStoredSetList = do
+ st <- asks tiStorage
+ [tref] <- asks tiParams
+ Just ref <- liftIO $ readRef st (encodeUtf8 tref)
+ let items = fromSetBy compare $ loadSet @[Stored Object] ref
+ forM_ items $ \item -> do
+ cmdOut $ "stored-set-item" ++ concatMap ((' ':) . show . refDigest . storedRef) item
+ cmdOut $ "stored-set-done"
+
cmdCreateIdentity :: Command
cmdCreateIdentity = do
st <- asks tiStorage