diff options
Diffstat (limited to 'src/Test.hs')
| -rw-r--r-- | src/Test.hs | 15 |
1 files changed, 15 insertions, 0 deletions
diff --git a/src/Test.hs b/src/Test.hs index 694f16d..8ea8925 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -224,6 +224,7 @@ commands = map (T.pack *** id) , ("contact-accept", cmdContactAccept) , ("contact-reject", cmdContactReject) , ("contact-list", cmdContactList) + , ("contact-set-name", cmdContactSetName) ] cmdStore :: Command @@ -435,9 +436,23 @@ cmdContactList = do h <- maybe (fail "failed to reload head") return =<< maybe (fail "no current head") reloadHead =<< gets tsHead let contacts = fromSetBy (comparing contactName) . lookupSharedValue . lsShared . headObject $ h forM_ contacts $ \c -> do + r:_ <- return $ filterAncestors $ concatMap storedRoots $ toComponents c cmdOut $ concat [ "contact-list-item " + , show $ refDigest $ storedRef r + , " " , T.unpack $ contactName c , case contactIdentity c of Nothing -> ""; Just idt -> " " ++ T.unpack (displayIdentity idt) ] cmdOut "contact-list-done" + +cmdContactSetName :: Command +cmdContactSetName = do + [cid, name] <- asks tiParams + h <- maybe (fail "failed to reload head") return =<< maybe (fail "no current head") reloadHead =<< gets tsHead + 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 + updateSharedState_ $ contactSetName contact name + cmdOut "contact-set-name-done" |