Merge branch 'master' into f/public-groups

This commit is contained in:
spaced4ndy committed 2026-06-02 12:49:41 +04:00
commit aed17866cb
115 files changed
+4737 -1064

No files matched your search

+2
View File
@@ -1053,6 +1053,7 @@ data GroupLinkPlan
| GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
| GLPKnown {groupInfo :: GroupInfo, groupUpdated :: BoolDef, ownerVerification :: Maybe OwnerVerification, linkOwners :: ListDef GroupLinkOwner}
| GLPNoRelays {groupSLinkData_ :: Maybe GroupShortLinkData}
| GLPUpdateRequired {groupSLinkData_ :: Maybe GroupShortLinkData}
deriving (Show)
data GroupLinkOwner = GroupLinkOwner
@@ -1098,6 +1099,7 @@ connectionPlanProceed = \case
GLPOwnLink _ -> True
GLPConnectingConfirmReconnect -> True
GLPNoRelays _ -> False
GLPUpdateRequired _ -> False
_ -> False
CPError _ -> True
+41 -28
View File
@@ -2535,7 +2535,8 @@ processChatCommand vr nm = \case
-- generate owner key, OwnerAuth signed by root key
memberId <- MemberId <$> liftIO (encodedRandomBytes gVar 12)
(memberPrivKey, ownerAuth) <- liftIO $ SL.newOwnerAuth gVar (unMemberId memberId) rootPrivKey
let groupProfile' = (groupProfile :: GroupProfile) {publicGroup = Just PublicGroupProfile {groupType = GTChannel, groupLink = sLnk, publicGroupId = B64UrlByteString entityId}}
-- TODO [channel web] pass publicGroupAccess from owner's profile
let groupProfile' = (groupProfile :: GroupProfile) {publicGroup = Just PublicGroupProfile {groupType = GTChannel, groupLink = sLnk, publicGroupId = B64UrlByteString entityId, publicGroupAccess = Nothing}}
userData = encodeShortLinkData $ GroupShortLinkData {groupProfile = groupProfile', publicGroupData = Just (PublicGroupData 1)}
userLinkData = UserContactLinkData UserContactData {direct = False, owners = [ownerAuth], relays = [], userData}
-- create connection with prepared link (single network call)
@@ -2653,8 +2654,7 @@ processChatCommand vr nm = \case
Nothing -> throwChatError $ CEContactNotActive ct
APIAcceptMember groupId gmId role -> withUser $ \user@User {userId} -> do
(gInfo, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user gmId
-- TODO check that user's role is > role, possibly restrict role to only observer and member
assertUserGroupRole gInfo GRModerator
assertUserGroupRole gInfo $ max GRModerator role
case memberStatus m of
GSMemPendingApproval | memberCategory m == GCInviteeMember -> do -- only host can approve
let GroupInfo {groupProfile = GroupProfile {memberAdmission}} = gInfo
@@ -4149,21 +4149,25 @@ processChatCommand vr nm = \case
Nothing -> do
(fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays})) <- getShortLinkConnReq' nm user l'
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
if not direct && null relays
then pure (con (linkConnReq fd), CPGroupLink (GLPNoRelays groupSLinkData_))
else do
let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd
linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId}
let profilePGId = groupSLinkData_ >>= \GroupShortLinkData {groupProfile = GroupProfile {publicGroup}} ->
fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId) publicGroup
case (B64UrlByteString <$> linkEntityId, profilePGId) of
(Just entityId, Just publicGroupId) | entityId == publicGroupId -> pure ()
(Nothing, Nothing) -> pure ()
_ -> throwChatError CEInvalidConnReq
let ov = verifyLinkOwner rootKey owners l' sig_
plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov
pure (con cReq, plan)
if
| not direct && unsupportedGroupType groupSLinkData_ -> pure (con (linkConnReq fd), CPGroupLink (GLPUpdateRequired groupSLinkData_))
| not direct && null relays -> pure (con (linkConnReq fd), CPGroupLink (GLPNoRelays groupSLinkData_))
| otherwise -> do
let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd
linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId}
let profilePGId = groupSLinkData_ >>= \GroupShortLinkData {groupProfile = GroupProfile {publicGroup}} ->
fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId) publicGroup
case (B64UrlByteString <$> linkEntityId, profilePGId) of
(Just entityId, Just publicGroupId) | entityId == publicGroupId -> pure ()
(Nothing, Nothing) -> pure ()
_ -> throwChatError CEInvalidConnReq
let ov = verifyLinkOwner rootKey owners l' sig_
plan <- groupJoinRequestPlan user cReq (Just linkInfo) groupSLinkData_ ov
pure (con cReq, plan)
where
unsupportedGroupType = \case
Just GroupShortLinkData {groupProfile = GroupProfile {publicGroup = Just PublicGroupProfile {groupType}}} -> groupType /= GTChannel
_ -> False
knownLinkPlans = withFastStore $ \db ->
liftIO (getGroupInfoViaUserShortLink db vr user l') >>= \case
Just (cReq, g) -> pure $ Just (con cReq, CPGroupLink (GLPOwnLink g))
@@ -5563,7 +5567,8 @@ chatCommandP =
addressAA = AddressSettings False <$> (Just . AutoAccept <$> (" incognito=" *> onOffP <|> pure False)) <*> autoReply
businessAA = " business" *> (AddressSettings True (Just $ AutoAccept False) <$> autoReply)
autoReply = optional (A.space *> msgContentP)
rcCtrlAddressP = RCCtrlAddress <$> ("addr=" *> strP) <*> (" iface=" *> (jsonP <|> text1P))
rcCtrlAddressP = RCCtrlAddress <$> ("addr=" *> strP) <*> (" iface=" *> (quotedP <|> text1P))
quotedP = safeDecodeUtf8 <$> (A.char '"' *> A.takeTill (== '"') <* A.char '"')
text1P = safeDecodeUtf8 <$> A.takeTill (== ' ')
char_ = optional . A.char
@@ -5584,17 +5589,25 @@ mkValidName :: String -> String
mkValidName = dropWhileEnd isSpace . take 50 . reverse . fst3 . foldl' addChar ("", '\NUL', 0 :: Int)
where
fst3 (x, _, _) = x
addChar (r, prev, punct) c = if validChar then (c' : r, c', punct') else (r, prev, punct)
addChar (r, prev, punct) c' = if validChar then (c : r, c, punct') else (r, prev, punct)
where
c' = if isSpace c then ' ' else c
c = if isSpace c' then ' ' else c'
cat = generalCategory c
isPunct = case cat of
ConnectorPunctuation -> True
DashPunctuation -> True
OtherPunctuation -> True
_ -> False
punct'
| isPunctuation c = punct + 1
| isSpace c = punct
| isPunct = punct + 1
| c == ' ' = punct
| otherwise = 0
validChar
| c == '\'' = False
| prev == '\NUL' = c > ' ' && c /= '#' && c /= '@' && validFirstChar
| isSpace prev = validFirstChar || (punct == 0 && isPunctuation c)
| isPunctuation prev = validFirstChar || isSpace c || (punct < 3 && isPunctuation c)
| otherwise = validFirstChar || isSpace c || isMark c || isPunctuation c
validFirstChar = isLetter c || isNumber c || isSymbol c
| c `elem` prohibited = False
| prev == '\NUL' = c > ' ' && validFirstNameChar
| prev == ' ' = validFirstChar || (punct == 0 && isPunct)
| punct > 0 = validFirstChar || c == ' '
| otherwise = validFirstChar || c == ' ' || isMark c || isPunct
validFirstNameChar = isLetter c || cat == DecimalNumber || cat == OtherSymbol
validFirstChar = validFirstNameChar || cat == CurrencySymbol || cat == MathSymbol
prohibited = ".,;/\\#@'\"`~" :: String
+2 -1
View File
@@ -1045,7 +1045,8 @@ acceptRelayJoinRequestAsync
cReqInvId
cReqChatVRange
relayLink = do
let msg = XGrpRelayAcpt relayLink
-- TODO [channel web] derive RelayCapabilities from relay config (RelayWebOptions)
let msg = XGrpRelayAcpt relayLink defaultRelayCapabilities
subMode <- chatReadVar subscriptionMode
vr <- chatVersionRange
let chatV = vr `peerConnChatVersion` cReqChatVRange
+10 -2
View File
@@ -774,9 +774,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
allowAgentConnectionAsync user conn' confId XOk
| otherwise -> messageError "x.grp.acpt: memberId is different from expected"
XGrpRelayAcpt relayLink
XGrpRelayAcpt relayLink relayCap
| memberRole' membership == GROwner && isRelay m -> do
withStore' $ \db -> setRelayLinkConfId db m confId relayLink
withStore' $ \db -> do
setRelayLinkConfId db m confId relayLink
updateRelayCapabilities db m relayCap
void $ getAgentConnShortLinkAsync user CFGetRelayDataAccept (Just conn') relayLink
| otherwise -> messageError "x.grp.relay.acpt: only owner can add relay"
XGrpRelayReject reason
@@ -1045,6 +1047,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
XGrpLinkMem p -> Nothing <$ xGrpLinkMem gInfo' m'' conn' p
XGrpLinkAcpt acceptance role memberId -> Nothing <$ xGrpLinkAcpt gInfo' m'' acceptance role memberId msg brokerTs
XGrpRelayNew rl -> fmap ctx <$> xGrpRelayNew gInfo' m'' rl
XGrpRelayCap relayCap
| memberRole' membership == GROwner && isRelay m'' ->
Nothing <$ withStore' (\db -> updateRelayCapabilities db m'' relayCap)
| otherwise -> Nothing <$ messageWarning "x.grp.relay.cap: only owner should receive relay capabilities"
XGrpMemNew memInfo msgScope -> fmap ctx <$> xGrpMemNew gInfo' m'' memInfo msgScope msg brokerTs
XGrpMemIntro memInfo memRestrictions_ -> Nothing <$ xGrpMemIntro gInfo' m'' memInfo memRestrictions_
XGrpMemInv memId introInv -> Nothing <$ xGrpMemInv gInfo' m'' memId introInv
@@ -2617,6 +2623,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupAcceptance -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM ()
xGrpLinkAcpt gInfo@GroupInfo {membership} m acceptance role memberId msg brokerTs
| memberRole' m < GRModerator || memberRole' m < role =
messageError "x.grp.link.acpt with insufficient member permissions"
| sameMemberId memberId membership = processUserAccepted
| otherwise =
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case
+31 -11
View File
@@ -35,11 +35,11 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnReqUriData (..), ConnShortLink (..), ConnectionLink (..), ConnectionRequestUri (..), ContactConnType (..), SMPQueue (..), simplexConnReqUri, simplexShortLink)
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnReqUriData (..), ConnShortLink (..), ConnectionLink (..), ConnectionRequestUri (..), ContactConnType (..), SMPQueue (..), SimplexNameInfo (..), simplexConnReqUri, simplexShortLink)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fstToLower, sumTypeJSON)
import Simplex.Messaging.Protocol (ProtocolServer (..))
import Simplex.Messaging.Util (decodeJSON, safeDecodeUtf8, tshow)
import Simplex.Messaging.Util (decodeJSON, safeDecodeUtf8, tshow, (<$?>))
import System.Console.ANSI.Types
import qualified Text.Email.Validate as Email
import qualified URI.ByteString as U
@@ -59,6 +59,7 @@ data Format
-- showText is Nothing for the usual Uri without text
| HyperLink {showText :: Maybe Text, linkUri :: Text}
| SimplexLink {showText :: Maybe Text, linkType :: SimplexLinkType, simplexUri :: AConnectionLink, smpHosts :: NonEmpty Text}
| SimplexName {nameInfo :: SimplexNameInfo}
| Command {commandStr :: Text}
| Mention {memberName :: Text}
| Email
@@ -184,6 +185,7 @@ isLink = \case
Uri -> True
HyperLink {} -> True
SimplexLink {} -> True
SimplexName {} -> True
_ -> False
hasLinks :: MarkdownList -> Bool
@@ -202,9 +204,9 @@ markdownP = mconcat <$> A.many' fragmentP
'_' -> formattedP '_' Italic
'~' -> formattedP '~' StrikeThrough
'`' -> formattedP '`' Snippet
'#' -> A.char '#' *> secretP
'#' -> A.char '#' *> (secretP <|> nameRefP '#' <|> secretFallback)
'!' -> styledP <|> wordP
'@' -> mentionP <|> wordP
'@' -> (A.char '@' *> nameRefP '@') <|> mentionP <|> wordP
'/' -> commandP <|> wordP
'[' -> sowLinkP <|> wordP
_
@@ -221,14 +223,29 @@ markdownP = mconcat <$> A.many' fragmentP
unmarked $ c `T.cons` s `T.snoc` c
| otherwise = markdown f s
secretP :: Parser Markdown
secretP = secret <$> A.takeWhile (== '#') <*> A.takeTill (== '#') <*> A.takeWhile (== '#')
secret :: Text -> Text -> Text -> Markdown
secret b s a
| T.null a || T.null s || T.head s == ' ' || T.last s == ' ' =
unmarked $ '#' `T.cons` ss
| otherwise = markdown Secret $ T.init ss
secretP = secret <$?> ((,,) <$> A.takeWhile (== '#') <*> A.takeTill (== '#') <*> A.takeWhile1 (== '#'))
secret :: (Text, Text, Text) -> Either String Markdown
secret (b, s, a)
| T.null s || T.head s == ' ' || T.last s == ' ' = Left "not secret"
| otherwise = Right $ markdown Secret $ T.init ss
where
ss = b <> s <> a
secretFallback :: Parser Markdown
secretFallback = unmarked . ('#' `T.cons`) <$> A.takeTill (== ' ')
nameRefP :: Char -> Parser Markdown
nameRefP pfx = nameRef <$?> A.takeTill (== ' ')
where
nameRef word
| pfx == '@' && T.all (/= '.') name = Left "not a name"
| otherwise = mkMd <$> strDecode (encodeUtf8 full)
where
(name, punct) = splitPunctuation word
full = pfx `T.cons` name
mkMd ni
| T.null punct = md'
| otherwise = md' :|: unmarked punct
where
md' = markdown (SimplexName ni) full
styledP :: Parser Markdown
styledP = do
f <- A.char '!' *> ((A.char '-' $> Small) <|> (colored <$> colorP)) <* A.space
@@ -449,6 +466,7 @@ markdownText (FormattedText f_ t) = case f_ of
Uri -> t
HyperLink {} -> t
SimplexLink {} -> t
SimplexName {} -> t
Mention _ -> t
Command _ -> t
Email -> t
@@ -479,7 +497,6 @@ displayNameTextP_ = (,"") <$> quoted '\'' <|> splitPunctuation <$> takeNameTill
takeNameTill p =
A.peekChar' >>= \c ->
if refChar c then A.takeTill p else fail "invalid first character in display name"
splitPunctuation s = (T.dropWhileEnd isPunctuation s, T.takeWhileEnd isPunctuation s)
quoted c = A.char c *> takeNameTill (== c) <* A.char c
refChar c = c > ' ' && c /= '#' && c /= '@' && c /= '\''
@@ -490,6 +507,9 @@ commandTextP = do
(keyword : _) | T.all (\c -> isAlpha c || isDigit c || c == '_') keyword -> pure (cmd, punct)
_ -> fail "invalid command keyword"
splitPunctuation :: Text -> (Text, Text)
splitPunctuation s = (T.dropWhileEnd isPunctuation s, T.takeWhileEnd isPunctuation s)
-- quotes names that contain spaces or end on punctuation
viewName :: Text -> Text
viewName s = if T.any isSpace s || maybe False (isPunctuation . snd) (T.unsnoc s) then "'" <> s <> "'" else s
+3 -2
View File
@@ -46,7 +46,7 @@ import Data.Time (addUTCTime)
import Data.Time.Clock (UTCTime, nominalDay)
import Language.Haskell.TH.Syntax (lift)
import Simplex.Chat.Operators.Conditions
import Simplex.Chat.Protocol (RelayProfile (..))
import Simplex.Chat.Protocol (RelayCapabilities (..), RelayProfile (..))
import Simplex.Chat.Types (ShortLinkContact, User)
import Simplex.Chat.Types.Shared (RelayStatus)
import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..), ServerRoles (..), allRoles)
@@ -280,7 +280,8 @@ data GroupRelay = GroupRelay
groupMemberId :: Int64,
userChatRelay :: UserChatRelay,
relayStatus :: RelayStatus,
relayLink :: Maybe ShortLinkContact
relayLink :: Maybe ShortLinkContact,
relayCap :: RelayCapabilities
}
deriving (Eq, Show)
+25 -4
View File
@@ -262,6 +262,14 @@ data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknow
data ReportReason = RRSpam | RRContent | RRCommunity | RRProfile | RROther | RRUnknown Text
deriving (Eq, Show)
data RelayCapabilities = RelayCapabilities
{ webDomain :: Maybe Text
}
deriving (Eq, Show)
defaultRelayCapabilities :: RelayCapabilities
defaultRelayCapabilities = RelayCapabilities {webDomain = Nothing}
$(pure [])
instance FromJSON LinkContent where
@@ -281,6 +289,12 @@ instance ToJSON LinkContent where
$(JQ.deriveJSON defaultJSON ''LinkPreview)
$(JQ.deriveToJSON defaultJSON ''RelayCapabilities)
instance FromJSON RelayCapabilities where
parseJSON = $(JQ.mkParseJSON defaultJSON ''RelayCapabilities)
omittedField = Just defaultRelayCapabilities
instance StrEncoding ReportReason where
strEncode = \case
RRSpam -> "spam"
@@ -456,10 +470,11 @@ data ChatMsgEvent (e :: MsgEncoding) where
XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
XGrpLinkAcpt :: GroupAcceptance -> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json
XGrpRelayInv :: GroupRelayInvitation -> ChatMsgEvent 'Json
XGrpRelayAcpt :: ShortLinkContact -> ChatMsgEvent 'Json
XGrpRelayAcpt :: ShortLinkContact -> RelayCapabilities -> ChatMsgEvent 'Json
XGrpRelayTest :: ByteString -> Maybe ByteString -> ChatMsgEvent 'Json
XGrpRelayNew :: ShortLinkContact -> ChatMsgEvent 'Json
XGrpRelayReject :: RelayRejectionReason -> ChatMsgEvent 'Json
XGrpRelayCap :: RelayCapabilities -> ChatMsgEvent 'Json
XGrpMemNew :: MemberInfo -> Maybe MsgScope -> ChatMsgEvent 'Json
XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
@@ -1016,6 +1031,7 @@ data CMEventTag (e :: MsgEncoding) where
XGrpRelayTest_ :: CMEventTag 'Json
XGrpRelayNew_ :: CMEventTag 'Json
XGrpRelayReject_ :: CMEventTag 'Json
XGrpRelayCap_ :: CMEventTag 'Json
XGrpMemNew_ :: CMEventTag 'Json
XGrpMemIntro_ :: CMEventTag 'Json
XGrpMemInv_ :: CMEventTag 'Json
@@ -1076,6 +1092,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
XGrpRelayTest_ -> "x.grp.relay.test"
XGrpRelayNew_ -> "x.grp.relay.new"
XGrpRelayReject_ -> "x.grp.relay.reject"
XGrpRelayCap_ -> "x.grp.relay.cap"
XGrpMemNew_ -> "x.grp.mem.new"
XGrpMemIntro_ -> "x.grp.mem.intro"
XGrpMemInv_ -> "x.grp.mem.inv"
@@ -1137,6 +1154,7 @@ instance StrEncoding ACMEventTag where
"x.grp.relay.test" -> XGrpRelayTest_
"x.grp.relay.new" -> XGrpRelayNew_
"x.grp.relay.reject" -> XGrpRelayReject_
"x.grp.relay.cap" -> XGrpRelayCap_
"x.grp.mem.new" -> XGrpMemNew_
"x.grp.mem.intro" -> XGrpMemIntro_
"x.grp.mem.inv" -> XGrpMemInv_
@@ -1190,10 +1208,11 @@ toCMEventTag msg = case msg of
XGrpLinkMem _ -> XGrpLinkMem_
XGrpLinkAcpt {} -> XGrpLinkAcpt_
XGrpRelayInv _ -> XGrpRelayInv_
XGrpRelayAcpt _ -> XGrpRelayAcpt_
XGrpRelayAcpt {} -> XGrpRelayAcpt_
XGrpRelayTest {} -> XGrpRelayTest_
XGrpRelayNew _ -> XGrpRelayNew_
XGrpRelayReject _ -> XGrpRelayReject_
XGrpRelayCap _ -> XGrpRelayCap_
XGrpMemNew {} -> XGrpMemNew_
XGrpMemIntro _ _ -> XGrpMemIntro_
XGrpMemInv _ _ -> XGrpMemInv_
@@ -1346,7 +1365,8 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "acceptance" <*> p "role" <*> p "memberId"
XGrpRelayInv_ -> XGrpRelayInv <$> p "groupRelayInvitation"
XGrpRelayAcpt_ -> XGrpRelayAcpt <$> p "relayLink"
XGrpRelayAcpt_ -> XGrpRelayAcpt <$> p "relayLink" <*> (fromMaybe defaultRelayCapabilities <$> opt "relayCap")
XGrpRelayCap_ -> XGrpRelayCap <$> p "relayCap"
XGrpRelayTest_ -> do
B64UrlByteString challenge <- p "challenge"
sig_ <- fmap (\(B64UrlByteString s) -> s) <$> opt "signature"
@@ -1419,7 +1439,8 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en
XGrpLinkMem profile -> o ["profile" .= profile]
XGrpLinkAcpt acceptance role memberId -> o ["acceptance" .= acceptance, "role" .= role, "memberId" .= memberId]
XGrpRelayInv groupRelayInv -> o ["groupRelayInvitation" .= groupRelayInv]
XGrpRelayAcpt relayLink -> o ["relayLink" .= relayLink]
XGrpRelayAcpt relayLink relayCap -> o ["relayLink" .= relayLink, "relayCap" .= relayCap]
XGrpRelayCap relayCap -> o ["relayCap" .= relayCap]
XGrpRelayTest challenge sig_ -> o $
("signature" .=? (B64UrlByteString <$> sig_))
["challenge" .= B64UrlByteString challenge]
+1
View File
@@ -139,6 +139,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
+30 -11
View File
@@ -97,6 +97,7 @@ module Simplex.Chat.Store.Groups
updateRelayStatusFromTo,
setRelayLinkAccepted,
setRelayLinkConfId,
updateRelayCapabilities,
getRelayConfId,
updateRelayMemberData,
setGroupInProgressDone,
@@ -378,10 +379,11 @@ createNewGroup db vr user@User {userId} groupProfile incognitoProfile useRelays
INSERT INTO group_profiles
(display_name, full_name, short_descr, description, image,
group_type, group_link, public_group_id,
group_web_page, group_domain, domain_web_page, allow_embedding,
user_id, preferences, member_admission, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_)
((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. publicGroupAccessRow publicGroup
:. (userId, groupPreferences, memberAdmission, currentTs, currentTs))
profileId <- insertedRowId db
DB.execute
@@ -881,10 +883,11 @@ createGroup_ db userId groupProfile prepared business useRelays relayOwnStatus p
INSERT INTO group_profiles
(display_name, full_name, short_descr, description, image,
group_type, group_link, public_group_id,
group_web_page, group_domain, domain_web_page, allow_embedding,
user_id, preferences, member_admission, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_)
((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. publicGroupAccessRow publicGroup
:. (userId, groupPreferences, memberAdmission, currentTs, currentTs))
profileId <- insertedRowId db
DB.execute
@@ -1391,15 +1394,16 @@ groupRelayQuery =
[sql|
SELECT gr.group_relay_id, gr.group_member_id,
cr.chat_relay_id, cr.address, cr.display_name, cr.full_name, cr.short_descr, cr.image, cr.domains, cr.preset, cr.tested, cr.enabled, cr.deleted,
gr.relay_status, gr.relay_link
gr.relay_status, gr.relay_link, gr.base_web_url
FROM group_relays gr
JOIN chat_relays cr ON cr.chat_relay_id = gr.chat_relay_id
|]
toGroupRelay :: (Int64, GroupMemberId, DBEntityId, ShortLinkContact, Text, Text, Maybe Text, Maybe ImageData, Text, BoolInt) :. (Maybe BoolInt, BoolInt, BoolInt, RelayStatus, Maybe ShortLinkContact) -> GroupRelay
toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, fullName, shortDescr, image, domains, BI preset) :. (tested, BI enabled, BI deleted, relayStatus, relayLink)) =
toGroupRelay :: (Int64, GroupMemberId, DBEntityId, ShortLinkContact, Text, Text, Maybe Text, Maybe ImageData, Text, BoolInt) :. (Maybe BoolInt, BoolInt, BoolInt, RelayStatus, Maybe ShortLinkContact, Maybe Text) -> GroupRelay
toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, fullName, shortDescr, image, domains, BI preset) :. (tested, BI enabled, BI deleted, relayStatus, relayLink, webDomain)) =
let userChatRelay = UserChatRelay {chatRelayId, address, relayProfile = toRelayProfile (displayName, fullName, shortDescr, image), domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted}
in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink}
relayCap = RelayCapabilities {webDomain}
in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink, relayCap}
setGroupRosterVersion :: DB.Connection -> GroupInfo -> VersionRoster -> IO ()
setGroupRosterVersion db GroupInfo {groupId} v = do
@@ -1578,6 +1582,18 @@ setRelayLinkConfId db m confId relayLink = do
|]
(relayLink, currentTs, groupMemberId' m)
updateRelayCapabilities :: DB.Connection -> GroupMember -> RelayCapabilities -> IO ()
updateRelayCapabilities db m RelayCapabilities {webDomain} = do
currentTs <- getCurrentTime
DB.execute
db
[sql|
UPDATE group_relays
SET base_web_url = ?, updated_at = ?
WHERE group_member_id = ?
|]
(webDomain, currentTs, groupMemberId' m)
getRelayConfId :: DB.Connection -> GroupMember -> ExceptT StoreError IO ConfirmationId
getRelayConfId db m =
ExceptT . firstRow fromOnly (SEGroupRelayNotFoundByMemberId $ groupMemberId' m) $
@@ -2426,6 +2442,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
UPDATE group_profiles
SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?,
group_type = ?, group_link = ?,
group_web_page = ?, group_domain = ?, domain_web_page = ?, allow_embedding = ?,
preferences = ?, member_admission = ?, updated_at = ?
WHERE group_profile_id IN (
SELECT group_profile_id
@@ -2433,7 +2450,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
WHERE user_id = ? AND group_id = ?
)
|]
((newName, fullName, shortDescr, description, image, groupType_, groupLink_) :. (groupPreferences, memberAdmission, currentTs, userId, groupId))
((newName, fullName, shortDescr, description, image, groupType_, groupLink_) :. publicGroupAccessRow publicGroup :. (groupPreferences, memberAdmission, currentTs, userId, groupId))
updateGroup_ ldn currentTs = do
DB.execute
db
@@ -2473,14 +2490,16 @@ updateGroupProfileFromMember db user g@GroupInfo {groupId} Profile {displayName
[sql|
SELECT gp.display_name, gp.full_name, gp.short_descr, gp.description, gp.image,
gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
gp.preferences, gp.member_admission
FROM group_profiles gp
JOIN groups g ON gp.group_profile_id = g.group_profile_id
WHERE g.group_id = ?
|]
(Only groupId)
toGroupProfile (displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_, groupPreferences, memberAdmission) =
GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_, groupPreferences, memberAdmission}
toGroupProfile ((displayName, fullName, shortDescr, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (groupPreferences, memberAdmission)) =
let publicGroupAccess = toPublicGroupAccess accessRow
in GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ publicGroupAccess, groupPreferences, memberAdmission}
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
+10 -8
View File
@@ -31,10 +31,11 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260403_item_viewed
import Simplex.Chat.Store.Postgres.Migrations.M20260429_relay_request_retries
import Simplex.Chat.Store.Postgres.Migrations.M20260507_relay_inactive_at
import Simplex.Chat.Store.Postgres.Migrations.M20260514_relay_request_group_link_index
import Simplex.Chat.Store.Postgres.Migrations.M20260515_delivery_job_senders
import Simplex.Chat.Store.Postgres.Migrations.M20260520_client_services
import Simplex.Chat.Store.Postgres.Migrations.M20260525_member_removed_at
import Simplex.Chat.Store.Postgres.Migrations.M20260526_group_roster
import Simplex.Chat.Store.Postgres.Migrations.M20260515_public_group_access
import Simplex.Chat.Store.Postgres.Migrations.M20260529_delivery_job_senders
import Simplex.Chat.Store.Postgres.Migrations.M20260530_client_services
import Simplex.Chat.Store.Postgres.Migrations.M20260531_member_removed_at
import Simplex.Chat.Store.Postgres.Migrations.M20260601_group_roster
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
@@ -66,10 +67,11 @@ schemaMigrations =
("20260429_relay_request_retries", m20260429_relay_request_retries, Just down_m20260429_relay_request_retries),
("20260507_relay_inactive_at", m20260507_relay_inactive_at, Just down_m20260507_relay_inactive_at),
("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index),
("20260515_delivery_job_senders", m20260515_delivery_job_senders, Just down_m20260515_delivery_job_senders),
("20260520_client_services", m20260520_client_services, Just down_m20260520_client_services),
("20260525_member_removed_at", m20260525_member_removed_at, Just down_m20260525_member_removed_at),
("20260526_group_roster", m20260526_group_roster, Just down_m20260526_group_roster)
("20260515_public_group_access", m20260515_public_group_access, Just down_m20260515_public_group_access),
("20260529_delivery_job_senders", m20260529_delivery_job_senders, Just down_m20260529_delivery_job_senders),
("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),
("20260601_group_roster", m20260601_group_roster, Just down_m20260601_group_roster)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,29 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20260515_public_group_access where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20260515_public_group_access :: Text
m20260515_public_group_access =
[r|
ALTER TABLE group_profiles ADD COLUMN group_web_page TEXT;
ALTER TABLE group_profiles ADD COLUMN group_domain TEXT;
ALTER TABLE group_profiles ADD COLUMN domain_web_page BIGINT;
ALTER TABLE group_profiles ADD COLUMN allow_embedding BIGINT;
ALTER TABLE group_relays ADD COLUMN base_web_url TEXT;
|]
down_m20260515_public_group_access :: Text
down_m20260515_public_group_access =
[r|
ALTER TABLE group_relays DROP COLUMN base_web_url;
ALTER TABLE group_profiles DROP COLUMN allow_embedding;
ALTER TABLE group_profiles DROP COLUMN domain_web_page;
ALTER TABLE group_profiles DROP COLUMN group_domain;
ALTER TABLE group_profiles DROP COLUMN group_web_page;
|]
@@ -5,13 +5,13 @@
-- NULL means [] (sender-less jobs, e.g. DJRelayRemoved). One column carries
-- single- and multi-sender jobs uniformly; the per-job introduction bits live
-- in group_members.member_relations_vector (MRIntroduced).
module Simplex.Chat.Store.Postgres.Migrations.M20260515_delivery_job_senders where
module Simplex.Chat.Store.Postgres.Migrations.M20260529_delivery_job_senders where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20260515_delivery_job_senders :: Text
m20260515_delivery_job_senders =
m20260529_delivery_job_senders :: Text
m20260529_delivery_job_senders =
[r|
DROP INDEX idx_delivery_jobs_single_sender_group_member_id;
@@ -24,8 +24,8 @@ WHERE single_sender_group_member_id IS NOT NULL;
ALTER TABLE delivery_jobs DROP COLUMN single_sender_group_member_id;
|]
down_m20260515_delivery_job_senders :: Text
down_m20260515_delivery_job_senders =
down_m20260529_delivery_job_senders :: Text
down_m20260529_delivery_job_senders =
[r|
-- Pre-up the FK was ON DELETE CASCADE, so orphan delivery_jobs cannot
-- exist. After up the FK was dropped and orphans may accumulate. Drop
@@ -1,19 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20260520_client_services where
module Simplex.Chat.Store.Postgres.Migrations.M20260530_client_services where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20260520_client_services :: Text
m20260520_client_services =
m20260530_client_services :: Text
m20260530_client_services =
[r|
ALTER TABLE users ADD COLUMN client_service SMALLINT NOT NULL DEFAULT 0;
|]
down_m20260520_client_services :: Text
down_m20260520_client_services =
down_m20260530_client_services :: Text
down_m20260530_client_services =
[r|
ALTER TABLE users DROP COLUMN client_service;
|]
@@ -1,19 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20260525_member_removed_at where
module Simplex.Chat.Store.Postgres.Migrations.M20260531_member_removed_at where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20260525_member_removed_at :: Text
m20260525_member_removed_at =
m20260531_member_removed_at :: Text
m20260531_member_removed_at =
[r|
ALTER TABLE group_members ADD COLUMN removed_at TIMESTAMPTZ;
|]
down_m20260525_member_removed_at :: Text
down_m20260525_member_removed_at =
down_m20260531_member_removed_at :: Text
down_m20260531_member_removed_at =
[r|
ALTER TABLE group_members DROP COLUMN removed_at;
|]
@@ -1,13 +1,13 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20260526_group_roster where
module Simplex.Chat.Store.Postgres.Migrations.M20260601_group_roster where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20260526_group_roster :: Text
m20260526_group_roster =
m20260601_group_roster :: Text
m20260601_group_roster =
[r|
ALTER TABLE groups ADD COLUMN roster_version INTEGER;
ALTER TABLE groups ADD COLUMN roster_msg_body BYTEA;
@@ -17,8 +17,8 @@ ALTER TABLE groups ADD COLUMN roster_sending_owner_gm_id BIGINT;
ALTER TABLE groups ADD COLUMN roster_broker_ts TIMESTAMPTZ;
|]
down_m20260526_group_roster :: Text
down_m20260526_group_roster =
down_m20260601_group_roster :: Text
down_m20260601_group_roster =
[r|
ALTER TABLE groups DROP COLUMN roster_broker_ts;
ALTER TABLE groups DROP COLUMN roster_sending_owner_gm_id;
@@ -850,7 +850,11 @@ CREATE TABLE test_chat_schema.group_profiles (
short_descr text,
group_type text,
group_link bytea,
public_group_id bytea
public_group_id bytea,
group_web_page text,
group_domain text,
domain_web_page bigint,
allow_embedding bigint
);
@@ -875,7 +879,8 @@ CREATE TABLE test_chat_schema.group_relays (
relay_link bytea,
conf_id bytea,
created_at text DEFAULT now() NOT NULL,
updated_at text DEFAULT now() NOT NULL
updated_at text DEFAULT now() NOT NULL,
base_web_url text
);
@@ -963,7 +968,7 @@ CREATE TABLE test_chat_schema.groups (
public_member_count bigint,
relay_request_retries bigint DEFAULT 0 NOT NULL,
relay_request_delay bigint DEFAULT 0 NOT NULL,
relay_request_execute_at timestamp with time zone DEFAULT '1970-01-01 04:00:00+04'::timestamp with time zone NOT NULL,
relay_request_execute_at timestamp with time zone DEFAULT '1970-01-01 01:00:00+01'::timestamp with time zone NOT NULL,
relay_inactive_at timestamp with time zone,
roster_version integer,
roster_msg_body bytea,
+10 -8
View File
@@ -154,10 +154,11 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260403_item_viewed
import Simplex.Chat.Store.SQLite.Migrations.M20260429_relay_request_retries
import Simplex.Chat.Store.SQLite.Migrations.M20260507_relay_inactive_at
import Simplex.Chat.Store.SQLite.Migrations.M20260514_relay_request_group_link_index
import Simplex.Chat.Store.SQLite.Migrations.M20260515_delivery_job_senders
import Simplex.Chat.Store.SQLite.Migrations.M20260520_client_services
import Simplex.Chat.Store.SQLite.Migrations.M20260525_member_removed_at
import Simplex.Chat.Store.SQLite.Migrations.M20260526_group_roster
import Simplex.Chat.Store.SQLite.Migrations.M20260515_public_group_access
import Simplex.Chat.Store.SQLite.Migrations.M20260529_delivery_job_senders
import Simplex.Chat.Store.SQLite.Migrations.M20260530_client_services
import Simplex.Chat.Store.SQLite.Migrations.M20260531_member_removed_at
import Simplex.Chat.Store.SQLite.Migrations.M20260601_group_roster
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -312,10 +313,11 @@ schemaMigrations =
("20260429_relay_request_retries", m20260429_relay_request_retries, Just down_m20260429_relay_request_retries),
("20260507_relay_inactive_at", m20260507_relay_inactive_at, Just down_m20260507_relay_inactive_at),
("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index),
("20260515_delivery_job_senders", m20260515_delivery_job_senders, Just down_m20260515_delivery_job_senders),
("20260520_client_services", m20260520_client_services, Just down_m20260520_client_services),
("20260525_member_removed_at", m20260525_member_removed_at, Just down_m20260525_member_removed_at),
("20260526_group_roster", m20260526_group_roster, Just down_m20260526_group_roster)
("20260515_public_group_access", m20260515_public_group_access, Just down_m20260515_public_group_access),
("20260529_delivery_job_senders", m20260529_delivery_job_senders, Just down_m20260529_delivery_job_senders),
("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),
("20260601_group_roster", m20260601_group_roster, Just down_m20260601_group_roster)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,28 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20260515_public_group_access where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20260515_public_group_access :: Query
m20260515_public_group_access =
[sql|
ALTER TABLE group_profiles ADD COLUMN group_web_page TEXT;
ALTER TABLE group_profiles ADD COLUMN group_domain TEXT;
ALTER TABLE group_profiles ADD COLUMN domain_web_page INTEGER;
ALTER TABLE group_profiles ADD COLUMN allow_embedding INTEGER;
ALTER TABLE group_relays ADD COLUMN base_web_url TEXT;
|]
down_m20260515_public_group_access :: Query
down_m20260515_public_group_access =
[sql|
ALTER TABLE group_relays DROP COLUMN base_web_url;
ALTER TABLE group_profiles DROP COLUMN allow_embedding;
ALTER TABLE group_profiles DROP COLUMN domain_web_page;
ALTER TABLE group_profiles DROP COLUMN group_domain;
ALTER TABLE group_profiles DROP COLUMN group_web_page;
|]
@@ -4,13 +4,13 @@
-- NULL means [] (sender-less jobs, e.g. DJRelayRemoved). One column carries
-- single- and multi-sender jobs uniformly; the per-job introduction bits live
-- in group_members.member_relations_vector (MRIntroduced).
module Simplex.Chat.Store.SQLite.Migrations.M20260515_delivery_job_senders where
module Simplex.Chat.Store.SQLite.Migrations.M20260529_delivery_job_senders where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20260515_delivery_job_senders :: Query
m20260515_delivery_job_senders =
m20260529_delivery_job_senders :: Query
m20260529_delivery_job_senders =
[sql|
DROP INDEX idx_delivery_jobs_single_sender_group_member_id;
@@ -23,8 +23,8 @@ WHERE single_sender_group_member_id IS NOT NULL;
ALTER TABLE delivery_jobs DROP COLUMN single_sender_group_member_id;
|]
down_m20260515_delivery_job_senders :: Query
down_m20260515_delivery_job_senders =
down_m20260529_delivery_job_senders :: Query
down_m20260529_delivery_job_senders =
[sql|
-- Pre-up the FK was ON DELETE CASCADE, so orphan delivery_jobs cannot
-- exist. After up the FK was dropped and orphans may accumulate. Drop
@@ -1,18 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20260520_client_services where
module Simplex.Chat.Store.SQLite.Migrations.M20260530_client_services where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20260520_client_services :: Query
m20260520_client_services =
m20260530_client_services :: Query
m20260530_client_services =
[sql|
ALTER TABLE users ADD COLUMN client_service INTEGER NOT NULL DEFAULT 0;
|]
down_m20260520_client_services :: Query
down_m20260520_client_services =
down_m20260530_client_services :: Query
down_m20260530_client_services =
[sql|
ALTER TABLE users DROP COLUMN client_service;
|]
@@ -1,18 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20260525_member_removed_at where
module Simplex.Chat.Store.SQLite.Migrations.M20260531_member_removed_at where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20260525_member_removed_at :: Query
m20260525_member_removed_at =
m20260531_member_removed_at :: Query
m20260531_member_removed_at =
[sql|
ALTER TABLE group_members ADD COLUMN removed_at TEXT;
|]
down_m20260525_member_removed_at :: Query
down_m20260525_member_removed_at =
down_m20260531_member_removed_at :: Query
down_m20260531_member_removed_at =
[sql|
ALTER TABLE group_members DROP COLUMN removed_at;
|]
@@ -1,12 +1,12 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20260526_group_roster where
module Simplex.Chat.Store.SQLite.Migrations.M20260601_group_roster where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20260526_group_roster :: Query
m20260526_group_roster =
m20260601_group_roster :: Query
m20260601_group_roster =
[sql|
ALTER TABLE groups ADD COLUMN roster_version INTEGER;
ALTER TABLE groups ADD COLUMN roster_msg_body BLOB;
@@ -16,8 +16,8 @@ ALTER TABLE groups ADD COLUMN roster_sending_owner_gm_id INTEGER;
ALTER TABLE groups ADD COLUMN roster_broker_ts TEXT;
|]
down_m20260526_group_roster :: Query
down_m20260526_group_roster =
down_m20260601_group_roster :: Query
down_m20260601_group_roster =
[sql|
ALTER TABLE groups DROP COLUMN roster_broker_ts;
ALTER TABLE groups DROP COLUMN roster_sending_owner_gm_id;
@@ -141,6 +141,7 @@ Query:
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
@@ -970,6 +971,7 @@ SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_next (group_id=? A
Query:
SELECT gp.display_name, gp.full_name, gp.short_descr, gp.description, gp.image,
gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
gp.preferences, gp.member_admission
FROM group_profiles gp
JOIN groups g ON gp.group_profile_id = g.group_profile_id
@@ -1217,8 +1219,9 @@ Query:
INSERT INTO group_profiles
(display_name, full_name, short_descr, description, image,
group_type, group_link, public_group_id,
group_web_page, group_domain, domain_web_page, allow_embedding,
user_id, preferences, member_admission, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
@@ -1741,6 +1744,7 @@ Query:
UPDATE group_profiles
SET display_name = ?, full_name = ?, short_descr = ?, description = ?, image = ?,
group_type = ?, group_link = ?,
group_web_page = ?, group_domain = ?, domain_web_page = ?, allow_embedding = ?,
preferences = ?, member_admission = ?, updated_at = ?
WHERE group_profile_id IN (
SELECT group_profile_id
@@ -5120,6 +5124,14 @@ SEARCH group_profiles USING INTEGER PRIMARY KEY (rowid=?)
LIST SUBQUERY 1
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE group_relays
SET base_web_url = ?, updated_at = ?
WHERE group_member_id = ?
Plan:
SEARCH group_relays USING INDEX idx_group_relays_group_member_id (group_member_id=?)
Query:
UPDATE group_relays
SET conf_id = ?, relay_link = ?, updated_at = ?
@@ -5313,6 +5325,7 @@ Query:
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
@@ -5349,6 +5362,7 @@ Query:
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
@@ -5378,6 +5392,7 @@ Query:
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
@@ -5793,7 +5808,7 @@ SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)
Query:
SELECT gr.group_relay_id, gr.group_member_id,
cr.chat_relay_id, cr.address, cr.display_name, cr.full_name, cr.short_descr, cr.image, cr.domains, cr.preset, cr.tested, cr.enabled, cr.deleted,
gr.relay_status, gr.relay_link
gr.relay_status, gr.relay_link, gr.base_web_url
FROM group_relays gr
JOIN chat_relays cr ON cr.chat_relay_id = gr.chat_relay_id
@@ -5810,7 +5825,7 @@ SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT gr.group_relay_id, gr.group_member_id,
cr.chat_relay_id, cr.address, cr.display_name, cr.full_name, cr.short_descr, cr.image, cr.domains, cr.preset, cr.tested, cr.enabled, cr.deleted,
gr.relay_status, gr.relay_link
gr.relay_status, gr.relay_link, gr.base_web_url
FROM group_relays gr
JOIN chat_relays cr ON cr.chat_relay_id = gr.chat_relay_id
WHERE gr.group_id = ?
@@ -5821,7 +5836,7 @@ SEARCH cr USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT gr.group_relay_id, gr.group_member_id,
cr.chat_relay_id, cr.address, cr.display_name, cr.full_name, cr.short_descr, cr.image, cr.domains, cr.preset, cr.tested, cr.enabled, cr.deleted,
gr.relay_status, gr.relay_link
gr.relay_status, gr.relay_link, gr.base_web_url
FROM group_relays gr
JOIN chat_relays cr ON cr.chat_relay_id = gr.chat_relay_id
WHERE gr.group_member_id = ?
@@ -5832,7 +5847,7 @@ SEARCH cr USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT gr.group_relay_id, gr.group_member_id,
cr.chat_relay_id, cr.address, cr.display_name, cr.full_name, cr.short_descr, cr.image, cr.domains, cr.preset, cr.tested, cr.enabled, cr.deleted,
gr.relay_status, gr.relay_link
gr.relay_status, gr.relay_link, gr.base_web_url
FROM group_relays gr
JOIN chat_relays cr ON cr.chat_relay_id = gr.chat_relay_id
WHERE gr.group_relay_id = ?
@@ -126,7 +126,11 @@ CREATE TABLE group_profiles(
short_descr TEXT,
group_type TEXT,
group_link BLOB,
public_group_id BLOB
public_group_id BLOB,
group_web_page TEXT,
group_domain TEXT,
domain_web_page INTEGER,
allow_embedding INTEGER
) STRICT;
CREATE TABLE groups(
group_id INTEGER PRIMARY KEY, -- local group ID
@@ -787,6 +791,8 @@ CREATE TABLE group_relays(
conf_id BLOB,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
,
base_web_url TEXT
) STRICT;
CREATE INDEX contact_profiles_index ON contact_profiles(
display_name,
+25 -7
View File
@@ -665,18 +665,20 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member
type GroupKeysRow = (Maybe C.PrivateKeyEd25519, Maybe C.PublicKeyEd25519, Maybe C.PrivateKeyEd25519)
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe VersionRoster, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe VersionRoster, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow
type PublicGroupAccessRow = (Maybe Text, Maybe Text, Maybe BoolInt, Maybe BoolInt)
type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences)
toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_
publicGroup = toPublicGroupProfile groupType_ groupLink_ publicGroupId_ (toPublicGroupAccess accessRow)
groupKeys = toGroupKeys publicGroupId_ groupKeysRow
groupProfile = GroupProfile {displayName, fullName, shortDescr, description, image, publicGroup, groupPreferences, memberAdmission}
businessChat = toBusinessChatInfo businessRow
@@ -690,10 +692,25 @@ toPreparedGroup = \case
Just PreparedGroup {connLinkToConnect = CCLink fullLink shortLink_, connLinkPreparedConnection, connLinkStartedConnection, welcomeSharedMsgId, requestSharedMsgId}
_ -> Nothing
toPublicGroupProfile :: Maybe GroupType -> Maybe ShortLinkContact -> Maybe B64UrlByteString -> Maybe PublicGroupProfile
toPublicGroupProfile (Just groupType) (Just groupLink) (Just publicGroupId) =
Just PublicGroupProfile {groupType, groupLink, publicGroupId}
toPublicGroupProfile _ _ _ = Nothing
toPublicGroupProfile :: Maybe GroupType -> Maybe ShortLinkContact -> Maybe B64UrlByteString -> Maybe PublicGroupAccess -> Maybe PublicGroupProfile
toPublicGroupProfile (Just groupType) (Just groupLink) (Just publicGroupId) publicGroupAccess =
Just PublicGroupProfile {groupType, groupLink, publicGroupId, publicGroupAccess}
toPublicGroupProfile _ _ _ _ = Nothing
publicGroupAccessRow :: Maybe PublicGroupProfile -> PublicGroupAccessRow
publicGroupAccessRow pgp = case pgp >>= publicGroupAccess of
Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding} ->
(groupWebPage, groupDomain, Just (BI domainWebPage), Just (BI allowEmbedding))
Nothing -> (Nothing, Nothing, Nothing, Nothing)
toPublicGroupAccess :: PublicGroupAccessRow -> Maybe PublicGroupAccess
toPublicGroupAccess (groupWebPage, groupDomain, domainWebPage_, allowEmbedding_)
| isJust groupWebPage || isJust groupDomain || domainWebPage || allowEmbedding =
Just PublicGroupAccess {groupWebPage, groupDomain, domainWebPage, allowEmbedding}
| otherwise = Nothing
where
domainWebPage = maybe False unBI domainWebPage_
allowEmbedding = maybe False unBI allowEmbedding_
toGroupKeys :: Maybe B64UrlByteString -> GroupKeysRow -> Maybe GroupKeys
toGroupKeys (Just publicGroupId) (rootPrivKey_, rootPubKey_, Just memberPrivKey) =
@@ -760,6 +777,7 @@ groupInfoQueryFields =
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.short_descr, g.local_alias, gp.description, gp.image, gp.group_type, gp.group_link, gp.public_group_id,
gp.group_web_page, gp.group_domain, gp.domain_web_page, gp.allow_embedding,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
+1 -9
View File
@@ -8,7 +8,6 @@
module Simplex.Chat.Terminal where
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import qualified Data.List.NonEmpty as L
import Simplex.Chat (defaultChatConfig)
import Simplex.Chat.Controller
@@ -23,8 +22,6 @@ import Simplex.Chat.Terminal.Output
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
import Simplex.Messaging.Client (NetworkConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig)
import Simplex.Messaging.Util (raceAny_)
import System.Terminal (Key, Modifiers)
import UnliftIO.STM
#if !defined(dbPostgres)
import Control.Exception (handle, throwIO)
import qualified Data.ByteArray as BA
@@ -102,9 +99,4 @@ simplexChatTerminal cfg options t = run options
#endif
runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
runChatTerminal ct cc opts = do
keyQ <- newTQueueIO
raceAny_ [runKeyReader ct keyQ, runTerminalInput ct cc keyQ, runTerminalOutput ct cc opts, runInputLoop ct cc]
runKeyReader :: ChatTerminal -> TQueue (Key, Modifiers) -> IO ()
runKeyReader ct q = withChatTerm ct $ forever $ getKey >>= liftIO . atomically . writeTQueue q
runChatTerminal ct cc opts = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc opts, runInputLoop ct cc]
+7 -7
View File
@@ -152,14 +152,14 @@ sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do
let cmd = UpdateLiveMessage chatName chatItemId live $ T.pack sentMsg
execChatCommand' cmd 0 `runReaderT` cc
runTerminalInput :: ChatTerminal -> ChatController -> TQueue (Key, Modifiers) -> IO ()
runTerminalInput ct cc keyQ = do
updateInputView ct
receiveFromTTY keyQ cc ct
runTerminalInput :: ChatTerminal -> ChatController -> IO ()
runTerminalInput ct cc = withChatTerm ct $ do
updateInput ct
receiveFromTTY cc ct
receiveFromTTY :: TQueue (Key, Modifiers) -> ChatController -> ChatTerminal -> IO ()
receiveFromTTY keyQ cc@ChatController {inputQ, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState, activeTo} =
forever $ atomically (readTQueue keyQ) >>= processKey >> updateInputView ct
receiveFromTTY :: forall m. MonadTerminal m => ChatController -> ChatTerminal -> m ()
receiveFromTTY cc@ChatController {inputQ, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState, activeTo} =
forever $ getKey >>= liftIO . processKey >> withTermLock ct (updateInput ct)
where
processKey :: (Key, Modifiers) -> IO ()
processKey key = case key of
+12 -1
View File
@@ -796,10 +796,19 @@ instance FromField GroupType where fromField = fromTextField_ textDecode
instance ToField GroupType where toField = toField . textEncode
data PublicGroupAccess = PublicGroupAccess
{ groupWebPage :: Maybe Text,
groupDomain :: Maybe Text,
domainWebPage :: Bool,
allowEmbedding :: Bool
}
deriving (Eq, Show)
data PublicGroupProfile = PublicGroupProfile
{ groupType :: GroupType,
groupLink :: ShortLinkContact,
publicGroupId :: B64UrlByteString -- group identity = sha256(genesis root key), immutable
publicGroupId :: B64UrlByteString, -- group identity = sha256(genesis root key), immutable
publicGroupAccess :: Maybe PublicGroupAccess
}
deriving (Eq, Show)
@@ -2098,6 +2107,8 @@ instance ToJSON GroupType where
toJSON = textToJSON
toEncoding = textToEncoding
$(JQ.deriveJSON defaultJSON ''PublicGroupAccess)
$(JQ.deriveJSON defaultJSON ''PublicGroupProfile)
$(JQ.deriveJSON defaultJSON ''GroupProfile)
+1
View File
@@ -2150,6 +2150,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
]
knownGroup prepared = grpOrBizLink g <> ": known " <> prepared <> grpOrBiz g <> " " <> ttyGroup' g
GLPNoRelays _ -> [grpLink "channel has no active relays, please try to join later"]
GLPUpdateRequired _ -> [grpLink "this group requires a newer version of the app, please upgrade"]
where
connecting g = [grpOrBizLink g <> ": connecting to " <> grpOrBiz g <> " " <> ttyGroup' g]
grpLink = ("group link: " <>)