IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #196 from simplex-chat/v1

Browse Source 
v1
This commit is contained in:
Evgeny Poberezkin
2022-01-12 17:44:05 +00:00
committed by GitHub
parent 7498cd4432 a8faaef54e
commit 2b4bdf39fb
28 changed files with 1282 additions and 1157 deletions
Download Patch File Download Diff File Expand all files Collapse all files

132
README.md
View File

@@ -2,7 +2,7 @@
# SimpleX Chat
**The world's most private and secure chat** - open-source, decentralized, and without global identities of any kind.
SimpleX - the most private and secure open-source chat and applications platform - now with double-ratchet E2E encryption.
[![GitHub build](https://github.com/simplex-chat/simplex-chat/workflows/build/badge.svg)](https://github.com/simplex-chat/simplex-chat/actions?query=workflow%3Abuild)
[![GitHub downloads](https://img.shields.io/github/downloads/simplex-chat/simplex-chat/total)](https://github.com/simplex-chat/simplex-chat/releases)
@@ -10,13 +10,11 @@
[![Follow on Twitter](https://img.shields.io/twitter/follow/SimpleXChat?style=social)](https://twitter.com/simplexchat)
[![Join on Reddit](https://img.shields.io/reddit/subreddit-subscribers/SimpleXChat?style=social)](https://www.reddit.com/r/SimpleXChat)
SimpleX chat prototype is a thin terminal UI on top of [SimpleXMQ](https://github.com/simplex-chat/simplexmq) message broker that uses [SMP protocols](https://github.com/simplex-chat/simplexmq/blob/master/protocol). The motivation for SimpleX chat is [presented here](./simplex.md). See [simplex.chat](https://simplex.chat) website for chat demo and the explanations of the system and how SMP protocol works.
SimpleX Chat is a terminal (command line) UI using [SimpleXMQ](https://github.com/simplex-chat/simplexmq) message broker.
**NEW in v0.5.4: [messages persistence](#access-chat-history)**
See [SimpleX overview](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md) for more information on platform objectives and technical design.
**NEW in v0.5.0: [user contact addresses](#user-contact-addresses-alpha)**
**Please note**: v0.5.0 of SimpleX Chat works with the same database, but the connection links are not compatible with the prior versions - please ask all your contacts to upgrade!
**v1.0.0 is released: [read announcement here](https://github.com/simplex-chat/simplex-chat/blob/master/blog/20220112-simplex-chat-v1-released.md)**
### :zap: Quick installation
@@ -26,22 +24,6 @@ curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/inst
Once the chat client is installed, simply run `simplex-chat` from your terminal.
### :wave: Welcome
**We are building the world's most private and secure chat**. If you would like to support it, you can do so in the following ways:
- 🌟 **Star it on GitHub** - it helps us raise the visibility of the project.
- **Install the chat and try it out** - if you spot a bug, please [raise an issue](https://github.com/simplex-chat/simplex-chat/issues).
- :speech_balloon: **Spread the word** - terminal chat is an [early-stage product](#disclaimer) while we stabilize the protocol - you can invite your friends for some fun chat inside your terminal. We're using it right inside our IDEs as we are coding it 👨‍💻
- **Make a donation** via [opencollective](https://opencollective.com/simplex-chat) - every donation helps, however large or small!
- **Make a contribution to the project** - we're constantly moving the project forward and there are always lots of things to do!
We appreciate all the help from our contributors, thank you!
![simplex-chat](./images/connection.gif)
## Table of contents
@@ -52,7 +34,6 @@ We appreciate all the help from our contributors, thank you!
- [Installation](#🚀-installation)
- [Download chat client](#download-chat-client)
- [Linux and MacOS](#linux-and-macos)
- [Troubleshooting on Unix](#troubleshooting-on-unix)
- [Windows](#windows)
- [Build from source](#build-from-source)
- [Using Docker](#using-docker)
@@ -62,26 +43,26 @@ We appreciate all the help from our contributors, thank you!
- [How to use SimpleX chat](#how-to-use-simplex-chat)
- [Groups](#groups)
- [Sending files](#sending-files)
- [User contact addresses](#user-contact-addresses-alpha)
- [User contact addresses](#user-contact-addresses)
- [Access chat history](#access-chat-history)
- [Roadmap](#Roadmap)
- [License](#license)
## Disclaimer
This is WIP implementation of SimpleX Chat that implements a new network topology for asynchronous communication combining the advantages and avoiding the disadvantages of federated and P2P networks.
SimpleX Chat implements a new network topology for asynchronous communication combining the advantages and avoiding the disadvantages of federated and P2P networks.
If you expect software to be reliable most of the time, then this is probably not ready for you yet. We use it ourselves for terminal chat and it seems to work most of the time - we would really appreciate if you try SimpleX Chat and give us your feedback!
[SimpleXMQ security model](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md) had many improvements in v1.0.0; the implementation has not been audited yet.
> :warning: **Please note:** The main differentiation of SimpleX network is the approach to internet message routing rather than encryption; for that reason no sufficient attention was paid to either TCP transport level encryption or to E2E encryption protocols - they are implemented in an ad hoc way based on RSA and AES algorithms. See [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a) on TCP transport encryption protocol (AEAD-GCM scheme, with an AES key negotiation based on RSA key hash known to the client in advance) and [this section](https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption) on E2E encryption protocol (an ad hoc hybrid scheme a la PGP). These protocols will change in a consumer ready version to something more robust.
We use SimpleX Chat all the time, but you may find some bugs. We would really appreciate if you use it and let us know anything that needs to be fixed or improved.
## Network topology
SimpleX is a decentralized client-server network that uses redundant, disposable nodes to asynchronously pass messages via message queues, providing receiver and sender anonymity.
SimpleX is a client-server network that uses redundant, disposable nodes to asynchronously pass messages via message queues, providing receiver and sender anonymity.
Unlike P2P networks, all messages are passed through one or several (for redundancy) servers, that do not even need to have persistence (in fact, the current [SMP server implementation](https://github.com/simplex-chat/simplexmq#smp-server) uses in-memory message storage, persisting only the queue records) - it provides better metadata protection than P2P designs, as no global participant ID is required, and avoids many [problems of P2P networks](https://github.com/simplex-chat/simplex-chat/blob/master/simplex.md#comparison-with-p2p-messaging-protocols).
Unlike federated networks, the participating server nodes **do not have records of the users**, **do not communicate with each other**, **do not store messages** after they are delivered to the recipients, and there is no way to discover the full list of participating servers. SimpleX network avoids the problem of metadata visibility that federated networks suffer from and better protects the network, as servers do not communicate with each other. Each server node provides unidirectional "dumb pipes" to the users, that do authorization without authentication, having no knowledge of the the users or their contacts. Each queue is assigned two RSA keys - one for receiver and one for sender - and each queue access is authorized with a signature created using a respective key's private counterpart.
Unlike federated networks, the participating server nodes **do not have records of the users**, **do not communicate with each other**, **do not store messages** after they are delivered to the recipients, and there is no way to discover the full list of participating servers. SimpleX network avoids the problem of metadata visibility that federated networks have and better protects the network, as servers do not communicate with each other. Each server node provides unidirectional "dumb pipes" to the users, that do authorization without authentication, having no knowledge of the the users or their contacts. Each queue is assigned two Ed448 keys - one for receiver and one for sender - and each queue access is authorized with a signature created using a respective key's private counterpart.
The routing of messages relies on the knowledge of client devices how user contacts and groups map at any given moment of time to these disposable queues on server nodes.
@@ -95,13 +76,15 @@ The routing of messages relies on the knowledge of client devices how user conta
- Auto-populated recipient name - just type your messages to reply to the sender once the connection is established.
- Demo SMP servers available and pre-configured in the app - or you can [deploy your own server](https://github.com/simplex-chat/simplexmq#using-smp-server-and-smp-agent).
- No global identity or any names visible to the server(s), ensuring full privacy of your contacts and conversations.
- E2E encryption, with RSA public key that has to be passed out-of-band (see [How to use SimpleX chat](#how-to-use-simplex-chat)).
- Message signing and verification with automatically generated RSA keys.
- Two layers of E2E encryption (double-ratchet for duplex connections, using X3DH key agreement with ephemeral Curve448 keys, and NaCl crypto_box for SMP queues, using Curve25519 keys) and out-of-band passing of recipient keys (see [How to use SimpleX chat](#how-to-use-simplex-chat)).
- Message integrity validation (via including the digests of the previous messages).
- Authentication of each command/message by SMP servers with automatically generated RSA key pairs.
- TCP transport encryption using SMP transport protocol.
- Authentication of each command/message by SMP servers with automatically generated Ed448 keys.
- TLS 1.2 transport encryption.
- Additional encryption of messages from SMP server to recipient to reduce traffic correlation.
RSA keys are not used as identity, they are randomly generated for each contact.
Public keys involved in key exchange are not used as identity, they are randomly generated for each contact.
See [Encryption Primitives Used](https://github.com/simplex-chat/simplexmq/blob/master/protocol/overview-tjr.md#encryption-primitives-used) for technical details.
<a name="🚀-installation"></a>
@@ -134,30 +117,6 @@ mv <binary> ~/.local/bin/simplex-chat
On MacOS you also need to [allow Gatekeeper to run it](https://support.apple.com/en-us/HT202491).
##### Troubleshooting on Unix
If you get `simplex-chat: command not found` when executing the downloaded binary, you need to add the directory containing it to the [`PATH` variable](https://man7.org/linux/man-pages/man7/environ.7.html) (find "PATH" in page). To modify `PATH` for future sessions, put `PATH="$PATH:/path/to/dir"` in `~/.profile`, or in `~/.bash_profile` if that's what you have. See [this answer](https://unix.stackexchange.com/a/26059) for the detailed explanation on the appropriate place to define environment variables for `bash` and other shells.
For example, if you followed the previous instructions, open `~/.profile` for editing:
```sh
vi ~/.profile
```
And add the following line to the end:
```sh
PATH="$PATH:$HOME/.local/bin"
```
Note that this will not automatically update your `PATH` for the remainder of the session. To do this, you should run:
```sh
source ~/.profile
```
Or restart your terminal to start a new session.
#### Windows
```sh
@@ -198,9 +157,9 @@ $ stack install
### Running the chat client
To start the chat client, run `simplex-chat` from the terminal. If you get `simplex-chat: command not found`, see [Troubleshooting on Unix](#troubleshooting-on-unix).
To start the chat client, run `simplex-chat` from the terminal.
By default, app data directory is created in the home directory (`~/.simplex`, or `%APPDATA%/simplex` on Windows), and two SQLite database files `simplex.chat.db` and `simplex.agent.db` are initialized in it.
By default, app data directory is created in the home directory (`~/.simplex`, or `%APPDATA%/simplex` on Windows), and two SQLite database files `simplex_v1_chat.db` and `simplex_v1_agent.db` are initialized in it.
To specify a different file path prefix for the database files use `-d` command line option:
@@ -208,17 +167,17 @@ To specify a different file path prefix for the database files use `-d` command
$ simplex-chat -d alice
```
Running above, for example, would create `alice.chat.db` and `alice.agent.db` database files in current directory.
Running above, for example, would create `alice_v1_chat.db` and `alice_v1_agent.db` database files in current directory.
Default SMP servers are hosted on Linode (London, UK and Fremont, CA) - they are [pre-configured in the app](https://github.com/simplex-chat/simplex-chat/blob/master/src/Simplex/Chat/Options.hs#L40). Base-64 encoded string after server host is the transport key digest.
Three default SMP servers are hosted on Linode - they are [pre-configured in the app](https://github.com/simplex-chat/simplex-chat/blob/master/src/Simplex/Chat/Options.hs#L42).
If you deployed your own SMP server(s) you can configure client via `-s` option:
```shell
$ simplex-chat -s smp.example.com:5223#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8=
$ simplex-chat -s smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@smp.example.com
```
The base-64 encoded string in server address is the digest of RSA transport handshake key that the server will generate on the first run and output its digest.
Base64url encoded string preceding the server address is the server's online certificate fingerprint. It is generated on server initialization and validated by client during TLS handshake.
You can still talk to people using default or any other server - it only affects the location of the message queue when you initiate the connection (and the reply queue can be on another server, as set by the other party's client).
@@ -238,7 +197,7 @@ Once you've set up your local profile, enter `/c` (for `/connect`) to create a n
You are able to create multiple invitations by entering `/connect` multiple times and sending these invitations to the corresponding contacts you'd like to connect with.
The invitation has the format `smp::<server>::<queue_id>::<rsa_public_key_for_this_queue_only>`. The invitation can only be used once and even if this is intercepted, the attacker would not be able to use it to send you the messages via this queue once your contact confirms that the connection is established.
The invitation can only be used once and even if this is intercepted, the attacker would not be able to use it to send you the messages via this queue once your contact confirms that the connection is established. See agent protocol for explanation of [invitation format](https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#connection-request).
The contact who received the invitation should enter `/c <invitation>` to accept the connection. This establishes the connection, and both parties are notified.
@@ -262,7 +221,7 @@ You can send a file to your contact with `/f @<contact> <file_path>` - the recip
You can send files to a group with `/f #<group> <file_path>`.
### User contact addresses (alpha)
### User contact addresses
As an alternative to one-time invitation links, you can create a long-term address with `/ad` (for `/address`). The created address can then be shared via any channel, and used by other users as a link to make a contact request with `/c <user_contact_address>`.
@@ -272,47 +231,28 @@ User address is "long-term" in a sense that it is a multiple-use connection link
Use `/help address` for other commands.
> :warning: **Please note:** This is an "alpha" feature - at the moment there is nothing to prevent someone who has obtained this address from spamming you with connection requests; countermeasures will be added soon! (In the short term, you can simply delete the long-term address you created if it starts getting abused.)
![simplex-chat](./images/user-addresses.gif)
### Access chat history
SimpleX chat stores all your contacts and conversations in a local SQLite database, making it private and portable by design, owned and controlled by user.
You can view and search your chat history by querying your database:
You can view and search your chat history by querying your database. Run the below script to create message views in your database.
```
sqlite3 ~/.simplex/simplex.chat.db
```sh
curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/message_views.sql | sqlite3 ~/.simplex/simplex_v1_chat.db
```
Now you can run queries against `direct_messages`, `group_messages` and `all_messages` (or their simpler alternatives `direct_messages_plain`, `group_messages_plain` and `all_messages_plain`), for example:
Open SQLite Command Line Shell:
```sql
-- you can put these or your preferred settings into ~/.sqliterc to persist across sqlite3 client sessions
.mode column
.headers on
-- simple views into direct, group and all_messages with user's messages deduplicated for group and all_messages
-- only 'x.msg.new' ("new message") chat events - filters out service events
-- msg_sent is 0 for received, 1 for sent
select * from direct_messages_plain;
select * from group_messages_plain;
select * from all_messages_plain;
-- query other details of your chat history with regular SQL
select * from direct_messages where msg_sent = 1 and chat_msg_event = 'x.file'; -- files you offered for sending
select * from direct_messages where msg_sent = 0 and contact = 'catherine' and msg_body like '%cats%'; -- everything catherine sent related to cats
select * from group_messages where group_name = 'team' and contact = 'alice'; -- all correspondence with alice in #team
-- aggregate your chat data
select contact_or_group, num_messages from (
select contact as contact_or_group, count(1) as num_messages from direct_messages_plain group by contact
union
select group_name as contact_or_group, count(1) as num_messages from group_messages_plain group by group_name
) order by num_messages desc;
```sh
sqlite3 ~/.simplex/simplex_v1_chat.db
```
See [Message queries](./message_queries.md) for examples.
> **Please note:** SQLite foreign key constraints are disabled by default, and must be **[enabled separately for each database connection](https://sqlite.org/foreignkeys.html#fk_enable)**. The latter can be achieved by running `PRAGMA foreign_keys = ON;` command on an open database connection. By running data altering queries without enabling foreign keys prior to that, you may risk putting your database in an inconsistent state.
**Convenience queries**
Get all messages from today (`chat_dt` is in UTC):
@@ -327,8 +267,6 @@ Get overnight messages in the morning:
select * from all_messages_plain where chat_dt > datetime('now', '-15 hours') order by chat_dt;
```
> **Please note:** SQLite foreign key constraints are disabled by default, and must be **[enabled separately for each database connection](https://sqlite.org/foreignkeys.html#fk_enable)**. The latter can be achieved by running `PRAGMA foreign_keys = ON;` command on an open database connection. By running data altering queries without enabling foreign keys prior to that, you may risk putting your database in an inconsistent state.
## Roadmap
1. Mobile and desktop apps (in progress).

2
apps/simplex-chat/Main.hs
View File

@@ -22,6 +22,6 @@ welcomeGetOpts = do
appDir <- getAppUserDataDirectory "simplex"
opts@ChatOpts {dbFile} <- getChatOpts appDir
putStrLn $ "SimpleX Chat v" ++ versionNumber
putStrLn $ "db: " <> dbFile <> ".chat.db, " <> dbFile <> ".agent.db"
putStrLn $ "db: " <> dbFile <> "_chat.db, " <> dbFile <> "_agent.db"
putStrLn "type \"/help\" or \"/h\" for usage info"
pure opts

31
images/simplex-chat-logo.svg
View File

File diff suppressed because one or more lines are too long
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 83 KiB

After

Width:  |  Height:  |  Size: 82 KiB

78
install.sh
View File

@@ -1,7 +1,8 @@
set -eu
APP_NAME="simplex-chat"
TARGET_DIR="$HOME/.local/bin"
BIN_DIR="$HOME/.local/bin"
BIN_PATH="$BIN_DIR/$APP_NAME"
PLATFORM="$(uname)"
if [ $PLATFORM == "Darwin" ]; then
@@ -10,39 +11,88 @@ elif [ $PLATFORM == "Linux" ]; then
PLATFORM="ubuntu-20_04-x86-64"
else
echo "Scripted installation on your platform is not supported."
echo "See compiled binaries in the latest release: https://github.com/simplex-chat/simplex-chat/releases/latest"
echo "See compiled binaries in the latest release: https://github.com/$APP_NAME/$APP_NAME/releases/latest"
exit 1
fi
[ ! -d $TARGET_DIR ] && mkdir -p $TARGET_DIR
# / Prepare to upgrade from v0 to v1
# Determine path of chat binary
if [[ -n "$(which $APP_NAME)" ]]; then
binary=$(which $APP_NAME)
elif [[ -f "$BIN_PATH" ]]; then
binary=$BIN_PATH
else
binary=""
fi
# If chat binary not found, check v0 initial migration and offer to abort or continue
if [[ -z $binary ]]; then
agent_db="$HOME/.simplex/simplex.agent.db"
if [[ \
-f "$agent_db" && \
$(echo "select * from migrations;" | sqlite3 $agent_db | grep 20210101_initial) \
]]; then
echo "Warning: found SimpleX Chat database, the current version is not backwards compatible."
echo "If you continue, the current version will be installed as $APP_NAME with a clean database, the old database will be preserved."
while true; do
read -p "Please choose to (a)bort or (c)ontinue: " yn
case $yn in
[Aa]* ) exit 1 ;;
[Cc]* ) break ;;
* ) echo "Please answer 'a' or 'c'."
esac
done
fi
# If chat binary found, check version and offer to abort or continue, on continue rename chat binary
elif [[ ! $($binary -h | grep v1) ]]; then
echo "Warning: found a previous version of SimpleX Chat, the current version is not backwards compatible."
echo "If you continue, it will be renamed to $APP_NAME-v0, and the new version will be installed as $APP_NAME with a clean database."
while true; do
read -p "Please choose (a)bort or (c)ontinue: " yn
case $yn in
[Aa]* ) exit 1 ;;
[Cc]* )
binary_v0="$binary-v0"
mv ${binary} ${binary_v0}
echo "Renamed $binary into $binary_v0"
break
;;
* ) echo "Please answer 'a' or 'c'."
esac
done
fi
# Prepare to upgrade from v0 to v1 /
[ ! -d $BIN_DIR ] && mkdir -p $BIN_DIR
if [ -n "$(command -v curl)" ]; then
curl -L -o $TARGET_DIR/$APP_NAME "https://github.com/$APP_NAME/$APP_NAME/releases/latest/download/$APP_NAME-$PLATFORM"
curl -L -o $BIN_PATH "https://github.com/$APP_NAME/$APP_NAME/releases/latest/download/$APP_NAME-$PLATFORM"
elif [ -n "$(command -v wget)" ]; then
wget -O $TARGET_DIR/$APP_NAME "https://github.com/$APP_NAME/$APP_NAME/releases/latest/download/$APP_NAME-$PLATFORM"
wget -O $BIN_PATH "https://github.com/$APP_NAME/$APP_NAME/releases/latest/download/$APP_NAME-$PLATFORM"
else
echo "Cannot download simplex-chat - please install curl or wget"
echo "Cannot download $APP_NAME - please install curl or wget"
exit 1
fi
chmod +x $TARGET_DIR/$APP_NAME
chmod +x $BIN_PATH
echo "$APP_NAME installed sucesfully!"
if [ -z "$(command -v simplex-chat)" ]; then
if [ -z "$(command -v $APP_NAME)" ]; then
if [ -n "$($SHELL -c 'echo $ZSH_VERSION')" ]; then
SHELL_FILE="$HOME/.zshrc"
elif [ -n "$($SHELL -c 'echo $BASH_VERSION')" ]; then
SHELL_FILE="$HOME/.bashrc"
else
echo "Unknown shell - cannot add simplex-chat folder to PATH"
echo "Please add $TARGET_DIR to PATH variable"
echo "Or you can run simplex-chat via full path: $TARGET_DIR/simplex-chat"
echo "Unknown shell - cannot add $APP_NAME folder to PATH"
echo "Please add $BIN_DIR to PATH variable"
echo "Or you can run $APP_NAME via full path: $BIN_PATH"
fi
if [ -n "$SHELL_FILE" ]; then
echo "export PATH=\$PATH:$TARGET_DIR" >> $SHELL_FILE
echo "Source your $SHELL_FILE or open a new shell and type simplex-chat to run it"
echo "export PATH=\$PATH:$BIN_DIR" >> $SHELL_FILE
echo "Source your $SHELL_FILE or open a new shell and type $APP_NAME to run it"
fi
else
echo "Type simplex-chat in your terminal to run it"
echo "Type $APP_NAME in your terminal to run it"
fi

39
message_queries.md Normal file
View File

@@ -0,0 +1,39 @@
# Message queries
You can run queries against `direct_messages`, `group_messages` and `all_messages` (or their simpler alternatives `direct_messages_plain`, `group_messages_plain` and `all_messages_plain`), for example:
```sql
-- you can put these or your preferred settings into ~/.sqliterc
-- to persist across sqlite3 client sessions
.mode column
.headers on
.nullvalue NULL
-- simple views into direct, group and all_messages
-- with user's messages deduplicated for group and all_messages;
-- only 'x.msg.new' ("new message") chat events - filters out service events;
-- msg_sent is 0 for received, 1 for sent
select * from direct_messages_plain;
select * from group_messages_plain;
select * from all_messages_plain;
-- query other details of your chat history with regular SQL, for example:
-- files you offered for sending
select * from direct_messages where msg_sent = 1 and chat_msg_event = 'x.file';
-- everything catherine sent related to cats
select * from direct_messages where msg_sent = 0 and contact = 'catherine' and msg_body like '%cats%';
-- all correspondence with alice in #team
select * from group_messages where group_name = 'team' and contact = 'alice';
-- aggregate your chat data
select contact_or_group, num_messages from (
select
contact as contact_or_group, count(1) as num_messages
from direct_messages_plain group by contact
union
select
group_name as contact_or_group, count(1) as num_messages
from group_messages_plain group by group_name
)
order by num_messages desc;
```

110
message_views.sql Normal file
View File

@@ -0,0 +1,110 @@
CREATE VIEW direct_messages AS
SELECT
ct.local_display_name AS contact,
m.message_id AS message_id,
m.msg_sent AS msg_sent,
m.chat_msg_event AS chat_msg_event,
m.msg_body AS msg_body,
md.msg_delivery_id AS delivery_id,
datetime(md.chat_ts) AS chat_dt,
md.agent_msg_meta AS msg_meta,
mde.delivery_status AS delivery_status,
datetime(mde.created_at) AS delivery_status_dt
FROM messages m
JOIN msg_deliveries md ON md.message_id = m.message_id
JOIN (
SELECT msg_delivery_id, MAX(created_at) MaxDate
FROM msg_delivery_events
GROUP BY msg_delivery_id
) MaxDates ON MaxDates.msg_delivery_id = md.msg_delivery_id
JOIN msg_delivery_events mde ON mde.msg_delivery_id = MaxDates.msg_delivery_id
AND mde.created_at = MaxDates.MaxDate
JOIN connections c ON c.connection_id = md.connection_id
JOIN contacts ct ON ct.contact_id = c.contact_id
ORDER BY chat_dt DESC;
CREATE VIEW direct_messages_plain AS
SELECT
dm.contact AS contact,
dm.msg_sent AS msg_sent,
dm.msg_body AS msg_body,
dm.chat_dt AS chat_dt
FROM direct_messages dm
WHERE dm.chat_msg_event = 'x.msg.new';
CREATE VIEW group_messages AS
SELECT
g.local_display_name AS group_name,
gm.local_display_name AS contact,
m.message_id AS message_id,
m.msg_sent AS msg_sent,
m.chat_msg_event AS chat_msg_event,
m.msg_body AS msg_body,
md.msg_delivery_id AS delivery_id,
datetime(md.chat_ts) AS chat_dt,
md.agent_msg_meta AS msg_meta,
mde.delivery_status AS delivery_status,
datetime(mde.created_at) AS delivery_status_dt
FROM messages m
JOIN msg_deliveries md ON md.message_id = m.message_id
JOIN (
SELECT msg_delivery_id, MAX(created_at) MaxDate
FROM msg_delivery_events
GROUP BY msg_delivery_id
) MaxDates ON MaxDates.msg_delivery_id = md.msg_delivery_id
JOIN msg_delivery_events mde ON mde.msg_delivery_id = MaxDates.msg_delivery_id
AND mde.created_at = MaxDates.MaxDate
JOIN connections c ON c.connection_id = md.connection_id
JOIN group_members gm ON gm.group_member_id = c.group_member_id
JOIN groups g ON g.group_id = gm.group_id
ORDER BY chat_dt DESC;
CREATE VIEW group_messages_plain AS
SELECT
gm.group_name AS group_name,
(CASE WHEN gm.msg_sent = 0 THEN gm.contact ELSE gm.group_name END) AS contact,
gm.msg_sent AS msg_sent,
gm.msg_body AS msg_body,
gm.chat_dt AS chat_dt
FROM group_messages gm
JOIN (
SELECT message_id, MIN(delivery_id) MinDeliveryId
FROM group_messages
GROUP BY message_id
) Deduplicated ON Deduplicated.message_id = gm.message_id
AND Deduplicated.MinDeliveryId = gm.delivery_id
WHERE gm.chat_msg_event = 'x.msg.new';
CREATE VIEW all_messages (
group_name,
contact,
message_id,
msg_sent,
chat_msg_event,
msg_body,
delivery_id,
chat_dt,
msg_meta,
delivery_status,
delivery_status_dt
) AS
SELECT * FROM (
SELECT NULL AS group_name, * FROM direct_messages
UNION
SELECT * FROM group_messages
)
ORDER BY chat_dt DESC;
CREATE VIEW all_messages_plain (
group_name,
contact,
msg_sent,
msg_body,
chat_dt
) AS
SELECT * FROM (
SELECT NULL AS group_name, * FROM direct_messages_plain
UNION
SELECT * FROM group_messages_plain
)
ORDER BY chat_dt DESC;

29
migrations/20211205_user_contacts.sql
View File

@@ -1,29 +0,0 @@
CREATE TABLE user_contact_links (
user_contact_link_id INTEGER PRIMARY KEY,
conn_req_contact BLOB NOT NULL,
local_display_name TEXT NOT NULL DEFAULT '',
created_at TEXT NOT NULL DEFAULT (datetime('now')),
user_id INTEGER NOT NULL REFERENCES users,
UNIQUE (user_id, local_display_name)
);
CREATE TABLE contact_requests (
contact_request_id INTEGER PRIMARY KEY,
user_contact_link_id INTEGER NOT NULL REFERENCES user_contact_links
ON UPDATE CASCADE ON DELETE CASCADE,
agent_invitation_id BLOB NOT NULL,
contact_profile_id INTEGER REFERENCES contact_profiles
DEFERRABLE INITIALLY DEFERRED, -- NULL if it's an incognito profile
local_display_name TEXT NOT NULL,
created_at TEXT NOT NULL DEFAULT (datetime('now')),
user_id INTEGER NOT NULL REFERENCES users,
FOREIGN KEY (user_id, local_display_name)
REFERENCES display_names (user_id, local_display_name)
ON UPDATE CASCADE
DEFERRABLE INITIALLY DEFERRED,
UNIQUE (user_id, local_display_name),
UNIQUE (user_id, contact_profile_id)
);
ALTER TABLE connections ADD user_contact_link_id INTEGER
REFERENCES user_contact_links ON DELETE RESTRICT;

200
migrations/20211229_messages.sql
View File

@@ -1,200 +0,0 @@
DROP TABLE event_body_parts;
DROP TABLE contact_profile_events;
DROP TABLE group_profile_events;
DROP TABLE group_event_parents;
DROP TABLE group_events;
DROP TABLE message_events;
DROP TABLE message_content;
DROP TABLE events;
DROP TABLE messages;
-- all message events as received or sent, append only
-- maps to message deliveries as one-to-many for group messages
CREATE TABLE messages (
message_id INTEGER PRIMARY KEY,
msg_sent INTEGER NOT NULL, -- 0 for received, 1 for sent
chat_msg_event TEXT NOT NULL, -- message event type (the constructor of ChatMsgEvent)
msg_body BLOB, -- agent message body as received or sent
created_at TEXT NOT NULL DEFAULT (datetime('now'))
);
-- message deliveries communicated with the agent, append only
CREATE TABLE msg_deliveries (
msg_delivery_id INTEGER PRIMARY KEY,
message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
agent_msg_id INTEGER, -- internal agent message ID (NULL while pending)
agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
chat_ts TEXT NOT NULL DEFAULT (datetime('now')), -- broker_ts for received, created_at for sent
UNIQUE (connection_id, agent_msg_id)
);
-- TODO recovery for received messages with "rcv_agent" status - acknowledge to agent
-- changes of messagy delivery status, append only
CREATE TABLE msg_delivery_events (
msg_delivery_event_id INTEGER PRIMARY KEY,
msg_delivery_id INTEGER NOT NULL REFERENCES msg_deliveries ON DELETE CASCADE, -- non UNIQUE for multiple events per msg delivery
delivery_status TEXT NOT NULL, -- see MsgDeliveryStatus for allowed values
created_at TEXT NOT NULL DEFAULT (datetime('now')),
UNIQUE (msg_delivery_id, delivery_status)
);
CREATE VIEW direct_messages AS
SELECT
ct.local_display_name AS contact,
m.message_id AS message_id,
m.msg_sent AS msg_sent,
m.chat_msg_event AS chat_msg_event,
m.msg_body AS msg_body,
md.msg_delivery_id AS delivery_id,
datetime(md.chat_ts) AS chat_dt,
md.agent_msg_meta AS msg_meta,
mde.delivery_status AS delivery_status,
datetime(mde.created_at) AS delivery_status_dt
FROM messages m
JOIN msg_deliveries md ON md.message_id = m.message_id
JOIN (
SELECT msg_delivery_id, MAX(created_at) MaxDate
FROM msg_delivery_events
GROUP BY msg_delivery_id
) MaxDates ON MaxDates.msg_delivery_id = md.msg_delivery_id
JOIN msg_delivery_events mde ON mde.msg_delivery_id = MaxDates.msg_delivery_id
AND mde.created_at = MaxDates.MaxDate
JOIN connections c ON c.connection_id = md.connection_id
JOIN contacts ct ON ct.contact_id = c.contact_id
ORDER BY chat_dt DESC;
CREATE VIEW direct_messages_plain AS
SELECT
dm.contact AS contact,
dm.msg_sent AS msg_sent,
dm.msg_body AS msg_body,
dm.chat_dt AS chat_dt
FROM direct_messages dm
WHERE dm.chat_msg_event = 'x.msg.new';
CREATE VIEW group_messages AS
SELECT
g.local_display_name AS group_name,
gm.local_display_name AS contact,
m.message_id AS message_id,
m.msg_sent AS msg_sent,
m.chat_msg_event AS chat_msg_event,
m.msg_body AS msg_body,
md.msg_delivery_id AS delivery_id,
datetime(md.chat_ts) AS chat_dt,
md.agent_msg_meta AS msg_meta,
mde.delivery_status AS delivery_status,
datetime(mde.created_at) AS delivery_status_dt
FROM messages m
JOIN msg_deliveries md ON md.message_id = m.message_id
JOIN (
SELECT msg_delivery_id, MAX(created_at) MaxDate
FROM msg_delivery_events
GROUP BY msg_delivery_id
) MaxDates ON MaxDates.msg_delivery_id = md.msg_delivery_id
JOIN msg_delivery_events mde ON mde.msg_delivery_id = MaxDates.msg_delivery_id
AND mde.created_at = MaxDates.MaxDate
JOIN connections c ON c.connection_id = md.connection_id
JOIN group_members gm ON gm.group_member_id = c.group_member_id
JOIN groups g ON g.group_id = gm.group_id
ORDER BY chat_dt DESC;
CREATE VIEW group_messages_plain AS
SELECT
gm.group_name AS group_name,
(CASE WHEN gm.msg_sent = 0 THEN gm.contact ELSE gm.group_name END) AS contact,
gm.msg_sent AS msg_sent,
gm.msg_body AS msg_body,
gm.chat_dt AS chat_dt
FROM group_messages gm
JOIN (
SELECT message_id, MIN(delivery_id) MinDeliveryId
FROM group_messages
GROUP BY message_id
) Deduplicated ON Deduplicated.message_id = gm.message_id
AND Deduplicated.MinDeliveryId = gm.delivery_id
WHERE gm.chat_msg_event = 'x.msg.new';
CREATE VIEW all_messages (
group_name,
contact,
message_id,
msg_sent,
chat_msg_event,
msg_body,
delivery_id,
chat_dt,
msg_meta,
delivery_status,
delivery_status_dt
) AS
SELECT * FROM (
SELECT NULL AS group_name, * FROM direct_messages
UNION
SELECT * FROM group_messages
)
ORDER BY chat_dt DESC;
CREATE VIEW all_messages_plain (
group_name,
contact,
msg_sent,
msg_body,
chat_dt
) AS
SELECT * FROM (
SELECT NULL AS group_name, * FROM direct_messages_plain
UNION
SELECT * FROM group_messages_plain
)
ORDER BY chat_dt DESC;
-- TODO group message parents and chat items not to be implemented in current scope
-- CREATE TABLE group_message_parents (
-- group_message_parent_id INTEGER PRIMARY KEY,
-- message_id INTEGER NOT NULL REFERENCES group_messages (event_id),
-- parent_group_member_id INTEGER REFERENCES group_members (group_member_id), -- can be NULL if parent_member_id is incorrect
-- parent_member_id BLOB, -- shared member ID, unique per group
-- parent_message_id INTEGER REFERENCES messages (message_id) ON DELETE CASCADE, -- can be NULL if received message references another message that's not received yet
-- parent_chat_msg_id INTEGER NOT NULL,
-- parent_msg_body_hash BLOB NOT NULL
-- );
-- CREATE INDEX group_event_parents_parent_chat_event_id_index
-- ON group_message_parents (parent_member_id, parent_chat_msg_id);
-- CREATE TABLE chat_items ( -- mutable chat_items presented to user
-- chat_item_id INTEGER PRIMARY KEY,
-- chat_msg_id INTEGER NOT NULL, -- sent as part of the message that created the item
-- item_deleted INTEGER NOT NULL, -- 1 for deleted
-- item_type TEXT NOT NULL,
-- item_text TEXT NOT NULL, -- textual representation
-- item_props TEXT NOT NULL -- JSON
-- );
-- CREATE TABLE direct_chat_items (
-- chat_item_id INTEGER NOT NULL UNIQUE REFERENCES chat_items ON DELETE CASCADE,
-- contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT,
-- item_sent INTEGER -- 1 for sent, 0 for received
-- );
-- CREATE TABLE group_chat_items (
-- chat_item_id INTEGER NOT NULL UNIQUE REFERENCES chat_items ON DELETE CASCADE,
-- group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT, -- NULL for sent
-- group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT
-- );
-- CREATE TABLE chat_item_content (
-- chat_item_content_id INTEGER PRIMARY KEY,
-- chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
-- content_type TEXT NOT NULL,
-- content_size INTEGER NOT NULL,
-- content BLOB NOT NULL
-- );
-- CREATE TABLE chat_item_messages (
-- message_id INTEGER NOT NULL UNIQUE REFERENCES messages,
-- chat_item_id INTEGER NOT NULL REFERENCES chat_items
-- );

205
migrations/20210612_initial.sql → migrations/20220101_initial.sql
View File

@@ -15,13 +15,13 @@ CREATE TABLE users (
active_user INTEGER NOT NULL DEFAULT 0, -- 1 for active user
FOREIGN KEY (user_id, local_display_name)
REFERENCES display_names (user_id, local_display_name)
ON DELETE RESTRICT
ON DELETE CASCADE
ON UPDATE CASCADE
DEFERRABLE INITIALLY DEFERRED
);
CREATE TABLE display_names (
user_id INTEGER NOT NULL REFERENCES users,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
local_display_name TEXT NOT NULL,
ldn_base TEXT NOT NULL,
ldn_suffix INTEGER NOT NULL DEFAULT 0,
@@ -31,15 +31,15 @@ CREATE TABLE display_names (
CREATE TABLE contacts (
contact_id INTEGER PRIMARY KEY,
contact_profile_id INTEGER REFERENCES contact_profiles, -- NULL if it's an incognito profile
user_id INTEGER NOT NULL REFERENCES users,
contact_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL, -- NULL if it's an incognito profile
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
local_display_name TEXT NOT NULL,
is_user INTEGER NOT NULL DEFAULT 0, -- 1 if this contact is a user
via_group INTEGER REFERENCES groups (group_id) ON DELETE SET NULL,
created_at TEXT NOT NULL DEFAULT (datetime('now')),
FOREIGN KEY (user_id, local_display_name)
REFERENCES display_names (user_id, local_display_name)
ON DELETE RESTRICT
ON DELETE CASCADE
ON UPDATE CASCADE,
UNIQUE (user_id, local_display_name),
UNIQUE (user_id, contact_profile_id)
@@ -49,7 +49,7 @@ CREATE TABLE sent_probes (
sent_probe_id INTEGER PRIMARY KEY,
contact_id INTEGER NOT NULL UNIQUE REFERENCES contacts ON DELETE CASCADE,
probe BLOB NOT NULL,
user_id INTEGER NOT NULL REFERENCES users,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
UNIQUE (user_id, probe)
);
@@ -57,7 +57,7 @@ CREATE TABLE sent_probe_hashes (
sent_probe_hash_id INTEGER PRIMARY KEY,
sent_probe_id INTEGER NOT NULL REFERENCES sent_probes ON DELETE CASCADE,
contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE,
user_id INTEGER NOT NULL REFERENCES users,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
UNIQUE (sent_probe_id, contact_id)
);
@@ -66,7 +66,7 @@ CREATE TABLE received_probes (
contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE,
probe BLOB,
probe_hash BLOB NOT NULL,
user_id INTEGER NOT NULL REFERENCES users
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE
);
CREATE TABLE known_servers(
@@ -74,7 +74,7 @@ CREATE TABLE known_servers(
host TEXT NOT NULL,
port TEXT NOT NULL,
key_hash BLOB,
user_id INTEGER NOT NULL REFERENCES users,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
UNIQUE (user_id, host, port)
) WITHOUT ROWID;
@@ -87,35 +87,38 @@ CREATE TABLE group_profiles ( -- shared group profiles
CREATE TABLE groups (
group_id INTEGER PRIMARY KEY, -- local group ID
user_id INTEGER NOT NULL REFERENCES users,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
local_display_name TEXT NOT NULL, -- local group name without spaces
group_profile_id INTEGER REFERENCES group_profiles, -- shared group profile
inv_queue_info BLOB,
group_profile_id INTEGER REFERENCES group_profiles ON DELETE SET NULL, -- shared group profile
inv_queue_info BLOB, -- received
FOREIGN KEY (user_id, local_display_name)
REFERENCES display_names (user_id, local_display_name)
ON DELETE RESTRICT
ON DELETE CASCADE
ON UPDATE CASCADE,
UNIQUE (user_id, local_display_name),
UNIQUE (user_id, group_profile_id)
);
CREATE INDEX idx_groups_inv_queue_info ON groups (inv_queue_info);
CREATE TABLE group_members ( -- group members, excluding the local user
group_member_id INTEGER PRIMARY KEY,
group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT,
group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
member_id BLOB NOT NULL, -- shared member ID, unique per group
member_role TEXT NOT NULL, -- owner, admin, member
member_category TEXT NOT NULL, -- see GroupMemberCategory
member_status TEXT NOT NULL, -- see GroupMemberStatus
invited_by INTEGER REFERENCES contacts (contact_id) ON DELETE RESTRICT, -- NULL for the members who joined before the current user and for the group creator
group_queue_info BLOB,
direct_queue_info BLOB,
user_id INTEGER NOT NULL REFERENCES users,
invited_by INTEGER REFERENCES contacts (contact_id) ON DELETE SET NULL, -- NULL for the members who joined before the current user and for the group creator
sent_inv_queue_info BLOB, -- sent
group_queue_info BLOB, -- received
direct_queue_info BLOB, -- received
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
local_display_name TEXT NOT NULL, -- should be the same as contact
contact_profile_id INTEGER NOT NULL REFERENCES contact_profiles ON DELETE RESTRICT,
contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
contact_profile_id INTEGER NOT NULL REFERENCES contact_profiles ON DELETE CASCADE,
contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
FOREIGN KEY (user_id, local_display_name)
REFERENCES display_names (user_id, local_display_name)
ON DELETE RESTRICT
ON DELETE CASCADE
ON UPDATE CASCADE,
UNIQUE (group_id, member_id)
);
@@ -132,28 +135,28 @@ CREATE TABLE group_member_intros (
CREATE TABLE files (
file_id INTEGER PRIMARY KEY,
contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
group_id INTEGER REFERENCES groups ON DELETE RESTRICT,
contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
group_id INTEGER REFERENCES groups ON DELETE CASCADE,
file_name TEXT NOT NULL,
file_path TEXT,
file_size INTEGER NOT NULL,
chunk_size INTEGER NOT NULL,
created_at TEXT NOT NULL DEFAULT (datetime('now')),
user_id INTEGER NOT NULL REFERENCES users
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE
);
CREATE TABLE snd_files (
file_id INTEGER NOT NULL REFERENCES files ON DELETE RESTRICT,
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE RESTRICT,
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
file_status TEXT NOT NULL, -- new, accepted, connected, completed
group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
PRIMARY KEY (file_id, connection_id)
) WITHOUT ROWID;
CREATE TABLE rcv_files (
file_id INTEGER PRIMARY KEY REFERENCES files ON DELETE RESTRICT,
file_id INTEGER PRIMARY KEY REFERENCES files ON DELETE CASCADE,
file_status TEXT NOT NULL, -- new, accepted, connected, completed
group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
file_queue_info BLOB
);
@@ -168,7 +171,7 @@ CREATE TABLE snd_file_chunks (
) WITHOUT ROWID;
CREATE TABLE rcv_file_chunks (
file_id INTEGER NOT NULL REFERENCES rcv_files,
file_id INTEGER NOT NULL REFERENCES rcv_files ON DELETE CASCADE,
chunk_number INTEGER NOT NULL,
chunk_agent_msg_id INTEGER NOT NULL,
chunk_stored INTEGER NOT NULL DEFAULT 0, -- 0 (received), 1 (appended to file)
@@ -179,102 +182,78 @@ CREATE TABLE connections ( -- all SMP agent connections
connection_id INTEGER PRIMARY KEY,
agent_conn_id BLOB NOT NULL UNIQUE,
conn_level INTEGER NOT NULL DEFAULT 0,
via_contact INTEGER REFERENCES contacts (contact_id),
via_contact INTEGER REFERENCES contacts (contact_id) ON DELETE SET NULL,
conn_status TEXT NOT NULL,
conn_type TEXT NOT NULL, -- contact, member, rcv_file, snd_file
contact_id INTEGER REFERENCES contacts ON DELETE RESTRICT,
group_member_id INTEGER REFERENCES group_members ON DELETE RESTRICT,
user_contact_link_id INTEGER REFERENCES user_contact_links ON DELETE CASCADE,
contact_id INTEGER REFERENCES contacts ON DELETE CASCADE,
group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
snd_file_id INTEGER,
rcv_file_id INTEGER REFERENCES rcv_files (file_id) ON DELETE RESTRICT,
rcv_file_id INTEGER REFERENCES rcv_files (file_id) ON DELETE CASCADE,
created_at TEXT NOT NULL DEFAULT (datetime('now')),
user_id INTEGER NOT NULL REFERENCES users,
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
FOREIGN KEY (snd_file_id, connection_id)
REFERENCES snd_files (file_id, connection_id)
ON DELETE RESTRICT
ON DELETE CASCADE
DEFERRABLE INITIALLY DEFERRED
);
-- PLEASE NOTE: all tables below were unused and are removed in the migration 20211227_messages.sql
CREATE TABLE user_contact_links (
user_contact_link_id INTEGER PRIMARY KEY,
conn_req_contact BLOB NOT NULL,
local_display_name TEXT NOT NULL DEFAULT '',
created_at TEXT NOT NULL DEFAULT (datetime('now')),
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
UNIQUE (user_id, local_display_name)
);
CREATE TABLE events ( -- messages received by the agent, append only
event_id INTEGER PRIMARY KEY,
agent_msg_id INTEGER NOT NULL, -- internal message ID
external_msg_id INTEGER NOT NULL, -- external message ID (sent or received)
agent_meta TEXT NOT NULL, -- JSON with timestamps etc. sent in MSG
connection_id INTEGER NOT NULL REFERENCES connections,
received INTEGER NOT NULL, -- 0 for received, 1 for sent
chat_event_id INTEGER,
continuation_of INTEGER, -- references chat_event_id, but can be incorrect
event_type TEXT NOT NULL, -- event type - see protocol/types.ts
event_encoding INTEGER NOT NULL, -- format of event_body: 0 - binary, 1 - text utf8, 2 - JSON (utf8)
content_type TEXT NOT NULL, -- content type - see protocol/types.ts
event_body BLOB, -- agent message body as sent
event_hash BLOB NOT NULL,
integrity TEXT NOT NULL DEFAULT '',
CREATE TABLE contact_requests (
contact_request_id INTEGER PRIMARY KEY,
user_contact_link_id INTEGER NOT NULL REFERENCES user_contact_links
ON UPDATE CASCADE ON DELETE CASCADE,
agent_invitation_id BLOB NOT NULL,
contact_profile_id INTEGER REFERENCES contact_profiles
ON DELETE SET NULL -- NULL if it's an incognito profile
DEFERRABLE INITIALLY DEFERRED,
local_display_name TEXT NOT NULL,
created_at TEXT NOT NULL DEFAULT (datetime('now')),
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
FOREIGN KEY (user_id, local_display_name)
REFERENCES display_names (user_id, local_display_name)
ON UPDATE CASCADE
ON DELETE CASCADE
DEFERRABLE INITIALLY DEFERRED,
UNIQUE (user_id, local_display_name),
UNIQUE (user_id, contact_profile_id)
);
-- all message events as received or sent, append only
-- maps to message deliveries as one-to-many for group messages
CREATE TABLE messages (
message_id INTEGER PRIMARY KEY,
msg_sent INTEGER NOT NULL, -- 0 for received, 1 for sent
chat_msg_event TEXT NOT NULL, -- message event type (the constructor of ChatMsgEvent)
msg_body BLOB, -- agent message body as received or sent
created_at TEXT NOT NULL DEFAULT (datetime('now'))
);
CREATE INDEX events_external_msg_id_index ON events (connection_id, external_msg_id);
CREATE TABLE event_body_parts (
event_body_part_id INTEGER PRIMARY KEY,
event_id REFERENCES events,
full_size INTEGER NOT NULL,
part_status TEXT, -- full, partial
content_type TEXT NOT NULL,
event_part BLOB
-- message deliveries communicated with the agent, append only
CREATE TABLE msg_deliveries (
msg_delivery_id INTEGER PRIMARY KEY,
message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages
connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
agent_msg_id INTEGER, -- internal agent message ID (NULL while pending)
agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
chat_ts TEXT NOT NULL DEFAULT (datetime('now')), -- broker_ts for received, created_at for sent
UNIQUE (connection_id, agent_msg_id)
);
CREATE TABLE contact_profile_events (
event_id INTEGER NOT NULL UNIQUE REFERENCES events,
contact_profile_id INTEGER NOT NULL REFERENCES contact_profiles
);
CREATE TABLE group_profile_events (
event_id INTEGER NOT NULL UNIQUE REFERENCES events,
group_profile_id INTEGER NOT NULL REFERENCES group_profiles
);
CREATE TABLE group_events (
event_id INTEGER NOT NULL UNIQUE REFERENCES events,
group_id INTEGER NOT NULL REFERENCES groups ON DELETE RESTRICT,
group_member_id INTEGER REFERENCES group_members -- NULL for current user
);
CREATE TABLE group_event_parents (
group_event_parent_id INTEGER PRIMARY KEY,
event_id INTEGER NOT NULL REFERENCES group_events (event_id),
parent_group_member_id INTEGER REFERENCES group_members (group_member_id), -- can be NULL if parent_member_id is incorrect
parent_member_id BLOB, -- shared member ID, unique per group
parent_event_id INTEGER REFERENCES events (event_id) ON DELETE CASCADE, -- this can be NULL if received event references another event that's not received yet
parent_chat_event_id INTEGER NOT NULL,
parent_event_hash BLOB NOT NULL
);
CREATE INDEX group_event_parents_parent_chat_event_id_index
ON group_event_parents (parent_member_id, parent_chat_event_id);
CREATE TABLE messages ( -- mutable messages presented to user
message_id INTEGER PRIMARY KEY,
contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE RESTRICT, -- 1 for sent messages
group_id INTEGER REFERENCES groups ON DELETE RESTRICT, -- NULL for direct messages
deleted INTEGER NOT NULL, -- 1 for deleted
msg_type TEXT NOT NULL,
content_type TEXT NOT NULL,
msg_text TEXT NOT NULL, -- textual representation
msg_props TEXT NOT NULL -- JSON
);
CREATE TABLE message_content (
message_content_id INTEGER PRIMARY KEY,
message_id INTEGER REFERENCES messages ON DELETE CASCADE,
content_type TEXT NOT NULL,
content_size INTEGER, -- full expected content size
content_status TEXT, -- empty, part, full
content BLOB NOT NULL
);
CREATE TABLE message_events (
event_id INTEGER NOT NULL UNIQUE REFERENCES events,
message_id INTEGER NOT NULL REFERENCES messages
-- TODO recovery for received messages with "rcv_agent" status - acknowledge to agent
-- changes of messagy delivery status, append only
CREATE TABLE msg_delivery_events (
msg_delivery_event_id INTEGER PRIMARY KEY,
msg_delivery_id INTEGER NOT NULL REFERENCES msg_deliveries ON DELETE CASCADE, -- non UNIQUE for multiple events per msg delivery
delivery_status TEXT NOT NULL, -- see MsgDeliveryStatus for allowed values
created_at TEXT NOT NULL DEFAULT (datetime('now')),
UNIQUE (msg_delivery_id, delivery_status)
);

3
migrations/20220106_group_members_inv_queue_info.sql
View File

@@ -1,3 +0,0 @@
ALTER TABLE group_members ADD inv_queue_info BLOB;
CREATE INDEX idx_groups_inv_queue_info ON groups (inv_queue_info);

5
package.yaml
View File

@@ -1,5 +1,5 @@
name: simplex-chat
version: 0.5.5
version: 1.0.0
#synopsis:
#description:
homepage: https://github.com/simplex-chat/simplex-chat#readme
@@ -29,7 +29,7 @@ dependencies:
- optparse-applicative >= 0.15 && < 0.17
- process == 1.6.*
- simple-logger == 0.1.*
- simplexmq >= 0.5.2 && < 0.6
- simplexmq >= 1.0 && < 1.1
- sqlite-simple == 0.4.*
- stm == 2.5.*
- terminal == 0.2.*
@@ -37,6 +37,7 @@ dependencies:
- time == 1.9.*
- unliftio == 0.2.*
- unliftio-core == 0.2.*
- unordered-containers == 0.2.*
library:
source-dirs: src

11
simplex-chat.cabal
View File

@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: simplex-chat
version: 0.5.5
version: 1.0.0
category: Web, System, Services, Cryptography
homepage: https://github.com/simplex-chat/simplex-chat#readme
author: Evgeny Poberezkin
@@ -56,7 +56,7 @@ library
, optparse-applicative >=0.15 && <0.17
, process ==1.6.*
, simple-logger ==0.1.*
, simplexmq >=0.5.2 && <0.6
, simplexmq ==1.0.*
, sqlite-simple ==0.4.*
, stm ==2.5.*
, terminal ==0.2.*
@@ -64,6 +64,7 @@ library
, time ==1.9.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, unordered-containers ==0.2.*
default-language: Haskell2010
executable simplex-chat
@@ -92,7 +93,7 @@ executable simplex-chat
, process ==1.6.*
, simple-logger ==0.1.*
, simplex-chat
, simplexmq >=0.5.2 && <0.6
, simplexmq ==1.0.*
, sqlite-simple ==0.4.*
, stm ==2.5.*
, terminal ==0.2.*
@@ -100,6 +101,7 @@ executable simplex-chat
, time ==1.9.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, unordered-containers ==0.2.*
default-language: Haskell2010
test-suite simplex-chat-test
@@ -136,7 +138,7 @@ test-suite simplex-chat-test
, process ==1.6.*
, simple-logger ==0.1.*
, simplex-chat
, simplexmq >=0.5.2 && <0.6
, simplexmq ==1.0.*
, sqlite-simple ==0.4.*
, stm ==2.5.*
, terminal ==0.2.*
@@ -144,4 +146,5 @@ test-suite simplex-chat-test
, time ==1.9.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, unordered-containers ==0.2.*
default-language: Haskell2010

218
src/Simplex/Chat.hs
View File

@@ -9,6 +9,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Simplex.Chat where
@@ -34,6 +35,7 @@ import Data.Maybe (isJust, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word32)
import Simplex.Chat.Controller
import Simplex.Chat.Help
import Simplex.Chat.Input
@@ -50,10 +52,12 @@ import Simplex.Messaging.Agent
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), defaultAgentConfig)
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Protocol (MsgBody)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Util (bshow, raceAny_, tryError)
import Simplex.Messaging.Util (raceAny_, tryError)
import System.Exit (exitFailure, exitSuccess)
import System.FilePath (combine, splitExtensions, takeFileName)
import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
@@ -73,9 +77,8 @@ data ChatCommand
| MarkdownHelp
| Welcome
| AddContact
| Connect (Maybe AConnectionRequest)
| Connect (Maybe AConnectionRequestUri)
| ConnectAdmin
| SendAdminWelcome ContactName
| DeleteContact ContactName
| ListContacts
| CreateMyAddress
@@ -117,7 +120,7 @@ defaultChatConfig =
},
dbPoolSize = 1,
tbqSize = 16,
fileChunkSize = 7050
fileChunkSize = 15780
}
logCfg :: LogConfig
@@ -138,7 +141,7 @@ newChatController config@ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} Cha
chatStore <- createStore f dbPoolSize
currentUser <- newTVarIO =<< getCreateActiveUser chatStore
chatTerminal <- newChatTerminal t
smpAgent <- getSMPAgentClient cfg {dbFile = dbFile <> ".agent.db", smpServers}
smpAgent <- getSMPAgentClient cfg {dbFile = dbFile <> "_agent.db", smpServers}
idsDrg <- newTVarIO =<< drgNew
inputQ <- newTBQueueIO tbqSize
notifyQ <- newTBQueueIO tbqSize
@@ -150,10 +153,10 @@ newChatController config@ChatConfig {agentConfig = cfg, dbPoolSize, tbqSize} Cha
runSimplexChat :: ChatController -> IO ()
runSimplexChat = runReaderT $ do
user <- readTVarIO =<< asks currentUser
whenM (asks firstTime) . printToView . chatWelcome user $ Onboarding 0 0 0 0 0
whenM (asks firstTime) . printToView $ chatWelcome user
race_ runTerminalInput runChatController
runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
runChatController :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
runChatController =
raceAny_
[ inputSubscriber,
@@ -167,7 +170,7 @@ withLock lock =
(void . atomically $ takeTMVar lock)
(atomically $ putTMVar lock ())
inputSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
inputSubscriber :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
inputSubscriber = do
q <- asks inputQ
l <- asks chatLock
@@ -184,7 +187,6 @@ inputSubscriber = do
SendGroupMessage g msg -> showSentGroupMessage g msg
SendFile c f -> showSentFileInvitation c f
SendGroupFile g f -> showSentGroupFileInvitation g f
SendAdminWelcome c -> forM_ adminWelcomeMessages $ showSentMessage c
_ -> printToView [plain s]
user <- readTVarIO =<< asks currentUser
withAgentLock a . withLock l . void . runExceptT $
@@ -197,9 +199,7 @@ processChatCommand user@User {userId, profile} = \case
GroupsHelp -> printToView groupsHelpInfo
MyAddressHelp -> printToView myAddressHelpInfo
MarkdownHelp -> printToView markdownInfo
Welcome -> do
ob <- withStore (`getOnboarding` userId)
printToView $ chatWelcome user ob
Welcome -> printToView $ chatWelcome user
AddContact -> do
(connId, cReq) <- withAgent (`createConnection` SCMInvitation)
withStore $ \st -> createDirectConnection st userId connId
@@ -208,7 +208,6 @@ processChatCommand user@User {userId, profile} = \case
Connect (Just (ACR SCMContact cReq)) -> connect cReq (XContact profile Nothing) >> showSentInvitation
Connect Nothing -> showInvalidConnReq
ConnectAdmin -> connect adminContactReq (XContact profile Nothing) >> showSentInvitation
SendAdminWelcome cName -> forM_ adminWelcomeMessages $ sendMessageCmd cName
DeleteContact cName ->
withStore (\st -> getContactGroupNames st userId cName) >>= \case
[] -> do
@@ -259,7 +258,7 @@ processChatCommand user@User {userId, profile} = \case
unless (memberActive membership) $ chatError CEGroupMemberNotActive
let sendInvitation memberId cReq = do
sendDirectMessage (contactConn contact) $
XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
XGrpInv $ GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
showSentGroupInvitation gName cName
setActive $ ActiveG gName
case contactMember contact members of
@@ -276,7 +275,7 @@ processChatCommand user@User {userId, profile} = \case
| otherwise -> chatError (CEGroupDuplicateMember cName)
JoinGroup gName -> do
ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName
agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId userMember
agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId (userMember :: GroupMember)
withStore $ \st -> do
createMemberConnection st userId fromMember agentConnId
updateGroupMemberStatus st userId fromMember GSMemAccepted
@@ -286,13 +285,13 @@ processChatCommand user@User {userId, profile} = \case
Group {membership, members} <- withStore $ \st -> getGroup st user gName
case find ((== cName) . (localDisplayName :: GroupMember -> ContactName)) members of
Nothing -> chatError $ CEGroupMemberNotFound cName
Just member -> do
let userRole = memberRole membership
when (userRole < GRAdmin || userRole < memberRole member) $ chatError CEGroupUserRole
when (memberStatus member /= GSMemInvited) . sendGroupMessage members $ XGrpMemDel (memberId member)
deleteMemberConnection member
withStore $ \st -> updateGroupMemberStatus st userId member GSMemRemoved
showDeletedMember gName Nothing (Just member)
Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus} -> do
let userRole = memberRole (membership :: GroupMember)
when (userRole < GRAdmin || userRole < mRole) $ chatError CEGroupUserRole
when (mStatus /= GSMemInvited) . sendGroupMessage members $ XGrpMemDel mId
deleteMemberConnection m
withStore $ \st -> updateGroupMemberStatus st userId m GSMemRemoved
showDeletedMember gName Nothing (Just m)
LeaveGroup gName -> do
Group {membership, members} <- withStore $ \st -> getGroup st user gName
sendGroupMessage members XGrpLeave
@@ -303,7 +302,7 @@ processChatCommand user@User {userId, profile} = \case
g@Group {membership, members} <- withStore $ \st -> getGroup st user gName
let s = memberStatus membership
canDelete =
memberRole membership == GROwner
memberRole (membership :: GroupMember) == GROwner
|| (s == GSMemRemoved || s == GSMemLeft || s == GSMemGroupDeleted || s == GSMemInvited)
unless canDelete $ chatError CEGroupUserRole
when (memberActive membership) $ sendGroupMessage members XGrpDel
@@ -318,7 +317,7 @@ processChatCommand user@User {userId, profile} = \case
-- TODO save pending message delivery for members without connections
Group {members, membership} <- withStore $ \st -> getGroup st user gName
unless (memberActive membership) $ chatError CEGroupMemberUserRemoved
let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
let msgEvent = XMsgNew . MCText $ safeDecodeUtf8 msg
sendGroupMessage members msgEvent
setActive $ ActiveG gName
SendFile cName f -> do
@@ -376,14 +375,14 @@ processChatCommand user@User {userId, profile} = \case
QuitChat -> liftIO exitSuccess
ShowVersion -> printToView clientVersionInfo
where
connect :: ConnectionRequest c -> ChatMsgEvent -> m ()
connect :: ConnectionRequestUri c -> ChatMsgEvent -> m ()
connect cReq msg = do
connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg
withStore $ \st -> createDirectConnection st userId connId
sendMessageCmd :: ContactName -> ByteString -> m ()
sendMessageCmd cName msg = do
contact <- withStore $ \st -> getContact st userId cName
let msgEvent = XMsgNew $ MsgContent MTText [] [MsgContentBody {contentType = SimplexContentType XCText, contentData = msg}]
let msgEvent = XMsgNew . MCText $ safeDecodeUtf8 msg
sendDirectMessage (contactConn contact) msgEvent
setActive $ ActiveC cName
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
@@ -426,7 +425,7 @@ processChatCommand user@User {userId, profile} = \case
f = filePath `combine` (name <> suffix <> ext)
in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
agentSubscriber = do
q <- asks $ subQ . smpAgent
l <- asks chatLock
@@ -437,7 +436,7 @@ agentSubscriber = do
withLock l . void . runExceptT $
processAgentMessage user connId msg `catchError` showChatError
subscribeUserConnections :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
subscribeUserConnections :: (MonadUnliftIO m, MonadReader ChatController m, MonadFail m) => m ()
subscribeUserConnections = void . runExceptT $ do
user <- readTVarIO =<< asks currentUser
subscribeContacts user
@@ -519,7 +518,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
where
isMember :: MemberId -> Group -> Bool
isMember memId Group {membership, members} =
memberId membership == memId || isJust (find ((== memId) . memberId) members)
sameMemberId memId membership || isJust (find (sameMemberId memId) members)
contactIsReady :: Contact -> Bool
contactIsReady Contact {activeConn} = connStatus activeConn == ConnReady
@@ -548,13 +547,17 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
ackMsgDeliveryEvent conn meta
SENT msgId ->
sentMsgDeliveryEvent conn msgId
-- TODO print errors
MERR _ _ -> pure ()
ERR _ -> pure ()
-- TODO add debugging output
_ -> pure ()
Just ct@Contact {localDisplayName = c} -> case agentMsg of
MSG meta msgBody -> do
chatMsgEvent <- saveRcvMSG conn meta msgBody
withAckMessage agentConnId meta $
case chatMsgEvent of
XMsgNew (MsgContent MTText [] body) -> newTextMessage c meta $ find (isSimplexContentType XCText) body
XMsgNew (MCText text) -> newTextMessage c meta text
XFile fInv -> processFileInvitation ct meta fInv
XInfo p -> xInfo ct p
XGrpInv gInv -> processGroupInvitation ct gInv
@@ -607,6 +610,10 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
showContactSubscribed c
showToast (c <> "> ") "is active"
setActive $ ActiveC c
-- TODO print errors
MERR _ _ -> pure ()
ERR _ -> pure ()
-- TODO add debugging output
_ -> pure ()
processGroupMessage :: ACommand 'Agent -> Connection -> GroupName -> GroupMember -> m ()
@@ -617,7 +624,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
GCInviteeMember ->
case chatMsgEvent of
XGrpAcpt memId
| memId == memberId m -> do
| sameMemberId memId m -> do
withStore $ \st -> updateGroupMemberStatus st userId m GSMemAccepted
allowAgentConnection conn confId XOk
| otherwise -> messageError "x.grp.acpt: memberId is different from expected"
@@ -625,17 +632,17 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
_ ->
case chatMsgEvent of
XGrpMemInfo memId _memProfile
| memId == memberId m -> do
| sameMemberId memId m -> do
-- TODO update member profile
Group {membership} <- withStore $ \st -> getGroup st user gName
allowAgentConnection conn confId $ XGrpMemInfo (memberId membership) profile
allowAgentConnection conn confId $ XGrpMemInfo (memberId (membership :: GroupMember)) profile
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
_ -> messageError "CONF from member must have x.grp.mem.info"
INFO connInfo -> do
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
case chatMsgEvent of
XGrpMemInfo memId _memProfile
| memId == memberId m -> do
| sameMemberId memId m -> do
-- TODO update member profile
pure ()
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
@@ -678,8 +685,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
chatMsgEvent <- saveRcvMSG conn meta msgBody
withAckMessage agentConnId meta $
case chatMsgEvent of
XMsgNew (MsgContent MTText [] body) ->
newGroupTextMessage gName m meta $ find (isSimplexContentType XCText) body
XMsgNew (MCText text) -> newGroupTextMessage gName m meta text
XFile fInv -> processGroupFileInvitation gName m meta fInv
XGrpMemNew memInfo -> xGrpMemNew gName m memInfo
XGrpMemIntro memInfo -> xGrpMemIntro conn gName m memInfo
@@ -692,6 +698,10 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
ackMsgDeliveryEvent conn meta
SENT msgId ->
sentMsgDeliveryEvent conn msgId
-- TODO print errors
MERR _ _ -> pure ()
ERR _ -> pure ()
-- TODO add debugging output
_ -> pure ()
processSndFileConn :: ACommand 'Agent -> Connection -> SndFileTransfer -> m ()
@@ -721,6 +731,9 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
_ -> chatError $ CEFileSend fileId err
MSG meta _ ->
withAckMessage agentConnId meta $ pure ()
-- TODO print errors
ERR _ -> pure ()
-- TODO add debugging output
_ -> pure ()
processRcvFileConn :: ACommand 'Agent -> Connection -> RcvFileTransfer -> m ()
@@ -731,10 +744,10 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
showRcvFileStart ft
MSG meta@MsgMeta {recipient = (msgId, _), integrity} msgBody -> withAckMessage agentConnId meta $ do
parseFileChunk msgBody >>= \case
(0, _) -> do
FileChunkCancel -> do
cancelRcvFileTransfer ft
showRcvFileSndCancelled ft
(chunkNo, chunk) -> do
FileChunk {chunkNo, chunkBytes = chunk} -> do
case integrity of
MsgOk -> pure ()
MsgError MsgDuplicate -> pure () -- TODO remove once agent removes duplicates
@@ -758,6 +771,10 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
withAgent (`deleteConnection` agentConnId)
RcvChunkDuplicate -> pure ()
RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
-- TODO print errors
MERR _ _ -> pure ()
ERR _ -> pure ()
-- TODO add debugging output
_ -> pure ()
processUserContactRequest :: ACommand 'Agent -> Connection -> UserContact -> m ()
@@ -769,12 +786,17 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
XInfo p -> profileContactRequest invId p
-- TODO show/log error, other events in contact request
_ -> pure ()
-- TODO print errors
MERR _ _ -> pure ()
ERR _ -> pure ()
-- TODO add debugging output
_ -> pure ()
where
profileContactRequest :: InvitationId -> Profile -> m ()
profileContactRequest invId p = do
cName <- withStore $ \st -> createContactRequest st userId userContactLinkId invId p
showReceivedContactRequest cName p
showToast (cName <> "> ") "wants to connect to you"
withAckMessage :: ConnId -> MsgMeta -> m () -> m ()
withAckMessage cId MsgMeta {recipient = (msgId, _)} action =
@@ -808,7 +830,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
(probe, probeId) <- withStore $ \st -> createSentProbe st gVar userId ct
sendDirectMessage (contactConn ct) $ XInfoProbe probe
cs <- withStore (\st -> getMatchingContacts st userId ct)
let probeHash = C.sha256Hash probe
let probeHash = ProbeHash $ C.sha256Hash (unProbe probe)
forM_ cs $ \c -> sendProbeHash c probeHash probeId `catchError` const (pure ())
where
sendProbeHash c probeHash probeId = do
@@ -821,23 +843,17 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
messageError :: Text -> m ()
messageError = showMessageError "error"
newTextMessage :: ContactName -> MsgMeta -> Maybe MsgContentBody -> m ()
newTextMessage c meta = \case
Just MsgContentBody {contentData = bs} -> do
let text = safeDecodeUtf8 bs
showReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
showToast (c <> "> ") text
setActive $ ActiveC c
_ -> messageError "x.msg.new: no expected message body"
newTextMessage :: ContactName -> MsgMeta -> Text -> m ()
newTextMessage c meta text = do
showReceivedMessage c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
showToast (c <> "> ") text
setActive $ ActiveC c
newGroupTextMessage :: GroupName -> GroupMember -> MsgMeta -> Maybe MsgContentBody -> m ()
newGroupTextMessage gName GroupMember {localDisplayName = c} meta = \case
Just MsgContentBody {contentData = bs} -> do
let text = safeDecodeUtf8 bs
showReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
showToast ("#" <> gName <> " " <> c <> "> ") text
setActive $ ActiveG gName
_ -> messageError "x.msg.new: no expected message body"
newGroupTextMessage :: GroupName -> GroupMember -> MsgMeta -> Text -> m ()
newGroupTextMessage gName GroupMember {localDisplayName = c} meta text = do
showReceivedGroupMessage gName c (snd $ broker meta) (msgPlain text) (integrity (meta :: MsgMeta))
showToast ("#" <> gName <> " " <> c <> "> ") text
setActive $ ActiveG gName
processFileInvitation :: Contact -> MsgMeta -> FileInvitation -> m ()
processFileInvitation contact@Contact {localDisplayName = c} meta fInv = do
@@ -845,6 +861,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
chSize <- asks $ fileChunkSize . config
ft <- withStore $ \st -> createRcvFileTransfer st userId contact fInv chSize
showReceivedMessage c (snd $ broker meta) (receivedFileInvitation ft) (integrity (meta :: MsgMeta))
showToast (c <> "> ") "wants to send a file"
setActive $ ActiveC c
processGroupFileInvitation :: GroupName -> GroupMember -> MsgMeta -> FileInvitation -> m ()
@@ -852,37 +869,39 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
chSize <- asks $ fileChunkSize . config
ft <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize
showReceivedGroupMessage gName c (snd $ broker meta) (receivedFileInvitation ft) (integrity (meta :: MsgMeta))
showToast ("#" <> gName <> " " <> c <> "> ") "wants to send a file"
setActive $ ActiveG gName
processGroupInvitation :: Contact -> GroupInvitation -> m ()
processGroupInvitation ct@Contact {localDisplayName} inv@(GroupInvitation (fromMemId, fromRole) (memId, memRole) _ _) = do
when (fromRole < GRAdmin || fromRole < memRole) $ chatError (CEGroupContactRole localDisplayName)
processGroupInvitation ct@Contact {localDisplayName = c} inv@(GroupInvitation (MemberIdRole fromMemId fromRole) (MemberIdRole memId memRole) _ _) = do
when (fromRole < GRAdmin || fromRole < memRole) $ chatError (CEGroupContactRole c)
when (fromMemId == memId) $ chatError CEGroupDuplicateMemberId
group <- withStore $ \st -> createGroupInvitation st user ct inv
showReceivedGroupInvitation group localDisplayName memRole
group@Group {localDisplayName = gName} <- withStore $ \st -> createGroupInvitation st user ct inv
showReceivedGroupInvitation group c memRole
showToast ("#" <> gName <> " " <> c <> "> ") $ "invited you to join the group"
xInfo :: Contact -> Profile -> m ()
xInfo c@Contact {profile = p} p' = unless (p == p') $ do
c' <- withStore $ \st -> updateContactProfile st userId c p'
showContactUpdated c c'
xInfoProbe :: Contact -> ByteString -> m ()
xInfoProbe :: Contact -> Probe -> m ()
xInfoProbe c2 probe = do
r <- withStore $ \st -> matchReceivedProbe st userId c2 probe
forM_ r $ \c1 -> probeMatch c1 c2 probe
xInfoProbeCheck :: Contact -> ByteString -> m ()
xInfoProbeCheck :: Contact -> ProbeHash -> m ()
xInfoProbeCheck c1 probeHash = do
r <- withStore $ \st -> matchReceivedProbeHash st userId c1 probeHash
forM_ r . uncurry $ probeMatch c1
probeMatch :: Contact -> Contact -> ByteString -> m ()
probeMatch :: Contact -> Contact -> Probe -> m ()
probeMatch c1@Contact {profile = p1} c2@Contact {profile = p2} probe =
when (p1 == p2) $ do
sendDirectMessage (contactConn c1) $ XInfoProbeOk probe
mergeContacts c1 c2
xInfoProbeOk :: Contact -> ByteString -> m ()
xInfoProbeOk :: Contact -> Probe -> m ()
xInfoProbeOk c1 probe = do
r <- withStore $ \st -> matchSentProbe st userId c1 probe
forM_ r $ \c2 -> mergeContacts c1 c2
@@ -904,7 +923,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
xGrpMemNew :: GroupName -> GroupMember -> MemberInfo -> m ()
xGrpMemNew gName m memInfo@(MemberInfo memId _ _) = do
group@Group {membership} <- withStore $ \st -> getGroup st user gName
when (memberId membership /= memId) $
unless (sameMemberId memId membership) $
if isMember memId group
then messageError "x.grp.mem.new error: member already exists"
else do
@@ -932,7 +951,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
case memberCategory m of
GCInviteeMember -> do
group <- withStore $ \st -> getGroup st user gName
case find ((== memId) . memberId) $ members group of
case find (sameMemberId memId) $ members group of
Nothing -> messageError "x.grp.mem.inv error: referenced member does not exists"
Just reMember -> do
intro <- withStore $ \st -> saveIntroInvitation st reMember m introInv
@@ -946,7 +965,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
xGrpMemFwd :: GroupName -> GroupMember -> MemberInfo -> IntroInvitation -> m ()
xGrpMemFwd gName m memInfo@(MemberInfo memId _ _) introInv@IntroInvitation {groupConnReq, directConnReq} = do
group@Group {membership} <- withStore $ \st -> getGroup st user gName
toMember <- case find ((== memId) . memberId) $ members group of
toMember <- case find (sameMemberId memId) $ members group of
-- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent
-- the situation when member does not exist is an error
-- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
@@ -954,7 +973,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
Nothing -> withStore $ \st -> createNewGroupMember st user group memInfo GCPostMember GSMemAnnounced
Just m' -> pure m'
withStore $ \st -> saveMemberInvitation st toMember introInv
let msg = XGrpMemInfo (memberId membership) profile
let msg = XGrpMemInfo (memberId (membership :: GroupMember)) profile
groupConnId <- withAgent $ \a -> joinConnection a groupConnReq $ directMessage msg
directConnId <- withAgent $ \a -> joinConnection a directConnReq $ directMessage msg
withStore $ \st -> createIntroToMemberContact st userId m toMember groupConnId directConnId
@@ -962,22 +981,25 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
xGrpMemDel :: GroupName -> GroupMember -> MemberId -> m ()
xGrpMemDel gName m memId = do
Group {membership, members} <- withStore $ \st -> getGroup st user gName
if memberId membership == memId
if memberId (membership :: GroupMember) == memId
then do
mapM_ deleteMemberConnection members
withStore $ \st -> updateGroupMemberStatus st userId membership GSMemRemoved
showDeletedMemberUser gName m
else case find ((== memId) . memberId) members of
else case find (sameMemberId memId) members of
Nothing -> messageError "x.grp.mem.del with unknown member ID"
Just member -> do
let mRole = memberRole m
if mRole < GRAdmin || mRole < memberRole member
let mRole = memberRole (m :: GroupMember)
if mRole < GRAdmin || mRole < memberRole (member :: GroupMember)
then messageError "x.grp.mem.del with insufficient member permissions"
else do
deleteMemberConnection member
withStore $ \st -> updateGroupMemberStatus st userId member GSMemRemoved
showDeletedMember gName (Just m) (Just member)
sameMemberId :: MemberId -> GroupMember -> Bool
sameMemberId memId GroupMember {memberId} = memId == memberId
xGrpLeave :: GroupName -> GroupMember -> m ()
xGrpLeave gName m = do
deleteMemberConnection m
@@ -985,8 +1007,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
showLeftMember gName m
xGrpDel :: GroupName -> GroupMember -> m ()
xGrpDel gName m = do
when (memberRole m /= GROwner) $ chatError CEGroupUserRole
xGrpDel gName m@GroupMember {memberRole} = do
when (memberRole /= GROwner) $ chatError CEGroupUserRole
ms <- withStore $ \st -> do
Group {members, membership} <- getGroup st user gName
updateGroupMemberStatus st userId membership GSMemGroupDeleted
@@ -995,7 +1017,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
showGroupDeleted gName m
parseChatMessage :: ByteString -> Either ChatError ChatMessage
parseChatMessage msgBody = first ChatErrorMessage (parseAll rawChatMessageP msgBody >>= toChatMessage)
parseChatMessage = first ChatErrorMessage . strDecode
sendFileChunk :: ChatMonad m => SndFileTransfer -> m ()
sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
@@ -1012,8 +1034,8 @@ sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId} =
sendFileChunkNo :: ChatMonad m => SndFileTransfer -> Integer -> m ()
sendFileChunkNo ft@SndFileTransfer {agentConnId} chunkNo = do
bytes <- readFileChunk ft chunkNo
msgId <- withAgent $ \a -> sendMessage a agentConnId $ serializeFileChunk chunkNo bytes
chunkBytes <- readFileChunk ft chunkNo
msgId <- withAgent $ \a -> sendMessage a agentConnId $ smpEncode FileChunk {chunkNo, chunkBytes}
withStore $ \st -> updateSndFileChunkMsg st ft chunkNo msgId
readFileChunk :: ChatMonad m => SndFileTransfer -> Integer -> m ByteString
@@ -1027,13 +1049,24 @@ readFileChunk SndFileTransfer {fileId, filePath, chunkSize} chunkNo =
when (pos /= pos') $ hSeek h AbsoluteSeek pos'
liftIO . B.hGet h $ fromInteger chunkSize
parseFileChunk :: ChatMonad m => ByteString -> m (Integer, ByteString)
parseFileChunk msg =
liftEither . first (ChatError . CEFileRcvChunk) $
parseAll ((,) <$> A.decimal <* A.space <*> A.takeByteString) msg
data FileChunk = FileChunk {chunkNo :: Integer, chunkBytes :: ByteString} | FileChunkCancel
serializeFileChunk :: Integer -> ByteString -> ByteString
serializeFileChunk chunkNo bytes = bshow chunkNo <> " " <> bytes
instance Encoding FileChunk where
smpEncode = \case
FileChunk {chunkNo, chunkBytes} -> smpEncode ('F', fromIntegral chunkNo :: Word32, Tail chunkBytes)
FileChunkCancel -> smpEncode 'C'
smpP =
smpP >>= \case
'F' -> do
chunkNo <- fromIntegral <$> smpP @Word32
Tail chunkBytes <- smpP
pure FileChunk {chunkNo, chunkBytes}
'C' -> pure FileChunkCancel
_ -> fail "bad FileChunk"
parseFileChunk :: ChatMonad m => ByteString -> m FileChunk
parseFileChunk msg =
liftEither . first (ChatError . CEFileRcvChunk) $ parseAll smpP msg
appendFileChunk :: ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> m ()
appendFileChunk ft@RcvFileTransfer {fileId, fileStatus} chunkNo chunk =
@@ -1083,7 +1116,7 @@ cancelSndFileTransfer ft@SndFileTransfer {agentConnId, fileStatus} =
updateSndFileStatus st ft FSCancelled
deleteSndFileChunks st ft
withAgent $ \a -> do
void (sendMessage a agentConnId "0 ") `catchError` \_ -> pure ()
void (sendMessage a agentConnId $ smpEncode FileChunkCancel) `catchError` \_ -> pure ()
suspendConnection a agentConnId
closeFileHandle :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m ()
@@ -1105,15 +1138,13 @@ deleteMemberConnection m@GroupMember {activeConn} = do
sendDirectMessage :: ChatMonad m => Connection -> ChatMsgEvent -> m ()
sendDirectMessage conn chatMsgEvent = do
let msgBody = directMessage chatMsgEvent
newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventTag chatMsgEvent, msgBody}
-- can be done in transaction after sendMessage, probably shouldn't
msgId <- withStore $ \st -> createNewMessage st newMsg
deliverMessage conn msgBody msgId
directMessage :: ChatMsgEvent -> ByteString
directMessage chatMsgEvent =
serializeRawChatMessage $
rawChatMessage ChatMessage {chatMsgId = Nothing, chatMsgEvent, chatDAG = Nothing}
directMessage chatMsgEvent = strEncode ChatMessage {chatMsgEvent}
deliverMessage :: ChatMonad m => Connection -> MsgBody -> MessageId -> m ()
deliverMessage Connection {connId, agentConnId} msgBody msgId = do
@@ -1124,7 +1155,7 @@ deliverMessage Connection {connId, agentConnId} msgBody msgId = do
sendGroupMessage :: ChatMonad m => [GroupMember] -> ChatMsgEvent -> m ()
sendGroupMessage members chatMsgEvent = do
let msgBody = directMessage chatMsgEvent
newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
newMsg = NewMessage {direction = MDSnd, chatMsgEventType = toChatEventTag chatMsgEvent, msgBody}
msgId <- withStore $ \st -> createNewMessage st newMsg
-- TODO once scheduled delivery is implemented memberActive should be changed to memberCurrent
forM_ (map memberConn $ filter memberActive members) $
@@ -1133,7 +1164,7 @@ sendGroupMessage members chatMsgEvent = do
saveRcvMSG :: ChatMonad m => Connection -> MsgMeta -> MsgBody -> m ChatMsgEvent
saveRcvMSG Connection {connId} agentMsgMeta msgBody = do
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage msgBody
let newMsg = NewMessage {direction = MDRcv, chatMsgEventType = toChatEventType chatMsgEvent, msgBody}
let newMsg = NewMessage {direction = MDRcv, chatMsgEventType = toChatEventTag chatMsgEvent, msgBody}
agentMsgId = fst $ recipient agentMsgMeta
rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta}
withStore $ \st -> createNewMessageAndRcvMsgDelivery st newMsg rcvMsgDelivery
@@ -1241,7 +1272,7 @@ chatCommandP =
<|> ("/groups" <|> "/gs") $> ListGroups
<|> A.char '#' *> (SendGroupMessage <$> displayName <* A.space <*> A.takeByteString)
<|> ("/contacts" <|> "/cs") $> ListContacts
<|> ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> connReqP) <|> A.takeByteString $> Nothing))
<|> ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing))
<|> ("/connect" <|> "/c") $> AddContact
<|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName)
<|> A.char '@' *> (SendMessage <$> displayName <*> (A.space *> A.takeByteString))
@@ -1250,8 +1281,7 @@ chatCommandP =
<|> ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (A.space *> filePath))
<|> ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal)
<|> ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal)
<|> "/admin_welcome " *> (SendAdminWelcome <$> displayName)
<|> "/admin" $> ConnectAdmin
<|> "/simplex" $> ConnectAdmin
<|> ("/address" <|> "/ad") $> CreateMyAddress
<|> ("/delete_address" <|> "/da") $> DeleteMyAddress
<|> ("/show_address" <|> "/sa") $> ShowMyAddress
@@ -1284,6 +1314,6 @@ chatCommandP =
<|> (" member" $> GRMember)
<|> pure GRAdmin
adminContactReq :: ConnectionRequest 'CMContact
adminContactReq :: ConnReqContact
adminContactReq =
either error id $ parseAll connReqP' "https://simplex.chat/contact#/?smp=smp%3A%2F%2Fnxc7HnrnM8dOKgkMp008ub_9o9LXJlxlMrMpR-mfMQw%3D%40smp3.simplex.im%2F-TXnePw5eH5-4L7B%23&e2e=rsa%3AMIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEA6vpcsZggnYL38Qa2G5YU0W5uqnV8WAq_S3flIFU2kx4qW-aokVT8fo0CLJXv9aagdHObFfhc9SXcZPcm4T2NLnafKTgQa_HYFfj764l6cHkbSI-4JBE1gyhtaapsvrDGIdoiGDLgsF3AJVjqs8gavkuTsmw035aWMH-pkpc4qGlEWpNWp1Nn-7O4sdIIQ7yN48jsdCfeIY-BIk3kFR6s4oQOgiOcnir8e3x5tTuRMX1KWSiuzuqLHqgmcI1IqcPJPrBoTQLbXXEMGG1RsvIudxR03jejXXbQvlxXlNNrxwkniEe-P0rApGuCyv2NRMb4n0Wd3ZwewH7X-xtr16XNbQKBgDouGUHD1C55jB-w8W8VJRhFZS2xIYka9gJH1jjCFxHFzgjo69A_sObIamND1pF_JOzj_XCoA1fDICF95XbfS0rq9iS6xvX6M8Muq8QiJsfD5bRt5nh-Y3GK5rAFXS0ZtyOeh07iMLAMJ_EFxBQuKKDRu9_9KAvLL_plU0PuaMH3"
either error id $ strDecode "https://simplex.chat/contact#/?v=1&smp=smp%3A%2F%2FPQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo%3D%40smp6.simplex.im%2FK1rslx-m5bpXVIdMZg9NLUZ_8JBm8xTt%23MCowBQYDK2VuAyEALDeVe-sG8mRY22LsXlPgiwTNs9dbiLrNuA7f3ZMAJ2w%3D"

11
src/Simplex/Chat/Controller.hs
View File

@@ -26,7 +26,13 @@ import System.IO (Handle)
import UnliftIO.STM
versionNumber :: String
versionNumber = "0.5.5"
versionNumber = "1.0.0"
versionStr :: String
versionStr = "SimpleX Chat v" <> versionNumber
updateStr :: String
updateStr = "To update run: curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/master/install.sh | bash"
data ChatConfig = ChatConfig
{ agentConfig :: AgentConfig,
@@ -78,9 +84,10 @@ data ChatErrorType
| CEFileSend Int64 AgentErrorType
| CEFileRcvChunk String
| CEFileInternal String
| CEAgentVersion
deriving (Show, Exception)
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m, MonadFail m)
setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
setActive to = asks (activeTo . chatTerminal) >>= atomically . (`writeTVar` to)

38
src/Simplex/Chat/Help.hs
View File

@@ -3,7 +3,6 @@
module Simplex.Chat.Help
( chatWelcome,
adminWelcomeMessages,
chatHelpInfo,
filesHelpInfo,
groupsHelpInfo,
@@ -12,13 +11,12 @@ module Simplex.Chat.Help
)
where
import Data.ByteString (ByteString)
import Data.List (intersperse)
import Data.Text (Text)
import qualified Data.Text as T
import Simplex.Chat.Markdown
import Simplex.Chat.Styled
import Simplex.Chat.Types (Onboarding (..), Profile (..), User (..))
import Simplex.Chat.Types (Profile (..), User (..))
import System.Console.ANSI.Types
highlight :: Text -> Markdown
@@ -33,8 +31,8 @@ indent = " "
listHighlight :: [Text] -> Markdown
listHighlight = mconcat . intersperse ", " . map highlight
chatWelcome :: User -> Onboarding -> [StyledString]
chatWelcome user Onboarding {contactsCount, createdGroups, membersCount, filesSentCount, addressCount} =
chatWelcome :: User -> [StyledString]
chatWelcome user =
map
styleMarkdown
[ " __ __",
@@ -46,37 +44,21 @@ chatWelcome user Onboarding {contactsCount, createdGroups, membersCount, filesSe
"Welcome " <> green userName <> "!",
"Thank you for installing SimpleX Chat!",
"",
"We have created several groups that you can join to play with SimpleX Chat:",
highlight "#simplex" <> " (SimpleX Engineers 💻) - technical questions about running or contributing to SimpleX Chat",
highlight "#hacks" <> " (Ethical Hacking 🔓) - chatting about privacy, security, announced vulnerabilities etc.",
"We have a couple of groups that you can join to play with SimpleX Chat:",
highlight "#termux" <> " (Android Termux 📱) - chatting about using SimpleX Chat on Android devices",
highlight "#music" <> " (Music 🎸) - favorite music of our team and users",
highlight "#rand" <> " (Random 😇) - anything interesting, just keep it decent and friendly please :)",
"",
"Connect to our groups admin to be added to these groups - " <> highlight "/admin",
"Connect to SimpleX Chat team to be added to these groups - type " <> highlight "/simplex",
"",
"To continue:",
"[" <> check (contactsCount >= 2) <> "] " <> highlight "/connect" <> " with 2 friends - " <> highlight "/help" <> " for instructions",
"[" <> check (createdGroups >= 1 && membersCount >= 2) <> "] create a " <> highlight "/group" <> " with them - " <> highlight "/g #friends",
"[" <> check (filesSentCount >= 1) <> "] send " <> highlight "/file" <> ", e.g. your photo, to the group - " <> highlight "/f #friends ./photo.jpg",
"[" <> check (addressCount >= 1) <> "] create your optional chat " <> highlight "/address" <> " and share it with your friends - " <> highlight "/ad",
"Follow our updates:",
"> Reddit: https://www.reddit.com/r/SimpleXChat/",
"> Twitter: https://twitter.com/SimpleXChat",
"",
"To help us build SimpleX Chat:",
"> star GitHub repo: https://github.com/simplex-chat/simplex-chat",
"> join Reddit group: https://www.reddit.com/r/SimpleXChat/",
"",
"To show this message again - " <> highlight "/welcome" <> " (or " <> highlight "/w" <> ")"
"Type " <> highlight "/help" <> " for usage info, " <> highlight "/welcome" <> " to show this message"
]
where
User {profile = Profile {displayName, fullName}} = user
userName = if T.null fullName then displayName else fullName
check c = if c then green "*" else " "
adminWelcomeMessages :: [ByteString]
adminWelcomeMessages =
[ "Hello - and welcome to SimpleX Chat!",
"Which community groups you'd like to join:",
"!5 #simplex!, !5 #hacks!, !5 #music! or !5 #rand!"
]
chatHelpInfo :: [StyledString]
chatHelpInfo =

36
src/Simplex/Chat/Options.hs
View File

@@ -7,7 +7,9 @@ import qualified Data.ByteString.Char8 as B
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import Options.Applicative
import Simplex.Messaging.Agent.Protocol (SMPServer (..), smpServerP)
import Simplex.Chat.Controller (updateStr, versionStr)
import Simplex.Messaging.Agent.Protocol (SMPServer (..))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll)
import System.FilePath (combine)
@@ -23,8 +25,9 @@ chatOpts appDir =
( long "database"
<> short 'd'
<> metavar "DB_FILE"
<> help ("sqlite database file path (" <> defaultDbFilePath <> ")")
<> help "Path prefix to chat and agent database files"
<> value defaultDbFilePath
<> showDefault
)
<*> option
parseSMPServer
@@ -32,31 +35,30 @@ chatOpts appDir =
<> short 's'
<> metavar "SERVER"
<> help
( "SMP server(s) to use"
<> "\n(smp2.simplex.im,smp3.simplex.im)"
)
"Comma separated list of SMP server(s) to use \
\(default: smp4.simplex.im,smp5.simplex.im,smp6.simplex.im)"
<> value
( L.fromList
[ "smp2.simplex.im#z5W2QLQ1Br3Yd6CoWg7bIq1bHdwK7Y8bEiEXBs/WfAg=", -- London, UK
"smp3.simplex.im#nxc7HnrnM8dOKgkMp008ub/9o9LXJlxlMrMpR+mfMQw=" -- Fremont, CA
[ "smp://u2dS9sG8nMNURyZwqASV4yROM28Er0luVTx5X1CsMrU=@smp4.simplex.im",
"smp://hpq7_4gGJiilmz5Rf-CswuU5kZGkm_zOIooSw6yALRg=@smp5.simplex.im",
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im"
]
)
)
where
defaultDbFilePath = combine appDir "simplex"
defaultDbFilePath = combine appDir "simplex_v1"
parseSMPServer :: ReadM (NonEmpty SMPServer)
parseSMPServer = eitherReader $ parseAll servers . B.pack
where
servers = L.fromList <$> smpServerP `A.sepBy1` A.char ','
servers = L.fromList <$> strP `A.sepBy1` A.char ','
getChatOpts :: FilePath -> IO ChatOpts
getChatOpts appDir = execParser opts
getChatOpts appDir =
execParser $
info
(helper <*> versionOption <*> chatOpts appDir)
(header versionStr <> fullDesc <> progDesc "Start chat with DB_FILE file and use SERVER as SMP server")
where
opts =
info
(chatOpts appDir <**> helper)
( fullDesc
<> header "Chat prototype using Simplex Messaging Protocol (SMP)"
<> progDesc "Start chat with DB_FILE file and use SERVER as SMP server"
)
versionOption = infoOption versionAndUpdate (long "version" <> short 'v' <> help "Show version")
versionAndUpdate = versionStr <> "\n" <> updateStr

599
src/Simplex/Chat/Protocol.hs
View File

@@ -1,35 +1,32 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
module Simplex.Chat.Protocol where
import Control.Applicative (optional)
import Control.Monad ((<=<), (>=>))
import Data.Aeson (FromJSON, ToJSON)
import Control.Monad ((<=<))
import Data.Aeson (FromJSON, ToJSON, (.:), (.:?), (.=))
import qualified Data.Aeson as J
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Int (Int64)
import Data.List (find, findIndex)
import qualified Data.HashMap.Strict as H
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import GHC.Generics
import Simplex.Chat.Types
import Simplex.Chat.Util (safeDecodeUtf8)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Util (bshow)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Util ((<$?>))
data ChatDirection (p :: AParty) where
ReceivedDirectMessage :: Connection -> Maybe Contact -> ChatDirection 'Agent
@@ -52,6 +49,23 @@ fromConnection = \case
RcvFileConnection conn _ -> conn
UserContactConnection conn _ -> conn
-- chat message is sent as JSON with these properties
data AppMessage = AppMessage
{ event :: Text,
params :: J.Object
}
deriving (Generic, FromJSON)
instance ToJSON AppMessage where toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
newtype ChatMessage = ChatMessage {chatMsgEvent :: ChatMsgEvent}
deriving (Eq, Show)
instance StrEncoding ChatMessage where
strEncode = LB.toStrict . J.encode . chatToAppMessage
strDecode = appToChatMessage <=< J.eitherDecodeStrict'
strP = strDecode <$?> A.takeByteString
data ChatMsgEvent
= XMsgNew MsgContent
| XFile FileInvitation
@@ -70,372 +84,215 @@ data ChatMsgEvent
| XGrpMemDel MemberId
| XGrpLeave
| XGrpDel
| XInfoProbe ByteString
| XInfoProbeCheck ByteString
| XInfoProbeOk ByteString
| XInfoProbe Probe
| XInfoProbeCheck ProbeHash
| XInfoProbeOk Probe
| XOk
deriving (Eq, Show)
data MessageType = MTText | MTImage deriving (Eq, Show)
data MsgContentType = MCText_ | MCUnknown_
data MsgContent = MsgContent
{ messageType :: MessageType,
files :: [(ContentType, Int)],
content :: [MsgContentBody]
}
instance StrEncoding MsgContentType where
strEncode = \case
MCText_ -> "text"
MCUnknown_ -> "text"
strDecode = \case
"text" -> Right MCText_
_ -> Right MCUnknown_
strP = strDecode <$?> A.takeTill (== ' ')
instance FromJSON MsgContentType where
parseJSON = strParseJSON "MsgContentType"
instance ToJSON MsgContentType where
toJSON = strToJSON
toEncoding = strToJEncoding
data MsgContent = MCText Text | MCUnknown
deriving (Eq, Show)
toMsgType :: ByteString -> Either String MessageType
toMsgType = \case
"c.text" -> Right MTText
"c.image" -> Right MTImage
t -> Left $ "invalid message type " <> B.unpack t
toMsgContentType :: MsgContent -> MsgContentType
toMsgContentType = \case
MCText _ -> MCText_
MCUnknown -> MCUnknown_
rawMsgType :: MessageType -> ByteString
rawMsgType = \case
MTText -> "c.text"
MTImage -> "c.image"
instance FromJSON MsgContent where
parseJSON (J.Object v) = do
v .: "type" >>= \case
MCText_ -> MCText <$> v .: "text"
MCUnknown_ -> pure MCUnknown
parseJSON invalid =
JT.prependFailure "bad MsgContent, " (JT.typeMismatch "Object" invalid)
data ChatMessage = ChatMessage
{ chatMsgId :: Maybe Int64,
chatMsgEvent :: ChatMsgEvent,
chatDAG :: Maybe ByteString
}
deriving (Eq, Show)
unknownMsgType :: Text
unknownMsgType = "unknown message type"
toChatEventType :: ChatMsgEvent -> Text
toChatEventType = \case
XMsgNew _ -> "x.msg.new"
XFile _ -> "x.file"
XFileAcpt _ -> "x.file.acpt"
XInfo _ -> "x.info"
XContact _ _ -> "x.con"
XGrpInv _ -> "x.grp.inv"
XGrpAcpt _ -> "x.grp.acpt"
XGrpMemNew _ -> "x.grp.mem.new"
XGrpMemIntro _ -> "x.grp.mem.intro"
XGrpMemInv _ _ -> "x.grp.mem.inv"
XGrpMemFwd _ _ -> "x.grp.mem.fwd"
XGrpMemInfo _ _ -> "x.grp.mem.info"
XGrpMemCon _ -> "x.grp.mem.con"
XGrpMemConAll _ -> "x.grp.mem.con.all"
XGrpMemDel _ -> "x.grp.mem.del"
XGrpLeave -> "x.grp.leave"
XGrpDel -> "x.grp.del"
XInfoProbe _ -> "x.info.probe"
XInfoProbeCheck _ -> "x.info.probe.check"
XInfoProbeOk _ -> "x.info.probe.ok"
XOk -> "x.ok"
instance ToJSON MsgContent where
toJSON mc =
J.object $
("type" .= toMsgContentType mc) : case mc of
MCText t -> ["text" .= t]
MCUnknown -> ["text" .= unknownMsgType]
toEncoding mc =
J.pairs $
("type" .= toMsgContentType mc) <> case mc of
MCText t -> "text" .= t
MCUnknown -> "text" .= unknownMsgType
toChatMessage :: RawChatMessage -> Either String ChatMessage
toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody} = do
(chatDAG, body) <- getDAG <$> mapM toMsgBodyContent chatMsgBody
let chatMsg msg = pure ChatMessage {chatMsgId, chatMsgEvent = msg, chatDAG}
case (chatMsgEvent, chatMsgParams) of
("x.msg.new", mt : rawFiles) -> do
t <- toMsgType mt
files <- toFiles rawFiles
chatMsg . XMsgNew $ MsgContent {messageType = t, files, content = body}
("x.file", [name, size, cReq]) -> do
let fileName = T.unpack $ safeDecodeUtf8 name
fileSize <- parseAll A.decimal size
fileConnReq <- parseAll connReqP' cReq
chatMsg . XFile $ FileInvitation {fileName, fileSize, fileConnReq}
("x.file.acpt", [name]) ->
chatMsg . XFileAcpt . T.unpack $ safeDecodeUtf8 name
("x.info", []) -> do
profile <- getJSON body
chatMsg $ XInfo profile
("x.con", []) -> do
profile <- getJSON body
chatMsg $ XContact profile Nothing
("x.con", mt : rawFiles) -> do
(profile, body') <- extractJSON body
t <- toMsgType mt
files <- toFiles rawFiles
chatMsg . XContact profile $ Just MsgContent {messageType = t, files, content = body'}
("x.grp.inv", [fromMemId, fromRole, memId, role, cReq]) -> do
fromMem <- (,) <$> B64.decode fromMemId <*> toMemberRole fromRole
invitedMem <- (,) <$> B64.decode memId <*> toMemberRole role
groupConnReq <- parseAll connReqP' cReq
profile <- getJSON body
chatMsg . XGrpInv $ GroupInvitation fromMem invitedMem groupConnReq profile
("x.grp.acpt", [memId]) ->
chatMsg . XGrpAcpt =<< B64.decode memId
("x.grp.mem.new", [memId, role]) -> do
chatMsg . XGrpMemNew =<< toMemberInfo memId role body
("x.grp.mem.intro", [memId, role]) ->
chatMsg . XGrpMemIntro =<< toMemberInfo memId role body
("x.grp.mem.inv", [memId, groupConnReq, directConnReq]) ->
chatMsg =<< (XGrpMemInv <$> B64.decode memId <*> toIntroInv groupConnReq directConnReq)
("x.grp.mem.fwd", [memId, role, groupConnReq, directConnReq]) -> do
chatMsg =<< (XGrpMemFwd <$> toMemberInfo memId role body <*> toIntroInv groupConnReq directConnReq)
("x.grp.mem.info", [memId]) ->
chatMsg =<< (XGrpMemInfo <$> B64.decode memId <*> getJSON body)
("x.grp.mem.con", [memId]) ->
chatMsg . XGrpMemCon =<< B64.decode memId
("x.grp.mem.con.all", [memId]) ->
chatMsg . XGrpMemConAll =<< B64.decode memId
("x.grp.mem.del", [memId]) ->
chatMsg . XGrpMemDel =<< B64.decode memId
("x.grp.leave", []) ->
chatMsg XGrpLeave
("x.grp.del", []) ->
chatMsg XGrpDel
("x.info.probe", [probe]) -> do
chatMsg . XInfoProbe =<< B64.decode probe
("x.info.probe.check", [probeHash]) -> do
chatMsg . XInfoProbeCheck =<< B64.decode probeHash
("x.info.probe.ok", [probe]) -> do
chatMsg . XInfoProbeOk =<< B64.decode probe
("x.ok", []) ->
chatMsg XOk
_ -> Left $ "bad syntax or unsupported event " <> B.unpack chatMsgEvent
data CMEventTag
= XMsgNew_
| XFile_
| XFileAcpt_
| XInfo_
| XContact_
| XGrpInv_
| XGrpAcpt_
| XGrpMemNew_
| XGrpMemIntro_
| XGrpMemInv_
| XGrpMemFwd_
| XGrpMemInfo_
| XGrpMemCon_
| XGrpMemConAll_
| XGrpMemDel_
| XGrpLeave_
| XGrpDel_
| XInfoProbe_
| XInfoProbeCheck_
| XInfoProbeOk_
| XOk_
instance StrEncoding CMEventTag where
strEncode = \case
XMsgNew_ -> "x.msg.new"
XFile_ -> "x.file"
XFileAcpt_ -> "x.file.acpt"
XInfo_ -> "x.info"
XContact_ -> "x.contact"
XGrpInv_ -> "x.grp.inv"
XGrpAcpt_ -> "x.grp.acpt"
XGrpMemNew_ -> "x.grp.mem.new"
XGrpMemIntro_ -> "x.grp.mem.intro"
XGrpMemInv_ -> "x.grp.mem.inv"
XGrpMemFwd_ -> "x.grp.mem.fwd"
XGrpMemInfo_ -> "x.grp.mem.info"
XGrpMemCon_ -> "x.grp.mem.con"
XGrpMemConAll_ -> "x.grp.mem.con.all"
XGrpMemDel_ -> "x.grp.mem.del"
XGrpLeave_ -> "x.grp.leave"
XGrpDel_ -> "x.grp.del"
XInfoProbe_ -> "x.info.probe"
XInfoProbeCheck_ -> "x.info.probe.check"
XInfoProbeOk_ -> "x.info.probe.ok"
XOk_ -> "x.ok"
strDecode = \case
"x.msg.new" -> Right XMsgNew_
"x.file" -> Right XFile_
"x.file.acpt" -> Right XFileAcpt_
"x.info" -> Right XInfo_
"x.contact" -> Right XContact_
"x.grp.inv" -> Right XGrpInv_
"x.grp.acpt" -> Right XGrpAcpt_
"x.grp.mem.new" -> Right XGrpMemNew_
"x.grp.mem.intro" -> Right XGrpMemIntro_
"x.grp.mem.inv" -> Right XGrpMemInv_
"x.grp.mem.fwd" -> Right XGrpMemFwd_
"x.grp.mem.info" -> Right XGrpMemInfo_
"x.grp.mem.con" -> Right XGrpMemCon_
"x.grp.mem.con.all" -> Right XGrpMemConAll_
"x.grp.mem.del" -> Right XGrpMemDel_
"x.grp.leave" -> Right XGrpLeave_
"x.grp.del" -> Right XGrpDel_
"x.info.probe" -> Right XInfoProbe_
"x.info.probe.check" -> Right XInfoProbeCheck_
"x.info.probe.ok" -> Right XInfoProbeOk_
"x.ok" -> Right XOk_
_ -> Left "bad CMEventTag"
strP = strDecode <$?> A.takeTill (== ' ')
toCMEventTag :: ChatMsgEvent -> CMEventTag
toCMEventTag = \case
XMsgNew _ -> XMsgNew_
XFile _ -> XFile_
XFileAcpt _ -> XFileAcpt_
XInfo _ -> XInfo_
XContact _ _ -> XContact_
XGrpInv _ -> XGrpInv_
XGrpAcpt _ -> XGrpAcpt_
XGrpMemNew _ -> XGrpMemNew_
XGrpMemIntro _ -> XGrpMemIntro_
XGrpMemInv _ _ -> XGrpMemInv_
XGrpMemFwd _ _ -> XGrpMemFwd_
XGrpMemInfo _ _ -> XGrpMemInfo_
XGrpMemCon _ -> XGrpMemCon_
XGrpMemConAll _ -> XGrpMemConAll_
XGrpMemDel _ -> XGrpMemDel_
XGrpLeave -> XGrpLeave_
XGrpDel -> XGrpDel_
XInfoProbe _ -> XInfoProbe_
XInfoProbeCheck _ -> XInfoProbeCheck_
XInfoProbeOk _ -> XInfoProbeOk_
XOk -> XOk_
toChatEventTag :: ChatMsgEvent -> Text
toChatEventTag = decodeLatin1 . strEncode . toCMEventTag
appToChatMessage :: AppMessage -> Either String ChatMessage
appToChatMessage AppMessage {event, params} = do
eventTag <- strDecode $ encodeUtf8 event
chatMsgEvent <- msg eventTag
pure ChatMessage {chatMsgEvent}
where
getDAG :: [MsgContentBody] -> (Maybe ByteString, [MsgContentBody])
getDAG body = case break (isContentType SimplexDAG) body of
(b, MsgContentBody SimplexDAG dag : a) -> (Just dag, b <> a)
_ -> (Nothing, body)
toMemberInfo :: ByteString -> ByteString -> [MsgContentBody] -> Either String MemberInfo
toMemberInfo memId role body = MemberInfo <$> B64.decode memId <*> toMemberRole role <*> getJSON body
toIntroInv :: ByteString -> ByteString -> Either String IntroInvitation
toIntroInv groupConnReq directConnReq = IntroInvitation <$> parseAll connReqP' groupConnReq <*> parseAll connReqP' directConnReq
toContentInfo :: (RawContentType, Int) -> Either String (ContentType, Int)
toContentInfo (rawType, size) = (,size) <$> toContentType rawType
toFiles :: [ByteString] -> Either String [(ContentType, Int)]
toFiles = mapM $ toContentInfo <=< parseAll contentInfoP
getJSON :: FromJSON a => [MsgContentBody] -> Either String a
getJSON = J.eitherDecodeStrict' <=< getSimplexContentType XCJson
extractJSON :: FromJSON a => [MsgContentBody] -> Either String (a, [MsgContentBody])
extractJSON =
extractSimplexContentType XCJson >=> \(a, bs) -> do
j <- J.eitherDecodeStrict' a
pure (j, bs)
p :: FromJSON a => Text -> Either String a
p key = JT.parseEither (.: key) params
msg = \case
XMsgNew_ -> XMsgNew <$> p "content"
XFile_ -> XFile <$> p "file"
XFileAcpt_ -> XFileAcpt <$> p "fileName"
XInfo_ -> XInfo <$> p "profile"
XContact_ -> XContact <$> p "profile" <*> JT.parseEither (.:? "content") params
XGrpInv_ -> XGrpInv <$> p "groupInvitation"
XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo"
XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
XGrpMemFwd_ -> XGrpMemFwd <$> p "memberInfo" <*> p "memberIntro"
XGrpMemInfo_ -> XGrpMemInfo <$> p "memberId" <*> p "profile"
XGrpMemCon_ -> XGrpMemCon <$> p "memberId"
XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId"
XGrpMemDel_ -> XGrpMemDel <$> p "memberId"
XGrpLeave_ -> pure XGrpLeave
XGrpDel_ -> pure XGrpDel
XInfoProbe_ -> XInfoProbe <$> p "probe"
XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
XOk_ -> pure XOk
isContentType :: ContentType -> MsgContentBody -> Bool
isContentType t MsgContentBody {contentType = t'} = t == t'
isSimplexContentType :: XContentType -> MsgContentBody -> Bool
isSimplexContentType = isContentType . SimplexContentType
getContentType :: ContentType -> [MsgContentBody] -> Either String ByteString
getContentType t body = case find (isContentType t) body of
Just MsgContentBody {contentData} -> Right contentData
Nothing -> Left "no required content type"
extractContentType :: ContentType -> [MsgContentBody] -> Either String (ByteString, [MsgContentBody])
extractContentType t body = case findIndex (isContentType t) body of
Just i -> case splitAt i body of
(b, el : a) -> Right (contentData (el :: MsgContentBody), b ++ a)
(_, []) -> Left "no required content type" -- this can only happen if findIndex returns incorrect result
Nothing -> Left "no required content type"
getSimplexContentType :: XContentType -> [MsgContentBody] -> Either String ByteString
getSimplexContentType = getContentType . SimplexContentType
extractSimplexContentType :: XContentType -> [MsgContentBody] -> Either String (ByteString, [MsgContentBody])
extractSimplexContentType = extractContentType . SimplexContentType
rawChatMessage :: ChatMessage -> RawChatMessage
rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
case chatMsgEvent of
XMsgNew MsgContent {messageType = t, files, content} ->
rawMsg (rawMsgType t : toRawFiles files) content
XFile FileInvitation {fileName, fileSize, fileConnReq} ->
rawMsg [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeConnReq' fileConnReq] []
XFileAcpt fileName ->
rawMsg [encodeUtf8 $ T.pack fileName] []
XInfo profile ->
rawMsg [] [jsonBody profile]
XContact profile Nothing ->
rawMsg [] [jsonBody profile]
XContact profile (Just MsgContent {messageType = t, files, content}) ->
rawMsg (rawMsgType t : toRawFiles files) (jsonBody profile : content)
XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) cReq groupProfile) ->
let params =
[ B64.encode fromMemId,
serializeMemberRole fromRole,
B64.encode memId,
serializeMemberRole role,
serializeConnReq' cReq
]
in rawMsg params [jsonBody groupProfile]
XGrpAcpt memId ->
rawMsg [B64.encode memId] []
XGrpMemNew (MemberInfo memId role profile) ->
let params = [B64.encode memId, serializeMemberRole role]
in rawMsg params [jsonBody profile]
XGrpMemIntro (MemberInfo memId role profile) ->
rawMsg [B64.encode memId, serializeMemberRole role] [jsonBody profile]
XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq} ->
let params = [B64.encode memId, serializeConnReq' groupConnReq, serializeConnReq' directConnReq]
in rawMsg params []
XGrpMemFwd (MemberInfo memId role profile) IntroInvitation {groupConnReq, directConnReq} ->
let params =
[ B64.encode memId,
serializeMemberRole role,
serializeConnReq' groupConnReq,
serializeConnReq' directConnReq
]
in rawMsg params [jsonBody profile]
XGrpMemInfo memId profile ->
rawMsg [B64.encode memId] [jsonBody profile]
XGrpMemCon memId ->
rawMsg [B64.encode memId] []
XGrpMemConAll memId ->
rawMsg [B64.encode memId] []
XGrpMemDel memId ->
rawMsg [B64.encode memId] []
XGrpLeave ->
rawMsg [] []
XGrpDel ->
rawMsg [] []
XInfoProbe probe ->
rawMsg [B64.encode probe] []
XInfoProbeCheck probeHash ->
rawMsg [B64.encode probeHash] []
XInfoProbeOk probe ->
rawMsg [B64.encode probe] []
XOk ->
rawMsg [] []
chatToAppMessage :: ChatMessage -> AppMessage
chatToAppMessage ChatMessage {chatMsgEvent} = AppMessage {event, params}
where
rawMsg :: [ByteString] -> [MsgContentBody] -> RawChatMessage
rawMsg chatMsgParams body = do
let event = encodeUtf8 $ toChatEventType chatMsgEvent
RawChatMessage {chatMsgId, chatMsgEvent = event, chatMsgParams, chatMsgBody = rawWithDAG body}
rawContentInfo :: (ContentType, Int) -> (RawContentType, Int)
rawContentInfo (t, size) = (rawContentType t, size)
jsonBody :: ToJSON a => a -> MsgContentBody
jsonBody x =
let json = LB.toStrict $ J.encode x
in MsgContentBody {contentType = SimplexContentType XCJson, contentData = json}
rawWithDAG :: [MsgContentBody] -> [RawMsgBodyContent]
rawWithDAG body = map rawMsgBodyContent $ case chatDAG of
Nothing -> body
Just dag -> MsgContentBody {contentType = SimplexDAG, contentData = dag} : body
toRawFiles :: [(ContentType, Int)] -> [ByteString]
toRawFiles = map $ serializeContentInfo . rawContentInfo
toMsgBodyContent :: RawMsgBodyContent -> Either String MsgContentBody
toMsgBodyContent RawMsgBodyContent {contentType, contentData} = do
cType <- toContentType contentType
pure MsgContentBody {contentType = cType, contentData}
rawMsgBodyContent :: MsgContentBody -> RawMsgBodyContent
rawMsgBodyContent MsgContentBody {contentType = t, contentData} =
RawMsgBodyContent {contentType = rawContentType t, contentData}
data MsgContentBody = MsgContentBody
{ contentType :: ContentType,
contentData :: ByteString
}
deriving (Eq, Show)
data ContentType
= SimplexContentType XContentType
| MimeContentType MContentType
| SimplexDAG
deriving (Eq, Show)
data XContentType = XCText | XCImage | XCJson deriving (Eq, Show)
data MContentType = MCImageJPG | MCImagePNG deriving (Eq, Show)
toContentType :: RawContentType -> Either String ContentType
toContentType (RawContentType ns cType) = case ns of
"x" -> case cType of
"text" -> Right $ SimplexContentType XCText
"image" -> Right $ SimplexContentType XCImage
"json" -> Right $ SimplexContentType XCJson
"dag" -> Right SimplexDAG
_ -> err
"m" -> case cType of
"image/jpg" -> Right $ MimeContentType MCImageJPG
"image/png" -> Right $ MimeContentType MCImagePNG
_ -> err
_ -> err
where
err = Left . B.unpack $ "invalid content type " <> ns <> "." <> cType
rawContentType :: ContentType -> RawContentType
rawContentType t = case t of
SimplexContentType t' -> RawContentType "x" $ case t' of
XCText -> "text"
XCImage -> "image"
XCJson -> "json"
MimeContentType t' -> RawContentType "m" $ case t' of
MCImageJPG -> "image/jpg"
MCImagePNG -> "image/png"
SimplexDAG -> RawContentType "x" "dag"
newtype ContentMsg = NewContentMsg ContentData
newtype ContentData = ContentText Text
data RawChatMessage = RawChatMessage
{ chatMsgId :: Maybe Int64,
chatMsgEvent :: ByteString,
chatMsgParams :: [ByteString],
chatMsgBody :: [RawMsgBodyContent]
}
deriving (Eq, Show)
data RawMsgBodyContent = RawMsgBodyContent
{ contentType :: RawContentType,
contentData :: ByteString
}
deriving (Eq, Show)
data RawContentType = RawContentType NameSpace ByteString
deriving (Eq, Show)
type NameSpace = ByteString
newtype MsgData = MsgData ByteString
deriving (Eq, Show)
class DataLength a where
dataLength :: a -> Int
rawChatMessageP :: Parser RawChatMessage
rawChatMessageP = do
chatMsgId <- optional A.decimal <* A.space
chatMsgEvent <- B.intercalate "." <$> identifierP `A.sepBy1'` A.char '.' <* A.space
chatMsgParams <- A.takeWhile1 (not . A.inClass ", ") `A.sepBy'` A.char ',' <* A.space
chatMsgBody <- msgBodyContent =<< contentInfoP `A.sepBy'` A.char ',' <* A.space
pure RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody}
where
msgBodyContent :: [(RawContentType, Int)] -> Parser [RawMsgBodyContent]
msgBodyContent [] = pure []
msgBodyContent ((contentType, size) : ps) = do
contentData <- A.take size <* A.space
((RawMsgBodyContent {contentType, contentData}) :) <$> msgBodyContent ps
contentInfoP :: Parser (RawContentType, Int)
contentInfoP = do
contentType <- RawContentType <$> identifierP <* A.char '.' <*> A.takeTill (A.inClass ":, ")
size <- A.char ':' *> A.decimal
pure (contentType, size)
identifierP :: Parser ByteString
identifierP = B.cons <$> A.letter_ascii <*> A.takeWhile (\c -> A.isAlpha_ascii c || A.isDigit c)
serializeRawChatMessage :: RawChatMessage -> ByteString
serializeRawChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBody} =
B.unwords
[ maybe "" bshow chatMsgId,
chatMsgEvent,
B.intercalate "," chatMsgParams,
B.unwords $ map serializeBodyContentInfo chatMsgBody,
B.unwords $ map msgContentData chatMsgBody
]
serializeBodyContentInfo :: RawMsgBodyContent -> ByteString
serializeBodyContentInfo RawMsgBodyContent {contentType = t, contentData} =
serializeContentInfo (t, B.length contentData)
serializeContentInfo :: (RawContentType, Int) -> ByteString
serializeContentInfo (RawContentType ns cType, size) = ns <> "." <> cType <> ":" <> bshow size
msgContentData :: RawMsgBodyContent -> ByteString
msgContentData RawMsgBodyContent {contentData} = contentData <> " "
event = toChatEventTag chatMsgEvent
o :: [(Text, J.Value)] -> J.Object
o = H.fromList
params = case chatMsgEvent of
XMsgNew content -> o ["content" .= content]
XFile fileInv -> o ["file" .= fileInv]
XFileAcpt fileName -> o ["fileName" .= fileName]
XInfo profile -> o ["profile" .= profile]
XContact profile content -> o $ maybe id ((:) . ("content" .=)) content ["profile" .= profile]
XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
XGrpAcpt memId -> o ["memberId" .= memId]
XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
XGrpMemIntro memInfo -> o ["memberInfo" .= memInfo]
XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]
XGrpMemFwd memInfo memIntro -> o ["memberInfo" .= memInfo, "memberIntro" .= memIntro]
XGrpMemInfo memId profile -> o ["memberId" .= memId, "profile" .= profile]
XGrpMemCon memId -> o ["memberId" .= memId]
XGrpMemConAll memId -> o ["memberId" .= memId]
XGrpMemDel memId -> o ["memberId" .= memId]
XGrpLeave -> H.empty
XGrpDel -> H.empty
XInfoProbe probe -> o ["probe" .= probe]
XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
XInfoProbeOk probe -> o ["probe" .= probe]
XOk -> H.empty

60
src/Simplex/Chat/Store.hs
View File

@@ -90,7 +90,6 @@ module Simplex.Chat.Store
deleteRcvFileChunks,
getFileTransfer,
getFileTransferProgress,
getOnboarding,
createNewMessage,
createSndMsgDelivery,
createNewMessageAndRcvMsgDelivery,
@@ -145,7 +144,7 @@ createStore :: FilePath -> Int -> IO SQLiteStore
createStore dbFilePath poolSize = createSQLiteStore dbFilePath poolSize migrations
chatStoreFile :: FilePath -> FilePath
chatStoreFile = (<> ".chat.db")
chatStoreFile = (<> "_chat.db")
checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
checkConstraint err action = action `E.catch` (pure . Left . handleSQLError err)
@@ -667,20 +666,20 @@ getMatchingContacts st userId Contact {contactId, profile = Profile {displayName
]
rights <$> mapM (runExceptT . getContact_ db userId) contactNames
createSentProbe :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> UserId -> Contact -> m (ByteString, Int64)
createSentProbe :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> UserId -> Contact -> m (Probe, Int64)
createSentProbe st gVar userId _to@Contact {contactId} =
liftIOEither . withTransaction st $ \db ->
createWithRandomBytes 32 gVar $ \probe -> do
DB.execute db "INSERT INTO sent_probes (contact_id, probe, user_id) VALUES (?,?,?)" (contactId, probe, userId)
(probe,) <$> insertedRowId db
(Probe probe,) <$> insertedRowId db
createSentProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> Contact -> m ()
createSentProbeHash st userId probeId _to@Contact {contactId} =
liftIO . withTransaction st $ \db ->
DB.execute db "INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, user_id) VALUES (?,?,?)" (probeId, contactId, userId)
matchReceivedProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe Contact)
matchReceivedProbe st userId _from@Contact {contactId} probe =
matchReceivedProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Probe -> m (Maybe Contact)
matchReceivedProbe st userId _from@Contact {contactId} (Probe probe) =
liftIO . withTransaction st $ \db -> do
let probeHash = C.sha256Hash probe
contactNames <-
@@ -701,8 +700,8 @@ matchReceivedProbe st userId _from@Contact {contactId} probe =
either (const Nothing) Just
<$> runExceptT (getContact_ db userId cName)
matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe (Contact, ByteString))
matchReceivedProbeHash st userId _from@Contact {contactId} probeHash =
matchReceivedProbeHash :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ProbeHash -> m (Maybe (Contact, Probe))
matchReceivedProbeHash st userId _from@Contact {contactId} (ProbeHash probeHash) =
liftIO . withTransaction st $ \db -> do
namesAndProbes <-
DB.query
@@ -718,11 +717,11 @@ matchReceivedProbeHash st userId _from@Contact {contactId} probeHash =
case namesAndProbes of
[] -> pure Nothing
(cName, probe) : _ ->
either (const Nothing) (Just . (,probe))
either (const Nothing) (Just . (,Probe probe))
<$> runExceptT (getContact_ db userId cName)
matchSentProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> ByteString -> m (Maybe Contact)
matchSentProbe st userId _from@Contact {contactId} probe =
matchSentProbe :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> Probe -> m (Maybe Contact)
matchSentProbe st userId _from@Contact {contactId} (Probe probe) =
liftIO . withTransaction st $ \db -> do
contactNames <-
map fromOnly
@@ -889,7 +888,7 @@ createNewGroup st gVar user groupProfile =
DB.execute db "INSERT INTO groups (local_display_name, user_id, group_profile_id) VALUES (?, ?, ?)" (displayName, uId, profileId)
groupId <- insertedRowId db
memberId <- randomBytes gVar 12
membership <- createContactMember_ db user groupId user (memberId, GROwner) GCUserMember GSMemCreator IBUser
membership <- createContactMember_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser
pure $ Right Group {groupId, localDisplayName = displayName, groupProfile, members = [], membership}
-- | creates a new group record for the group the current user was invited to, or returns an existing one
@@ -1022,7 +1021,7 @@ getGroupInvitation st user localDisplayName =
findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId)
findFromContact _ = const Nothing
type GroupMemberRow = (Int64, Int64, ByteString, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text)
type GroupMemberRow = (Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Maybe Int64, ContactName, Maybe Int64, ContactName, Text)
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId (groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, localDisplayName, memberContactId, displayName, fullName) =
@@ -1035,7 +1034,7 @@ createContactMember :: StoreMonad m => SQLiteStore -> TVar ChaChaDRG -> User ->
createContactMember st gVar user groupId contact memberRole agentConnId connRequest =
liftIOEither . withTransaction st $ \db ->
createWithRandomId gVar $ \memId -> do
member@GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact (memId, memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest)
member@GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact (MemberIdRole (MemberId memId) memberRole) GCInviteeMember GSMemInvited IBUser (Just connRequest)
void $ createMemberConnection_ db (userId user) groupMemberId agentConnId Nothing 0
pure member
@@ -1043,7 +1042,7 @@ getMemberInvitation :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Maybe
getMemberInvitation st User {userId} groupMemberId =
liftIO . withTransaction st $ \db ->
join . listToMaybe . map fromOnly
<$> DB.query db "SELECT inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?;" (groupMemberId, userId)
<$> DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?;" (groupMemberId, userId)
createMemberConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> GroupMember -> ConnId -> m ()
createMemberConnection st userId GroupMember {groupMemberId} agentConnId =
@@ -1269,12 +1268,12 @@ createIntroToMemberContact st userId GroupMember {memberContactId = viaContactId
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe Int64 -> Int -> IO Connection
createMemberConnection_ db userId groupMemberId = createConnection_ db userId ConnMember (Just groupMemberId)
createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
createContactMember_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy =
createContactMemberInv_ db user groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy Nothing
createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
createContactMember_ db user groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy =
createContactMemberInv_ db user groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy Nothing
createContactMemberInv_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember
createContactMemberInv_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy connRequest = do
createContactMemberInv_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ConnReqInvitation -> IO GroupMember
createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy connRequest = do
insertMember_
groupMemberId <- insertedRowId db
let memberProfile = profile' userOrContact
@@ -1289,12 +1288,12 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact (m
[sql|
INSERT INTO group_members
( group_id, member_id, member_role, member_category, member_status, invited_by,
user_id, local_display_name, contact_profile_id, contact_id, inv_queue_info)
user_id, local_display_name, contact_profile_id, contact_id, sent_inv_queue_info)
VALUES
(:group_id,:member_id,:member_role,:member_category,:member_status,:invited_by,
:user_id,:local_display_name,
(SELECT contact_profile_id FROM contacts WHERE contact_id = :contact_id),
:contact_id, :inv_queue_info)
:contact_id, :sent_inv_queue_info)
|]
[ ":group_id" := groupId,
":member_id" := memberId,
@@ -1305,7 +1304,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact (m
":user_id" := userId,
":local_display_name" := localDisplayName' userOrContact,
":contact_id" := contactId' userOrContact,
":inv_queue_info" := connRequest
":sent_inv_queue_info" := connRequest
]
getViaGroupMember :: MonadUnliftIO m => SQLiteStore -> User -> Contact -> m (Maybe (GroupName, GroupMember))
@@ -1625,21 +1624,6 @@ getSndFileTransfers_ db userId fileId =
Just recipientDisplayName -> Right SndFileTransfer {..}
Nothing -> Left $ SESndFileInvalid fileId
getOnboarding :: MonadUnliftIO m => SQLiteStore -> UserId -> m Onboarding
getOnboarding st userId =
liftIO . withTransaction st $ \db -> do
contactsCount <- intQuery db "SELECT COUNT(contact_id) FROM contacts WHERE user_id = ? AND is_user = 0"
createdGroups <- headOrZero <$> DB.query db "SELECT COUNT(g.group_id) FROM groups g JOIN group_members m WHERE g.user_id = ? AND m.member_status = ?" (userId, GSMemCreator)
membersCount <- headOrZero <$> DB.query db "SELECT COUNT(group_member_id) FROM group_members WHERE user_id = ? AND (member_status = ? OR member_status = ?)" (userId, GSMemConnected, GSMemComplete)
filesSentCount <- intQuery db "SELECT COUNT(s.file_id) FROM snd_files s JOIN files f USING (file_id) WHERE f.user_id = ?"
addressCount <- intQuery db "SELECT COUNT(user_contact_link_id) FROM user_contact_links WHERE user_id = ?"
pure $ Onboarding {..}
where
intQuery :: DB.Connection -> DB.Query -> IO Int
intQuery db q = headOrZero <$> DB.query db q (Only userId)
headOrZero [] = 0
headOrZero (n : _) = fromOnly n
createNewMessage :: MonadUnliftIO m => SQLiteStore -> NewMessage -> m MessageId
createNewMessage st newMsg =
liftIO . withTransaction st $ \db ->

176
src/Simplex/Chat/Types.hs
View File

@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
@@ -11,8 +12,10 @@
module Simplex.Chat.Types where
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson (FromJSON, ToJSON, (.:), (.=))
import qualified Data.Aeson as J
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
@@ -29,9 +32,11 @@ import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok (Ok (Ok))
import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, ConnectionMode (..), ConnectionRequest, InvitationId, MsgMeta (..), serializeMsgIntegrity)
import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, MsgMeta (..), serializeMsgIntegrity)
import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (MsgBody)
import Simplex.Messaging.Util ((<$?>))
class IsContact a where
contactId' :: a -> Int64
@@ -106,41 +111,56 @@ data Profile = Profile
{ displayName :: ContactName,
fullName :: Text
}
deriving (Generic, Eq, Show)
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON Profile where toEncoding = J.genericToEncoding J.defaultOptions
instance FromJSON Profile
data GroupProfile = GroupProfile
{ displayName :: GroupName,
fullName :: Text
}
deriving (Generic, Eq, Show)
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON GroupProfile where toEncoding = J.genericToEncoding J.defaultOptions
instance FromJSON GroupProfile
data GroupInvitation = GroupInvitation
{ fromMember :: (MemberId, GroupMemberRole),
invitedMember :: (MemberId, GroupMemberRole),
{ fromMember :: MemberIdRole,
invitedMember :: MemberIdRole,
connRequest :: ConnReqInvitation,
groupProfile :: GroupProfile
}
deriving (Eq, Show)
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON GroupInvitation where toEncoding = J.genericToEncoding J.defaultOptions
data MemberIdRole = MemberIdRole
{ memberId :: MemberId,
memberRole :: GroupMemberRole
}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON MemberIdRole where toEncoding = J.genericToEncoding J.defaultOptions
data IntroInvitation = IntroInvitation
{ groupConnReq :: ConnReqInvitation,
directConnReq :: ConnReqInvitation
}
deriving (Eq, Show)
deriving (Eq, Show, Generic, FromJSON)
data MemberInfo = MemberInfo MemberId GroupMemberRole Profile
deriving (Eq, Show)
instance ToJSON IntroInvitation where toEncoding = J.genericToEncoding J.defaultOptions
data MemberInfo = MemberInfo
{ memberId :: MemberId,
memberRole :: GroupMemberRole,
profile :: Profile
}
deriving (Eq, Show, Generic, FromJSON)
instance ToJSON MemberInfo where toEncoding = J.genericToEncoding J.defaultOptions
memberInfo :: GroupMember -> MemberInfo
memberInfo m = MemberInfo (memberId m) (memberRole m) (memberProfile m)
memberInfo GroupMember {memberId, memberRole, memberProfile} =
MemberInfo memberId memberRole memberProfile
data ReceivedGroupInvitation = ReceivedGroupInvitation
{ fromMember :: GroupMember,
@@ -183,7 +203,24 @@ data NewGroupMember = NewGroupMember
memContactId :: Maybe Int64
}
type MemberId = ByteString
newtype MemberId = MemberId {unMemberId :: ByteString}
deriving (Eq, Show)
instance FromField MemberId where fromField f = MemberId <$> fromField f
instance ToField MemberId where toField (MemberId m) = toField m
instance StrEncoding MemberId where
strEncode (MemberId m) = strEncode m
strDecode s = MemberId <$> strDecode s
strP = MemberId <$> strP
instance FromJSON MemberId where
parseJSON = strParseJSON "MemberId"
instance ToJSON MemberId where
toJSON = strToJSON
toEncoding = strToJEncoding
data InvitedBy = IBContact Int64 | IBUser | IBUnknown
deriving (Eq, Show)
@@ -203,22 +240,28 @@ fromInvitedBy userCtId = \case
data GroupMemberRole = GRMember | GRAdmin | GROwner
deriving (Eq, Show, Ord)
instance FromField GroupMemberRole where fromField = fromBlobField_ toMemberRole
instance FromField GroupMemberRole where fromField = fromBlobField_ strDecode
instance ToField GroupMemberRole where toField = toField . serializeMemberRole
instance ToField GroupMemberRole where toField = toField . strEncode
toMemberRole :: ByteString -> Either String GroupMemberRole
toMemberRole = \case
"owner" -> Right GROwner
"admin" -> Right GRAdmin
"member" -> Right GRMember
r -> Left $ "invalid group member role " <> B.unpack r
instance StrEncoding GroupMemberRole where
strEncode = \case
GROwner -> "owner"
GRAdmin -> "admin"
GRMember -> "member"
strDecode = \case
"owner" -> Right GROwner
"admin" -> Right GRAdmin
"member" -> Right GRMember
r -> Left $ "bad GroupMemberRole " <> B.unpack r
strP = strDecode <$?> A.takeByteString
serializeMemberRole :: GroupMemberRole -> ByteString
serializeMemberRole = \case
GROwner -> "owner"
GRAdmin -> "admin"
GRMember -> "member"
instance FromJSON GroupMemberRole where
parseJSON = strParseJSON "GroupMemberRole"
instance ToJSON GroupMemberRole where
toJSON = strToJSON
toEncoding = strToJEncoding
fromBlobField_ :: Typeable k => (ByteString -> Either String k) -> FieldParser k
fromBlobField_ p = \case
@@ -228,6 +271,36 @@ fromBlobField_ p = \case
Left e -> returnError ConversionFailed f ("could not parse field: " ++ e)
f -> returnError ConversionFailed f "expecting SQLBlob column type"
newtype Probe = Probe {unProbe :: ByteString}
deriving (Eq, Show)
instance StrEncoding Probe where
strEncode (Probe p) = strEncode p
strDecode s = Probe <$> strDecode s
strP = Probe <$> strP
instance FromJSON Probe where
parseJSON = strParseJSON "Probe"
instance ToJSON Probe where
toJSON = strToJSON
toEncoding = strToJEncoding
newtype ProbeHash = ProbeHash {unProbeHash :: ByteString}
deriving (Eq, Show)
instance StrEncoding ProbeHash where
strEncode (ProbeHash p) = strEncode p
strDecode s = ProbeHash <$> strDecode s
strP = ProbeHash <$> strP
instance FromJSON ProbeHash where
parseJSON = strParseJSON "ProbeHash"
instance ToJSON ProbeHash where
toJSON = strToJSON
toEncoding = strToJEncoding
data GroupMemberCategory
= GCUserMember
| GCInviteeMember -- member invited by the user
@@ -350,7 +423,24 @@ data FileInvitation = FileInvitation
fileSize :: Integer,
fileConnReq :: ConnReqInvitation
}
deriving (Eq, Show)
deriving (Eq, Show, Generic)
instance FromJSON FileInvitation where
parseJSON (J.Object v) = FileInvitation <$> v .: "fileName" <*> v .: "fileSize" <*> v .: "fileConnReq"
parseJSON invalid = JT.prependFailure "bad FileInvitation, " (JT.typeMismatch "Object" invalid)
instance ToJSON FileInvitation where
toJSON (FileInvitation fileName fileSize fileConnReq) =
J.object
[ "fileName" .= fileName,
"fileSize" .= fileSize,
"fileConnReq" .= fileConnReq
]
toEncoding (FileInvitation fileName fileSize fileConnReq) =
J.pairs $
"fileName" .= fileName
<> "fileSize" .= fileSize
<> "fileConnReq" .= fileConnReq
data RcvFileTransfer = RcvFileTransfer
{ fileId :: Int64,
@@ -404,9 +494,9 @@ serializeFileStatus = \case
data RcvChunkStatus = RcvChunkOk | RcvChunkFinal | RcvChunkDuplicate | RcvChunkError
deriving (Eq, Show)
type ConnReqInvitation = ConnectionRequest 'CMInvitation
type ConnReqInvitation = ConnectionRequestUri 'CMInvitation
type ConnReqContact = ConnectionRequest 'CMContact
type ConnReqContact = ConnectionRequestUri 'CMContact
data Connection = Connection
{ connId :: Int64,
@@ -534,14 +624,6 @@ serializeIntroStatus = \case
GMIntroToConnected -> "to-con"
GMIntroConnected -> "con"
data Onboarding = Onboarding
{ contactsCount :: Int,
createdGroups :: Int,
membersCount :: Int,
filesSentCount :: Int,
addressCount :: Int
}
data NewMessage = NewMessage
{ direction :: MsgDirection,
chatMsgEventType :: Text,
@@ -592,7 +674,7 @@ data RcvMsgDelivery = RcvMsgDelivery
agentMsgMeta :: MsgMeta
}
data MsgMetaJ = MsgMetaJ
data MsgMetaJSON = MsgMetaJSON
{ integrity :: Text,
rcvId :: Int64,
rcvTs :: UTCTime,
@@ -600,15 +682,13 @@ data MsgMetaJ = MsgMetaJ
serverTs :: UTCTime,
sndId :: Int64
}
deriving (Generic, Eq, Show)
deriving (Eq, Show, FromJSON, Generic)
instance ToJSON MsgMetaJ where toEncoding = J.genericToEncoding J.defaultOptions
instance ToJSON MsgMetaJSON where toEncoding = J.genericToEncoding J.defaultOptions
instance FromJSON MsgMetaJ
msgMetaToJson :: MsgMeta -> MsgMetaJ
msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sender = (sndId, _)} =
MsgMetaJ
msgMetaToJson :: MsgMeta -> MsgMetaJSON
msgMetaToJson MsgMeta {integrity, recipient = (rcvId, rcvTs), broker = (serverId, serverTs), sndMsgId = sndId} =
MsgMetaJSON
{ integrity = (decodeLatin1 . serializeMsgIntegrity) integrity,
rcvId,
rcvTs,

13
src/Simplex/Chat/View.hs
View File

@@ -1,4 +1,5 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
@@ -102,6 +103,7 @@ import Simplex.Chat.Terminal (printToTerminal)
import Simplex.Chat.Types
import Simplex.Chat.Util (safeDecodeUtf8)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Encoding.String
import qualified Simplex.Messaging.Protocol as SMP
import System.Console.ANSI.Types
@@ -328,7 +330,7 @@ connReqInvitation_ :: ConnReqInvitation -> [StyledString]
connReqInvitation_ cReq =
[ "pass this invitation link to your contact (via another channel): ",
"",
(plain . serializeConnReq') cReq,
(plain . strEncode) cReq,
"",
"and ask them to connect: " <> highlight' "/c <invitation_link_above>"
]
@@ -380,7 +382,7 @@ connReqContact_ :: StyledString -> ConnReqContact -> [StyledString]
connReqContact_ intro cReq =
[ intro,
"",
(plain . serializeConnReq') cReq,
(plain . strEncode) cReq,
"",
"Anybody can send you contact requests with: " <> highlight' "/c <contact_link_above>",
"to show it again: " <> highlight' "/sa",
@@ -444,7 +446,7 @@ cannotResendInvitation g c =
receivedGroupInvitation :: Group -> ContactName -> GroupMemberRole -> [StyledString]
receivedGroupInvitation g@Group {localDisplayName} c role =
[ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (serializeMemberRole role),
[ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (strEncode role),
"use " <> highlight ("/j " <> localDisplayName) <> " to accept"
]
@@ -492,7 +494,7 @@ groupMembers Group {membership, members} = map groupMember . filter (not . remov
where
removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
groupMember m = ttyFullMember m <> ": " <> role m <> ", " <> category m <> status m
role = plain . serializeMemberRole . memberRole
role m = plain . strEncode $ memberRole (m :: GroupMember)
category m = case memberCategory m of
GCUserMember -> "you, "
GCInviteeMember -> "invited, "
@@ -753,6 +755,7 @@ chatError = \case
CEFileSend fileId e -> ["error sending file " <> sShow fileId <> ": " <> sShow e]
CEFileRcvChunk e -> ["error receiving file: " <> plain e]
CEFileInternal e -> ["file error: " <> plain e]
CEAgentVersion -> ["unsupported agent version"]
-- e -> ["chat error: " <> sShow e]
ChatErrorStore err -> case err of
SEDuplicateName -> ["this display name is already used by user, contact or group"]
@@ -831,4 +834,4 @@ styleTime :: String -> StyledString
styleTime = Styled [SetColor Foreground Vivid Black]
clientVersionInfo :: [StyledString]
clientVersionInfo = [plain $ "SimpleX Chat v" <> versionNumber]
clientVersionInfo = [plain versionStr, plain updateStr]

216
src/Simplex/Chat/protocol.md
View File

@@ -22,9 +22,6 @@ The syntax of the message inside agent MSG:
```abnf
agentMessageBody = [chatMsgId] SP msgEvent SP [parameters] SP [contentParts [SP msgBodyParts]]
chatMsgId = 1*DIGIT ; used to refer to previous message;
; in the group should only be used in messages sent to all members,
; which is the main reason not to use external agent ID -
; some messages are sent only to one member
msgEvent = protocolNamespace 1*("." msgTypeName)
protocolNamespace = 1*ALPHA ; "x" for all events defined in the protocol
msgTypeName = 1*ALPHA
@@ -68,6 +65,219 @@ refMsgHash = 16*16(OCTET) ; SHA256 of agent message body
' x.file name,size x.text:NNN <invitation> '
```
Chat message JTD:
```jsonc
{
"properties": {
"msgId": {"type": "string"},
"minVersion": {"type": "uint16"}, // Word16
"maxVersion": {"type": "uint16"}, // Word16
"event": {"type": "string"}, // Text e.g. s.ok
"params": {"values": {}}, // Map Text Value
},
"optionalProperties": {
"dag": {"type": "string"}
}
}
```
Events:
```jsonc
"event": "x.msg.new" // XMsgNew
"params": // MsgContent
{
"content": {
"msgType": "text",
// field "files" can be represented in content as contentType "file" with length prepended or as complex contentData
"text": "<msg text>"
}
// "content": [
// free form contentType for extensibility and/or complex content types? e.g. MIME
// could it be useful if contentData was free form as well? currently it is ByteString
// {"contentType": <content type>, "contentData": "<content data>"},
// ...
// {"contentType": <content type N>, "contentData": "<content data N>"}
// ]
}
"event": "x.file" // XFile; TODO rename into x.file.inv?
"params": // FileInvitation
{
"file": {
"fileName": "<file name>",
"fileSize": <file size>, // integer
"fileConnReq": "<file conn req>"
}
}
"event": "x.file.acpt" // XFileAcpt
"params": // String
{
"fileName": "<file name>"
}
"event": "x.info" // XInfo
"params": // Profile
{
"profile": {
"displayName": "<display name>",
"fullName": "<full name>"
}
}
"event": "x.contact" // XContact
"params": // Profile (Maybe MsgContent)
{
"profile": {
"displayName": "<display name>",
"fullName": "<full name>"
},
"content": {
"msgType": "text",
"text": "<msg text>"
} // optional
}
"event": "x.grp.inv" // XGrpInv
"params": // GroupInvitation
{
"groupInvitation": {
"fromMember": {
"memberId": "<from_member ID>",
"memberRole": "<from_member role>"
},
"invitedMember": {
"memberId": "<invited_member ID>",
"memberRole": "<invited_member role>"
},
"connRequest": "<conn request>",
"groupProfile": {
"displayName": "<display name>",
"fullName": "<full name>"
}
}
}
"event": "x.grp.acpt" // XGrpAcpt
"params": // MemberId
{
"memberId": "<member ID>"
}
"event": "x.grp.mem.new" // XGrpMemNew
"params": // MemberInfo
{
"memberInfo": {
"memberId": "<member ID>",
"memberRole": "<member role>",
"profile": {
"displayName": "<display name>",
"fullName": "<full name>"
}
}
}
"event": "x.grp.mem.intro" // XGrpMemIntro
"params": // MemberInfo
{
"memberInfo": {
"memberId": "<member ID>",
"memberRole": "<member role>",
"profile": {
"displayName": "<display name>",
"fullName": "<full name>"
}
}
}
"event": "x.grp.mem.inv" // XGrpMemInv
"params": // MemberId IntroInvitation
{
"memberId": "<member ID>",
"memberIntro": {
"groupConnReq": "<group conn req>",
"directConnReq": "<direct conn req>"
}
}
"event": "x.grp.mem.fwd" // XGrpMemFwd
"params": // MemberInfo IntroInvitation
{
"memberInfo": {
"memberId": "<member ID>",
"memberRole": "<member role>",
"profile": {
"displayName": "<display name>",
"fullName": "<full name>"
},
},
"memberIntro": {
"groupConnReq": "<group conn req>",
"directConnReq": "<direct conn req>"
}
}
"event": "x.grp.mem.info" // XGrpMemInfo
"params": // MemberId Profile
{
"memberId": "<member ID>",
"profile": {
"displayName": "<display name>",
"fullName": "<full name>"
}
}
"event": "x.grp.mem.con" // XGrpMemCon
"params": // MemberId
{
"memberId": "<member ID>"
}
"event": "x.grp.mem.con.all" // XGrpMemConAll
"params": // MemberId
{
"memberId": "<member ID>"
}
"event": "x.grp.mem.del" // XGrpMemDel
"params": // MemberId
{
"memberId": "<member ID>"
}
"event": "x.grp.leave" // XGrpLeave
"params":
{}
"event": "x.grp.del" // XGrpDel
"params":
{}
"event": "x.info.probe" // XInfoProbe
"params": // ByteString
{
"probe": "<probe>"
}
"event": "x.info.probe.check" // XInfoProbeCheck
"params": // ByteString
{
"probeHash": "<probe hash>"
}
"event": "x.info.probe.ok" // XInfoProbeOk
"params": // ByteString
{
"probe": "<probe>"
}
"event": "x.ok" // XOk
"params":
{}
```
### Group protocol
#### Add group member

9
stack.yaml
View File

@@ -38,10 +38,15 @@ extra-deps:
- cryptostore-0.2.1.0@sha256:9896e2984f36a1c8790f057fd5ce3da4cbcaf8aa73eb2d9277916886978c5b19,3881
- simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
- terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
- simplexmq-0.5.2@sha256:3544e479f353c1bbc6aa9405ef6976b78364f437d8af9cc45b9e0b228429e240,7884
- simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
# - github: simplex-chat/simplexmq
# commit: f15067cf6891bda3216c6cf6d2e3ecdba9b7269e
# commit: bfa4911217b71527a6fbaf73b242b5684aaf9fce
- github: simplex-chat/hs-tls
commit: cea6d52c512716ff09adcac86ebc95bb0b3bb797
subdirs:
- core
#
# extra-deps: []

42
tests/ChatClient.hs
View File

@@ -39,7 +39,7 @@ opts :: ChatOpts
opts =
ChatOpts
{ dbFile = undefined,
smpServers = ["localhost:5001"]
smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"]
}
termSettings :: VirtualTerminalSettings
@@ -66,12 +66,12 @@ cfg :: ChatConfig
cfg =
defaultChatConfig
{ agentConfig =
aCfg {retryInterval = (retryInterval aCfg) {initialInterval = 50000}}
aCfg {reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}}
}
virtualSimplexChat :: FilePath -> Profile -> IO TestCC
virtualSimplexChat dbFile profile = do
st <- createStore (dbFile <> ".chat.db") 1
st <- createStore (dbFile <> "_chat.db") 1
void . runExceptT $ createUser st profile True
t <- withVirtualTerminal termSettings pure
cc <- newChatController cfg opts {dbFile} t . const $ pure () -- no notifications
@@ -143,44 +143,16 @@ concurrentlyN_ = mapConcurrently_ id
serverCfg :: ServerConfig
serverCfg =
ServerConfig
{ transports = [(serverPort, transport @TCP)],
{ transports = [(serverPort, transport @TLS)],
tbqSize = 1,
serverTbqSize = 1,
msgQueueQuota = 4,
queueIdBytes = 12,
msgIdBytes = 6,
storeLog = Nothing,
blockSize = 4096,
serverPrivateKey =
-- full RSA private key (only for tests)
"MIIFIwIBAAKCAQEArZyrri/NAwt5buvYjwu+B/MQeJUszDBpRgVqNddlI9kNwDXu\
\kaJ8chEhrtaUgXeSWGooWwqjXEUQE6RVbCC6QVo9VEBSP4xFwVVd9Fj7OsgfcXXh\
\AqWxfctDcBZQ5jTUiJpdBc+Vz2ZkumVNl0W+j9kWm9nfkMLQj8c0cVSDxz4OKpZb\
\qFuj0uzHkis7e7wsrKSKWLPg3M5ZXPZM1m9qn7SfJzDRDfJifamxWI7uz9XK2+Dp\
\NkUQlGQgFJEv1cKN88JAwIqZ1s+TAQMQiB+4QZ2aNfSqGEzRJN7FMCKRK7pM0A9A\
\PCnijyuImvKFxTdk8Bx1q+XNJzsY6fBrLWJZ+QKBgQCySG4tzlcEm+tOVWRcwrWh\
\6zsczGZp9mbf9c8itRx6dlldSYuDG1qnddL70wuAZF2AgS1JZgvcRZECoZRoWP5q\
\Kq2wvpTIYjFPpC39lxgUoA/DXKVKZZdan+gwaVPAPT54my1CS32VrOiAY4gVJ3LJ\
\Mn1/FqZXUFQA326pau3loQKCAQEAoljmJMp88EZoy3HlHUbOjl5UEhzzVsU1TnQi\
\QmPm+aWRe2qelhjW4aTvSVE5mAUJsN6UWTeMf4uvM69Z9I5pfw2pEm8x4+GxRibY\
\iiwF2QNaLxxmzEHm1zQQPTgb39o8mgklhzFPill0JsnL3f6IkVwjFJofWSmpqEGs\
\dFSMRSXUTVXh1p/o7QZrhpwO/475iWKVS7o48N/0Xp513re3aXw+DRNuVnFEaBIe\
\TLvWM9Czn16ndAu1HYiTBuMvtRbAWnGZxU8ewzF4wlWK5tdIL5PTJDd1VhZJAKtB\
\npDvJpwxzKmjAhcTmjx0ckMIWtdVaOVm/2gWCXDty2FEdg7koQKBgQDOUUguJ/i7\
\q0jldWYRnVkotKnpInPdcEaodrehfOqYEHnvro9xlS6OeAS4Vz5AdH45zQ/4J3bV\
\2cH66tNr18ebM9nL//t5G69i89R9W7szyUxCI3LmAIdi3oSEbmz5GQBaw4l6h9Wi\
\n4FmFQaAXZrjQfO2qJcAHvWRsMp2pmqAGwKBgQDXaza0DRsKWywWznsHcmHa0cx8\
\I4jxqGaQmLO7wBJRP1NSFrywy1QfYrVX9CTLBK4V3F0PCgZ01Qv94751CzN43TgF\
\ebd/O9r5NjNTnOXzdWqETbCffLGd6kLgCMwPQWpM9ySVjXHWCGZsRAnF2F6M1O32\
\43StIifvwJQFqSM3ewKBgCaW6y7sRY90Ua7283RErezd9EyT22BWlDlACrPu3FNC\
\LtBf1j43uxBWBQrMLsHe2GtTV0xt9m0MfwZsm2gSsXcm4Xi4DJgfN+Z7rIlyy9UY\
\PCDSdZiU1qSr+NrffDrXlfiAM1cUmCdUX7eKjp/ltkUHNaOGfSn5Pdr3MkAiD/Hf\
\AoGBAKIdKCuOwuYlwjS9J+IRGuSSM4o+OxQdwGmcJDTCpyWb5dEk68e7xKIna3zf\
\jc+H+QdMXv1nkRK9bZgYheXczsXaNZUSTwpxaEldzVD3hNvsXSgJRy9fqHwA4PBq\
\vqiBHoO3RNbqg+2rmTMfDuXreME3S955ZiPZm4Z+T8Hj52mPAoGAQm5QH/gLFtY5\
\+znqU/0G8V6BKISCQMxbbmTQVcTgGySrP2gVd+e4MWvUttaZykhWqs8rpr7mgpIY\
\hul7Swx0SHFN3WpXu8uj+B6MLpRcCbDHO65qU4kQLs+IaXXsuuTjMvJ5LwjkZVrQ\
\TmKzSAw7iVWwEUZR/PeiEKazqrpp9VU="
caCertificateFile = "tests/fixtures/tls/ca.crt",
privateKeyFile = "tests/fixtures/tls/server.key",
certificateFile = "tests/fixtures/tls/server.crt"
}
withSmpServer :: IO a -> IO a

6
tests/ChatTests.hs
View File

@@ -295,6 +295,8 @@ testGroup2 =
]
dan #> "#club how is it going?"
dan <## "you are no longer a member of the group"
dan ##> "/d #club"
dan <## "#club: you deleted the group"
dan <##> cath
dan <##> alice
-- member leaves
@@ -316,6 +318,8 @@ testGroup2 =
(bob </)
bob #> "#club how is it going?"
bob <## "you are no longer a member of the group"
bob ##> "/d #club"
bob <## "#club: you deleted the group"
bob <##> cath
bob <##> alice
@@ -338,6 +342,8 @@ testGroupDelete =
bob <## "#team: you deleted the group"
cath #> "#team hi"
cath <## "you are no longer a member of the group"
cath ##> "/d #team"
cath <## "#team: you deleted the group"
testGroupDeleteWhenInvited :: IO ()
testGroupDeleteWhenInvited =

142
tests/ProtocolTests.hs
View File

@@ -1,3 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -5,43 +7,115 @@ module ProtocolTests where
import Data.ByteString.Char8 (ByteString)
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Protocol (smpClientVRange)
import Test.Hspec
protocolTests :: Spec
protocolTests = do
parseChatMessageTest
protocolTests = decodeChatMessageTest
(#==) :: ByteString -> RawChatMessage -> Expectation
s #== msg = parseAll rawChatMessageP s `shouldBe` Right msg
srv :: SMPServer
srv =
SMPServer
{ host = "smp.simplex.im",
port = "5223",
keyHash = C.KeyHash "\215m\248\251"
}
parseChatMessageTest :: Spec
parseChatMessageTest = describe "Raw chat message format" $ do
it "no parameters and content" $
"5 x.grp.mem.leave " #== RawChatMessage (Just 5) "x.grp.mem.leave" [] []
it "one parameter, no content" $
"6 x.msg.del 3 " #== RawChatMessage (Just 6) "x.msg.del" ["3"] []
it "with content that fits the message" $
"7 x.msg.new c.text x.text:11 hello there "
#== RawChatMessage
(Just 7)
"x.msg.new"
["c.text"]
[RawMsgBodyContent (RawContentType "x" "text") "hello there"]
it "with DAG reference and partial content" $
"8 x.msg.new c.image x.dag:16,x.text:7,m.image/jpg:6 0123456789012345 picture abcdef "
#== RawChatMessage
(Just 8)
"x.msg.new"
["c.image"]
[ RawMsgBodyContent (RawContentType "x" "dag") "0123456789012345",
RawMsgBodyContent (RawContentType "x" "text") "picture",
RawMsgBodyContent (RawContentType "m" "image/jpg") "abcdef"
]
it "without message id" $
" x.grp.mem.inv 23456,123 x.json:46 {\"contactRef\":\"john\",\"displayName\":\"John Doe\"} "
#== RawChatMessage
Nothing
"x.grp.mem.inv"
["23456", "123"]
[RawMsgBodyContent (RawContentType "x" "json") "{\"contactRef\":\"john\",\"displayName\":\"John Doe\"}"]
queue :: SMPQueueUri
queue =
SMPQueueUri
{ smpServer = srv,
senderId = "\223\142z\251",
clientVRange = smpClientVRange,
dhPublicKey = "MCowBQYDK2VuAyEAjiswwI3O/NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
}
connReqData :: ConnReqUriData
connReqData =
ConnReqUriData
{ crScheme = simplexChat,
crAgentVRange = smpAgentVRange,
crSmpQueues = [queue]
}
testDhPubKey :: C.PublicKeyX448
testDhPubKey = "MEIwBQYDK2VvAzkAmKuSYeQ/m0SixPDS8Wq8VBaTS1cW+Lp0n0h4Diu+kUpR+qXx4SDJ32YGEFoGFGSbGPry5Ychr6U="
testE2ERatchetParams :: E2ERatchetParamsUri 'C.X448
testE2ERatchetParams = E2ERatchetParamsUri e2eEncryptVRange testDhPubKey testDhPubKey
testConnReq :: ConnectionRequestUri 'CMInvitation
testConnReq = CRInvitationUri connReqData testE2ERatchetParams
(==#) :: ByteString -> ChatMsgEvent -> Expectation
s ==# msg = do
strDecode s `shouldBe` Right (ChatMessage msg)
parseAll strP s `shouldBe` Right (ChatMessage msg)
(#==) :: ByteString -> ChatMsgEvent -> Expectation
s #== msg = strEncode (ChatMessage msg) `shouldBe` s
(#==#) :: ByteString -> ChatMsgEvent -> Expectation
s #==# msg = do
s #== msg
s ==# msg
testProfile :: Profile
testProfile = Profile {displayName = "alice", fullName = "Alice"}
testGroupProfile :: GroupProfile
testGroupProfile = GroupProfile {displayName = "team", fullName = "Team"}
decodeChatMessageTest :: Spec
decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
it "x.msg.new" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" #==# XMsgNew (MCText "hello")
it "x.file" $
"{\"event\":\"x.file\",\"params\":{\"file\":{\"fileConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
#==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = testConnReq}
it "x.file.acpt" $ "{\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}" #==# XFileAcpt "photo.jpg"
it "x.info" $ "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}" #==# XInfo testProfile
it "x.info" $ "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\"}}}" #==# XInfo Profile {displayName = "alice", fullName = ""}
it "x.contact without content field" $
"{\"event\":\"x.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}"
#==# XContact testProfile Nothing
it "x.contact with content null" $
"{\"event\":\"x.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}"
==# XContact testProfile Nothing
it "x.contact with content" $
"{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}"
#==# XContact testProfile (Just $ MCText "hello")
it "x.grp.inv" $
"{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\"},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}"
#==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile}
it "x.grp.acpt" $ "{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpAcpt (MemberId "\1\2\3\4")
it "x.grp.acpt" $ "{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpAcpt (MemberId "\1\2\3\4")
it "x.grp.mem.new" $
"{\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}}"
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile}
it "x.grp.mem.intro" $
"{\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}}"
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile}
it "x.grp.mem.inv" $
"{\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}"
#==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq}
it "x.grp.mem.fwd" $
"{\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%3D&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}}"
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq}
it "x.grp.mem.info" $
"{\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\"}}}"
#== XGrpMemInfo (MemberId "\1\2\3\4") testProfile
it "x.grp.mem.con" $ "{\"event\":\"x.grp.mem.con\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemCon (MemberId "\1\2\3\4")
it "x.grp.mem.con.all" $ "{\"event\":\"x.grp.mem.con.all\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemConAll (MemberId "\1\2\3\4")
it "x.grp.mem.del" $ "{\"event\":\"x.grp.mem.del\",\"params\":{\"memberId\":\"AQIDBA==\"}}" #==# XGrpMemDel (MemberId "\1\2\3\4")
it "x.grp.leave" $ "{\"event\":\"x.grp.leave\",\"params\":{}}" ==# XGrpLeave
it "x.grp.del" $ "{\"event\":\"x.grp.del\",\"params\":{}}" ==# XGrpDel
it "x.info.probe" $ "{\"event\":\"x.info.probe\",\"params\":{\"probe\":\"AQIDBA==\"}}" #==# XInfoProbe (Probe "\1\2\3\4")
it "x.info.probe.check" $ "{\"event\":\"x.info.probe.check\",\"params\":{\"probeHash\":\"AQIDBA==\"}}" #==# XInfoProbeCheck (ProbeHash "\1\2\3\4")
it "x.info.probe.ok" $ "{\"event\":\"x.info.probe.ok\",\"params\":{\"probe\":\"AQIDBA==\"}}" #==# XInfoProbeOk (Probe "\1\2\3\4")
it "x.ok" $ "{\"event\":\"x.ok\",\"params\":{}}" ==# XOk

12
tests/fixtures/tls/ca.crt vendored Normal file
View File

@@ -0,0 +1,12 @@
-----BEGIN CERTIFICATE-----
MIIBtjCCATagAwIBAgIUe2PryrWo0xXX9vcA3WfbCzcdmgAwBQYDK2VxMCoxFjAU
BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjIwMTEx
MTExNjM5WhgPNDc1OTEyMDgxMTE2MzlaMCoxFjAUBgNVBAMMDVNNUCBzZXJ2ZXIg
Q0ExEDAOBgNVBAoMB1NpbXBsZVgwQzAFBgMrZXEDOgCAcvFwVicR+RLZpiEWPFNR
XYTbf+mFcX1NHIyPQDugFwOCgqJAW1fsjYgFhtQJSMH/lc1N7clfm4CjUzBRMB0G
A1UdDgQWBBQcUJvR7mm26yxMQfCsWgbnwMmJVDAfBgNVHSMEGDAWgBQcUJvR7mm2
6yxMQfCsWgbnwMmJVDAPBgNVHRMBAf8EBTADAQH/MAUGAytlcQNzAAAP/hMPNxyW
fyJi+iJViodU+C/aklnvHtjh5P3AbiVCSUfY6+PEdvkC8Ov0pBAYpYi5ukSNNVXl
ABVRlipB+vOcLQStNyaZ7kXzQ2IO/0btmIidh+G6SP8I4aytYIYYcV5pEUZpG1L1
57g8P29SDv81AA==
-----END CERTIFICATE-----

12
tests/fixtures/tls/server.crt vendored Normal file
View File

@@ -0,0 +1,12 @@
-----BEGIN CERTIFICATE-----
MIIBvDCCATygAwIBAgIUUgqht3ibEJ9jp5JuroML5Baxa/IwBQYDK2VxMCoxFjAU
BgNVBAMMDVNNUCBzZXJ2ZXIgQ0ExEDAOBgNVBAoMB1NpbXBsZVgwIBcNMjIwMTEx
MTYzOTQ2WhgPNDc1OTEyMDgxNjM5NDZaMBQxEjAQBgNVBAMMCWxvY2FsaG9zdDBD
MAUGAytlcQM6AFj+fmjmgOMBFgQ7lXfICSlSaB5sYp1wzhM2IaqgmVhWbDs3Tw7W
oUXFJsWpKku1kFjLH2yhqIInAKNvMG0wCQYDVR0TBAIwADALBgNVHQ8EBAMCA8gw
EwYDVR0lBAwwCgYIKwYBBQUHAwEwHQYDVR0OBBYEFMjbHbxESDI8YDPjJ8kXWjkg
jHxmMB8GA1UdIwQYMBaAFBxQm9HuabbrLExB8KxaBufAyYlUMAUGAytlcQNzAP98
RpFacmjxsc07GwC07uAxUxNgxX4R2nA+0St866uFbdyxApiyn44giG+m+YXCXLjh
1ffKEhhqAPdlpzByLarx8EWgmOsisBCRWrmraksOV15FKxjPqm7OYKp4f9GvieAQ
o/SKOyZVVdcZX7NcuDUxAA==
-----END CERTIFICATE-----

4
tests/fixtures/tls/server.key vendored Normal file
View File

@@ -0,0 +1,4 @@
-----BEGIN PRIVATE KEY-----
MEcCAQAwBQYDK2VxBDsEOZcXSjKQ3FQ9EBfqHmFIidOu4LecpUgi5NVPMhx7mS2d
QNQ0lFasp+EfvLErbs1Sd9xLVxA1hnZJng==
-----END PRIVATE KEY-----