direct in group plan

This commit is contained in:
spaced4ndy
2025-11-06 15:29:31 +04:00
parent aa1db463cd
commit 8a19acda8b
7 changed files with 39 additions and 48 deletions

View File

@@ -990,7 +990,7 @@ data ContactAddressPlan
deriving (Show)
data GroupLinkPlan
= GLPOk {groupSLinkData_ :: Maybe GroupShortLinkData}
= GLPOk {direct :: Bool, groupSLinkData_ :: Maybe GroupShortLinkData}
| GLPOwnLink {groupInfo :: GroupInfo}
| GLPConnectingConfirmReconnect
| GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
@@ -1010,7 +1010,7 @@ connectionPlanProceed = \case
CAPContactViaAddress _ -> True
_ -> False
CPGroupLink glp -> case glp of
GLPOk _ -> True
GLPOk _direct _ -> True
GLPOwnLink _ -> True
GLPConnectingConfirmReconnect -> True
_ -> False

View File

@@ -3685,7 +3685,7 @@ processChatCommand vr nm = \case
Just r -> pure r
Nothing -> do
(cReq, cData) <- getShortLinkConnReq nm user l'
contactSLinkData_ <- liftIO $ decodeShortLinkData cData
contactSLinkData_ <- liftIO $ decodeLinkUserData cData
invitationReqAndPlan cReq (Just l') contactSLinkData_
where
knownLinkPlans l' = withFastStore $ \db -> do
@@ -3714,7 +3714,7 @@ processChatCommand vr nm = \case
withFastStore' (\db -> getContactWithoutConnViaShortAddress db vr user l') >>= \case
Just ct' | not (contactDeleted ct') -> pure (con cReq, CPContactAddress (CAPContactViaAddress ct'))
_ -> do
contactSLinkData_ <- liftIO $ decodeShortLinkData cData
contactSLinkData_ <- liftIO $ decodeLinkUserData cData
plan <- contactRequestPlan user cReq contactSLinkData_
pure (con cReq, plan)
where
@@ -3730,21 +3730,10 @@ processChatCommand vr nm = \case
Just r -> pure r
Nothing -> do
-- TODO [relays] member: connect to relays
-- TODO - get ContactLinkData.relays data
-- TODO - see decodeShortLinkData -> linkUserData', retrieve relays in addition to userData
-- TODO - if relay list is non-empty, connect to relays
-- TODO - or, base on group profile? add useRelays/group type to group link data? (e.g. "channel")
-- TODO note:
-- TODO this is Connection Plan api - we're not connecting here yet;
-- TODO options:
-- TODO - save relay links on prepared group record, connect to them in APIConnectPreparedGroup
-- TODO - only mark group as `useRelays`, repeat retrieving link data in APIConnectPreparedGroup
-- TODO retreiving relays at point of conenctions seems better, as arbitrary time
-- TODO can pass between creating prepared group from plan and connecting to it,
-- TODO during which relays can change.
(cReq, cData) <- getShortLinkConnReq nm user l'
groupSLinkData_ <- liftIO $ decodeShortLinkData cData
plan <- groupJoinRequestPlan user cReq groupSLinkData_
-- TODO - mark group as `useRelays`, repeat retrieving link data in APIConnectPreparedGroup
(cReq, cData@(ContactLinkData _ UserContactData {direct})) <- getShortLinkConnReq nm user l'
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
plan <- groupJoinRequestPlan user cReq direct groupSLinkData_
pure (con cReq, plan)
where
knownLinkPlans = withFastStore $ \db ->
@@ -3789,7 +3778,7 @@ processChatCommand vr nm = \case
groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
case groupLinkId of
Nothing -> contactRequestPlan user cReq Nothing
Just _ -> groupJoinRequestPlan user cReq Nothing
Just _ -> groupJoinRequestPlan user cReq True Nothing
contactRequestPlan :: User -> ConnReqContact -> Maybe ContactShortLinkData -> CM ConnectionPlan
contactRequestPlan user (CRContactUri crData) contactSLinkData_ = do
let cReqSchemas = contactCReqSchemas crData
@@ -3810,10 +3799,10 @@ processChatCommand vr nm = \case
| contactDeleted ct -> pure $ CPContactAddress (CAPOk contactSLinkData_)
| otherwise -> pure $ CPContactAddress (CAPKnown ct)
-- TODO [short links] RcvGroupMsgConnection branch is deprecated? (old group link protocol?)
Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo Nothing
Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo True Nothing
Just _ -> throwCmdError "found connection entity is not RcvDirectMsgConnection or RcvGroupMsgConnection"
groupJoinRequestPlan :: User -> ConnReqContact -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupJoinRequestPlan user (CRContactUri crData) groupSLinkData_ = do
groupJoinRequestPlan :: User -> ConnReqContact -> Bool -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupJoinRequestPlan user (CRContactUri crData) direct groupSLinkData_ = do
let cReqSchemas = contactCReqSchemas crData
cReqHashes = bimap contactCReqHash contactCReqHash cReqSchemas
withFastStore' (\db -> getGroupInfoByUserContactLinkConnReq db vr user cReqSchemas) >>= \case
@@ -3822,21 +3811,21 @@ processChatCommand vr nm = \case
connEnt_ <- withFastStore' $ \db -> getContactConnEntityByConnReqHash db vr user cReqHashes
gInfo_ <- withFastStore' $ \db -> getGroupInfoByGroupLinkHash db vr user cReqHashes
case (gInfo_, connEnt_) of
(Nothing, Nothing) -> pure $ CPGroupLink (GLPOk groupSLinkData_)
(Nothing, Nothing) -> pure $ CPGroupLink (GLPOk direct groupSLinkData_)
-- TODO [short links] RcvDirectMsgConnection branches are deprecated? (old group link protocol?)
(Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect
(Nothing, Just (RcvDirectMsgConnection _ (Just ct)))
| not (contactReady ct) && contactActive ct -> pure $ CPGroupLink (GLPConnectingProhibit gInfo_)
| otherwise -> pure $ CPGroupLink (GLPOk groupSLinkData_)
| otherwise -> pure $ CPGroupLink (GLPOk direct groupSLinkData_)
(Nothing, Just _) -> throwCmdError "found connection entity is not RcvDirectMsgConnection"
(Just gInfo, _) -> groupPlan gInfo groupSLinkData_
groupPlan :: GroupInfo -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupPlan gInfo@GroupInfo {membership} groupSLinkData_
(Just gInfo, _) -> groupPlan gInfo direct groupSLinkData_
groupPlan :: GroupInfo -> Bool -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupPlan gInfo@GroupInfo {membership} direct groupSLinkData_
| memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo)
| not (memberActive membership) && not (memberRemoved membership) =
pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo)
| memberActive membership = pure $ CPGroupLink (GLPKnown gInfo)
| otherwise = pure $ CPGroupLink (GLPOk groupSLinkData_)
| otherwise = pure $ CPGroupLink (GLPOk direct groupSLinkData_)
contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact)
contactCReqSchemas crData =
( CRContactUri crData {crScheme = SSSimplex},

View File

@@ -1287,8 +1287,8 @@ encodeShortLinkData d =
| otherwise = s
in UserLinkData s'
decodeShortLinkData :: J.FromJSON a => ConnLinkData c -> IO (Maybe a)
decodeShortLinkData cData
decodeLinkUserData :: J.FromJSON a => ConnLinkData c -> IO (Maybe a)
decodeLinkUserData cData
| B.null s = pure Nothing
| B.head s == 'X' = case Z1.decompress $ B.drop 1 s of
Z1.Error e -> Nothing <$ logError ("Error decompressing link data: " <> tshow e)

View File

@@ -1343,7 +1343,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- TODO [relays] relay: retrieve group link data asynchronously/add recovery
-- TODO - * duplicate requests can be deduplicated by group link
(_cReq, cData) <- getShortLinkConnReq NRMBackground user groupLink
(liftIO $ decodeShortLinkData cData) >>= \case
(liftIO $ decodeLinkUserData cData) >>= \case
Nothing -> messageError "relayContactRequest: no group link data"
Just (GroupShortLinkData gp) -> do
validateGroupProfile gp

View File

@@ -2013,7 +2013,9 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
| business -> ("business address: " <>)
_ -> ("contact address: " <>)
CPGroupLink glp -> case glp of
GLPOk groupSLinkData -> [grpLink "ok to connect"] <> [viewJSON groupSLinkData | testView]
GLPOk direct groupSLinkData ->
[grpLink $ if direct then "ok to connect directly" else "ok to connect via relays"]
<> [viewJSON groupSLinkData | testView]
GLPOwnLink g -> [grpLink "own link for group " <> ttyGroup' g]
GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
GLPConnectingProhibit Nothing -> [grpLink "connecting"]

View File

@@ -2442,12 +2442,12 @@ testPlanGroupLinkLeaveRejoin =
threadDelay 100000
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
_sLinkData <- getTermLine bob
let gLinkSchema2 = linkAnotherSchema gLink
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
_sLinkData <- getTermLine bob
bob ##> ("/c " <> gLink)
@@ -3478,7 +3478,7 @@ testPlanGroupLinkKnown =
gLink <- getGroupLink alice "team" GRMember True
bob ##> ("/_connect plan 1 " <> gLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
_sLinkData <- getTermLine bob
bob ##> ("/c " <> gLink)

View File

@@ -2956,7 +2956,7 @@ testShortLinkJoinGroup =
name <- userName cc
sName <- showName cc
cc ##> ("/_connect plan 1 " <> link)
cc <## "group link: ok to connect"
cc <## "group link: ok to connect directly"
_sLinkData <- getTermLine cc
cc ##> ("/c " <> link)
cc <## "connection request sent!"
@@ -3428,7 +3428,7 @@ testShortLinkPrepareGroup = testChat3 aliceProfile bobProfile cathProfile test
alice ##> "/create link #team"
(shortLink, fullLink) <- getGroupLinks alice "team" GRMember True
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData)
bob <## "#team: group is prepared"
@@ -3462,7 +3462,7 @@ testShortLinkPrepareGroup = testChat3 aliceProfile bobProfile cathProfile test
alice <## "#team: bob left the group"
cath <## "#team: bob left the group"
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
void $ getTermLine bob
testShortLinkPrepareGroupReject :: HasCallStack => TestParams -> IO ()
@@ -3473,7 +3473,7 @@ testShortLinkPrepareGroupReject = testChatCfg3 cfg aliceProfile bobProfile cathP
alice ##> "/create link #team"
(shortLink, fullLink) <- getGroupLinks alice "team" GRMember True
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData)
bob <## "#team: group is prepared"
@@ -3506,7 +3506,7 @@ testGroupShortLinkWelcome = testChat2 aliceProfile bobProfile test
alice ##> "/create link #team"
(shortLink, fullLink) <- getGroupLinks alice "team" GRMember True
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData)
bob <## "#team: group is prepared"
@@ -3539,7 +3539,7 @@ testShortLinkGroupRetry ps = testChatOpts2 opts' aliceProfile bobProfile test ps
alice ##> "/create link #team"
(shortLink, fullLink) <- getGroupLinks alice "team" GRMember True
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData)
bob <## "#team: group is prepared"
@@ -3754,7 +3754,7 @@ testShortLinkConnectPreparedGroupIncognito = testChat3 aliceProfile bobProfile c
alice ##> "/create link #team"
(shortLink, fullLink) <- getGroupLinks alice "team" GRMember True
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData)
bob <## "#team: group is prepared"
@@ -3798,7 +3798,7 @@ testShortLinkChangePreparedGroupUser = testChat3 aliceProfile bobProfile cathPro
showActiveUser bob "bob (Bob)"
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData)
bob <## "#team: group is prepared"
@@ -3854,7 +3854,7 @@ testShortLinkChangePreparedGroupUserDuplicate = testChat3 aliceProfile bobProfil
showActiveUser bob "robert"
bob ##> ("/_connect plan 2 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData1 <- getTermLine bob
bob ##> ("/_prepare group 2 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData1)
bob <## "#team: group is prepared"
@@ -3863,7 +3863,7 @@ testShortLinkChangePreparedGroupUserDuplicate = testChat3 aliceProfile bobProfil
showActiveUser bob "bob (Bob)"
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData2 <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData2)
bob <## "#team: group is prepared"
@@ -4126,7 +4126,7 @@ testShortLinkGroupChangeProfile = testChat3 aliceProfile bobProfile cathProfile
cath <## "changed to #club"
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData)
bob <## "#club: group is prepared"
@@ -4164,7 +4164,7 @@ testShortLinkGroupChangeProfileReceived = testChat3 aliceProfile bobProfile cath
alice <## "changed to #club"
bob ##> ("/_connect plan 1 " <> shortLink)
bob <## "group link: ok to connect"
bob <## "group link: ok to connect directly"
groupSLinkData <- getTermLine bob
bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData)
bob <## "#club: group is prepared"