mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-05-25 16:24:37 +00:00
Merge branch 'master' into master-ghc8107
This commit is contained in:
Evgeny Poberezkin
@@ -11,7 +11,7 @@ on:
|
||||
|
||||
jobs:
|
||||
build:
|
||||
name: build-${{ matrix.os }}
|
||||
name: build-${{ matrix.os }}-${{ matrix.ghc }}
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
fail-fast: false
|
||||
@@ -19,8 +19,13 @@ jobs:
|
||||
include:
|
||||
- os: ubuntu-20.04
|
||||
platform_name: 20_04-x86-64
|
||||
ghc: "8.10.7"
|
||||
- os: ubuntu-20.04
|
||||
platform_name: 20_04-x86-64
|
||||
ghc: "9.6.3"
|
||||
- os: ubuntu-22.04
|
||||
platform_name: 22_04-x86-64
|
||||
ghc: "9.6.3"
|
||||
steps:
|
||||
- name: Clone project
|
||||
uses: actions/checkout@v2
|
||||
@@ -28,8 +33,8 @@ jobs:
|
||||
- name: Setup Haskell
|
||||
uses: haskell/actions/setup@v1
|
||||
with:
|
||||
ghc-version: "8.10.7"
|
||||
cabal-version: "latest"
|
||||
ghc-version: ${{ matrix.ghc }}
|
||||
cabal-version: "3.10.1.0"
|
||||
|
||||
- name: Cache dependencies
|
||||
uses: actions/cache@v2
|
||||
|
||||
+44
-9
@@ -1,8 +1,43 @@
|
||||
# 5.4.0
|
||||
|
||||
Migrate to GHC 9.6.3
|
||||
|
||||
Agent:
|
||||
- database improvements:
|
||||
- track slow queries.
|
||||
- better performance.
|
||||
- "busy" error handling.
|
||||
- create parent folder when needed.
|
||||
- support closing and re-opening database.
|
||||
- SMP agent improvements
|
||||
- streaming for batched SMP commands.
|
||||
- fix asynchronous JOINing connection.
|
||||
- handle repeating JOINs without failure.
|
||||
- api to get subscribed connections.
|
||||
- return simplex:/ links as invitations.
|
||||
- fix memory leak.
|
||||
- XFTP improvements:
|
||||
- suspend when agent is suspended.
|
||||
- support locally encrypted files.
|
||||
- fixes - create empty file, prevent permanent error treated as temporary.
|
||||
- upgrade HTTP2 library (fixes error handling and flow control).
|
||||
- Remote control protocol (XRCP)
|
||||
|
||||
SMP server:
|
||||
- control port commands for GHC threads introspection.
|
||||
- allow creating new queues without subscriptions (required for iOS).
|
||||
|
||||
XFTP server:
|
||||
- allow 64kb file chunks.
|
||||
|
||||
NTF server:
|
||||
- faster startup.
|
||||
|
||||
# 5.3.0
|
||||
|
||||
Agent:
|
||||
- improve performance, track slow database queries.
|
||||
- support delievery receipts.
|
||||
- support delivery receipts.
|
||||
|
||||
SMP server:
|
||||
- control port
|
||||
@@ -81,7 +116,7 @@ SMP agent:
|
||||
- batch connection deletion
|
||||
- improve asynchronous connection deletion – it may now be completed after the client is restarted as well.
|
||||
- improve subscription logic to retry if initial attempt fails.
|
||||
- end SMP client connection after a number of failed PINGs (defalt is 3).
|
||||
- end SMP client connection after a number of failed PINGs (default is 3).
|
||||
|
||||
# 4.3.0
|
||||
|
||||
@@ -114,7 +149,7 @@ SMP agent:
|
||||
|
||||
Notification server (v1.3.0):
|
||||
|
||||
- check token status when sending verification notificaiton.
|
||||
- check token status when sending verification notification.
|
||||
|
||||
# 4.1.0
|
||||
|
||||
@@ -133,15 +168,15 @@ SMP agent:
|
||||
SMP server:
|
||||
|
||||
- Basic authentication. The server address can now include an optional password that is required to create messaging queues, so the contacts who message you will not be able to receive messages via your server, unless you share with them the address with the password. It is recommended to enable basic authentication on all private servers by adding `create_password` parameter into AUTH section of server INI file (the previously deployed servers do not have this section, you need to add it).
|
||||
- Disable creating new queues completely with `new_queues: off` parameter in AUTH section of INI file - it can be used to simplify migrating the exising connections to another server.
|
||||
- Disable creating new queues completely with `new_queues: off` parameter in AUTH section of INI file - it can be used to simplify migrating the existing connections to another server.
|
||||
- Updated server CLI with changed defaults:
|
||||
- interactive server initialization, use -y flag to initalize the server non-interactively.
|
||||
- interactive server initialization, use -y flag to initialize the server non-interactively.
|
||||
- store log is now enabled by default, so messaging queues and messages are restored when the server is restarted (to restore undelivered messages the server needs to be stopped with SIGINT signal).
|
||||
- a random password is now generated by default during the server initialization.
|
||||
|
||||
SMP agent:
|
||||
|
||||
- API to test SMP servers. It connects to the server, creates and deletes a messaging queue. The new SimpleX Chat client uses this API to allow you to test that you have the correct server address, with the valid certificate fingerprint and pasword, before enabling the new server.
|
||||
- API to test SMP servers. It connects to the server, creates and deletes a messaging queue. The new SimpleX Chat client uses this API to allow you to test that you have the correct server address, with the valid certificate fingerprint and password, before enabling the new server.
|
||||
|
||||
# 3.4.0
|
||||
|
||||
@@ -187,9 +222,9 @@ SMP server and agent:
|
||||
|
||||
SMP server:
|
||||
|
||||
- restore undeliverd messages when the server is restarted.
|
||||
- restore undelivered messages when the server is restarted.
|
||||
- SMP protocol v3 to support push notification:
|
||||
- updated SEND and MSG to add message flags (for notification flag that contros whether the notification is sent and for any future extensions) and to move message meta-data sent to the recipient into the encrypted envelope.
|
||||
- updated SEND and MSG to add message flags (for notification flag that confirm whether the notification is sent and for any future extensions) and to move message meta-data sent to the recipient into the encrypted envelope.
|
||||
- update NKEY and NID to add e2e encryption keys (for the notification meta-data encryption between SMP server and the client), and update NMSG to include this meta-data.
|
||||
- update ACK command to include message ID (to avoid acknowledging unprocessed message).
|
||||
- add NDEL commands to remove notification subscription credentials from SMP queue.
|
||||
@@ -200,7 +235,7 @@ SMP agent:
|
||||
- new protocol for duplex connection handshake reducing traffic and connection time.
|
||||
- support for SMP notifications server and managing device token.
|
||||
- remove redundant FQDN validation from TLS handshake to prepare for access via Tor.
|
||||
- support for fully stopping agent and for termporary suspending agent operations.
|
||||
- support for fully stopping agent and for temporary suspending agent operations.
|
||||
- improve management of duplicate message delivery.
|
||||
|
||||
SMP notifications server v1.0:
|
||||
|
||||
+3
-2
@@ -1,9 +1,10 @@
|
||||
with-compiler: ghc-8.10.7
|
||||
|
||||
packages: .
|
||||
-- packages: . ../direct-sqlcipher ../sqlcipher-simple
|
||||
-- packages: . ../hs-socks
|
||||
-- packages: . ../http2
|
||||
-- packages: . ../network-transport
|
||||
|
||||
with-compiler: ghc-8.10.7
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
||||
+2
-2
@@ -1,5 +1,5 @@
|
||||
name: simplexmq
|
||||
version: 5.4.0.6
|
||||
version: 5.4.0.7
|
||||
synopsis: SimpleXMQ message broker
|
||||
description: |
|
||||
This package includes <./docs/Simplex-Messaging-Server.html server>,
|
||||
@@ -62,7 +62,7 @@ dependencies:
|
||||
- socks == 0.6.*
|
||||
- sqlcipher-simple == 0.4.*
|
||||
- stm == 2.5.*
|
||||
- template-haskell == 2.16.*
|
||||
- template-haskell >= 2.16 && < 2.21
|
||||
- temporary == 1.3.*
|
||||
- text == 1.2.*
|
||||
- time == 1.9.*
|
||||
|
||||
@@ -0,0 +1,58 @@
|
||||
# Re-sync encryption ratchets, queue rotation, message delivery receipts
|
||||
|
||||
This is very unfocussed doc outlining several problems that seem somewhat related, and some possible solution approaches.
|
||||
|
||||
## Problems
|
||||
|
||||
When old database backup is used, the sending client encrypts the messages in a way that the receiving client cannot decrypt them, because it does not store the old keys, and does not try to decrypt ratchet headers using the old keys. When receiving the messages, the client that uses the old database is unable to decrypt them, either the header or the message itself (if more than 500 messages are skipped, or if root ratchet step happened).
|
||||
|
||||
The same symptoms happen during the queue rotation, unfortunately, as we do not keep the history of received messages once they are acknowledged, so the client reports these error to the users.
|
||||
|
||||
While these are two different problems, to the users they manifest in the same way, so it is difficult to differentiate.
|
||||
|
||||
Another ratchet problem that should be solved as well is not deleting unused skipped keys after some time or some number of events, possibly it should be considered at the same time.
|
||||
|
||||
While it is tempting to consider delivery receipts as an isolated problem, it is somewhat coupled, as the requests to re-sync ratchets and to re-deliver skipped messages are effectively delivery receipts.
|
||||
|
||||
A naive solution to delivery receipts when each message is responded to with a confirmation has two downsides:
|
||||
|
||||
- it doubles the traffic.
|
||||
- in the absense of delays, it also leaks some information about the network latency, that can be used to track user's location.
|
||||
|
||||
Both problems can be mitigated by sending delivery receipts with a random delay, to confirm all messages sent, not each one. But this would only reduce the traffic when the sender sends many messages. Alternatively, we could think how to reduce the block size for SMP commands. The challenge is profile pictures and image previews, so to reduce traffic we need to start sending them as XFTP files, potentially with a smaller 64kb chunks (that would also increase preview quality).
|
||||
|
||||
## Solution for queue rotation
|
||||
|
||||
We need to:
|
||||
- store and show the rotation status in the UI to prevent attempts to rotate the queue multiple times.
|
||||
- process multiple message delivery events while there is a redundancy, to avoid errors in terminal.
|
||||
- differentiate between decryption errors during queue rotation - that would require keeping the messages for some time, at least keeping their IDs and hashes together with some additional status. In this case when duplicate or old message arrives, we can check whether this message was already processed, and do not show error if it was.
|
||||
|
||||
## Solution to re-sync ratchets
|
||||
|
||||
When we establish that the receiving client is indeed unable to decrypt messages, we should:
|
||||
- notify the user - it is already happening, but it happens in case of rotation as well.
|
||||
- optionally, notify another client that message was not decrypted - this effectively becomes a delivery receipt. That could be a separate command triggered by the user in the UI.
|
||||
- clients can get into this state at the same time, how do we handle concurrent requests? Possibly, we could design these messages so this is irrelevant whether the message is sent in response or not, and calculate the new ratchet keys once the clients have both the sent and received messages. After that both clients can send "ratchet reset" message:
|
||||
- EKEY - message containing a new set of keys to initialize the ratchets
|
||||
- EREADY - message confirming that the ratchet is ready, already e2e encrypted
|
||||
|
||||
The downside of this approach, is that unlike the initial handshake, where the second ratchet key is sent in e2e encrypted response, this message will be sent only encrypted with queue key. We could change this protocol by adding EREPLY message, and the clients would know to ingnore EKEY with bigger hash of the keys, so that the client who sent keys with smaller hash would be processing response from another client (that is if EKEY is received after EKEY is sent).
|
||||
|
||||
```
|
||||
A B
|
||||
|
||||
EKEY 1 -> <- EKEY 2 (e2e encrypted with per-queue key only)
|
||||
EKEY 2 <- -> EKEY 1
|
||||
1 < 2, wait 2 > 1, reply EREPLY 3 (e2e encrypted with ratchets)
|
||||
ratchet: 1, 3 ratchet: 3, 1
|
||||
```
|
||||
|
||||
Once ratchets are re-synched the clients could additionally request delivery of skipped messages. As ratchets being out of sync is not the only problem when messages can be lost, it may be managed independently from the ratchet re-sync. This problem seems tied with delivery receipts too, as requesting to re-deliver some messages automatically confirms that some other messages were delivered.
|
||||
|
||||
Alternatively, the request for ratchet sync can already contain the ID of the first failed message - that would allow the agent:
|
||||
- stop sending messages until ratchets are in sync.
|
||||
- re-deliver failed messages first.
|
||||
- only then deliver any pending messages.
|
||||
|
||||
This approach would probably result in a better UX (no out of order delivery), but requires tracking pending messages that are not attempted to deliver and to also insert old messages in the delivery queue with the old IDs.
|
||||
@@ -0,0 +1,34 @@
|
||||
# SMP and XFTP delivery relays
|
||||
|
||||
## Problem
|
||||
|
||||
SimpleX network relies on SMP relays to hold sent messages while the recipient is offline. This design provides many advantages over pure p2p designs [1]. The threat model for relays is covered in [2].
|
||||
|
||||
The problem with this design is that the relays are chosen by the recipients, and they as a result can be used to record transport addresses of the senders.
|
||||
|
||||
Similar problem, but reversed, exists with XFTP design - XFTP relays are chosen by the senders and also can be modified to record transport addresses of the recipients.
|
||||
|
||||
The current solution to this problem is to use onion routing to access relays, and many users do it already. The downside is that it requires additional configuration and can be complex to some users.
|
||||
|
||||
## Solution approach
|
||||
|
||||
Add a second type of relays to the network design.
|
||||
|
||||
For SMP protocol, these relays would accept messages from the senders and deliver them to the recipients. If the recipient were to modify the relay used to receive the messages to also records senders' IP addresses, then they would only succeed in recording the IP address of the relay, not the sender.
|
||||
|
||||
Similar relay can be introduced for XFTP protocol.
|
||||
|
||||
The additional advantage of using the relays is the reduced number of network connections that need to be used, and reduced traffic.
|
||||
|
||||
Compared with Tor this approach has:
|
||||
- lower latency
|
||||
- no centralized components or the registry of the servers
|
||||
- still no visibility of the whole network to the relays, as sending relays do not need to randomly choose the next relay, but would forward the messages directly to the destination relay.
|
||||
|
||||
The downside of this approach is that relays will have more visibility of the network than in the current design.
|
||||
|
||||
## Implementation considerations
|
||||
|
||||
1. Should this new relays be included in the existing SMP and XFTP protocols and servers, or should they be designed as separate protocols and servers?
|
||||
|
||||
2. Should the client aim to choose the same host for delivery relay as the destination server (to reduce the traffic), if possible, or should it aim to choose a different host (to reduce metadata available to single host)? The answer to this would affect the answer to the first question.
|
||||
@@ -0,0 +1,234 @@
|
||||
# Protecting IP addresses of the users from their contacts
|
||||
|
||||
## Problem
|
||||
|
||||
SMP protocol relays are chosen and can be controlled by the message recipients. It means that the recipients can find out IP addresses of message senders by modifying SMP relay code (or by using proxies and timing correlation), unless the senders use VPN or some overlay network. Tor is an audequate solution in most cases to mitigate it, but it requires additional technical knowledge to install and configure (even installing Orbot on Android is seen as "complex" by many users), and reduces usability because of higher latency.
|
||||
|
||||
The lack of in-built IP address protection is the main concern of many users, particularly given that most people do not realise that it is lacking by default - without transport protection SimpleX is not perceived as a "whole product".
|
||||
|
||||
Similarly, XFTP protocol relays are chosen by senders, and they can be used to detect file recipients' IP addresses.
|
||||
|
||||
## Possible solutions
|
||||
|
||||
1. Embed Tor in the client.
|
||||
|
||||
Pros:
|
||||
- no changes in the protocols/servers
|
||||
- acceptable threat model for most users
|
||||
- removes complexity of installing and configuring Tor
|
||||
- probably, the most attractive option for Tor users
|
||||
|
||||
Cons:
|
||||
- higher latency and error rate
|
||||
- higher resource usage
|
||||
- requires us updating Tor client regularly
|
||||
- restriction on Tor usage in some networks, so it would require supporting bridges in the app UI
|
||||
- legislative restrictions on Tor usage, so it may require supporting multiple app versions, and won't solve the problem where Tor is not embedded
|
||||
|
||||
2. Thin clients with hosted accounts.
|
||||
|
||||
Host some part of the current client on the server and have another part running on the devices.
|
||||
|
||||
Pros:
|
||||
- substantially reduces the traffic for mobile clients
|
||||
- probably the most attractive option for mass market users who expect to have an account on the server and be able to access it from multiple devices and via web.
|
||||
|
||||
Cons:
|
||||
- a lot of design and development
|
||||
- makes accounts visible to the server
|
||||
- the new protocol design to protect connections graph and message content from the hosting server.
|
||||
- quite different threat model
|
||||
|
||||
Overall, this is not a viable or even appropriate option for the current stage.
|
||||
|
||||
3. SMP / XFTP proxy.
|
||||
|
||||
Introduce SMP and XFTP protocol extenstions to allow message senders and file recipients to delegate the tasks of sending messages and receiving files to the proxies, so that peer-chosen relays can only observe IP addresses of the proxies and not of the users.
|
||||
|
||||
Pros:
|
||||
- no dependency on and lower latency than via Tor
|
||||
- reduces client traffic, both due to retries handled by these proxies and due to the smaller number of connections to the peer-chosen relays. The flip side is that additional commands (and traffic) are needed to create the sessions with relays.
|
||||
- higher transport privacy: protects IP addresses from peers and makes transport correlation harder.
|
||||
- additional function: retrying pending messages, while the queue is not secured yet, without extra traffic for the clients.
|
||||
- improves current threat model by preventing session-based correlation of the traffic by the destination relay (assuming no information sharing with the proxies), as there will be one session between proxy and destination relay, mixing traffic from multiple users.
|
||||
|
||||
Cons:
|
||||
- design and development cost
|
||||
- can undermine delivery stability
|
||||
|
||||
This seems an attractive option, both from technical (reasonable complexity) and positioning (moving SimpleX closer to mix networks, while still avoiding server list visibility) points of view, and it is in the middle between embedding Tor, which would make the product more niche and has downsides and development costs too, and thin clients, which is 10x+ more work, and also creates a different threat model, that is not very attractive for the current stage and users.
|
||||
|
||||
Below considers this design.
|
||||
|
||||
## SMP/XFTP proxy design
|
||||
|
||||
### Design requirements
|
||||
|
||||
1. To avoid increasing the complexity of self-hosting, we should not create additional server types, and existing SMP and XFTP servers should be extended to provide proxy functions.
|
||||
|
||||
2. SMP proxy should not be able to observe queue addresses and their count on the destination relays. This requirement is not needed for XFTP proxies, as each file chunk is downloaded only once, so there is no need to hide its address.
|
||||
|
||||
3. There must be no identifiers and cyphertext in common in outgoing and incoming traffic inside TLS (the current designs have this quality).
|
||||
|
||||
4. Traffic between the client and destination relays must be e2e encrypted, with MITM-by-proxy mitigated, relying on the relay identity (certificate fingerprint), ideally without any additional fingerprint in relay address.
|
||||
|
||||
5. SMP proxy should implement retry logic and hold messages while they are delivered. They also should return relay replies to the client. To avoid any additional traffic the client should just add "sent to proxy" status and only show "sent" once proxy returns the response from the destination relay - there should be no additional response from the proxy confirming acceptance to delivery.
|
||||
|
||||
6. Sending messages to groups have to be batched in the client to avoid multiple requests for destination relay sessions - such requests can be batched to proxy, even though it leaks _some_ metadata - which destination relays are used by a given sender's IP address, it also reduces the overhead from proxies – it could be an option based on the privacy slider.
|
||||
|
||||
6. SMP proxy may also increase utility and privacy of the platform:
|
||||
|
||||
- holding messages and retrying them for the new connections while the receiving queue is not secured yet.
|
||||
- add delays in message delivery to make traffic correlation harder (same can be done in SMP relays).
|
||||
|
||||
### Implementation considerations
|
||||
|
||||
1. Block size. Possibly, there is not enough spare capacity in the current 16kb block to fit additional headers, any necessary metadata and encryption authentication tags, in which case we cannot send SMP and SMP-proxy traffic in the same transport connection (in case the same server plays both roles). In which case we will need to negotiate role during connection handshake and define a different (sub-)protocol for SMP-proxy.
|
||||
|
||||
2. To be decided if we see it as extension of SMP protocol or as another protocol, irrespective of whether it's provided by the same or another server. Given different roles and block size it may be simpler to see it as a separate protocol, and which protocol is provided in the connection is determined during handshake.
|
||||
|
||||
3. We probably should aim to avoid changing agent/client logic and see it instead as transport concern that can be dynamically decided at a point of sending a message, based on the current configuration.
|
||||
|
||||
4. Configuration should probably allow to choose between not using proxies (particularly, during testing, when it would be the default), using proxies only for unknown relays, and using proxies for all relays (extra traffic, but more complex transport correlation). The clients can aim to use proxy from another provider, to reduce the risks of sharing the information.
|
||||
|
||||
### SMP-proxy protocol
|
||||
|
||||
The flow of the messages will be:
|
||||
|
||||
1. Client requests proxy to create session with the relay by sending `server` command with the SMP relay address and optional proxy basic AUTH (below). It should be possible to batch multiple session requests into one block, to reduce traffic.
|
||||
|
||||
2. Proxy connects to SMP relay, negotiating a shared secret in the handshake that will be used to encrypt all sender blocks inside TLS (proxy-relay encryption). SMP relay also returns in handshake its temporary DH key to agree e2e encryption with the client (sender-relay encryption, to protect metadata from proxy).
|
||||
|
||||
3. Proxy replies with `server_id` command including relay session ID to identify it in further requests, relay DH key for e2e encryption with the client - this key is signed with the TLS online private key associated with the certificate (its fingerprint is included in the relay address), and the TLS session ID between proxy and relay (this session ID must be used in transmissions, to mitigate replay attacks as before).
|
||||
|
||||
A possible attack here is that proxy can use this TLS session to replay commands received from the client. Possibly, it could be mitigated with a bloom filter per proxy/SMP relay connection that would reject the repeated DH keys (that need to be used for replay), and also with DH key expiration (this mitigation should allow some acceptable rate of false positives from the bloom filter).
|
||||
|
||||
With 32 bits per key there will be ~1/1,000,000 false positives (see https://en.wikipedia.org/wiki/Bloom_filter), and the filter would use ~32mb per each proxy connection if we reset relay key every 1000000 messages or more frequently. Given that the only commands accepted via relay would be SEND, replaying it would be interpreted by the receiving client as duplicate message delivery, so a small number of replayed messages won't cause any problems. But without mitigation it could be used to flood the receiving SMP relay queues with repeated messages, effectively causing DoS on these queues, even in case when SMP relays require basic auth to create queues.
|
||||
|
||||
Given that the client chooses proxy it has some trust to, maybe this replay attack risk can be accepted.
|
||||
|
||||
4. Now the client sends `forward` to proxy, which it then forwards to SMP relay, applying additional encryption layer.
|
||||
|
||||
5. SMP relay sends `response` to proxy applying additional encryption layer, which it then forwards to the client removing the additional encryption layer.
|
||||
|
||||
Effectively it works as a simplified two-hop onion routing with the first relay (proxy) chosen by the sending client and the second relay chosen by the recipient, not only protecting senders' IP addresses from the recipients' relays, but also preventing recipients relays from correlating senders' traffic to different queues, as TLS session is owned by the proxy now and it mixes the traffic from multiple senders. To correlate traffic to users, proxy and relay would have to combine their information. SMP relays are still able to correlate traffic to receiving users via transport session.
|
||||
|
||||
Sequence diagram for sending the message via SMP proxy:
|
||||
|
||||
```
|
||||
------------- ------------- ------------- -------------
|
||||
| sending | | SMP | | SMP | | receiving |
|
||||
| client | | proxy | | relay | | client |
|
||||
------------- ------------- ------------- -------------
|
||||
| `server` | | |
|
||||
| -------------------------> | create TLS session, get keys | |
|
||||
| | ------------------------------> | |
|
||||
| `server_id` | (if doesn't exist) | |
|
||||
| <------------------------- | | |
|
||||
| | | |
|
||||
| TLS(F:s2r(SEND(e2e(msg)))) | | |
|
||||
| -------------------------> | TLS(F:p2r(s2r(SEND(e2e(msg))))) | |
|
||||
| | ------------------------------> | |
|
||||
| | | |
|
||||
| | TLS(R:p2r(s2r(OK/ERR))) | |
|
||||
| TLS(R:s2r(OK/ERR)) | <------------------------------ | |
|
||||
| <------------------------- | | TLS(MSG(r2c(e2e(msg)))) |
|
||||
| | | -----------------------> |
|
||||
| | | |
|
||||
| | | TLS(ACK) |
|
||||
| | | <----------------------- |
|
||||
| | | |
|
||||
| | | |
|
||||
|
||||
```
|
||||
|
||||
Below diagram shows the encrypttion layers for `forward` and `response` commands:
|
||||
|
||||
- s2r (added) - encryption between client and SMP relay, with relay key returned in server_id command, with MITM by proxy mitigated by verifying the certificate fingerprint included in the relay address.
|
||||
- e2e (exists now) - end-to-end encryption per SMP queue, with double ratchet e2e encryption inside it.
|
||||
- p2r (added) - additional encryption between proxy and SMP relay with key agreed in the handshake, to mitigate traffic correlation inside TLS. This key could also be signed by the same certificate, if we don't want to rely on TLS security.
|
||||
- r2c (exists now) additional encryption between SMP relay and client to prevent traffic correlation inside TLS.
|
||||
|
||||
```
|
||||
----------------- ----------------- -- TLS -- ----------------- -----------------
|
||||
| | -- TLS -- | | -- p2r -- | | -- TLS -- | |
|
||||
| | -- s2r -- | | -- s2r -- | | -- r2c -- | |
|
||||
| sending | -- e2e -- | | -- e2e -- | | -- e2e -- | receiving |
|
||||
| client | MSG | SMP proxy | MSG | SMP relay | MSG | client |
|
||||
| | -- e2e -- | | -- e2e -- | | -- e2e -- | |
|
||||
| | -- s2r -- | | -- s2r -- | | -- r2c -- | |
|
||||
| | -- TLS -- | | -- p2r -- | | -- TLS -- | |
|
||||
----------------- ----------------- -- TLS -- ----------------- -----------------
|
||||
```
|
||||
|
||||
When proxy connects to SMP relay it would indicate in the handshake that it will use proxy protocol and the SMP relay would expect the same `forward` commands and reply with `response`s.
|
||||
|
||||
Below syntax aims to fit in 16kb block using spare capacity in SMP protocol.
|
||||
|
||||
```abnf
|
||||
proxy_block = padded(proxy_transmission, 16384)
|
||||
proxy_transmission = corr_id relay_session_id proxy_command
|
||||
corr_id = length *8 OCTET
|
||||
proxy_command = server / server_id / forward / response / error
|
||||
server = "S" address [relay_basic_auth] ; creates transport session between proxy and relay
|
||||
server_id = "I" relay_session_id tls_session_id signed_relay_key ;
|
||||
; session_id is the TLS session ID between proxy and relay, it has to be included inside encrypted block to prevent replay attacks
|
||||
forward = %s"F" random_dh_pub_key encrypted_block
|
||||
response = %s"R" encrypted_block; response received from the destination SMP relay
|
||||
relay_session_id = length *8 OCTET
|
||||
error = %s"E" error
|
||||
```
|
||||
|
||||
The overhead is: 1+8 (corrId) + 1+8 (relay_session_id) + 1 (command) + 1+32 (random_dh_pub_key) + 2 (original length) + 16 (auth tag for e2e encryption) + 16 (auth tag for proxy to relay encryption) = 86 bytes. The reserve for sent messages in SMP is ~84 bytes, so it should about fit with some reduced bytes somewhere.
|
||||
|
||||
Another possible design is to allow mixing sent messages and normal SMP commands in the same transport connection, but it can make fitting in the block a bit harder, additional overhead would be: 1 (transmission count) + 2 (transmission size) + 1 (empty signature) = 4 bytes.
|
||||
|
||||
The above assumes that the client can only send one message to an SMP relay and then has to wait for response before sending the next message. Missing the response would cause re-delivery (further improvement is possible when proxy detects these redelieveries and not send them to relays but simply reply with the same response).
|
||||
|
||||
### Threat model for SMP proxy and changes to threat model for SMP
|
||||
|
||||
#### SMP proxy
|
||||
|
||||
*can:*
|
||||
|
||||
- learn a user's IP address, as long as Tor is not used.
|
||||
|
||||
- learn when a user with a given IP address is online.
|
||||
|
||||
- know how many messages are sent from a given IP address and to a given destination SMP relay.
|
||||
|
||||
- drop all messages from a given IP address or to a given destination relay.
|
||||
|
||||
- unless SMP relay detects repeated public DH keys of senders, replay messages to a destination relay within a single session, causing either duplicate message delivery (which will be detected and ignored by the receiving clients), or, when receiving client is not connected to SMP relay, exhausting capacity of destination queues used within the session.
|
||||
|
||||
*cannot:*
|
||||
|
||||
- perform queue correlation (matching multiple queues to a single user), unless it has additional information from SMP relay.
|
||||
|
||||
- undetectably add, duplicate, or corrupt individual messages.
|
||||
|
||||
- undetectably drop individual messages, so long as a subsequent message is delivered.
|
||||
|
||||
- learn the contents of messages.
|
||||
|
||||
- learn the destination queues of messages.
|
||||
|
||||
- distinguish noise messages from regular messages except via timing regularities.
|
||||
|
||||
- compromise the user's end-to-end encryption with another user via an active attack.
|
||||
|
||||
- compromise the user's end-to-end encryption with destination relay via an active attack.
|
||||
|
||||
#### SMP relay accessed via SMP proxy
|
||||
|
||||
*still can:*
|
||||
|
||||
- perform recipients' queue correlation (matching multiple queues to a single recipient) via either a re-used transport connection, user's IP Address, or connection timing regularities
|
||||
|
||||
*no longer can:*
|
||||
|
||||
- perform senders' queue correlation (matching multiple queues to a single sender) via either a re-used transport connection, user's IP Address, or connection timing regularities, unless it has additional information from SMP proxy.
|
||||
|
||||
- learn a sender's IP address, track them through other IP addresses they use to access the same queue, and infer information (e.g. employer) based on the IP addresses, even if Tor is not used.
|
||||
|
||||
The rest of the threat model for SMP relays remains the same as in [overview](../protocol/overview-tjr.md#simplex-messaging-protocol-server).
|
||||
+8
-8
@@ -5,7 +5,7 @@ cabal-version: 1.12
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: simplexmq
|
||||
version: 5.4.0.6
|
||||
version: 5.4.0.7
|
||||
synopsis: SimpleXMQ message broker
|
||||
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
|
||||
<./docs/Simplex-Messaging-Client.html client> and
|
||||
@@ -204,7 +204,7 @@ library
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
, template-haskell >=2.16 && <2.21
|
||||
, temporary ==1.3.*
|
||||
, text ==1.2.*
|
||||
, time ==1.9.*
|
||||
@@ -270,7 +270,7 @@ executable ntf-server
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
, template-haskell >=2.16 && <2.21
|
||||
, temporary ==1.3.*
|
||||
, text ==1.2.*
|
||||
, time ==1.9.*
|
||||
@@ -336,7 +336,7 @@ executable smp-agent
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
, template-haskell >=2.16 && <2.21
|
||||
, temporary ==1.3.*
|
||||
, text ==1.2.*
|
||||
, time ==1.9.*
|
||||
@@ -402,7 +402,7 @@ executable smp-server
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
, template-haskell >=2.16 && <2.21
|
||||
, temporary ==1.3.*
|
||||
, text ==1.2.*
|
||||
, time ==1.9.*
|
||||
@@ -468,7 +468,7 @@ executable xftp
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
, template-haskell >=2.16 && <2.21
|
||||
, temporary ==1.3.*
|
||||
, text ==1.2.*
|
||||
, time ==1.9.*
|
||||
@@ -534,7 +534,7 @@ executable xftp-server
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
, template-haskell >=2.16 && <2.21
|
||||
, temporary ==1.3.*
|
||||
, text ==1.2.*
|
||||
, time ==1.9.*
|
||||
@@ -637,7 +637,7 @@ test-suite simplexmq-test
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
, template-haskell >=2.16 && <2.21
|
||||
, temporary ==1.3.*
|
||||
, text ==1.2.*
|
||||
, time ==1.9.*
|
||||
|
||||
@@ -483,7 +483,7 @@ runXFTPSndWorker c srv doWork = do
|
||||
rcvChunks :: [[FileChunk]]
|
||||
rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
|
||||
sortChunks :: [FileChunk] -> [FileChunk]
|
||||
sortChunks = map reverseReplicas . sortOn (chunkNo :: FileChunk -> Int)
|
||||
sortChunks = map reverseReplicas . sortOn (\FileChunk {chunkNo} -> chunkNo)
|
||||
reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
|
||||
addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
|
||||
addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =
|
||||
|
||||
@@ -109,7 +109,7 @@ xftpClientServer = B.unpack . strEncode . snd3 . transportSession
|
||||
snd3 (_, s, _) = s
|
||||
|
||||
xftpTransportHost :: XFTPClient -> TransportHost
|
||||
xftpTransportHost = (host :: HClient -> TransportHost) . client_ . http2Client
|
||||
xftpTransportHost XFTPClient {http2Client = HTTP2Client {client_ = HClient {host}}} = host
|
||||
|
||||
xftpSessionTs :: XFTPClient -> UTCTime
|
||||
xftpSessionTs = sessionTs . http2Client
|
||||
|
||||
@@ -359,7 +359,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
|
||||
rcvChunks :: [[FileChunk]]
|
||||
rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
|
||||
sortChunks :: [FileChunk] -> [FileChunk]
|
||||
sortChunks = map reverseReplicas . sortOn (chunkNo :: FileChunk -> Int)
|
||||
sortChunks = map reverseReplicas . sortOn (\FileChunk {chunkNo} -> chunkNo)
|
||||
reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
|
||||
addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
|
||||
addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =
|
||||
@@ -418,7 +418,9 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
|
||||
a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
|
||||
liftIO $ printNoNewLine "Downloading file..."
|
||||
downloadedChunks <- newTVarIO []
|
||||
let srv FileChunk {replicas} = server (head replicas :: FileChunkReplica)
|
||||
let srv FileChunk {replicas} = case replicas of
|
||||
[] -> error "empty FileChunk.replicas"
|
||||
FileChunkReplica {server} : _ -> server
|
||||
srvChunks = groupAllOn srv chunks
|
||||
chunkPaths <- map snd . sortOn fst . concat <$> pooledForConcurrentlyN 16 srvChunks (mapM $ downloadFileChunk a encPath size downloadedChunks)
|
||||
encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
|
||||
@@ -496,10 +498,9 @@ cliFileDescrInfo InfoOptions {fileDescription} = do
|
||||
printParty
|
||||
putStrLn $ "File download size: " <> strEnc size
|
||||
putStrLn "File server(s):"
|
||||
forM_ replicas $ \srvReplicas -> do
|
||||
let srv = replicaServer $ head srvReplicas
|
||||
chSizes = map (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas
|
||||
putStrLn $ strEnc srv <> ": " <> strEnc (FileSize $ sum chSizes)
|
||||
forM_ replicas $ \srvReplicas@(FileServerReplica {server} :| _) -> do
|
||||
let chSizes = fmap (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas
|
||||
putStrLn $ strEnc server <> ": " <> strEnc (FileSize $ sum chSizes)
|
||||
where
|
||||
printParty :: IO ()
|
||||
printParty = case party of
|
||||
|
||||
@@ -45,6 +45,8 @@ import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Int (Int64)
|
||||
import Data.List (foldl', sortOn)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
@@ -59,7 +61,7 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, parseAll)
|
||||
import Simplex.Messaging.Protocol (XFTPServer)
|
||||
import Simplex.Messaging.Util (bshow, groupAllOn, (<$?>))
|
||||
import Simplex.Messaging.Util (bshow, (<$?>))
|
||||
|
||||
data FileDescription (p :: FileParty) = FileDescription
|
||||
{ party :: SFileParty p,
|
||||
@@ -199,7 +201,7 @@ validateFileDescription fd@FileDescription {size, chunks}
|
||||
| chunksSize chunks /= unFileSize size = Left "chunks total size is different than file size"
|
||||
| otherwise = Right $ ValidFD fd
|
||||
where
|
||||
chunkNos = map (chunkNo :: FileChunk -> Int) chunks
|
||||
chunkNos = map (\FileChunk {chunkNo} -> chunkNo) chunks
|
||||
chunksSize = fromIntegral . foldl' (\s FileChunk {chunkSize} -> s + unFileSize chunkSize) 0
|
||||
|
||||
encodeFileDescription :: FileDescription p -> YAMLFileDescription
|
||||
@@ -240,18 +242,18 @@ instance FromField a => FromField (FileSize a) where fromField f = FileSize <$>
|
||||
|
||||
instance ToField a => ToField (FileSize a) where toField (FileSize s) = toField s
|
||||
|
||||
groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [[FileServerReplica]]
|
||||
groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [NonEmpty FileServerReplica]
|
||||
groupReplicasByServer defChunkSize =
|
||||
groupAllOn replicaServer . unfoldChunksToReplicas defChunkSize
|
||||
L.groupAllWith (\FileServerReplica {server} -> server) . unfoldChunksToReplicas defChunkSize
|
||||
|
||||
encodeFileReplicas :: FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas]
|
||||
encodeFileReplicas defChunkSize =
|
||||
map encodeServerReplicas . groupReplicasByServer defChunkSize
|
||||
where
|
||||
encodeServerReplicas fs =
|
||||
encodeServerReplicas fs@(FileServerReplica {server} :| _) =
|
||||
YAMLServerReplicas
|
||||
{ server = replicaServer $ head fs, -- groupAllOn guarantees that fs is not empty
|
||||
chunks = map (B.unpack . encodeServerReplica) fs
|
||||
{ server,
|
||||
chunks = map (B.unpack . encodeServerReplica) $ L.toList fs
|
||||
}
|
||||
|
||||
replicaServer :: FileServerReplica -> XFTPServer
|
||||
@@ -308,7 +310,7 @@ foldReplicasToChunks :: FileSize Word32 -> [FileServerReplica] -> Either String
|
||||
foldReplicasToChunks defChunkSize fs = do
|
||||
sd <- foldSizesDigests fs
|
||||
-- TODO validate (check that chunks match) or in separate function
|
||||
sortOn (chunkNo :: FileChunk -> Int) . map reverseReplicas . M.elems <$> foldChunks sd fs
|
||||
sortOn (\FileChunk {chunkNo} -> chunkNo) . map reverseReplicas . M.elems <$> foldChunks sd fs
|
||||
where
|
||||
foldSizesDigests :: [FileServerReplica] -> Either String (Map Int (FileSize Word32), Map Int FileDigest)
|
||||
foldSizesDigests = foldl' addSizeDigest $ Right (M.empty, M.empty)
|
||||
|
||||
@@ -33,7 +33,7 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
xftpServerVersion :: String
|
||||
xftpServerVersion = "1.1.2"
|
||||
xftpServerVersion = "1.1.3"
|
||||
|
||||
xftpServerCLI :: FilePath -> FilePath -> IO ()
|
||||
xftpServerCLI cfgPath logPath = do
|
||||
|
||||
@@ -116,7 +116,7 @@ import qualified Data.Aeson as J
|
||||
import Data.Bifunctor (bimap, first, second)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Composition ((.:), (.:.), (.::))
|
||||
import Data.Composition ((.:), (.:.), (.::), (.::.))
|
||||
import Data.Foldable (foldl')
|
||||
import Data.Functor (($>))
|
||||
import Data.List (find)
|
||||
@@ -129,6 +129,7 @@ import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Clock.System (systemToUTCTime)
|
||||
import Data.Word (Word16)
|
||||
import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpReceiveFile', xftpSendFile')
|
||||
import Simplex.FileTransfer.Description (ValidFileDescription)
|
||||
import Simplex.FileTransfer.Protocol (FileParty (..))
|
||||
@@ -389,13 +390,13 @@ rcNewHostPairing :: MonadIO m => m RCHostPairing
|
||||
rcNewHostPairing = liftIO newRCHostPairing
|
||||
|
||||
-- | start TLS server for remote host with optional multicast
|
||||
rcConnectHost :: AgentErrorMonad m => AgentClient -> RCHostPairing -> J.Value -> Bool -> m RCHostConnection
|
||||
rcConnectHost c = withAgentEnv c .:. rcConnectHost'
|
||||
rcConnectHost :: AgentErrorMonad m => AgentClient -> RCHostPairing -> J.Value -> Bool -> Maybe RCCtrlAddress -> Maybe Word16 -> m RCHostConnection
|
||||
rcConnectHost c = withAgentEnv c .::. rcConnectHost'
|
||||
|
||||
rcConnectHost' :: AgentMonad m => RCHostPairing -> J.Value -> Bool -> m RCHostConnection
|
||||
rcConnectHost' pairing ctrlAppInfo multicast = do
|
||||
rcConnectHost' :: AgentMonad m => RCHostPairing -> J.Value -> Bool -> Maybe RCCtrlAddress -> Maybe Word16 -> m RCHostConnection
|
||||
rcConnectHost' pairing ctrlAppInfo multicast rcAddr_ port_ = do
|
||||
drg <- asks random
|
||||
liftError RCP $ connectRCHost drg pairing ctrlAppInfo multicast
|
||||
liftError RCP $ connectRCHost drg pairing ctrlAppInfo multicast rcAddr_ port_
|
||||
|
||||
-- | connect to remote controller via URI
|
||||
rcConnectCtrl :: AgentErrorMonad m => AgentClient -> RCVerifiedInvitation -> Maybe RCCtrlPairing -> J.Value -> m RCCtrlConnection
|
||||
|
||||
@@ -189,32 +189,27 @@ updatedQs q = L.map $ \q' -> if dbQId q == dbQId q' then q else q'
|
||||
class SMPQueue q => SMPQueueRec q where
|
||||
qUserId :: q -> UserId
|
||||
qConnId :: q -> ConnId
|
||||
queueId :: q -> QueueId
|
||||
dbQId :: q -> Int64
|
||||
dbReplaceQId :: q -> Maybe Int64
|
||||
|
||||
instance SMPQueueRec RcvQueue where
|
||||
qUserId = userId
|
||||
qUserId RcvQueue {userId} = userId
|
||||
{-# INLINE qUserId #-}
|
||||
qConnId = connId
|
||||
qConnId RcvQueue {connId} = connId
|
||||
{-# INLINE qConnId #-}
|
||||
queueId = rcvId
|
||||
{-# INLINE queueId #-}
|
||||
dbQId = dbQueueId
|
||||
dbQId RcvQueue {dbQueueId} = dbQueueId
|
||||
{-# INLINE dbQId #-}
|
||||
dbReplaceQId = dbReplaceQueueId
|
||||
dbReplaceQId RcvQueue {dbReplaceQueueId} = dbReplaceQueueId
|
||||
{-# INLINE dbReplaceQId #-}
|
||||
|
||||
instance SMPQueueRec SndQueue where
|
||||
qUserId = userId
|
||||
qUserId SndQueue {userId} = userId
|
||||
{-# INLINE qUserId #-}
|
||||
qConnId = connId
|
||||
qConnId SndQueue {connId} = connId
|
||||
{-# INLINE qConnId #-}
|
||||
queueId = sndId
|
||||
{-# INLINE queueId #-}
|
||||
dbQId = dbQueueId
|
||||
dbQId SndQueue {dbQueueId} = dbQueueId
|
||||
{-# INLINE dbQId #-}
|
||||
dbReplaceQId = dbReplaceQueueId
|
||||
dbReplaceQId SndQueue {dbReplaceQueueId} = dbReplaceQueueId
|
||||
{-# INLINE dbReplaceQId #-}
|
||||
|
||||
-- * Connection types
|
||||
|
||||
@@ -1968,7 +1968,7 @@ insertRcvMsgDetails_ db connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, interna
|
||||
DB.execute db "INSERT INTO encrypted_rcv_message_hashes (conn_id, hash) VALUES (?,?)" (connId, encryptedMsgHash)
|
||||
|
||||
updateHashRcv_ :: DB.Connection -> ConnId -> RcvMsgData -> IO ()
|
||||
updateHashRcv_ dbConn connId RcvMsgData {msgMeta, internalHash, internalRcvId} =
|
||||
updateHashRcv_ dbConn connId RcvMsgData {msgMeta = MsgMeta {sndMsgId}, internalHash, internalRcvId} =
|
||||
DB.executeNamed
|
||||
dbConn
|
||||
-- last_internal_rcv_msg_id equality check prevents race condition in case next id was reserved
|
||||
@@ -1979,7 +1979,7 @@ updateHashRcv_ dbConn connId RcvMsgData {msgMeta, internalHash, internalRcvId} =
|
||||
WHERE conn_id = :conn_id
|
||||
AND last_internal_rcv_msg_id = :last_internal_rcv_msg_id;
|
||||
|]
|
||||
[ ":last_external_snd_msg_id" := sndMsgId (msgMeta :: MsgMeta),
|
||||
[ ":last_external_snd_msg_id" := sndMsgId,
|
||||
":last_rcv_msg_hash" := internalHash,
|
||||
":conn_id" := connId,
|
||||
":last_internal_rcv_msg_id" := internalRcvId
|
||||
|
||||
@@ -29,7 +29,7 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
ntfServerVersion :: String
|
||||
ntfServerVersion = "1.6.3"
|
||||
ntfServerVersion = "1.6.4"
|
||||
|
||||
defaultSMPBatchDelay :: Int
|
||||
defaultSMPBatchDelay = 10000
|
||||
|
||||
@@ -55,8 +55,8 @@ newNtfServerStats ts = do
|
||||
pure NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs}
|
||||
|
||||
getNtfServerStatsData :: NtfServerStats -> STM NtfServerStatsData
|
||||
getNtfServerStatsData s = do
|
||||
_fromTime <- readTVar $ fromTime (s :: NtfServerStats)
|
||||
getNtfServerStatsData s@NtfServerStats {fromTime} = do
|
||||
_fromTime <- readTVar fromTime
|
||||
_tknCreated <- readTVar $ tknCreated s
|
||||
_tknVerified <- readTVar $ tknVerified s
|
||||
_tknDeleted <- readTVar $ tknDeleted s
|
||||
@@ -69,8 +69,8 @@ getNtfServerStatsData s = do
|
||||
pure NtfServerStatsData {_fromTime, _tknCreated, _tknVerified, _tknDeleted, _subCreated, _subDeleted, _ntfReceived, _ntfDelivered, _activeTokens, _activeSubs}
|
||||
|
||||
setNtfServerStats :: NtfServerStats -> NtfServerStatsData -> STM ()
|
||||
setNtfServerStats s d = do
|
||||
writeTVar (fromTime (s :: NtfServerStats)) $! _fromTime (d :: NtfServerStatsData)
|
||||
setNtfServerStats s@NtfServerStats {fromTime} d@NtfServerStatsData {_fromTime} = do
|
||||
writeTVar fromTime $! _fromTime
|
||||
writeTVar (tknCreated s) $! _tknCreated d
|
||||
writeTVar (tknVerified s) $! _tknVerified d
|
||||
writeTVar (tknDeleted s) $! _tknDeleted d
|
||||
|
||||
@@ -118,6 +118,8 @@ module Simplex.Messaging.Protocol
|
||||
userProtocol,
|
||||
rcvMessageMeta,
|
||||
noMsgFlags,
|
||||
messageId,
|
||||
messageTs,
|
||||
|
||||
-- * Parse and serialize
|
||||
ProtocolMsgTag (..),
|
||||
@@ -356,6 +358,16 @@ data Message
|
||||
msgTs :: SystemTime
|
||||
}
|
||||
|
||||
messageId :: Message -> MsgId
|
||||
messageId = \case
|
||||
Message {msgId} -> msgId
|
||||
MessageQuota {msgId} -> msgId
|
||||
|
||||
messageTs :: Message -> SystemTime
|
||||
messageTs = \case
|
||||
Message {msgTs} -> msgTs
|
||||
MessageQuota {msgTs} -> msgTs
|
||||
|
||||
instance StrEncoding RcvMessage where
|
||||
strEncode RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} =
|
||||
B.unwords
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
@@ -58,6 +59,7 @@ import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
|
||||
import Data.Time.Clock.System (SystemTime (..), getSystemTime)
|
||||
import Data.Time.Format.ISO8601 (iso8601Show)
|
||||
import Data.Type.Equality
|
||||
import GHC.Stats (getRTSStats)
|
||||
import GHC.TypeLits (KnownNat)
|
||||
import Network.Socket (ServiceName, Socket, socketToHandle)
|
||||
import Simplex.Messaging.Agent.Lock
|
||||
@@ -88,6 +90,12 @@ import UnliftIO.Directory (doesFileExist, renameFile)
|
||||
import UnliftIO.Exception
|
||||
import UnliftIO.IO
|
||||
import UnliftIO.STM
|
||||
#if MIN_VERSION_base(4,18,0)
|
||||
import Data.List (sort)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import GHC.Conc (listThreads, threadStatus)
|
||||
import GHC.Conc.Sync (threadLabel)
|
||||
#endif
|
||||
|
||||
-- | Runs an SMP server using passed configuration.
|
||||
--
|
||||
@@ -282,6 +290,18 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
|
||||
where
|
||||
putStat :: Show a => String -> TVar a -> IO ()
|
||||
putStat label var = readTVarIO var >>= \v -> hPutStrLn h $ label <> ": " <> show v
|
||||
CPStatsRTS -> getRTSStats >>= hPutStrLn h . show
|
||||
CPThreads -> do
|
||||
#if MIN_VERSION_base(4,18,0)
|
||||
threads <- liftIO listThreads
|
||||
hPutStrLn h $ "Threads: " <> show (length threads)
|
||||
forM_ (sort threads) $ \tid -> do
|
||||
label <- threadLabel tid
|
||||
status <- threadStatus tid
|
||||
hPutStrLn h $ show tid <> " (" <> show status <> ") " <> fromMaybe "" label
|
||||
#else
|
||||
hPutStrLn h "Not available on GHC 8.10"
|
||||
#endif
|
||||
CPSave -> withLock (savingLock srv) "control" $ do
|
||||
hPutStrLn h "saving server state..."
|
||||
unliftIO u $ saveServer True
|
||||
@@ -296,6 +316,7 @@ runClientTransport th@THandle {thVersion, sessionId} = do
|
||||
c <- atomically $ newClient q thVersion sessionId ts
|
||||
s <- asks server
|
||||
expCfg <- asks $ inactiveClientExpiration . config
|
||||
labelMyThread . B.unpack $ "client $" <> encode sessionId
|
||||
raceAny_ ([liftIO $ send th c, client c s, receive th c] <> disconnectThread_ c expCfg)
|
||||
`finally` clientDisconnected c
|
||||
where
|
||||
@@ -413,7 +434,8 @@ dummyKeyEd448 :: C.PublicKey 'C.Ed448
|
||||
dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"
|
||||
|
||||
client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
|
||||
client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscribedQ, ntfSubscribedQ, notifiers} =
|
||||
client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
|
||||
labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
|
||||
forever $
|
||||
atomically (readTBQueue rcvQ)
|
||||
>>= mapM processCommand
|
||||
@@ -734,11 +756,11 @@ client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ} Serv
|
||||
encrypt msgFlags body =
|
||||
let encBody = EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) (C.cbNonce msgId') body
|
||||
in RcvMessage msgId' msgTs' msgFlags encBody
|
||||
msgId' = msgId (msg :: Message)
|
||||
msgTs' = msgTs (msg :: Message)
|
||||
msgId' = messageId msg
|
||||
msgTs' = messageTs msg
|
||||
|
||||
setDelivered :: Sub -> Message -> STM Bool
|
||||
setDelivered s msg = tryPutTMVar (delivered s) $ msgId (msg :: Message)
|
||||
setDelivered s msg = tryPutTMVar (delivered s) (messageId msg)
|
||||
|
||||
getStoreMsgQueue :: T.Text -> RecipientId -> m MsgQueue
|
||||
getStoreMsgQueue name rId = time (name <> " getMsgQueue") $ do
|
||||
@@ -838,7 +860,7 @@ restoreServerMessages = asks (storeMsgsFile . config) >>= mapM_ restoreMessages
|
||||
| maybe True (systemSeconds msgTs >=) old_ -> isNothing <$> writeMsg q msg
|
||||
| otherwise -> pure False
|
||||
MessageQuota {} -> writeMsg q msg $> False
|
||||
when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (msgId (msg :: Message))
|
||||
when logFull . logError . decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
|
||||
updateMsgV1toV3 QueueRec {rcvDhSecret} RcvMessage {msgId, msgTs, msgFlags, msgBody = EncRcvMsgBody body} = do
|
||||
let nonce = C.cbNonce msgId
|
||||
msgBody <- liftEither . first (msgErr "v1 message decryption") $ C.maxLenBS =<< C.cbDecrypt rcvDhSecret nonce body
|
||||
|
||||
@@ -42,6 +42,7 @@ import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (isNothing)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Clock.System (getSystemTime)
|
||||
import Data.Word (Word16)
|
||||
import qualified Data.X509 as X509
|
||||
import Data.X509.Validation (Fingerprint (..), getFingerprint)
|
||||
import Network.Socket (PortNumber, SockAddr (..), hostAddressToTuple)
|
||||
@@ -100,26 +101,29 @@ data RCHClient_ = RCHClient_
|
||||
endSession :: TMVar ()
|
||||
}
|
||||
|
||||
type RCHostConnection = (RCSignedInvitation, RCHostClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)))
|
||||
type RCHostConnection = (NonEmpty RCCtrlAddress, RCSignedInvitation, RCHostClient, RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)))
|
||||
|
||||
connectRCHost :: TVar ChaChaDRG -> RCHostPairing -> J.Value -> Bool -> ExceptT RCErrorType IO RCHostConnection
|
||||
connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ctrlAppInfo multicast = do
|
||||
connectRCHost :: TVar ChaChaDRG -> RCHostPairing -> J.Value -> Bool -> Maybe RCCtrlAddress -> Maybe Word16 -> ExceptT RCErrorType IO RCHostConnection
|
||||
connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ctrlAppInfo multicast rcAddrPrefs_ port_ = do
|
||||
r <- newEmptyTMVarIO
|
||||
host <- getLocalAddress >>= maybe (throwError RCENoLocalAddress) pure
|
||||
found@(RCCtrlAddress {address} :| _) <- findCtrlAddress
|
||||
c@RCHClient_ {startedPort, announcer} <- liftIO mkClient
|
||||
hostKeys <- liftIO genHostKeys
|
||||
action <- runClient c r hostKeys `putRCError` r
|
||||
-- wait for the port to make invitation
|
||||
-- TODO can't we actually find to which interface the server got connected to get host there?
|
||||
portNum <- atomically $ readTMVar startedPort
|
||||
signedInv@RCSignedInvitation {invitation} <- maybe (throwError RCETLSStartFailed) (liftIO . mkInvitation hostKeys host) portNum
|
||||
signedInv@RCSignedInvitation {invitation} <- maybe (throwError RCETLSStartFailed) (liftIO . mkInvitation hostKeys address) portNum
|
||||
when multicast $ case knownHost of
|
||||
Nothing -> throwError RCENewController
|
||||
Just KnownHostPairing {hostDhPubKey} -> do
|
||||
ann <- async . liftIO . runExceptT $ announceRC drg 60 idPrivKey hostDhPubKey hostKeys invitation
|
||||
atomically $ putTMVar announcer ann
|
||||
pure (signedInv, RCHostClient {action, client_ = c}, r)
|
||||
pure (found, signedInv, RCHostClient {action, client_ = c}, r)
|
||||
where
|
||||
findCtrlAddress :: ExceptT RCErrorType IO (NonEmpty RCCtrlAddress)
|
||||
findCtrlAddress = do
|
||||
found' <- liftIO $ getLocalAddress rcAddrPrefs_
|
||||
maybe (throwError RCENoLocalAddress) pure $ L.nonEmpty found'
|
||||
mkClient :: IO RCHClient_
|
||||
mkClient = do
|
||||
startedPort <- newEmptyTMVarIO
|
||||
@@ -130,7 +134,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
|
||||
runClient :: RCHClient_ -> RCStepTMVar (SessionCode, TLS, RCStepTMVar (RCHostSession, RCHostHello, RCHostPairing)) -> RCHostKeys -> ExceptT RCErrorType IO (Async ())
|
||||
runClient RCHClient_ {startedPort, announcer, hostCAHash, endSession} r hostKeys = do
|
||||
tlsCreds <- liftIO $ genTLSCredentials caKey caCert
|
||||
startTLSServer startedPort tlsCreds (tlsHooks r knownHost hostCAHash) $ \tls ->
|
||||
startTLSServer port_ startedPort tlsCreds (tlsHooks r knownHost hostCAHash) $ \tls ->
|
||||
void . runExceptT $ do
|
||||
r' <- newEmptyTMVarIO
|
||||
whenM (atomically $ tryPutTMVar r $ Right (tlsUniq tls, tls, r')) $
|
||||
|
||||
@@ -7,21 +7,22 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
-- XXX: remove non-discovery functions
|
||||
module Simplex.RemoteControl.Discovery where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Logger.Simple
|
||||
import Control.Monad
|
||||
import Crypto.Random (getRandomBytes)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Default (def)
|
||||
import Data.Maybe (listToMaybe, mapMaybe)
|
||||
import Data.List (delete, find)
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.String (IsString)
|
||||
import qualified Data.Text as T
|
||||
import Data.Word (Word16)
|
||||
import Network.Info (IPv4 (..), NetworkInterface (..), getNetworkInterfaces)
|
||||
import qualified Network.Socket as N
|
||||
import qualified Network.TLS as TLS
|
||||
import qualified Network.UDP as UDP
|
||||
import Simplex.Messaging.Encoding (Encoding (..))
|
||||
import Simplex.Messaging.Transport (supportedParameters)
|
||||
import qualified Simplex.Messaging.Transport as Transport
|
||||
import Simplex.Messaging.Transport.Client (TransportHost (..))
|
||||
@@ -41,49 +42,36 @@ pattern ANY_ADDR_V4 = "0.0.0.0"
|
||||
pattern DISCOVERY_PORT :: (IsString a, Eq a) => a
|
||||
pattern DISCOVERY_PORT = "5227"
|
||||
|
||||
getLocalAddress :: MonadIO m => m (Maybe TransportHost)
|
||||
getLocalAddress = listToMaybe . mapMaybe usable <$> liftIO getNetworkInterfaces
|
||||
getLocalAddress :: Maybe RCCtrlAddress -> IO [RCCtrlAddress]
|
||||
getLocalAddress preferred_ =
|
||||
maybe id preferAddress preferred_ . mkLastLocalHost . mapMaybe toCtrlAddr <$> getNetworkInterfaces
|
||||
where
|
||||
usable NetworkInterface {ipv4 = IPv4 ha} = case N.hostAddressToTuple ha of
|
||||
toCtrlAddr NetworkInterface {name, ipv4 = IPv4 ha} = case N.hostAddressToTuple ha of
|
||||
(0, 0, 0, 0) -> Nothing -- "no" address
|
||||
(255, 255, 255, 255) -> Nothing -- broadcast
|
||||
(127, _, _, _) -> Nothing -- localhost
|
||||
(169, 254, _, _) -> Nothing -- link-local
|
||||
ok -> Just $ THIPv4 ok
|
||||
ok -> Just RCCtrlAddress {address = THIPv4 ok, interface = T.pack name}
|
||||
|
||||
getLocalAddressMulticast :: MonadIO m => TMVar Int -> m (Maybe TransportHost)
|
||||
getLocalAddressMulticast subscribers = liftIO $ do
|
||||
probe <- mkIpProbe
|
||||
let bytes = smpEncode probe
|
||||
withListener subscribers $ \receiver ->
|
||||
withSender $ \sender -> do
|
||||
UDP.send sender bytes
|
||||
let expect = do
|
||||
UDP.recvFrom receiver >>= \case
|
||||
(p, _) | p /= bytes -> expect
|
||||
(_, UDP.ClientSockAddr (N.SockAddrInet _port host) _cmsg) -> pure $ THIPv4 (N.hostAddressToTuple host)
|
||||
(_, UDP.ClientSockAddr _badAddr _) -> error "receiving from IPv4 socket"
|
||||
timeout 1000000 expect
|
||||
mkLastLocalHost :: [RCCtrlAddress] -> [RCCtrlAddress]
|
||||
mkLastLocalHost addrs = case find localHost addrs of
|
||||
Nothing -> addrs
|
||||
Just lh -> delete lh addrs <> [lh]
|
||||
where
|
||||
localHost RCCtrlAddress {address = a} = a == THIPv4 (127, 0, 0, 1)
|
||||
|
||||
mkIpProbe :: MonadIO m => m IpProbe
|
||||
mkIpProbe = do
|
||||
randomNonce <- liftIO $ getRandomBytes 32
|
||||
pure IpProbe {versionRange = ipProbeVersionRange, randomNonce}
|
||||
preferAddress :: RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress]
|
||||
preferAddress RCCtrlAddress {address, interface} addrs =
|
||||
case find matchAddr addrs <|> find matchIface addrs of
|
||||
Nothing -> addrs
|
||||
Just p -> p : delete p addrs
|
||||
where
|
||||
matchAddr RCCtrlAddress {address = a} = a == address
|
||||
matchIface RCCtrlAddress {interface = i} = i == interface
|
||||
|
||||
-- | Send replay-proof announce datagrams
|
||||
-- runAnnouncer :: (C.PrivateKeyEd25519, Announce) -> IO ()
|
||||
-- runAnnouncer (announceKey, initialAnnounce) = withSender $ loop initialAnnounce
|
||||
-- where
|
||||
-- loop announce sock = do
|
||||
-- UDP.send sock $ smpEncode (signAnnounce announceKey announce)
|
||||
-- threadDelay 1000000
|
||||
-- loop announce {announceCounter = announceCounter announce + 1} sock
|
||||
|
||||
-- XXX: move to RemoteControl.Client
|
||||
startTLSServer :: MonadUnliftIO m => TMVar (Maybe N.PortNumber) -> TLS.Credentials -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> m (Async ())
|
||||
startTLSServer startedOnPort credentials hooks server = async . liftIO $ do
|
||||
startTLSServer :: MonadUnliftIO m => Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credentials -> TLS.ServerHooks -> (Transport.TLS -> IO ()) -> m (Async ())
|
||||
startTLSServer port_ startedOnPort credentials hooks server = async . liftIO $ do
|
||||
started <- newEmptyTMVarIO
|
||||
bracketOnError (startTCPServer started "0") (\_e -> setPort Nothing) $ \socket ->
|
||||
bracketOnError (startTCPServer started $ maybe "0" show port_) (\_e -> setPort Nothing) $ \socket ->
|
||||
ifM
|
||||
(atomically $ readTMVar started)
|
||||
(runServer started socket)
|
||||
|
||||
@@ -14,6 +14,7 @@ import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
@@ -23,6 +24,7 @@ import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON)
|
||||
import Simplex.Messaging.Transport (TLS)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost)
|
||||
import Simplex.Messaging.Util (safeDecodeUtf8)
|
||||
import Simplex.Messaging.Version (Version, VersionRange, mkVersionRange)
|
||||
import UnliftIO
|
||||
@@ -134,6 +136,12 @@ data KnownHostPairing = KnownHostPairing
|
||||
hostDhPubKey :: C.PublicKeyX25519
|
||||
}
|
||||
|
||||
data RCCtrlAddress = RCCtrlAddress
|
||||
{ address :: TransportHost, -- allows any interface when found exactly
|
||||
interface :: Text
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Long-term part of host (mobile) connection to controller (desktop)
|
||||
data RCCtrlPairing = RCCtrlPairing
|
||||
{ caKey :: C.APrivateSignKey,
|
||||
@@ -226,3 +234,5 @@ cancelTasks :: MonadIO m => Tasks -> m ()
|
||||
cancelTasks tasks = readTVarIO tasks >>= mapM_ cancel
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCE") ''RCErrorType)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''RCCtrlAddress)
|
||||
|
||||
+3
-2
@@ -134,8 +134,9 @@ ntfServerTest ::
|
||||
IO (Maybe C.ASignature, ByteString, ByteString, BrokerMsg)
|
||||
ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
|
||||
where
|
||||
tPut' h (sig, corrId, queueId, smp) = do
|
||||
let t' = smpEncode (sessionId (h :: THandle c), corrId, queueId, smp)
|
||||
tPut' :: THandle c -> (Maybe C.ASignature, ByteString, ByteString, smp) -> IO ()
|
||||
tPut' h@THandle {sessionId} (sig, corrId, queueId, smp) = do
|
||||
let t' = smpEncode (sessionId, corrId, queueId, smp)
|
||||
[Right ()] <- tPut h Nothing [(sig, t')]
|
||||
pure ()
|
||||
tGet' h = do
|
||||
|
||||
+40
-4
@@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module RemoteControl where
|
||||
@@ -8,8 +9,10 @@ import Control.Logger.Simple
|
||||
import Crypto.Random (ChaChaDRG, drgNew)
|
||||
import qualified Data.Aeson as J
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Simplex.RemoteControl.Client (RCHostClient (..))
|
||||
import Simplex.Messaging.Encoding.String (StrEncoding (..))
|
||||
import qualified Simplex.RemoteControl.Client as HC (RCHostClient (action))
|
||||
import qualified Simplex.RemoteControl.Client as RC
|
||||
import Simplex.RemoteControl.Discovery (mkLastLocalHost, preferAddress)
|
||||
import Simplex.RemoteControl.Invitation (RCSignedInvitation, verifySignedInvitation)
|
||||
import Simplex.RemoteControl.Types
|
||||
import Test.Hspec
|
||||
@@ -18,12 +21,45 @@ import UnliftIO.Concurrent
|
||||
|
||||
remoteControlTests :: Spec
|
||||
remoteControlTests = do
|
||||
describe "preferred bindings should go first" testPreferAddress
|
||||
describe "New controller/host pairing" $ do
|
||||
it "should connect to new pairing" testNewPairing
|
||||
it "should connect to existing pairing" testExistingPairing
|
||||
describe "Multicast discovery" $ do
|
||||
it "should find paired host and connect" testMulticast
|
||||
|
||||
testPreferAddress :: Spec
|
||||
testPreferAddress = do
|
||||
it "suppresses localhost" $
|
||||
mkLastLocalHost addrs
|
||||
`shouldBe` [ "10.20.30.40" `on` "eth0",
|
||||
"10.20.30.42" `on` "wlan0",
|
||||
"127.0.0.1" `on` "lo"
|
||||
]
|
||||
it "finds by address" $ do
|
||||
preferAddress ("127.0.0.1" `on` "lo23") addrs' `shouldBe` addrs -- localhost is back on top
|
||||
preferAddress ("10.20.30.42" `on` "wlp2s0") addrs'
|
||||
`shouldBe` [ "10.20.30.42" `on` "wlan0",
|
||||
"10.20.30.40" `on` "eth0",
|
||||
"127.0.0.1" `on` "lo"
|
||||
]
|
||||
it "finds by interface" $ do
|
||||
preferAddress ("127.1.2.3" `on` "lo") addrs' `shouldBe` addrs
|
||||
preferAddress ("0.0.0.0" `on` "eth0") addrs' `shouldBe` addrs'
|
||||
it "survives duplicates" $ do
|
||||
preferAddress ("0.0.0.0" `on` "eth1") addrsDups `shouldBe` addrsDups
|
||||
preferAddress ("0.0.0.0" `on` "eth0") ifaceDups `shouldBe` ifaceDups
|
||||
where
|
||||
on th interface = RCCtrlAddress {address = either error id $ strDecode th, interface}
|
||||
addrs =
|
||||
[ "127.0.0.1" `on` "lo", -- localhost may go first and break things
|
||||
"10.20.30.40" `on` "eth0",
|
||||
"10.20.30.42" `on` "wlan0"
|
||||
]
|
||||
addrs' = mkLastLocalHost addrs
|
||||
addrsDups = "10.20.30.40" `on` "eth1" : addrs'
|
||||
ifaceDups = "10.20.30.41" `on` "eth0" : addrs'
|
||||
|
||||
testNewPairing :: IO ()
|
||||
testNewPairing = do
|
||||
drg <- drgNew >>= newTVarIO
|
||||
@@ -31,7 +67,7 @@ testNewPairing = do
|
||||
invVar <- newEmptyMVar
|
||||
ctrlSessId <- async . runRight $ do
|
||||
logNote "c 1"
|
||||
(inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") False
|
||||
(_found, inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") False Nothing Nothing
|
||||
logNote "c 2"
|
||||
putMVar invVar (inv, hc)
|
||||
logNote "c 3"
|
||||
@@ -62,7 +98,7 @@ testNewPairing = do
|
||||
logNote "ctrl: adios"
|
||||
pure sessId'
|
||||
|
||||
waitCatch (action hc) >>= \case
|
||||
waitCatch (HC.action hc) >>= \case
|
||||
Left err -> fromException err `shouldBe` Just AsyncCancelled
|
||||
Right () -> fail "Unexpected controller finish"
|
||||
|
||||
@@ -123,7 +159,7 @@ testMulticast = do
|
||||
|
||||
runCtrl :: TVar ChaChaDRG -> Bool -> RCHostPairing -> MVar RCSignedInvitation -> IO (Async RCHostPairing)
|
||||
runCtrl drg multicast hp invVar = async . runRight $ do
|
||||
(inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") multicast
|
||||
(_found, inv, hc, r) <- RC.connectRCHost drg hp (J.String "app") multicast Nothing Nothing
|
||||
putMVar invVar inv
|
||||
Right (_sessId, _tls, r') <- atomically $ takeTMVar r
|
||||
Right (_rcHostSession, _rcHelloBody, hp') <- atomically $ takeTMVar r'
|
||||
|
||||
+4
-2
@@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
@@ -159,8 +160,9 @@ smpServerTest ::
|
||||
IO (Maybe C.ASignature, ByteString, ByteString, BrokerMsg)
|
||||
smpServerTest _ t = runSmpTest $ \h -> tPut' h t >> tGet' h
|
||||
where
|
||||
tPut' h (sig, corrId, queueId, smp) = do
|
||||
let t' = smpEncode (sessionId (h :: THandle c), corrId, queueId, smp)
|
||||
tPut' :: THandle c -> (Maybe C.ASignature, ByteString, ByteString, smp) -> IO ()
|
||||
tPut' h@THandle {sessionId} (sig, corrId, queueId, smp) = do
|
||||
let t' = smpEncode (sessionId, corrId, queueId, smp)
|
||||
[Right ()] <- tPut h Nothing [(sig, t')]
|
||||
pure ()
|
||||
tGet' h = do
|
||||
|
||||
@@ -140,7 +140,7 @@ runTestFileChunkDelete s r = do
|
||||
deleteXFTPChunk s spKey sId
|
||||
liftIO $
|
||||
readChunk sId
|
||||
`shouldThrow` \(e :: SomeException) -> "openBinaryFile: does not exist" `isInfixOf` show e
|
||||
`shouldThrow` \(e :: SomeException) -> "withBinaryFile" `isInfixOf` show e
|
||||
downloadXFTPChunk r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
|
||||
`catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
|
||||
deleteXFTPChunk s spKey sId
|
||||
@@ -243,6 +243,8 @@ testFileLog = do
|
||||
rIdVar1 <- newTVarIO ""
|
||||
rIdVar2 <- newTVarIO ""
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerStoreLogOn $ \_ -> testXFTPClient $ \c -> runRight_ $ do
|
||||
let file = FileInfo {sndKey, size = chSize, digest}
|
||||
chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
|
||||
@@ -258,6 +260,8 @@ testFileLog = do
|
||||
logSize testXFTPLogFile `shouldReturn` 3
|
||||
logSize testXFTPStatsBackupFile `shouldReturn` 11
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerThreadOn $ \_ -> testXFTPClient $ \c -> runRight_ $ do
|
||||
sId <- liftIO $ readTVarIO sIdVar
|
||||
rId1 <- liftIO $ readTVarIO rIdVar1
|
||||
@@ -270,6 +274,8 @@ testFileLog = do
|
||||
deleteXFTPChunk c spKey sId
|
||||
`catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerStoreLogOn $ \_ -> testXFTPClient $ \c -> runRight_ $ do
|
||||
rId1 <- liftIO $ readTVarIO rIdVar1
|
||||
rId2 <- liftIO $ readTVarIO rIdVar2
|
||||
@@ -281,9 +287,13 @@ testFileLog = do
|
||||
logSize testXFTPLogFile `shouldReturn` 4
|
||||
logSize testXFTPStatsBackupFile `shouldReturn` 11
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerStoreLogOn $ \_ -> pure () -- ack is compacted - -1 from log
|
||||
logSize testXFTPLogFile `shouldReturn` 3
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerStoreLogOn $ \_ -> testXFTPClient $ \c -> runRight_ $ do
|
||||
sId <- liftIO $ readTVarIO sIdVar
|
||||
rId1 <- liftIO $ readTVarIO rIdVar1
|
||||
@@ -298,10 +308,14 @@ testFileLog = do
|
||||
logSize testXFTPLogFile `shouldReturn` 4
|
||||
logSize testXFTPStatsBackupFile `shouldReturn` 11
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerStoreLogOn $ \_ -> pure () -- compacts on start
|
||||
logSize testXFTPLogFile `shouldReturn` 0
|
||||
logSize testXFTPStatsBackupFile `shouldReturn` 11
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
removeFile testXFTPLogFile
|
||||
removeFile testXFTPStatsBackupFile
|
||||
where
|
||||
|
||||
Reference in New Issue
Block a user