mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-10-22 21:52:28 +00:00
Merge branch 'master' into f/public-groups
This commit is contained in:
commit
aed17866cb
115 files changed
+4737
-1064
No files matched your search
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
-5
@@ -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
|
||||
+5
-5
@@ -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;
|
||||
|]
|
||||
+5
-5
@@ -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;
|
||||
|]
|
||||
+5
-5
@@ -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,
|
||||
|
||||
@@ -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;
|
||||
|]
|
||||
+5
-5
@@ -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
|
||||
+5
-5
@@ -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;
|
||||
|]
|
||||
+5
-5
@@ -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;
|
||||
|]
|
||||
+5
-5
@@ -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,
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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]
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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: " <>)
|
||||
|
||||
Reference in new issue
Block a user