summaryrefslogtreecommitdiff
path: root/main/Test.hs
diff options
context:
space:
mode:
Diffstat (limited to 'main/Test.hs')
-rw-r--r--main/Test.hs14
1 files changed, 10 insertions, 4 deletions
diff --git a/main/Test.hs b/main/Test.hs
index 0181575..adb3c39 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -284,6 +284,7 @@ commands = map (T.pack *** id)
, ("contact-set-name", cmdContactSetName)
, ("dm-send-peer", cmdDmSendPeer)
, ("dm-send-contact", cmdDmSendContact)
+ , ("dm-send-identity", cmdDmSendIdentity)
, ("dm-list-peer", cmdDmListPeer)
, ("dm-list-contact", cmdDmListContact)
, ("chatroom-create", cmdChatroomCreate)
@@ -736,6 +737,14 @@ cmdDmSendContact = do
Just to <- contactIdentity <$> getContact cid
void $ sendDirectMessage to msg
+cmdDmSendIdentity :: Command
+cmdDmSendIdentity = do
+ st <- asks tiStorage
+ [ tid, msg ] <- asks tiParams
+ Just ref <- liftIO $ readRef st $ encodeUtf8 tid
+ Just to <- return $ validateExtendedIdentity $ wrappedLoad ref
+ void $ sendDirectMessage to msg
+
dmList :: Foldable f => Identity f -> Command
dmList peer = do
threads <- toThreadList . lookupSharedValue . lsShared . headObject <$> getHead
@@ -880,8 +889,5 @@ cmdDiscoveryConnect = do
st <- asks tiStorage
[ tref ] <- asks tiParams
Just ref <- liftIO $ readRef st $ encodeUtf8 tref
-
Just RunningServer {..} <- gets tsServer
- peers <- liftIO $ getCurrentPeerList rsServer
- forM_ peers $ \peer -> do
- sendToPeer peer $ DiscoverySearch ref
+ discoverySearch rsServer ref