diff options
| -rw-r--r-- | src/Contact.hs | 12 | ||||
| -rw-r--r-- | src/Test.hs | 15 |
2 files changed, 27 insertions, 0 deletions
diff --git a/src/Contact.hs b/src/Contact.hs index 4e2cb17..6585985 100644 --- a/src/Contact.hs +++ b/src/Contact.hs @@ -4,6 +4,8 @@ module Contact ( contactCustomName, contactName, + contactSetName, + ContactService, contactRequest, contactAccept, @@ -79,6 +81,16 @@ contactName c = fromJust $ msum , Just T.empty ] +contactSetName :: MonadHead LocalState m => Contact -> Text -> Set Contact -> m (Set Contact) +contactSetName contact name set = do + st <- getStorage + cdata <- wrappedStore st ContactData + { cdPrev = toComponents contact + , cdIdentity = [] + , cdName = Just name + } + storeSetAdd st (mergeSorted @Contact [cdata]) set + type ContactService = PairingService ContactAccepted 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" |