api to rotate keys, option to show full links in CLI

2026-09-28 02:38:44 +00:00 · 2026-07-20 15:05:27 +00:00
parent effea1c471
commit f58d00437c
13 changed files with 101 additions and 45 deletions
@@ -116,6 +116,7 @@ defaultChatConfig =
      inlineFiles = defaultInlineFilesConfig,
      autoAcceptFileSize = 0,
      showReactions = False,
+      showFullLinks = False,
      showReceipts = False,
      logLevel = CLLImportant,
      subscriptionEvents = False,
@@ -153,11 +154,11 @@ newChatController
  ChatDatabase {chatStore, agentStore}
  user
  cfg@ChatConfig {agentConfig = aCfg, presetServers, inlineFiles, deviceNameForRemote, confirmMigrations}
-  ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, simpleNetCfg, logLevel, logConnections, logServerHosts, logFile, tbqSize, deviceName, webPreviewConfig, highlyAvailable, yesToUpMigrations}, optFilesFolder, optTempDirectory, showReactions, allowInstantFiles, autoAcceptFileSize}
+  ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, simpleNetCfg, logLevel, logConnections, logServerHosts, logFile, tbqSize, deviceName, webPreviewConfig, highlyAvailable, yesToUpMigrations}, optFilesFolder, optTempDirectory, showReactions, showFullLinks, allowInstantFiles, autoAcceptFileSize}
  backgroundMode = do
    let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
        confirmMigrations' = if confirmMigrations == MCConsole && yesToUpMigrations then MCYesUp else confirmMigrations
-        config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, presetServers = presetServers', inlineFiles = inlineFiles', autoAcceptFileSize, webPreviewConfig, highlyAvailable, confirmMigrations = confirmMigrations'}
+        config = cfg {logLevel, showReactions, showFullLinks, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, presetServers = presetServers', inlineFiles = inlineFiles', autoAcceptFileSize, webPreviewConfig, highlyAvailable, confirmMigrations = confirmMigrations'}
    randomPresetServers <- chooseRandomServers presetServers'
    let rndSrvs = L.toList randomPresetServers
        operatorWithId (i, op) = (\o -> o {operatorId = DBEntityId i}) <$> pOperator op
@@ -152,6 +152,7 @@ data ChatConfig = ChatConfig
    inlineFiles :: InlineFilesConfig,
    autoAcceptFileSize :: Integer,
    showReactions :: Bool,
+    showFullLinks :: Bool,
    showReceipts :: Bool,
    subscriptionEvents :: Bool,
    hostEvents :: Bool,
@@ -554,6 +555,7 @@ data ChatCommand
  | APIShowMyAddress {userId :: UserId}
  | ShowMyAddress
  | APIAddMyAddressShortLink UserId
+  | APIRotateAddressRatchetKeys UserId
  | APISetProfileAddress {userId :: UserId, enable :: Bool}
  | SetProfileAddress Bool
  | APISetAddressSettings {userId :: UserId, settings :: AddressSettings}
@@ -2440,7 +2440,9 @@ processChatCommand cxt nm = \case
  ShowMyAddress -> withUser' $ \User {userId} ->
    processChatCommand cxt nm $ APIShowMyAddress userId
  APIAddMyAddressShortLink userId -> withUserId' userId $ \user ->
-    CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData user)
+    CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData False user)
+  APIRotateAddressRatchetKeys userId -> withUserId' userId $ \user ->
+    CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData True user)
  APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do
    let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
    updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
@@ -2460,7 +2462,7 @@ processChatCommand cxt nm = \case
      then pure $ CRUserContactLinkUpdated user ucl
      else do
        let ucl' = ucl {addressSettings = settings}
-        ucl'' <- if shortLinkDataSet then setMyAddressData user ucl' else pure ucl'
+        ucl'' <- if shortLinkDataSet then setMyAddressData False user ucl' else pure ucl'
        withFastStore' $ \db -> updateUserAddressSettings db userContactLinkId settings
        pure $ CRUserContactLinkUpdated user ucl''
  SetAddressSettings settings -> withUser $ \User {userId} ->
@@ -3826,7 +3828,7 @@ processChatCommand cxt nm = \case
            -- [incognito] generate profile to send
            incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
            subMode <- chatReadVar subscriptionMode
-            let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
+            let cReqHash = contactCReqHash cReq
            conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq cReqHash shortLink newXContactId (NewIncognito <$> incognitoProfile) Nothing subMode chatV pqSup
            void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing Nothing Nothing pqSup
            ct' <- withStore $ \db -> getContact db cxt user contactId
@@ -3939,7 +3941,7 @@ processChatCommand cxt nm = \case
        setMyAddressData' user' =
          withFastStore' (\db -> runExceptT $ getUserAddress db user) >>= \case
            Right ucl@UserContactLink {shortLinkDataSet}
-              | shortLinkDataSet -> void $ setMyAddressData user' ucl
+              | shortLinkDataSet -> void $ setMyAddressData False user' ucl
            _ -> pure ()
        sendUpdateToContacts :: User -> [Contact] -> CM UserProfileUpdateSummary
        sendUpdateToContacts user' contacts = do
@@ -3980,8 +3982,8 @@ processChatCommand cxt nm = \case
            ctMsgReq ChangedProfileContact {conn} =
              fmap $ \SndMessage {msgId, msgBody} ->
                (conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId]))
-    setMyAddressData :: User -> UserContactLink -> CM UserContactLink
-    setMyAddressData user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _, addressSettings} = do
+    setMyAddressData :: Bool -> User -> UserContactLink -> CM UserContactLink
+    setMyAddressData rotateKeys user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _, addressSettings} = do
      conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
      shortLinkProfile <- presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
      -- TODO [short links] do not save address to server if data did not change, spinners, error handling
@@ -3989,7 +3991,7 @@ processChatCommand cxt nm = \case
            | isTrue userChatRelay = relayShortLinkData shortLinkProfile
            | otherwise = contactShortLinkData shortLinkProfile $ Just addressSettings
          userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
-      sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData Nothing False (Just IKUsePQ))
+      sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData Nothing rotateKeys (Just IKUsePQ))
      withFastStore' $ \db -> setUserContactLinkShortLink db userContactLinkId sLnk
      let autoAccept' = (\aa -> aa {acceptIncognito = False}) <$> autoAccept addressSettings
          ucl' = (ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk), shortLinkDataSet = True, shortLinkLargeDataSet = BoolDef True, addressSettings = addressSettings {autoAccept = autoAccept'}}
@@ -5698,6 +5700,7 @@ chatCommandP =
      "/_show_address " *> (APIShowMyAddress <$> A.decimal),
      ("/show_address" <|> "/sa") $> ShowMyAddress,
      "/_short_link_address " *> (APIAddMyAddressShortLink <$> A.decimal),
+      "/_rotate_address_keys " *> (APIRotateAddressRatchetKeys <$> A.decimal),
      "/_profile_address " *> (APISetProfileAddress <$> A.decimal <* A.space <*> onOffP),
      ("/profile_address " <|> "/pa ") *> (SetProfileAddress <$> onOffP),
      "/_address_settings " *> (APISetAddressSettings <$> A.decimal <* A.space <*> jsonP),
@@ -276,6 +276,7 @@ mobileChatOpts dbOptions =
      optFilesFolder = Nothing,
      optTempDirectory = Nothing,
      showReactions = False,
+      showFullLinks = False,
      allowInstantFiles = True,
      autoAcceptFileSize = 0,
      muteNotifications = True,
@@ -46,6 +46,7 @@ data ChatOpts = ChatOpts
    optFilesFolder :: Maybe FilePath,
    optTempDirectory :: Maybe FilePath,
    showReactions :: Bool,
+    showFullLinks :: Bool,
    allowInstantFiles :: Bool,
    autoAcceptFileSize :: Integer,
    muteNotifications :: Bool,
@@ -418,6 +419,11 @@ chatOptsP appDir defaultDbName = do
      ( long "reactions"
          <> help "Show message reactions"
      )
+  showFullLinks <-
+    switch
+      ( long "show-full-links"
+          <> help "Log full connection links and addresses (by default only short links are logged)"
+      )
  allowInstantFiles <-
    switch
      ( long "allow-instant-files"
@@ -485,6 +491,7 @@ chatOptsP appDir defaultDbName = do
        optFilesFolder,
        optTempDirectory,
        showReactions,
+        showFullLinks,
        allowInstantFiles,
        autoAcceptFileSize,
        muteNotifications,
@@ -112,7 +112,7 @@ chatErrorToView :: Bool -> ChatConfig -> ChatError -> [StyledString]
 chatErrorToView isCmd ChatConfig {logLevel, testView} = viewChatError isCmd logLevel testView

 chatResponseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
-chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveItems ts tz outputRH = \case
+chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, showFullLinks, testView} liveItems ts tz outputRH = \case
  CRActiveUser User {profile = p@LocalProfile {localBadge}, uiThemes} -> viewUserProfile localBadge (fromLocalProfile p) <> viewUITheme uiThemes
  CRUsersList users -> viewUsersList users
  CRChatStarted -> ["chat started"]
@@ -179,7 +179,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
    HSDatabase -> databaseHelpInfo
  CRWelcome user -> chatWelcome user
  CRContactsList u cs -> ttyUser u $ viewContactsList cs
-  CRUserContactLink u UserContactLink {connLinkContact, addressSettings} -> ttyUser u $ connReqContact_ "Your chat address:" connLinkContact <> viewAddressSettings addressSettings
+  CRUserContactLink u UserContactLink {connLinkContact, addressSettings} -> ttyUser u $ connReqContact_ showFullLinks "Your chat address:" connLinkContact <> viewAddressSettings addressSettings
  CRUserContactLinkUpdated u UserContactLink {addressSettings} -> ttyUser u $ viewAddressSettings addressSettings
  CRContactRequestRejected u UserContactRequest {localDisplayName = c} _ct_ -> ttyUser u [ttyContact c <> ": contact request rejected"]
  CRGroupCreated u g -> ttyUser u $ viewGroupCreated g testView
@@ -201,9 +201,9 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
  CRUserProfileNoChange u -> ttyUser u ["user profile did not change"]
  CRUserPrivacy u u' -> ttyUserPrefix hu outputRH u $ viewUserPrivacy u u'
  CRVersionInfo info _ _ -> viewVersionInfo logLevel info
-  CRInvitation u ccLink _ -> ttyUser u $ viewConnReqInvitation ccLink
+  CRInvitation u ccLink _ -> ttyUser u $ viewConnReqInvitation showFullLinks ccLink
  CRConnectionIncognitoUpdated u c customUserProfile -> ttyUser u $ viewConnectionIncognitoUpdated c customUserProfile testView
-  CRConnectionUserChanged u c c' nu -> ttyUser u $ viewConnectionUserChanged u c nu c'
+  CRConnectionUserChanged u c c' nu -> ttyUser u $ viewConnectionUserChanged showFullLinks u c nu c'
  CRConnectionPlan u connLink _ otherSimplexName connectionPlan -> ttyUser u $ viewConnectionPlan cfg connLink connectionPlan <> otherSimplexNameNote otherSimplexName
  CRNewPreparedChat u (AChat _ (Chat cInfo _ _)) -> ttyUser u $ case cInfo of
    DirectChat ct -> [ttyContact' ct <> ": contact is prepared"]
@@ -221,7 +221,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
  CRChatCleared u chatInfo -> ttyUser u $ viewChatCleared chatInfo
  CRAcceptingContactRequest u c -> ttyUser u $ viewAcceptingContactRequest c
  CRContactAlreadyExists u c -> ttyUser u [ttyFullContact c <> ": contact already exists"]
-  CRUserContactLinkCreated u ccLink -> ttyUser u $ connReqContact_ "Your new chat address is created!" ccLink
+  CRUserContactLinkCreated u ccLink -> ttyUser u $ connReqContact_ showFullLinks "Your new chat address is created!" ccLink
  CRUserContactLinkDeleted u -> ttyUser u viewUserContactLinkDeleted
  CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
  CRUserDeletedMembers u g members wm signed -> case members of
@@ -260,8 +260,8 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
  CRGroupUpdated u g g' m signed -> ttyUser u $ viewGroupUpdated g g' m (if signed then Just MSSVerified else Nothing)
  CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
  CRGroupDescription u g -> ttyUser u $ viewGroupDescription g
-  CRGroupLinkCreated u g gLink -> ttyUser u $ groupLink_ "Group link is created!" g gLink
-  CRGroupLink u g gLink -> ttyUser u $ groupLink_ "Group link:" g gLink
+  CRGroupLinkCreated u g gLink -> ttyUser u $ groupLink_ showFullLinks "Group link is created!" g gLink
+  CRGroupLink u g gLink -> ttyUser u $ groupLink_ showFullLinks "Group link:" g gLink
  CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
  CRNewMemberContact u _ g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " is created"]
  CRNewMemberContactSentInv u _ct g m -> ttyUser u ["sent invitation to connect directly to member " <> ttyGroup' g <> " " <> ttyMember m]
@@ -1039,8 +1039,8 @@ viewInvalidConnReq =
    plain updateStr
  ]

-viewConnReqInvitation :: CreatedLinkInvitation -> [StyledString]
-viewConnReqInvitation (CCLink cReq shortLink) =
+viewConnReqInvitation :: Bool -> CreatedLinkInvitation -> [StyledString]
+viewConnReqInvitation showFullLinks (CCLink cReq shortLink) =
  [ "pass this invitation link to your contact (via another channel): ",
    "",
    plain $ maybe cReqStr strEncode shortLink,
@@ -1048,7 +1048,7 @@ viewConnReqInvitation (CCLink cReq shortLink) =
    "and ask them to connect: " <> highlight' "/c <invitation_link_above>"
  ]
    <>
-      if isJust shortLink
+      if showFullLinks && isJust shortLink
        then
          [ "The invitation link for old clients:",
            plain cReqStr
@@ -1111,8 +1111,8 @@ viewForwardPlan count itemIds = maybe [forwardCount] $ \fc -> [confirmation fc,
      | otherwise = plain $ show len <> " message(s) out of " <> show count <> " can be forwarded"
    len = length itemIds

-connReqContact_ :: StyledString -> CreatedLinkContact -> [StyledString]
-connReqContact_ intro (CCLink cReq shortLink) =
+connReqContact_ :: Bool -> StyledString -> CreatedLinkContact -> [StyledString]
+connReqContact_ showFullLinks intro (CCLink cReq shortLink) =
  [ intro,
    "",
    plain $ maybe cReqStr strEncode shortLink,
@@ -1122,7 +1122,7 @@ connReqContact_ intro (CCLink cReq shortLink) =
    "to share with your contacts: " <> highlight' "/profile_address on",
    "to delete it: " <> highlight' "/da" <> " (accepted contacts will remain connected)"
  ]
-    <> ["The contact link for old clients: " <> plain cReqStr | isJust shortLink]
+    <> ["The contact link for old clients: " <> plain cReqStr | showFullLinks, isJust shortLink]
  where
    cReqStr = strEncode $ simplexChatContact cReq

@@ -1172,8 +1172,8 @@ viewAddressSettings AddressSettings {businessAddress, autoAccept, autoReply} = c
        | otherwise = ""
  _ -> ["auto_accept off"]

-groupLink_ :: StyledString -> GroupInfo -> GroupLink -> [StyledString]
-groupLink_ intro g GroupLink {connLinkContact = CCLink cReq shortLink, acceptMemberRole} =
+groupLink_ :: Bool -> StyledString -> GroupInfo -> GroupLink -> [StyledString]
+groupLink_ showFullLinks intro g GroupLink {connLinkContact = CCLink cReq shortLink, acceptMemberRole} =
  [ intro,
    "",
    plain $ maybe cReqStr strEncode shortLink
@@ -1184,7 +1184,7 @@ groupLink_ intro g GroupLink {connLinkContact = CCLink cReq shortLink, acceptMem
         "to show it again: " <> highlight ("/show link #" <> viewGroupName g),
         "to delete it: " <> highlight ("/delete link #" <> viewGroupName g) <> " (joined members will remain connected to you)"
       ]
-    <> ["The group link for old clients: " <> plain cReqStr | isJust shortLink]
+    <> ["The group link for old clients: " <> plain cReqStr | showFullLinks, isJust shortLink]
  where
    cReqStr = strEncode $ simplexChatContact cReq

@@ -2116,8 +2116,8 @@ viewConnectionIncognitoUpdated PendingContactConnection {pccConnId, customUserPr
        Nothing -> ["unexpected response when changing connection, please report to developers"]
  | otherwise = ["connection " <> sShow pccConnId <> " changed to non incognito"]

-viewConnectionUserChanged :: User -> PendingContactConnection -> User -> PendingContactConnection -> [StyledString]
-viewConnectionUserChanged User {localDisplayName = n} PendingContactConnection {pccConnId} User {localDisplayName = n'} PendingContactConnection {connLinkInv = connLinkInv'} =
+viewConnectionUserChanged :: Bool -> User -> PendingContactConnection -> User -> PendingContactConnection -> [StyledString]
+viewConnectionUserChanged showFullLinks User {localDisplayName = n} PendingContactConnection {pccConnId} User {localDisplayName = n'} PendingContactConnection {connLinkInv = connLinkInv'} =
  case connLinkInv' of
    Just ccLink' -> [userChangedStr <> ", new link:"] <> newLink ccLink'
    _ -> [userChangedStr]
@@ -2129,7 +2129,7 @@ viewConnectionUserChanged User {localDisplayName = n} PendingContactConnection {
        ""
      ]
        <>
-          if isJust shortLink
+          if showFullLinks && isJust shortLink
            then
              [ "The invitation link for old clients:",
                plain cReqStr