Merge branch 'master' into f/channel-commenter-role

src/Simplex/Chat/Library/Commands.hs

@@ -1919,7 +1919,7 @@ processChatCommand vr nm = \case
     where
       recreateConn user conn@PendingContactConnection {customUserProfileId, connLinkInv} newUser = do
         subMode <- chatReadVar subscriptionMode
-        let short = isJust $ connShortLink =<< connLinkInv
+        let short = isJust $ connShortLink' =<< connLinkInv
             userLinkData_
               | short = Just $ UserInvLinkData $ contactShortLinkData (userProfileDirect newUser Nothing Nothing True) Nothing
               | otherwise = Nothing
@@ -2060,7 +2060,7 @@ processChatCommand vr nm = \case
     case gInfo of
       GroupInfo {preparedGroup = Nothing} -> throwCmdError "group doesn't have link to connect"
       GroupInfo {useRelays = BoolDef True, preparedGroup = Just PreparedGroup {connLinkToConnect}} -> do
-        sLnk <- case toShortLinkContact connLinkToConnect of
+        sLnk <- case connShortLink' connLinkToConnect of
           Just sl -> pure sl
           Nothing -> throwChatError $ CEException "failed to retrieve relays: no short link"
         (FixedLinkData {linkConnReq = mainCReq@(CRContactUri crData), linkEntityId, rootKey}, cData@(ContactLinkData _ UserContactData {owners, relays})) <- getShortLinkConnReq nm user sLnk
@@ -2216,7 +2216,7 @@ processChatCommand vr nm = \case
     -- TODO [certs rcv]
     (connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a nm (aUserId user) True True SCMContact (Just userLinkData) Nothing IKPQOn subMode
     ccLink' <- shortenCreatedLink ccLink
-    let ccLink'' = if isTrue userChatRelay then createdRelayLink ccLink' else ccLink'
+    let ccLink'' = if isTrue userChatRelay then setShortLinkType CCTRelay ccLink' else ccLink'
     withFastStore $ \db -> createUserContactLink db user connId ccLink'' subMode
     pure $ CRUserContactLinkCreated user ccLink''
   CreateMyAddress -> withUser $ \User {userId} ->
@@ -2438,8 +2438,8 @@ processChatCommand vr nm = \case
             crClientData = encodeJSON $ CRDataGroup groupLinkId
         -- prepare link with entityId as linkEntityId (no server request)
         (ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True (Just crClientData)
-        ccLink' <- createdChannelLink <$> shortenCreatedLink ccLink
-        sLnk <- case toShortLinkContact ccLink' of
+        ccLink' <- setShortLinkType CCTChannel <$> shortenCreatedLink ccLink
+        sLnk <- case connShortLink' ccLink' of
           Just sl -> pure sl
           Nothing -> throwChatError $ CEException "failed to create relayed group link: no short link"
         -- generate owner key, OwnerAuth signed by root key
@@ -2910,7 +2910,7 @@ processChatCommand vr nm = \case
         crClientData = encodeJSON $ CRDataGroup groupLinkId
     -- TODO [certs rcv]
     (connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a nm (aUserId user) True True SCMContact (Just userLinkData) (Just crClientData) IKPQOff subMode
-    ccLink' <- createdGroupLink <$> shortenCreatedLink ccLink
+    ccLink' <- setShortLinkType CCTGroup <$> shortenCreatedLink ccLink
     gVar <- asks random
     gLink <- withFastStore $ \db -> createGroupLink db gVar user gInfo connId ccLink' groupLinkId mRole subMode
     pure $ CRGroupLinkCreated user gInfo gLink
@@ -4070,7 +4070,7 @@ processChatCommand vr nm = \case
       encodeShortLinkData $ RelayAddressLinkData {relayProfile = RelayProfile {displayName, fullName, shortDescr, image}}
     updatePCCShortLinkData :: PendingContactConnection -> Profile -> CM (Maybe ShortLinkInvitation)
     updatePCCShortLinkData conn@PendingContactConnection {connLinkInv} profile =
-      forM (connShortLink =<< connLinkInv) $ \_ -> do
+      forM (connShortLink' =<< connLinkInv) $ \_ -> do
         let userData = contactShortLinkData profile Nothing
             userLinkData = UserInvLinkData userData
         shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId' conn) SCMInvitation userLinkData Nothing)

src/Simplex/Chat/Library/Internal.hs

@@ -1302,8 +1302,8 @@ setGroupLinkData nm user gInfo gLink = do
   (conn, groupRelays) <- withFastStore $ \db ->
     (,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
   let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
-      tagShortLink = if useRelays' gInfo then toShortChannelLink else toShortGroupLink
-  sLnk <- shortenShortLink' . tagShortLink =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData (Just crClientData))
+      linkType = if useRelays' gInfo then CCTChannel else CCTGroup
+  sLnk <- shortenShortLink' . setShortLinkType_ linkType =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData (Just crClientData))
   withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk
 
 setGroupLinkDataAsync :: User -> GroupInfo -> GroupLink -> CM ()
@@ -1382,27 +1382,6 @@ shortenShortLink' l = (`shortenShortLink` l) <$> asks (shortLinkPresetServers .
 shortenCreatedLink :: CreatedConnLink m -> CM (CreatedConnLink m)
 shortenCreatedLink (CCLink cReq sLnk) = CCLink cReq <$> mapM shortenShortLink' sLnk
 
-createdGroupLink :: CreatedLinkContact -> CreatedLinkContact
-createdGroupLink (CCLink cReq shortLink) = CCLink cReq (toShortGroupLink <$> shortLink)
-
-toShortGroupLink :: ShortLinkContact -> ShortLinkContact
-toShortGroupLink (CSLContact sch _ srv k) = CSLContact sch CCTGroup srv k
-
-createdChannelLink :: CreatedLinkContact -> CreatedLinkContact
-createdChannelLink (CCLink cReq shortLink) = CCLink cReq (toShortChannelLink <$> shortLink)
-
-toShortChannelLink :: ShortLinkContact -> ShortLinkContact
-toShortChannelLink (CSLContact sch _ srv k) = CSLContact sch CCTChannel srv k
-
-createdRelayLink :: CreatedLinkContact -> CreatedLinkContact
-createdRelayLink (CCLink cReq shortLink) = CCLink cReq (toShortRelayLink <$> shortLink)
-
-toShortRelayLink :: ShortLinkContact -> ShortLinkContact
-toShortRelayLink (CSLContact sch _ srv k) = CSLContact sch CCTRelay srv k
-
-toShortLinkContact :: CreatedLinkContact -> Maybe ShortLinkContact
-toShortLinkContact (CCLink _cReq sLink) = sLink
-
 deleteGroupLink' :: User -> GroupInfo -> CM ()
 deleteGroupLink' user gInfo = do
   vr <- chatVersionRange

src/Simplex/Chat/Library/Subscriber.hs

@@ -3724,8 +3724,8 @@ runRelayRequestWorker a Worker {doWork} = do
                   let crClientData = encodeJSON $ CRDataGroup groupLinkId
                   -- prepare link with relayMemId as linkEntityId (no server request)
                   (ccLink, preparedParams) <- withAgent $ \a' -> prepareConnectionLink a' (aUserId user) sigKeys relayMemId True (Just crClientData)
-                  ccLink' <- createdGroupLink <$> shortenCreatedLink ccLink
-                  sLnk <- case toShortLinkContact ccLink' of
+                  ccLink' <- setShortLinkType CCTGroup <$> shortenCreatedLink ccLink
+                  sLnk <- case connShortLink' ccLink' of
                     Just sl -> pure sl
                     Nothing -> throwChatError $ CEException "failed to create relay link: no short link"
                   let userData = encodeShortLinkData $ RelayShortLinkData {relayProfile = fromLocalProfile p}

src/Simplex/Chat/Types.hs

@@ -52,7 +52,7 @@ import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
 import Simplex.FileTransfer.Description (FileDigest)
 import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
-import Simplex.Messaging.Agent.Protocol (ACorrId, ACreatedConnLink, AEventTag (..), AEvtTag (..), ConnId, ConnShortLink, ConnectionLink, ConnectionMode (..), ConnectionRequestUri, CreatedConnLink, InvitationId, SAEntity (..), UserId)
+import Simplex.Messaging.Agent.Protocol (ACorrId, ACreatedConnLink, AEventTag (..), AEvtTag (..), ConnId, ConnShortLink (..), ConnectionLink, ConnectionMode (..), ConnectionRequestUri, ContactConnType (..), CreatedConnLink (..), InvitationId, SAEntity (..), UserId)
 import Simplex.Messaging.Agent.Store.DB (Binary (..), blobFieldDecoder, fromTextField_)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
@@ -518,6 +518,18 @@ instance FromField BusinessChatType where fromField = fromTextField_ textDecode
 
 instance ToField BusinessChatType where toField = toField . textEncode
 
+class HasShortLink l where
+  connShortLink' :: l c -> Maybe (ConnShortLink c)
+
+instance HasShortLink CreatedConnLink where
+  connShortLink' (CCLink _ sl) = sl
+
+setShortLinkType :: ContactConnType -> CreatedLinkContact -> CreatedLinkContact
+setShortLinkType ct (CCLink cReq sl) = CCLink cReq (setShortLinkType_ ct <$> sl)
+
+setShortLinkType_ :: ContactConnType -> ShortLinkContact -> ShortLinkContact
+setShortLinkType_ ct (CSLContact sch _ srv k) = CSLContact sch ct srv k
+
 data PreparedGroup = PreparedGroup
   { connLinkToConnect :: CreatedLinkContact,
     connLinkPreparedConnection :: Bool,