summaryrefslogtreecommitdiff
path: root/src/Test.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Test.hs')
-rw-r--r--src/Test.hs22
1 files changed, 17 insertions, 5 deletions
diff --git a/src/Test.hs b/src/Test.hs
index c0b8aed..7694322 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -249,6 +249,7 @@ commands = map (T.pack *** id)
, ("contact-list", cmdContactList)
, ("contact-set-name", cmdContactSetName)
, ("dm-send-peer", cmdDmSendPeer)
+ , ("dm-send-contact", cmdDmSendContact)
]
cmdStore :: Command
@@ -480,19 +481,30 @@ cmdContactList = do
]
cmdOut "contact-list-done"
-cmdContactSetName :: Command
-cmdContactSetName = do
- [cid, name] <- asks tiParams
+getContact :: Text -> CommandM Contact
+getContact cid = do
h <- getHead
let contacts = fromSetBy (comparing contactName) . lookupSharedValue . lsShared . headObject $ h
[contact] <- flip filterM contacts $ \c -> do
r:_ <- return $ filterAncestors $ concatMap storedRoots $ toComponents c
return $ T.pack (show $ refDigest $ storedRef r) == cid
+ return contact
+
+cmdContactSetName :: Command
+cmdContactSetName = do
+ [cid, name] <- asks tiParams
+ contact <- getContact cid
updateLocalHead_ $ updateSharedState_ $ contactSetName contact name
cmdOut "contact-set-name-done"
cmdDmSendPeer :: Command
cmdDmSendPeer = do
[spidx, msg] <- asks tiParams
- peer <- getPeer spidx
- void $ sendDirectMessage peer msg
+ PeerIdentityFull to <- peerIdentity =<< getPeer spidx
+ void $ sendDirectMessage to msg
+
+cmdDmSendContact :: Command
+cmdDmSendContact = do
+ [cid, msg] <- asks tiParams
+ Just to <- contactIdentity <$> getContact cid
+ void $ sendDirectMessage to msg