List and set ntf servers

This commit is contained in:
sim
2025-05-29 15:02:52 +02:00
parent 1b75ca5258
commit 36739fdf04
3 changed files with 16 additions and 0 deletions

View File

@@ -350,6 +350,8 @@ data ChatCommand
| APISetConnectionAlias Int64 LocalAlias
| APISetUserUIThemes UserId (Maybe UIThemeEntityOverrides)
| APISetChatUIThemes ChatRef (Maybe UIThemeEntityOverrides)
| APIGetNtfServers
| APISetNtfServers [NtfServer]
| APIGetNtfToken
| APIRegisterToken DeviceToken NotificationsMode
| APIVerifyToken DeviceToken C.CbNonce ByteString
@@ -717,6 +719,7 @@ data ChatResponse
| CRNewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
| CRNewMemberContactSentInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
| CRCallInvitations {callInvitations :: [RcvCallInvitation]}
| CRNtfServers {ntfServers :: [NtfServer]}
| CRNtfTokenStatus {status :: NtfTknStatus}
| CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode, ntfServer :: NtfServer}
| CRNtfConns {ntfConns :: [NtfConn]}

View File

@@ -1304,6 +1304,8 @@ processChatCommand' vr = \case
liftIO $ setGroupUIThemes db user g uiThemes
ok user
_ -> throwCmdError "not supported"
APIGetNtfServers -> withUser $ \_ -> CRNtfServers <$> lift (withAgent' getNtfServers)
APISetNtfServers servers -> withUser $ \_ -> lift (withAgent' (`setNtfServers` servers)) >> ok_
APIGetNtfToken -> withUser' $ \_ -> crNtfToken <$> withAgent getNtfToken
APIRegisterToken token mode -> withUser $ \_ ->
CRNtfTokenStatus <$> withAgent (\a -> registerNtfToken a token mode)
@@ -4098,6 +4100,8 @@ chatCommandP =
"/_set prefs @" *> (APISetContactPrefs <$> A.decimal <* A.space <*> jsonP),
"/_set theme user " *> (APISetUserUIThemes <$> A.decimal <*> optional (A.space *> jsonP)),
"/_set theme " *> (APISetChatUIThemes <$> chatRefP <*> optional (A.space *> jsonP)),
"/_ntf servers" $> APIGetNtfServers,
"/_ntf servers " *> (APISetNtfServers . map SMP.protoServer <$> protocolServersP),
"/_ntf get" $> APIGetNtfToken,
"/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
"/_ntf verify " *> (APIVerifyToken <$> strP <* A.space <*> strP <* A.space <*> strP),

View File

@@ -235,6 +235,7 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, testView} liveIte
CRNewMemberContactSentInv u _ct g m -> ttyUser u ["sent invitation to connect directly to member " <> ttyGroup' g <> " " <> ttyMember m]
CRCallInvitations _ -> []
CRContactConnectionDeleted u PendingContactConnection {pccConnId} -> ttyUser u ["connection :" <> sShow pccConnId <> " deleted"]
CRNtfServers ntfServers -> viewNtfServers ntfServers
CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
CRNtfToken _ status mode srv -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode) <> ", server: " <> sShow srv]
CRNtfConns {ntfConns} -> map (\NtfConn {agentConnId, expectedMsg_} -> plain $ show agentConnId <> " " <> show expectedMsg_) ntfConns
@@ -2201,6 +2202,14 @@ viewVersionInfo logLevel CoreVersionInfo {version, simplexmqVersion, simplexmqCo
parens :: (IsString a, Semigroup a) => a -> a
parens s = " (" <> s <> ")"
viewNtfServers :: [SMP.NtfServer] -> [StyledString]
viewNtfServers = \case
[] -> ["No remote NTF server"]
s -> map viewNtfServer s
where
viewNtfServer s =
plain $ SMP.legacyStrEncodeServer s
viewRemoteHosts :: [RemoteHostInfo] -> [StyledString]
viewRemoteHosts = \case
[] -> ["No remote hosts"]