summaryrefslogtreecommitdiff
path: root/main/Test.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-06-26 21:45:34 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-06-28 20:47:59 +0200
commitb00317484b42ce681877c72fb973cfc8381c9604 (patch)
tree80260259aafc53244f63707b5baaea8b32361087 /main/Test.hs
parent5b3c52c50b5301d009fb9a0d44b4cf91d50f6de4 (diff)
Automatic discovery of peers for pending messagesrelease-0.1
Changelog: Automatic discovery of peers for pending direct messages
Diffstat (limited to 'main/Test.hs')
-rw-r--r--main/Test.hs9
1 files changed, 9 insertions, 0 deletions
diff --git a/main/Test.hs b/main/Test.hs
index 75eaaaf..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