Compare commits

...
379 Commits
Author SHA1 Message Date
sim 5b56bdff2d Fix following rebase 2026-01-20 17:20:45 +01:00
sim afd001150b Parse webpush http2 response status 2026-01-20 17:06:55 +01:00
sim 8129eb6cc8 Add HTTP2 support to webpush 2026-01-20 16:57:20 +01:00
sim 8d95f1b30e WIP: add test to check webpush requests from ntf server 2026-01-20 16:19:05 +01:00
Evgenyandsim ea9adf1ac5 webpush: small fixes (#1699)
* Fix compilation for client lib

* Print VAPID fp

* Fix VAPID signature

* refactor

---------

Co-authored-by: sim <git@sgougeon.fr>
2026-01-19 21:05:28 +00:00
Evgeny 229c8956d9 ntf: e2e encrypt notifications, clean up encryption (#1698) 2026-01-19 20:22:23 +00:00
Evgeny 9c6f32c599 Merge pull request #1663 from p1gp1g/vapid
[webpush] Add VAPID to ntf server
2026-01-16 19:15:21 +00:00
sim 323d6daadf Fix compilation with GHC 8 2025-12-05 14:13:44 +01:00
sim 28aa2da55c Add safety delay for VAPID header expirity 2025-12-05 14:13:44 +01:00
sim 49a7e26a2f Send VAPID header with webpush requests 2025-12-05 14:13:43 +01:00
sim c50c77dbad Add WebPush config with VAPID key to NTF server 2025-12-05 13:45:50 +01:00
sim 3402d64029 Move functions to encode/decode EC keys to Crypto module 2025-12-05 13:44:18 +01:00
Evgeny Poberezkin 1007deb1f5 refactor 2025-11-11 18:41:20 +00:00
Evgeny Poberezkin 17fe6edcde instance 2025-11-11 18:16:20 +00:00
Evgeny Poberezkin 4257255de2 fix test 2025-11-11 17:51:50 +00:00
Evgeny Poberezkin a4931289a7 remove function 2025-11-11 17:39:12 +00:00
Evgeny Poberezkin 673f50e0f4 remove unused error constructor 2025-11-11 17:15:23 +00:00
Evgeny Poberezkin 63c4647f39 refactor 2025-11-11 16:54:38 +00:00
Evgeny Poberezkin 7485175980 remove comment 2025-11-10 21:30:06 +00:00
Evgeny Poberezkin 8ee3fd0ef7 fix migration 2025-11-10 21:14:09 +00:00
S1m 5e28d4faba [webpush] Parsing during registration (#1661)
* Parse WPDeviceToken during registration

* Clarify PPInvalidPusher with apnsPushProviderClient

* Use SrvLoc for webpush endpoints

* Remove unused WPEndpoint

* Test RFC8291 - webpush encryption - implementation

* Fix tests with -fserver_postgres

* Disable redirections with webpush

* Rename webpush tests, and move behind server_postgres flag

* Parse webpush endpoint with StrEncoding

* Fix rename webpush tests

* Lint import

* Test push notification encoding for webpush

* Test strDecoding invalid WPDeviceToken
2025-11-10 20:45:16 +00:00
Evgeny Poberezkin d3d97685c3 Merge branch 'unified-push' into p1gp1g-webpush_requests 2025-11-10 20:23:08 +00:00
Evgeny Poberezkin f455705974 Merge branch 'master' into unified-push 2025-11-10 20:22:13 +00:00
spaced4ndyandEvgeny Poberezkin 3016b929b4 agent: make createConnection and setConnShortLink apis support setting all link data fields (#1665)
* agent: make createConnection and setConnShortLink apis support setting all link data fields

* add functions

* refactor

* refactor

* fix tests

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-11-05 07:08:33 +00:00
Evgeny Poberezkin 1ae3e8d0be 6.5.0.3 2025-10-23 08:34:11 +01:00
Evgeny 1329fc726f smp: support client notices (#1659)
* agent: support client notices

* improve

* fix, test

* rename

* cleanup

* send and process notices in more cases

* dont delete

* dont remove notice on other permanent errors

* dont remove notice if there is no notice ID in queue

* add server to error

* allow deleting

* only use notice if key hash matches
2025-10-17 18:34:59 +01:00
spaced4ndyandEvgeny 234aeb81dd agent: add subscription status to connection stats (#1658)
* agent: add subscription status to connection stats

* wip

* conn status

* format

* refactor

* refactor

* m

* shorter

* shorter

---------

Co-authored-by: Evgeny <evgeny@poberezkin.com>
2025-10-13 17:53:28 +01:00
spaced4ndyandEvgeny Poberezkin 1dbc15b2e6 agent: sync connections (#1654)
* agent: sync subscriptions

* remove comment

* add shouldDelete flag

* compare api

* remove instance

* query

* rename

* refactor

* functor

* JSON instances

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-10-10 05:41:42 +00:00
Evgeny 80aa56cbcc agent: track which queues need subscribing for iOS NSE (#1657)
* agent: track which queues need subscribing for iOS NSE

* fix down migration

* fix, cleanup
2025-10-09 18:33:27 +01:00
Evgeny 9cda20381f agent: subscribe all connections (#1655)
* agent: subscribe all connections

* query, version

* BoolInt

* add query to errors

* Revert "add query to errors"

This reverts commit 32a1f7fe11.

* fix optional field

* version

* limit number of in-flight subscriptions to 35000
2025-10-09 13:43:48 +01:00
Evgeny 318ddf692a smp server: import/export to/from PostgreSQL with one command, deprecation notice for journal storage (#1653) 2025-10-09 13:31:57 +01:00
Evgeny 11a4859f8e agent: batch processing of subscription results and errors (#1652)
* agent: batch processing of subscription results and errors

* run agent tests with in-memory server storage

* version

* non empty errors

* size
2025-10-07 14:49:38 +01:00
Evgeny a3d1a72eb0 agent: optimize subscriptions memory usage (#1651)
* agent: optimize subscriptions memory usage more (do not store subscribed queues in memory) WIP

* use new session subscriptions data

* version

* remove old data structure

* remove version

* batch deletions

* test TSessionSubs

* comment
2025-10-06 15:21:17 +01:00
Evgeny Poberezkin 17b71cf673 Merge branch 'stable' 2025-10-05 22:03:58 +01:00
Evgeny 779222d1a7 agent: optimize subscriptions memory usage (#1649)
* agent: optimize subscriptions memory usage

* version

* remove typeclass

* disable subscription to test memory usage

* disable delivery and commands

* disable reading connections

* enable subscriptions

* RcvQueueCred

* RcvQueueCred postgres

* fix

* optimize keys

* version

* rename

* comments
2025-10-05 13:35:54 +01:00
Evgeny Poberezkin 538dcb6a4c 6.4.6.0 2025-10-04 14:49:42 +01:00
Evgeny Poberezkin 98115b6db1 6.5.0.2 2025-09-30 12:37:28 +01:00
Evgeny 9854caca33 agent: optimize subscriptions (#1645)
* agent: optimize subscriptions

* simplify

* clean up
2025-09-30 12:34:42 +01:00
spaced4ndy c8b551dcf7 agent: fix file reception error in postgres (#1647) 2025-09-30 08:32:45 +01:00
Evgeny 99f40ae109 support for additional database migrations (#1644) 2025-09-27 11:21:38 +01:00
sh 3a9381b966 ci/scripts: execute git version if chmod fails (#1643) 2025-09-23 09:08:56 +01:00
Evgeny Poberezkin 54a2a6c905 6.5.0.1 2025-09-17 09:04:03 +01:00
Evgeny Poberezkin f5a8d8b21c token types and migration (WIP, does not compile) 2025-09-16 21:29:38 +01:00
Evgeny Poberezkin c56b04fb6b Merge branch 'webpush_requests' of github.com:p1gp1g/simplexmq into p1gp1g-webpush_requests 2025-09-16 19:07:56 +01:00
Evgeny Poberezkin cf38c129da Merge branch 'master' into unified-push 2025-09-16 19:02:53 +01:00
Evgeny 7b7616ce7e agent: batch loading of connections with PostgreSQL client (#1639)
* agent: batch loading of connections with PostgreSQL client

* batch more

* optimize getPendingCommandServers

* fix Bool conversion

* enable all tests

* cleanup
2025-09-16 14:28:06 +01:00
sh b020a08ea0 ci: disable aarch64 tests (#1638) 2025-09-15 09:02:34 +01:00
Evgeny Poberezkin 2737e7d602 6.5.0.0.1 2025-09-15 07:52:17 +01:00
Evgeny d3754b36bc smp server: do not use queue cache with PostgreSQL message storage (#1637)
* smp server: do not use queue cache with PostgreSQL message storage

* fix loading queues via notifier IDs
2025-09-15 07:51:27 +01:00
Evgeny Poberezkin 112cd9d5f4 Merge branch 'stable' 2025-09-14 14:42:05 +01:00
Evgeny 8a7991a376 agent: option to set SQLite database backup path (#1636)
* agent: option to set SQLite database backup path

* fix test compilation
2025-09-14 12:41:49 +01:00
Evgeny 6f4d0f5377 Merge pull request #1630 from simplex-chat/db-messages
Feature branch: PostgreSQL message store
2025-09-13 19:24:59 +01:00
Evgeny 9cfdae3494 smp server: uniterruptible mask for DB operations (#1635) 2025-09-13 19:08:07 +01:00
Evgeny Poberezkin 62183699db 6.5.0.0 2025-09-13 11:37:59 +01:00
Evgeny 9be9a76b42 smp server: improve message expiration (#1634)
* smp server: limit by time the queues to export journal messages for

* pass queue/msg thresholds separately

* reset db connection on errors

* Revert "smp server: limit by time the queues to export journal messages for"

This reverts commit d3bc0cba4b.

* fix test compilation

* flag to expire messages

* improve test

* expire messages newer than quota
2025-09-13 11:35:34 +01:00
Evgeny Poberezkin 80f7be6dd7 Merge branch 'master' into db-messages 2025-09-13 09:31:23 +01:00
Evgeny 83721240a4 reset db connection on errors (#1633) 2025-09-13 09:30:01 +01:00
Evgeny 6c66cf367a smp server: set message counts correctly after import (#1632) 2025-09-12 13:08:11 +01:00
Evgeny a137d01c90 smp server: improve counts management and expiration for postgres message store (#1631)
* smp server: improve counts management and expiration for postgres message store

* one update

* fix expiration
2025-09-12 11:39:35 +01:00
Evgeny bac6ea6e91 smp server: store messages in PostgreSQL (#1622)
* smp server: store messages in PostgreSQL

* stored procedures to write and to expire messages

* function to export messages

* move all message functions to PostgreSQL, remove delete trigger

* comments

* import messages to db

* fix message import, add export

* fix export

* fix export

* fix compilation flags

* import messages line by line

* fix server start with database storage

* fix compilation

* comments
2025-09-11 20:22:55 +01:00
Evgeny 0c1030cf02 smp server: faster export (#1626)
* smp server: faster export

* flush

* export messages with PostgreSQL database

* remove flush

* batch message writes

* Revert "batch message writes"

This reverts commit 61fb3c3b9e.

* remove $!

* fast journal export

* another approach

* Revert "smp server: remove dependency of message size on the version (#1627)"

This reverts commit 8fea15245a.

* style

* faster?

* cleanup

* cleanup

* refactor

* refactor

* concurrent read messages

* Revert "concurrent read messages"

This reverts commit 05a32e6491.

* concurrent read/write

* parameter to export to/import from another message log file

* Revert "parameter to export to/import from another message log file"

This reverts commit 4e88b035c4.

* Revert "concurrent read/write"

This reverts commit a8eab1f7e3.
2025-09-10 18:22:58 +01:00
Evgeny Poberezkin 23aff6b0b1 Revert "smp server: remove dependency of message size on the version (#1627)"
This reverts commit 8fea15245a.
2025-09-09 09:56:48 +01:00
sh 3335cd5500 ci: add aarch64 builds (#1624) 2025-09-09 08:55:37 +01:00
spaced4ndyandEvgeny Poberezkin a4f049d8da agent: parameterize withWork, getWorkItem with StoreError; parameterized Binary for SQLite (#1617)
* agent: parameterize withWork StoreError

* getWorkItem

* export

* binary

* remove handleWrkErr AnyStoreError constraint

* put AnyError in AnyStoreError constraint

* move typeclass

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-09-08 16:38:08 +01:00
Evgeny 8fea15245a smp server: remove dependency of message size on the version (#1627) 2025-09-08 11:28:42 +01:00
sh 42a2c1fc57 ci: fix git in docker (#1623) 2025-09-08 09:41:20 +01:00
Evgeny Poberezkin 7e98b3103f 6.4.5.2 2025-09-07 15:13:19 +01:00
Evgeny Poberezkin 2a61085f07 backward compatible encoding for missing NetworkError 2025-09-07 15:04:06 +01:00
Evgeny 4386dd8b5a smp server: option to expire messages when new message is sent (now off by default) (#1625)
* smp server: option to expire messages when new message is sent (now off by default)

* fix test
2025-09-07 09:02:32 +01:00
Evgeny Poberezkin 50ddd630be 6.4.5.1 2025-09-03 11:12:20 +01:00
Evgeny cb3250e7b4 servers: better socket leak prevention during TLS handshake, add NetworkError type to better diagnose connection errors (#1619)
* servers: better socket leak prevention during TLS handshake

* log tcp connection errors

* more detailed network error

* log full address

* rename error

* add encodings for NetworkError

* refactor

* comment

* bind

* style

* remove parameters of NETWORK error from encoding
2025-09-02 16:07:37 +01:00
Evgeny Poberezkin 0319addd2b 6.4.5.0 2025-09-01 18:57:09 +01:00
Evgeny 77bf76e1f9 smp server: fix in-memory server not restoring queue/service associations after 2+ restarts (#1618)
* smp server: fix in-memory server not restoring queue/service associations after 2+ restarts

* fix test, do not reuse database
2025-09-01 17:45:31 +01:00
Evgeny 4a39c4a021 Merge branch 'unified-push' into webpush_requests 2025-08-29 10:34:03 +01:00
S1mandEvgeny 3e57dda015 ntf server: move token functions and types to shared module to be used with WebPush (#1611)
* Move generic push functions to Push.hs

* Fix move push

* minor changes

---------

Co-authored-by: Evgeny <evgeny@poberezkin.com>
2025-08-29 10:21:40 +01:00
Evgeny beafac1f73 agent: make agent workers usable from other contexts (#1614) 2025-08-29 08:33:55 +01:00
sim 9d30af4edd Fix Urgency case 2025-08-27 12:47:33 +02:00
sim 720fb40a86 Encrypt wp notifications 2025-08-27 12:47:33 +02:00
sim 1295b28298 Lint liftPPWPError 2025-08-27 12:47:33 +02:00
sim 2205a1fb7c Use content of push notif with web push 2025-08-27 12:47:33 +02:00
sim a24024c0b8 Prepare webpush requests 2025-08-27 12:47:33 +02:00
sim 64269c212a Add WPDeviceToken 2025-08-27 12:47:33 +02:00
sim e7e7c9bfa1 Rename APNSDeviceToken 2025-08-27 12:47:19 +02:00
sim c08c3794ba Fix move push 2025-08-27 12:46:56 +02:00
sim e90c15bb90 Move generic push functions to Push.hs 2025-08-27 10:33:56 +02:00
Evgeny Poberezkin a2d777bda0 6.4.4.1 2025-08-23 20:05:10 +01:00
Evgeny e48bedeaf2 servers: fix server pages when source code is not specified, include commit SHA in printed version and in web page. (#1608)
* smp server: fix server pages when source code is not specified

* servers: include git commit in version

* flexible alpn

* fix test

* fix ghc 8.10.7 build
2025-08-23 19:59:00 +01:00
Evgeny Poberezkin a2d35281b2 6.4.4.0 2025-08-18 16:22:24 +01:00
spaced4ndy 46035af9a3 agent: add context to SEMsgNotFound error (#1604) 2025-08-18 10:59:57 +01:00
Evgeny Poberezkin 4b7fc34fe3 enable all tests 2025-08-17 10:40:12 +01:00
Evgeny 96e8b4a146 smp server: wrap all queries in transactions (#1603)
* smp server: wrap all queries in transactions

* fix test

* fix schema test
2025-08-17 10:38:20 +01:00
Evgeny 2cedb66667 agent: chat relay address type for short links (#1602) 2025-08-15 07:24:37 +01:00
Evgeny e345671c76 agent: extend xrcp certificate validity 1 hour in the past, to allow out of sync clocks (#1601) 2025-08-14 22:48:11 +01:00
Evgeny 86fb2cddc5 smp server: support short SimpleX addresses in server information / pages (#1600) 2025-08-12 07:31:32 +01:00
Evgeny Poberezkin 931c533a3d 6.4.3.0 2025-08-05 12:30:28 +01:00
Evgeny 79ba60e3ad agent: update contact request server hosts to match server in short link (#1597) 2025-08-05 12:29:50 +01:00
Evgeny fb477b24d7 smp server: support short link URI as queue identifier in control port commands (#1596) 2025-08-05 08:18:39 +01:00
Evgeny Poberezkin 9f263e8f3e docs: changelog 2025-08-02 09:21:44 +01:00
Evgeny Poberezkin db325cb81f 6.4.2.0 2025-07-31 09:21:11 +01:00
Evgeny b167d01f8a rfc: using the same profile from multiple devices (#1588) 2025-07-30 20:54:03 +01:00
Evgenyandsh f4e7469f96 xftp server: prometheus metrics (#1595)
* xftp server: prometheus metrics

* update

Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>

---------

Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>
2025-07-30 16:18:49 +01:00
Evgeny 4647d69d4b smp server: do not include previously blocked queues in stats, prevent leak of client threads (#1593) 2025-07-30 11:12:57 +01:00
sh 9ab071d62c ci: fix reproduce-schedule (#1594) 2025-07-30 09:17:28 +01:00
Evgeny Poberezkin f4c09ac51f Merge branch 'stable' 2025-07-29 09:09:36 +01:00
Evgeny Poberezkin 846be50f72 6.4.1.0 2025-07-21 15:22:47 +01:00
Evgeny c0f357d817 servers: control port session improvements (#1591)
* servers: prohibit changing role during control port session

* quota for blocked queues

* allow disabling blocking and quota

* fix test

* fix INI file
2025-07-21 15:19:43 +01:00
Evgeny 40fc09a93d smp server: additional stat counter for ntf credentials created together with the queue (#1589)
* smp server: additional stat counter for ntf credentials created together with the queue

* fix prometheus

* fix test

* fix qSub
2025-07-18 09:26:25 +01:00
Evgeny 2a90a2c552 smp protocol: create notification credentials via NEW command that creates the queue (#1586)
* smp protocol: create notification credentials via NEW command that creates the queue

* create ntf subscription for queues created with ntf credetials

* do not create ntf credentials when switching connection to another queue
2025-07-16 16:46:45 +01:00
sh fc581bf729 github/workflows: fix reproduce schedule (#1587) 2025-07-16 11:42:14 +01:00
Evgeny Poberezkin b6ea025333 docs: update build badge 2025-07-15 10:03:27 +01:00
Evgeny Poberezkin d3e2d9ac5b docs: changelog v6.4 2025-07-13 15:20:26 +01:00
Evgeny Poberezkin 85a7fbf538 6.4.0.12 2025-07-12 14:19:32 +01:00
Evgeny 62733ef4c1 smp server: refactor subscriptions and delivery in order to always response SOK on subscription with an optional message to follow. (#1573)
* smp server: refactor subscriptions and delivery

* metric for time between MSG and ACK

* cleanup

* refactor pattern match for ghc 8.10.7

* time buckets

* split max time metric

* histogram

* fix
2025-07-12 14:18:38 +01:00
Evgeny 99e59b73a3 agent: fix message delivery in case one of the connections has no snd queue for any reason - it could break delivery to all connections (#1585)
* agent: fix message delivery in case one of the connections has no snd queue for any reason - it could break delivery to all connections

* simplify

* comment

* refactor, also postpone failing on ratchet sync send prohibited errors

* postpone failing on connection errors to allow subsequent connections succeed
2025-07-10 10:21:12 +01:00
Evgeny 384a3352cf ntf server: more efficient status update query (#1584) 2025-07-08 23:01:57 +01:00
Evgeny Poberezkin 7a04fdff2e 6.4.0.11.3 2025-07-07 18:50:31 +01:00
Evgeny ba3c75e58c smp server: correctly track if ntf service is subscribed and total subscribed queues count (fixes race condition between NSUB and NSUBS from notification server) (#1583) 2025-07-07 18:49:47 +01:00
Evgeny Poberezkin 1062ccc5c3 6.4.0.11.2 2025-07-07 10:07:54 +01:00
Evgeny 36f05e272e agent: support different timeouts for interactive and background requests (#1582)
* agent: support different timeouts for interactive and background requests

* fix tests

* use one constructor for the first request and for retries
2025-07-07 09:38:52 +01:00
Evgeny Poberezkin 660c4293f0 6.4.0.11.1 2025-07-05 11:35:27 +01:00
spaced4ndyandEvgeny Poberezkin 1b8613d767 build: do not exclude postgres modules for client_library flag (#1579)
* don't exclude postgres modules for client_library flag

* fix build with client and server postgres flag

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-07-04 17:31:57 +01:00
Evgeny bfa52c4ba5 docs: update RFC for short links to match the implementation (#1581) 2025-07-03 18:09:02 +01:00
spaced4ndy c5eb66038b agent: allow to accept contact requests after address is deleted (#1580) 2025-07-03 09:29:39 +00:00
Evgeny Poberezkin a46edd60f0 6.4.0.11 2025-06-30 21:50:21 +01:00
Evgeny b4bcfd325b agent: better handling errors during connection handshake retries (#1578)
* agent: handle invitation connection handshake errors

* fix/test retries for connecting via address
2025-06-25 19:06:00 +01:00
Evgeny 976bd3a389 agent: short link encodings (#1577) 2025-06-24 10:06:44 +01:00
Evgeny Poberezkin bf27c846da 6.4.0.10.1 2025-06-20 13:49:17 +01:00
Evgeny 455360205c smp server: prometheus histogram for message confirmation times (ACK) (#1575)
* time buckets

* split max time metric

* histogram

* histogram for confirmed delivery times

* gaugehistogram

* fix created, _ in gauge_histogram

* remove comments

* fix metrics
2025-06-20 13:46:59 +01:00
Evgeny 79c67f2026 agent: JSON encoding for connection mode (#1576) 2025-06-19 11:21:29 +01:00
Evgeny c8928626fc ntf server: do not log subscription status updates on subscribing/unsubscribing (#1574) 2025-06-19 09:15:07 +01:00
Evgeny b47d28a22a smp server: prometheus metrics for delievered and not acknowledged messages (to monitor stuck deliveries) (#1572) 2025-06-17 21:10:09 +01:00
Evgeny c5b7d3c7af agent: use flexible (small/large) string encoding for contact link data, for backward/forward compatibility (#1569)
* agent: use large string encoding for contact link data

* size-dependent user link data encoding

* tag large user data encoding with \255
2025-06-16 11:11:59 +01:00
Evgeny Poberezkin d950012530 6.4.0.10 2025-06-14 21:06:54 +01:00
Evgeny Poberezkin 27b1f48929 Merge branch 'stable' 2025-06-14 21:05:59 +01:00
Evgeny Poberezkin 3d62a383d5 6.4.0.3.1 2025-06-14 14:19:31 +01:00
Evgeny 6ac7101f4f agent: make decoding for short link data forward compatible (#1568) 2025-06-14 14:13:14 +01:00
Evgeny 65cc19842c servers: restore constant time for absent queue/wrong key (regression in 6.4-beta.9) (#1567) 2025-06-14 07:10:51 +01:00
Evgeny 656f290660 agent: fix updating short invitation link data (#1566) 2025-06-13 21:27:46 +01:00
Evgeny Poberezkin 643c3c3b3e 6.4.0.9 2025-06-13 09:48:20 +01:00
Evgeny da37384335 smp server: batch commands (#1559)
* protocol: refactor types and encoding

* clean

* smp server: batch commands (#1560)

* smp server: batch commands verification into one DB transaction

* ghc 8.10.7

* flatten transmission tuples

* diff

* only use batch logic if there is more than one transmission

* func

* reset NTF service when adding notifier

* version

* Revert "smp server: use separate database pool for reading queues and creating service records (#1561)"

This reverts commit 3df2425162.

* version

* Revert "version"

This reverts commit d80a6b74c5.
2025-06-12 23:05:04 +01:00
Evgeny 1658048c2c Revert "smp server: use separate database pool for reading queues and creating service records (#1561)" (#1564)
This reverts commit 3df2425162.
2025-06-12 11:04:43 +01:00
Evgeny 27d38518e1 agent: use PQ keys in contact request data inside link container (but not in contact request link); use PQ keys in invitations sent to contact addresses (#1563)
* agent: use PQ keys in contact request data inside link container (but not in contact request link); use PQ keys in invitations sent to contact addresses

* do not use PQ keys in the link with old address versions
2025-06-11 18:22:37 +01:00
Evgeny cf8088ac6a smp server: do not require ALPN for HTTP to fix Android asset links, do not use port 443 in server-server SMP connections (#1562)
* log alpn

* always use HTTP when SNI is sent, regardless of ALPN

* decide credential based on SNI

* do not use web port in SMP/Ntf servers connecting to SMP servers

* simpler

* refactor

* fix
2025-06-10 22:09:07 +01:00
Evgeny Poberezkin 1e82104224 6.4.0.8 2025-06-09 14:20:25 +01:00
Evgeny 46ff37c362 ntf server: additional statistics (#1558)
* ntf server: additional statistics

* version

* fix stats

* add stats to track notifications without active token

* refactor

* fix stats parser

* version
2025-06-09 14:14:27 +01:00
Evgeny 3df2425162 smp server: use separate database pool for reading queues and creating service records (#1561) 2025-06-09 12:47:35 +01:00
Evgeny 5241f5fe5e rfc: client certificates for servers using SMP protocol as clients (opertors' chat relays, notification servers, service bots) (#1534)
* rfc: client certificates for high volume clients (opertors' chat relays, notification servers, service bots)

* client certificates types (WIP)

* parameterize Transport

* protocol/schema/api changes

* agent API

* rename command

* agent subscriptions return local ClientServiceId to chat

* verify transmissions

* fix receiving client certificates, refactor

* ntf server: remove shared queue for all notification subscriptions (#1543)

* ntf server: remove shared queue for all notification subscriptions

* wait for subscriber with timeout

* safer

* refactor

* log

* remove unused

* WIP service subscriptions and associations, refactor

* process service subscriptions

* rename

* simplify switching subscriptions

* SMP service handshake with additional server handshake response

* notification delivery and STM persistence for services

* smp server: database storage, store log, fix encoding for STORE error, replace String with Text in locks and error

* stats

* more stats

* rename SMP commands

* service subscriptions in ntf server agent (tests fail)

* fix

* refactor

* exports

* subscribe ntf server as service for associated queues

* test ntf service connection, fix SOKS response, fix service associations not removed in STM storage

* INI option to support services

* ntf server: downgrade subscriptions when service is no longer supported, track counts of subscribed queues

* smp protocol: include service certificate fingerprint in the string signed over with entity key (TODO two tests fail)

* fix test

* ntf server prometheus stats, use Int64 in SOKS/ENDS responses (to avoid conversions), additional error status for ntf subscription

* update RFC

* refactor useServiceAuth to avoid ad hoc decisions about which commands use service signatures, and to prohibit service signatures on other commands

* remove duplicate service signature syntax check from checkCredentials, it is checked in verifyTransmission

* service errors, todos

* fix checkCredentials in ntf server, service errors

* refactor service auth

* refactor

* service agent: store returned queue count instead of expected

* refactor serverThread

* refactor serviceSig

* rename

* refactor, rename, test repeat NSUB service association

* respond with error to SUBS

* smp server: export/import service records between database and store log

* comment

* comments

* ghc 8.10.7
2025-06-06 08:03:47 +01:00
Evgeny 8e86c97a13 servers: include supported ALPNs in server transport config (#1557) 2025-06-03 13:35:35 +01:00
Evgeny 90e8c3adf6 smp agent: use static RNG function to avoid dynamic C stub created by Haskell FFI wrapper (#1556) 2025-06-02 20:11:27 +01:00
Evgeny 56851365b1 servers: parameterize SMP agent to optimize subscriptions (#1555)
* servers: parameterize SMP agent to optimize subscriptions

* refactor ClientCommand to avoid additional map in the notification server agent

* rename
2025-06-01 16:14:52 +01:00
Evgeny a9814bb6d3 smp server: parameterize server by store type to avoid boxing/unboxing client handles (#1554)
* smp server: parameterize server by store type to avoid boxing/unboxing client handles

* ghc 8.10.7
2025-05-29 22:17:28 +01:00
Evgeny Poberezkin 3ad8bd15a6 6.4.0.7 2025-05-29 13:14:09 +01:00
spaced4ndy 4c33d8ac43 agent: To and FromField instances for AConnShortLink (#1553) 2025-05-29 10:59:36 +01:00
spaced4ndyandEvgeny Poberezkin a94ca62624 agent: allow changing invitation link data before it is secured (#1552)
* agent: setInvitationShortLink api

* Eq instance

* allow changing link data on server, refactor

* fix

* encodings

* remove link data after connection

* Revert "encodings"

This reverts commit f8e254cca9.

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-05-29 10:44:16 +01:00
Evgeny 53b72469b6 refactor types (#1551) 2025-05-27 22:31:02 +01:00
Evgeny Poberezkin f80ed32a06 6.4.0.6 2025-05-25 17:28:39 +01:00
Evgeny 07eaf9157b smp server: allow getting and deleting short links for the old contact queues (#1549)
* smp server: allow getting and deleting short links for the old contact queues

* fix verifaction of legacy contact queues

* test
2025-05-25 17:03:02 +01:00
Evgeny 56ea2fdd56 refactor types for DB entity (#1548) 2025-05-24 18:19:11 +01:00
Evgeny ffecd4a17a parameterize transport by peer type (client/server) (#1545)
* parameterize transport by peer type (client/server)

* LogDebug level when test is retried

* support "flipped" HTTP2, fix test retry to avoid retrying pending tests

* move sync to the end of the tests
2025-05-24 14:34:22 +01:00
Evgeny Poberezkin dae649fb87 6.4.0.5 2025-05-24 14:21:53 +01:00
Evgeny 57a77f75c1 smp server: support adding link data to contact addresses created before July 2024 (#1547) 2025-05-24 14:20:25 +01:00
spaced4ndy 18e73b8aa7 agent: pass CRClientData to setContactShortLink (#1546)
* agent: pass CRClientData to setContactShortLink

* fix

* fix
2025-05-23 18:21:36 +01:00
Evgeny af9ca59e51 smp server: optimize concurrency and memory usage, refactor (#1544)
* smp server: optimize concurrency and memory usage, refactor

* hide clients IntMap

* reduce STM contention

* comment

* version

* correct stats for subscriptions

* version

* comment

* remove subscribed clients from map

* version

* optimze, refactor

* version

* debug test

* enable all tests

* remove test logs

* retry failed tests with debug logging

* increase test timeout

* sync between tests
2025-05-23 12:52:18 +01:00
Evgeny Poberezkin d352d518c2 6.4.0.4 2025-05-21 08:56:01 +01:00
Evgeny f0dc600016 ntf server: remove shared queue for all notification subscriptions (#1543)
* ntf server: remove shared queue for all notification subscriptions

* wait for subscriber with timeout

* safer

* refactor

* log
2025-05-21 08:55:32 +01:00
Evgeny Poberezkin f44ea0a6d8 6.4.0.3 2025-05-15 21:01:49 +01:00
Evgeny f7d31d4c02 Merge pull request #1524 from simplex-chat/ntf-storage
ntf server: PostgreSQL database storage (feature branch)
2025-05-15 21:00:58 +01:00
Evgeny b90e25a3a5 ntf server: fix repeat token registration when it became invalid (regression) (#1539) 2025-05-15 19:56:48 +01:00
Evgeny Poberezkin cf4b9f669d agent: always enable periodic notifications 2025-05-15 15:16:44 +01:00
Evgeny Poberezkin e417d35cce Merge branch 'master' into ntf-storage 2025-05-14 22:20:55 +01:00
Evgeny Poberezkin deaec3cce2 6.4.0.2 2025-05-07 07:24:06 +01:00
Evgeny 7bbd99644a agent: fix query that updates last message timestamps for notification processing (#1536) 2025-05-06 23:19:58 +01:00
Evgeny cb59a449dd agent: return error and message absence differently when getting notification messages (#1535)
* agent: return error and message absence differently when getting notification messages

* fix test

* mapM

* inline nse functions, release lock on error or no message
2025-05-06 16:20:01 +01:00
Evgeny a632eea75b protocol: parsing for UTCTime to stop on "," and ";" (#1532) 2025-05-04 21:11:06 +01:00
Evgeny 3d10c9bf9e agent: handle cases when last message ts is not set for notifications; set last ts for "stale" notifications when messages expired and queue is empty, to prevent repeated processing (#1531)
* agent: handle cases when last message ts is not set for notifications; set last ts for "stale" notifications when messages expired and queue is empty, to prevent repeated processing

* only log errors if they exist

* only set last ts for queue that delivered notification
2025-05-02 11:21:39 +01:00
Evgeny 2f0cdc40af ntf server: fix returned last notifications (#1530) 2025-04-30 14:57:04 +01:00
Evgeny 0a3d014f5d ntf server: priority db pool for notifications and client commands, concurrent resubscriptions, CLI options (#1529)
* ntf server: option to skip specific tokens when importing store log

* logs

* batch later

* subscribe in parallel, bigger queues

* ntf server: test schema and migrations

* optimize subscriptions

* log level

* resubscribe before starting

* better subscribing

* pooled concurrent resubscriptions

* 5

* async resubscribe

* typo

* priority pool

* db batch size
2025-04-30 11:40:32 +01:00
Evgeny 7d0115daec ntf server, agent: send all periodic notifications from one thread, only to old active clients or new clients with periodic notification mode (#1528)
* ntf server, agent: send all periodic notifications from one thread, only to old active clients or new clients with periodic notification mode

* send different type via subscription queues

* option to compact store log on start
2025-04-28 12:18:55 +01:00
Evgeny f024ab1c3f ntf server: prometheus metrics (#1527)
* ntf server: save prometheus stats

* info metrics

* fix test
2025-04-27 13:25:44 +01:00
Evgeny f4bc1f0926 ntf server: skip duplicates when importing tokens and subscriptions (#1526)
* ntf server: skip duplicates when importing tokens and subscriptions

* skip imported last notifications when no token or subscription present

* fix skipped imported notifications count

* all tests

* fix test
2025-04-26 23:37:55 +01:00
Evgeny 42dbb887f7 ntf server: allow retries when creating subscriptions, prohibit subscriptions with the same queue but another notifier key or token (#1525)
* ntf server: allow retries when creating subscriptions, prohibit subscriptions with the same queue but another notifier key or token

* sync files in the test

* refactor
2025-04-25 19:41:18 +01:00
Evgeny 850d2fa423 ntf server: PostgreSQL database storage (#1519)
* ntf server: PostgreSQL database storage

* ntf server: import/export stubs

* ntf server postgres db functions

* some notifications tests pass

* notifications tests pass

* import/export notification store logs

* fix ntf server CLI

* log in parralel

* update subscription statuses using executeMany

* fix import/export

* refactor

* fix queries

* prohibit token_id and subscription_id updates, dont update tokens and subscriptions on conflict, improve server insertion, remove duplicate tokens for import, remove subscriptions without tokens for import

* comment

* remame

* increase test delay
2025-04-25 16:47:39 +01:00
Evgeny 08b84deba4 agent: option to use web port by default for preset servers only (#1523)
* agent: option to use web port by default for preset servers only

* shorten/restore short links in agent, add encodings for SMP web port setting

* decouple preset domains from preset servers for short links

* refactor, rename
2025-04-24 17:11:52 +01:00
Evgeny Poberezkin ec5a60430d 6.4.0.1 2025-04-22 22:01:16 +01:00
Evgeny e4d4b51c59 smp server: fix/test database import (#1521) 2025-04-22 21:59:27 +01:00
Evgeny Poberezkin 6b60f8bab6 Revert "ntf server: optimize in-memory storage (#1516)"
This reverts commit afb338a41a.
2025-04-21 21:01:24 +01:00
shum aa9b93eee5 ci: retry only in stable or release 2025-04-21 19:06:04 +01:00
Evgeny afb338a41a ntf server: optimize in-memory storage (#1516)
* ntf server: optimize in-memory storage

* test

* ntf server: fix store log parser for token status
2025-04-21 17:12:16 +01:00
Evgenyandshum 1e29f7c811 ci: adjust output, retry tests on failure, include hashes in release notes (#1520)
* scripts/reproduce-builds: rename with prefix and adjust output

* ci: rerun tests and include hashes in release

* ci: fix variables and really skip 8.10.7

* ci: fix prepare step

* ci: setup swap for 8.10.7

* ci: fix upload and formatting

* ci: properly format hashes

* ci: simplify

---------

Co-authored-by: shum <shum@liber.li>
2025-04-21 17:05:31 +01:00
Evgeny Poberezkin d11be15295 ntf server: fix store log parser for token status 2025-04-16 13:01:14 +01:00
Evgeny Poberezkin 305f79d2a6 6.4.0.0 2025-04-14 10:52:05 +01:00
Evgeny Poberezkin af988f774e Merge branch 'stable' 2025-04-14 10:51:34 +01:00
Evgeny Poberezkin 82e389298a docs: CHANGELOG 2025-04-14 10:51:23 +01:00
Evgeny c784d5ce0c Merge pull request #1495 from simplex-chat/short-links
smp protocol: short 1-time invitations and contact address links
2025-04-14 09:58:09 +01:00
Evgeny c2c4730953 smp server: serve .well-known folder via server pages (#1514) 2025-04-13 22:02:48 +01:00
Evgeny Poberezkin ccdd8e1775 agent: additional encodings for short links 2025-04-13 13:43:27 +01:00
Evgeny Poberezkin 307a784174 Merge branch 'master' into short-links 2025-04-13 10:51:32 +01:00
Evgeny Poberezkin 9abc0fa88d 6.3.2.0 2025-04-11 23:22:48 +01:00
Evgeny 76aad61f00 smp server: update server page for short links to correctly change URI for apps (#1511)
* smp server: update server page for short links to correctly change URI for apps

* change page titles
2025-04-11 23:18:23 +01:00
Evgeny 37ce109009 smp server: .well-known folder for server pages for SimpleX apps to handle preset server links (#1510)
* smp server: .well-known folder for server pages for SimpleX apps to handle preset server links

* add short link group path

* test
2025-04-11 18:30:43 +01:00
Evgeny a66163dc46 agent: additional short link types and encodings (#1509) 2025-04-11 12:29:44 +01:00
Evgeny Poberezkin bdf8bf093c smp server: make symlinks relative 2025-04-10 20:58:33 +01:00
Evgenyandsh b7a9542213 smp server: short links and owners for channels (#1506)
* smp server: short links and owners for channels

* types

* support mutliple rcv keys

* fix down migration, test/create server schema dump

* reduce schema dump

* parameterize type for link data by connection type

* return full connection link data

* test version

* change short link encoding

* test: print pg_dump output

* server pages, link encoding

* fix connection request when queue data and sender ID are created for old servers

* test, change pattern

* ci: install postgresql tools in runner (#1507)

* ci: install postgresql tools in runner

* ci: docker shell abort on error

* fix pattern for ghc 8.10.7

* patch ConnReqUriData SMP encoding to preserve queue mode after decoding

* test for RKEY

* fix/test store log with RKEY

---------

Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>
2025-04-10 19:09:47 +01:00
Evgeny Poberezkin 3a3f9fd51e Merge branch 'master' into short-links 2025-04-10 11:51:37 +01:00
Evgeny 6dc9d76ed3 smp agent: handle client/agent version downgrades after connection was established (#1508) 2025-04-10 11:50:19 +01:00
Evgeny a2a4b80af4 agent: padded encryption for link data, shorten/restore short links, tests (#1505)
* agent: padded encryption for link data, tests

* lambda

* test short links via proxy

* tests: server persistence with short links

* rfc: group links

* shorten, restore, test short links encoding

* rfc
2025-04-05 07:45:39 +01:00
Evgeny 7ec0ae3bb5 agent: types and encodings to use from the app (#1504)
* agent: types and encodings to use from the app

* use action forks
2025-04-03 16:31:22 +01:00
Evgeny 2c5530c9f0 agent: binary protocol encoding for connection request (#1503)
* agent: binary protocol encoding for connection request

* enable tests

* test
2025-04-01 22:32:49 +01:00
Evgeny 94ee3ceced agent: replace sndSecure with queueMode in queue URIs and records (#1502)
* agent: replace sndSecure with queueMode in queue URIs and records

* fix test
2025-03-31 16:54:29 +01:00
Evgeny Poberezkin dd67de4d71 Merge branch 'master' into short-links 2025-03-31 16:54:07 +01:00
Evgeny 285fd93c32 smp server: notices about server pages and port 443, enable store log by default (#1501)
* smp server: notices about server pages and port 443, enable store log by default

* enable store log by default for ntf and xftp servers, fix tests
2025-03-31 16:41:11 +01:00
Evgeny 56bec06856 smp protocol: remove creating notifications from NEW command, new ideas for notifications (#1500) 2025-03-30 19:56:16 +01:00
Evgeny 04cbed90fb agent: set/update and delete contact short link data (#1499)
* agent: set/update and delete contact short link data

* delete contact link data, tests

* comments

* type signature for GHC 8.10.7
2025-03-30 11:17:25 +01:00
Evgeny c1a6647f19 agent: join connection when 1-time invitation short link is already secured (#1496)
* agent: join connection when 1-time invitation short link is already secured

* do not pass short link to join

* delete short link record after connection
2025-03-29 09:42:56 +00:00
Evgeny Poberezkin 1dd677eec2 Merge branch 'master' into short-links 2025-03-28 19:50:18 +00:00
Evgeny 7636bc7491 smp server: remove locks for deleted queues, additional statistics for objects in memory (#1498)
* smp server: remove locks for deleted queues, additional statistics for objects in memory

* version

* reduce queue cache usage

* less caching, refactor

* comments

* revert version
2025-03-28 18:51:54 +00:00
sh 79adb83782 ci: add reproduce builds workflow (#1497)
* ci: add reproduce builds workflow

* ci: trigger webhook and build every day

* ci: change secrets
2025-03-27 16:06:32 +00:00
Evgeny b83d897650 smp protocol: short links and other changes from RFC (#1489)
* smp protocol: short links types and other changes from RFC

* add fields for queue link ID and data

* create queue and ntf credentials with NEW command

* all tests

* simplfiy types, update rfc

* update rfc

* include SenderId in NEW request in case queue data is sent

* store queue data and generate link ID if needed

* update rfc

* agent API and types

* SMP commands and persistence for short links

* SMP client functions for short links

* agent client functions for short links

* create rcv queue with short link (TODO secret_box)

* encryption and encoding for link data, postgres client migration

* test creating short link

* get link and data, tests

* comments

* type signature
2025-03-26 17:26:27 +00:00
Evgeny Poberezkin 0c3b25706a Merge branch 'stable' 2025-03-23 18:18:07 +00:00
sh c3f57beafd scripts: fix script for reproducible builds (#1492)
* scripts: fix script for reproducible builds

* scripts: add automatic hash comparasion + compute file with checksums

* scripts: silence cleanup

* ci/scripts: enable parallel build (#1493)
2025-03-23 18:17:27 +00:00
Evgeny Poberezkin aace3fd2fb 6.3.1.0 2025-03-22 13:51:55 +00:00
sh 2e67ed9c4c ci/scripts: refactor reproducible builds (#1490)
* ci: build cache, remove 20.04, minor refactor

* scripts: update build reproducibility script

* script: add postgresql reproducibility

* script: no cache when building image

* scripts: force symlinks

* scripts: also download prebuilt postgresql binary

* scripts: add missing app var
2025-03-22 13:27:11 +00:00
Evgeny 614fa2b163 smp server: reduce queue expiration/idle intervals, skip expiring very old queues (#1488)
* smp server: reduce idle queue interval and queue expiration interval

* only expire recent queues (not very old)

* fix

* version
2025-03-20 08:57:47 +00:00
Evgeny 903e96bdfa rfc: smp queue protocol changes (#1485)
* rfc: smp queue protocol changes

* questions

* update

* update

* correction
2025-03-19 10:47:57 +00:00
Evgeny 5c0adcbbff Merge pull request #1467 from simplex-chat/postgres
SMP server PostgreSQL storage - feature branch (merge, dont squash)
2025-03-18 16:48:25 +00:00
sh b2f16eeff4 ci: seperate builds (pg/standard) (#1486) 2025-03-18 09:42:53 +00:00
Evgeny 6db79808aa smp server: use COPY to import store log to postgres db, improve concurrency and error handling (#1487)
* smp server: use COPY to import store log to postgres db

* compact queues when importing to postgres

* mempty

* version

* handle errors while expiring, mask async exceptions while getting queue

* whitespace

* version
2025-03-18 09:40:22 +00:00
Evgeny f4b55bfc0c smp server: CLI option to compact store log with PostgreSQL database (#1484)
* smp server: CLI option to compact store log with PostgreSQL database

* version

* fix test
2025-03-16 18:47:02 +00:00
Evgeny fe64d42db1 smp server: split postgres support to a separate executable, to not require postgres library in the main binary (#1482)
* smp server: split postgres support to a separate executable, to not require postgres library in the main binary

* comments

* enable server_postgres flag by default, add CPP option to test

* refactor

* change default for server_postgres to False

* diff
2025-03-16 11:37:25 +00:00
Evgeny 1b5a9f3b0c smp server: do not cache all queues from database while processing expirations (#1483)
* smp server: expire only active queues

* version

* do not cache all queues while processing expirations

* refactor

* foldWithOptions_

* version

* use shared lock when expiring all queues

* use TMVar

* comment

* rename

* remove fold options

* do not create locks in the Map for temporarily loaded queues

* fix

* revert version
2025-03-15 20:11:30 +00:00
Evgeny fdf8bd7ee2 smp server: mask database store operations from async exception for state consistency (#1481)
* smp server: mask database store operations from async exception for state consistency

* remove unused, comments
2025-03-13 13:57:46 +00:00
Evgeny 019a32a623 smp server: optionally append store log with postgres storage (without loading and compacting, for debugging during migration) (#1480)
* smp server: optionally maintain store log with postgres storage (without loading and compacting, for debugging during migration)

* refactor

* remove comment
2025-03-13 10:25:56 +00:00
Evgeny d44f09d111 tests: pass AStoreType to agent test as a parameter (#1479)
* tests: run agent tests with PostgreSQL SMP servers

* agent tests with postgres database

* enable tests

* fix store log tests

* fix test
2025-03-12 21:47:44 +00:00
Evgeny 6b5de2c51b smp server: exception on invalid migration, check queue storage settings on server start (#1478)
* smp server: check queue storage settings on server start

* fix incorrect postgres migration not throwing exception
2025-03-10 17:28:26 +00:00
shum 9410fb6f16 docker: add libpq dep 2025-03-10 10:03:44 +00:00
Evgeny 7b42aaa132 smp server: expire messages in postgres database, mark queues as deleted, combine tables (#1471)
* smp server: expire messages in postgres database

* tty

* fail if nothing updated in db

* remove old deleted queues

* index

* fix tests
2025-03-10 09:31:50 +00:00
Evgeny Poberezkin e4b9aa9746 Merge branch 'master' into postgres 2025-03-09 21:58:39 +00:00
Evgeny Poberezkin aa26a55df4 Merge branch 'master' into stable 2025-03-09 21:53:03 +00:00
sh 6e505f5c0b scripts: add script to reproduce binaries locally (#1477) 2025-03-08 20:51:20 +00:00
Evgeny Poberezkin a491a1d878 6.3.0.8 2025-03-07 14:30:00 +00:00
shandEvgeny Poberezkin 36f5539b9a ci: introduce reproducible builds (#1476)
* ci: introduce reproducible builds

* ci: return 20.04

* smp server: increase timing test threshold

* ci: test outside docker

* ci: fix test step

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-03-07 14:15:18 +00:00
Evgeny 1a2afe8bfd agent: fix JSON encoding for protocol errors to be compatible with iOS (#1475) 2025-03-06 08:02:27 +00:00
Evgeny Poberezkin 9fece9ce3d 6.3.0.7 2025-03-02 22:45:07 +00:00
Evgeny Poberezkin 2e2ede5968 Merge branch 'master' into postgres 2025-03-02 22:35:28 +00:00
Evgeny 205d4ead1c smp server: remove store log backups when server starts (#1472) 2025-02-27 07:39:05 +00:00
Evgenyandspaced4ndy 80a070a8ea smp server: update STM cache only after PostgreSQL update (#1470)
* refactor journal store

* update postgres store methods to update STM cache only after DB update

* todos

* drop

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* fix GHC 8.10.7

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
2025-02-26 11:43:08 +00:00
Evgeny 172540984c agent, smp server: PostgreSQL connection pool (#1468)
* agent, smp server: PostgreSQL connection pool

* simplify, create all connections before start

* rename

* remove imports
2025-02-25 15:33:54 +00:00
Evgenyandspaced4ndy 4dc40bd795 smp server: PostgreSQL queue store (#1448)
* smp server: queue store typeclass

* parameterize JournalMsgStore

* typeclass for queue store

* postgres WIP

* compiles, passes tests

* remove StoreType

* split migrations

* progress

* addQueueRec

* reduce type spaghetti

* remove addQueue from typeclass definition

* getQueue

* test postgres storage in SMP server

* fix schema

* comment

* import queues to postgresql

* import queues to postgresql

* log

* fix test

* counts

* ci: test smp server with postgres backend (#1463)

* ci: test smp server with postgres backend

* postgres service

* attempt

* attempt

* empty

* empty

* PGHOST attempt

* PGHOST + softlink attempt

* only softlink attempt

* working attempt (PGHOST)

* remove env var

* empty

* do not start server without DB schema, do not import when schema exists

* export database

* enable all tests, disable two tests

* option for migration confirmation

* comments

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
2025-02-24 15:47:27 +00:00
Evgeny Poberezkin f9d7b1eebc 6.3.0.6 2025-02-23 19:42:16 +00:00
Evgeny ffbc733d58 smp server: remove duplicate progress log (#1466) 2025-02-23 19:40:49 +00:00
Evgeny 2286726d72 smp server: start options maintenance and skip-warnings (#1465)
* smp server: start options `maintenance` and `skip-warnings`

* ignore invalid parsing of the last lines

* parsingErr

* fix
2025-02-22 19:26:03 +00:00
spaced4ndy 1b8110a332 xftp server: restore file status from log (#1461)
* xftp server: restore file blocking info from log

* fix parse

* rework

* update

* rename
2025-02-21 22:43:56 +00:00
sh dad7e1b60c simplex-servers-update: download scripts from tag (#1457)
* simplex-servers-update: download scripts from tag

* set remote version when re-executing the update script

* safeguard variables

* additional checks
2025-02-20 09:26:03 +00:00
Evgeny 72c2ddcf57 agent: move migrations (#1459) 2025-02-18 23:39:29 +00:00
Evgeny a75e138965 smp server: remove empty queues journals when expiring messages of idle queues (#1458)
* smp server: remove empty queues journals when expiring messages of idle queues

* remove unnecessary update

* ci: update action

* rename
2025-02-18 20:04:58 +00:00
Evgeny fa319d798a smp server: remove empty journals when opening message queue (#1456)
* smp server: remove empty journals when opening message queue

* update, do not backup state

* test

* version

* do not close queue state when queue is opened for writing

* comment

* quota = 4

* refactor openMsgQueue to prevent extra state backups

* use interval in config

* version, expire backups after 5 min

* refactor

* test
2025-02-17 23:11:34 +00:00
Evgeny Poberezkin c192339af9 6.3.0.5 2025-02-15 15:36:44 +00:00
Evgeny fa67d128d1 agent: fix deleting messages after delivery to avoid deleting shared message bodies (#1455)
* agent: fix deleting messages after delivery to avoid deleting shared message bodies

* fix, comments

* rename

* comment
2025-02-15 12:40:10 +00:00
Evgeny 55ff581655 SMP client: dont block on writing to sending queues (#1454)
* SMP client: dont block on writing to sending queues

* only fork if full
2025-02-15 11:31:05 +00:00
sh 560b257af7 scripts: simplex-servers-update menu to update only server binaries etc. (#1445)
* scripts/simplex-servers-update: refactor

* simplex-servers-update: don't check empty variable

* simplex-servers-update: minor decoration change

* simplex-servers-update: add new line when reexecuting script

* simplex-servers-update: refactor menus

* simplex-servers-update: fix re-executing

* simplex-servers-update: fix menus

* simplex-servers-update: do not rerended menu every time

* simplex-servers-update: update menus logic

* simplex-servers-update: ask permission to update only if versions differ

* simplex-servers-update: skip empty variable

* simplex-servers-update: include while loop

* simplex-servers-update: update re-executing skip logic

* simplex-servers-update: ignore empty

* simplex-servers-update: s/while/if

* simplex-servers-update: ignore empty variable

* simplex-servers-update: update skipping scripts

* simplex-servers-update: minor fixes

* simplex-servers-update: add spaces

* simplex-servers-update: safeguard files and add cleanup logic

* simplex-servers-update: update menus

* simplex-servers-update: fix binary check

* simplex-servers-update: adjust erasing lines

* simplex-servers-update: simplify bin update logic

* simplex-servers-update: fix binary path

* simplex-servers-update: format errors

* scripts/main/simplex-servers-update: initial refactor2

* simplex-servers-update: incr update

* simplex-servers-update: initial dynamic menu

* simplex-servers-update: misc fixes

* simplex-servers-update: fix VER

* simplex-servers-update: add VER check

* simplex-servers-update: abort early if there's no options available

* simplex-servers-update: add new helper function and update_misc

* simplex-servers-update: pass selection

* simplex-servers-update: non-interactive usage

* simplex-servers-update: add help menu

* simplex-servers-update: misc fixes and new binary update logic

* simplex-servers-update: local path check

* simplex-servers-update: fix change check

* simplex-servers-update: OLF -> OLD

* simplex-servers-update: always return code from functions

* simplex-servers-update: new menu flow

* simplex-servers-update: fixes

* simplex-servers-update: download function + fixes

* simplex-servers-update: s/bins/binaries

* simplex-servers-update: download message

* simplex-servers-update: cleanup
2025-02-15 10:31:19 +00:00
spaced4ndyandEvgeny Poberezkin 7ac80bffcb agent: store shared message body only once (when it is the same across messages when batching) (#1453)
* agent: store shared message body only once (when it is the same across messages when batching)

* rename

* refactor

* refactor

* save bodies and messages in single transaction

* comment

* comment

* comment

* box

* mapME

* box

* ValueOrRef

* remove instances

* refactor

* comments

* test

* refactor

* mapAccumLM compatibility with ghc 8.10.7

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-02-14 18:01:40 +00:00
spaced4ndyandEvgeny Poberezkin 0d8a1a2879 agent: encrypt messages on delivery (#1446)
* agent: save message body once (plan, schema)

* split

* new type

* bs

* encrypt on delivery

* schema

* fix test

* check pad size

* rename

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-02-14 12:35:18 +00:00
Evgeny Poberezkin bd97cb0449 6.3.0.4 2025-02-10 15:12:54 +00:00
Evgeny a58d3540ad agent: refactor migrations (#1452)
* agent: refactor migrations

* fix postgres
2025-02-07 17:17:53 +00:00
Evgenyandspaced4ndy 5dbe6337ea ntf server: additional statistics, new invalid token reasons (#1451)
* agent: check ntf token status on registration

* remove check

* update on check

* refactor

* version

* fix

* ntf server: additional statistics

* swap

* version

* more stats

* test, verify invalid

* rename

* exclude test token from stats

* increase delay

* handle invalid token in retry, more reasons

* focus tests

* disable new tests in CI

* fix

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
2025-02-07 12:19:11 +00:00
spaced4ndyandEvgeny Poberezkin b633f89c1a agent: check ntf token status on registration (#1450)
* agent: check ntf token status on registration

* remove check

* update on check

* refactor

* version

* fix

* test, verify invalid

* rename

* increase delay

* disable new tests in CI

* fix

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2025-02-07 11:36:29 +00:00
Evgeny 944a22a2fb ntf server: record token invalidation reason, add date of the last token activity (#1449)
* ntf server: record token invalidation reason, add date of the last token activity

* update time

* rename

* optional

* include token ID in delivery error

* version

* protocol version

* fix, log error
2025-02-06 17:11:35 +00:00
Evgeny ce24f83b64 refactor STM queues (#1447) 2025-02-05 12:04:27 +00:00
Evgeny Poberezkin 45373e7f1f 6.3.0.3 2025-01-31 13:01:03 +00:00
sh efe71cd598 docker: refactor (#1438)
* docker: refactor

* github/docker: bump actions and adjust smp ports
2025-01-30 09:22:13 +00:00
Evgeny ae41717b9b smp server: use origin client version when processing proxied command, fixes old client sending to new server (#1443)
* smp server: pass origin client version when processing proxied command, fixes old client sending to new server

* version

* version
2025-01-28 22:04:46 +00:00
Evgeny e78ab60c97 build: fix postgres (#1444) 2025-01-28 22:02:41 +00:00
Evgeny b3c8358a43 agent: combine connection deletion events (#1442) 2025-01-25 08:52:40 +00:00
sh be81fe1f74 scripts/systemd: update services (#1440) 2025-01-24 13:37:56 +00:00
sh 817f5e1737 scripts/systemd: update services (#1440) 2025-01-24 13:35:33 +00:00
Evgeny eda9e36c82 agent: track queries (#1439) 2025-01-24 10:31:50 +00:00
Evgeny Poberezkin 2318975375 6.3.0.2 2025-01-20 16:38:14 +00:00
Evgeny 298666380f servers: handle accept error ECONNABORTED (#1437) 2025-01-20 16:32:42 +00:00
Evgeny 6a9075141f xftp server: use recipient ID in control port to delete and block files, smp server: fix version negotiation (#1434)
* xftp server: use recipient ID in control port to delete and block files

* cap smp proxy agent version at 10

* version

* fix prometheus

* fix

* remove old version support

* log connection parameter on error

* tests

* log sent command tag

* log error and client version

* cap proxy version for previous destination server

* comment, test

* remove logging tag

* remove logs

* version

* SMP version 14

* version

* remove comments

* version
2025-01-20 13:45:49 +00:00
spaced4ndy 488c7082f3 agent: store interface (#1436) 2025-01-20 17:02:39 +04:00
spaced4ndy fdde9863cd agent: add reopenStore function for postgres; run notification tests with postgres (#1435) 2025-01-17 16:27:37 +04:00
Evgeny Poberezkin 9404a3ab63 xftp server: block stats 2025-01-14 10:46:27 +00:00
Evgeny Poberezkin dadf6ec5b6 6.3.0.1 2025-01-13 08:39:41 +00:00
Evgeny c528ea4f31 smp server: update versions (#1433) 2025-01-12 22:11:18 +00:00
Evgeny 3d4e0b06c0 servers: blocking records for content moderation (#1430)
* servers: blocking records for content moderation

* update

* encode BLOCKED as AUTH in old versions

* update

* unblock queue command

* test, status command
2025-01-12 19:34:00 +00:00
spaced4ndy 9d9ec8cd0b agent: remove unused functions (#1432)
* agent: remove unused functions

* cleanup imports
2025-01-10 07:59:17 +00:00
Evgeny 992b42e922 agent: option to enable/disable vacuum after SQLite migration (#1429) 2024-12-28 21:06:42 +00:00
Evgeny 3cf9dacbc0 Merge pull request #1428 from simplex-chat/ep/postgres-compat
agent: restore methods for backwards compatibility with simplex-chat
2024-12-28 11:39:18 +00:00
Evgeny Poberezkin cfde5932fd agent: restore methods for backwards compatibility with simplex-chat 2024-12-28 10:33:22 +00:00
Evgeny 69fb9a9e0e Merge pull request #1417 from simplex-chat/postgres
agent: support postgres backend
2024-12-27 19:52:18 +00:00
Evgeny Poberezkin 0a118f5631 Merge branch 'master' into postgres 2024-12-27 11:58:19 +00:00
spaced4ndy 0b986c1158 postgres: export fromOnlyBI 2024-12-26 20:13:27 +04:00
Evgeny Poberezkin 184a95cd2a 6.3.0.0 2024-12-26 13:54:38 +00:00
spaced4ndy b7a8df40c4 Merge branch 'master' into postgres 2024-12-25 12:15:41 +04:00
spaced4ndyandEvgeny Poberezkin bf28902327 agent: reuse ratchet on repeat join (#1426)
* agent: reuse ratchet on repeat join

* check status

* update

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2024-12-25 00:07:45 +00:00
Evgeny Poberezkin 426bf68763 6.2.2.0 2024-12-24 21:04:58 +00:00
spaced4ndy e557dc86e7 Merge branch 'master' into postgres 2024-12-20 17:18:54 +04:00
Evgeny Poberezkin f5cef2556b build: move type to client_library module 2024-12-20 13:12:11 +00:00
spaced4ndyandEvgeny Poberezkin cf66aadc20 postgres: store implementation, conditional compilation (#1421)
* postgres: implementation wip

* to from field

* agent store compiles

* methods

* create store

* tests wip

* migration tests pass

* tests compile

* fix tests

* tests wip

* bool int

* tests wip

* tests wip

* more boolint

* more fixes

* more fields pass

* more fixes

* binary

* instances, binary

* test passes

* remove todos, more tests pass

* fix conflict

* fix bool

* fix sequence breaking

* fix insertedRowId

* skip ratchet re-synchronization tests

* after test

* file tests

* after test

* rename

* remove comment

* format

* remove unused

* suppress notices

* fixes

* move

* fix

* instance

* instance2

* fix

* instances

* comment

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2024-12-20 15:54:58 +04:00
sh 77a5ed2ec6 6.2.1.0 (#1424) 2024-12-19 20:45:17 +00:00
Evgenyandsh 4d640c16aa smp server: log prometheus metrics (#1411)
* smp server: log prometheus metrics

* save metrics

* diff

* lines

* version

* do not include Prometheus into client

* corrections

Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>

* corrections

Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>

* corrections

Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>

* add timestamp to metrics

* remove type

* remove version

---------

Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>
2024-12-18 11:19:13 +00:00
Evgeny 0a827307d6 build: remove some modules from the client build (#1418)
* build: remove some modules from the client build

* remove websockets from client_library
2024-12-14 15:22:06 +00:00
spaced4ndy 64149599de postgres: db interfaces wip (sqlite passes) (#1419) 2024-12-12 17:42:58 +04:00
spaced4ndy 07be469f49 postgres: schema (#1416) 2024-12-10 18:53:01 +04:00
Evgeny Poberezkin 79e9447b73 6.2.0.7 2024-12-07 14:36:50 +00:00
spaced4ndy 9893935e7c agent: fix acceptContact inconsistent state after app restart (#1412) 2024-12-05 19:27:21 +04:00
Evgeny Poberezkin 966b9990e0 6.2.0.6 2024-12-04 19:57:11 +00:00
spaced4ndy bef1e38295 xftp: add debug info to "too many recipients" error (#1410) 2024-12-04 19:56:33 +00:00
Evgeny Poberezkin 4b43cb8054 6.2.0.5 2024-12-03 12:33:32 +00:00
Evgeny 38ad3c046e agent: function to check if contact address is the same (#1409) 2024-12-02 11:41:06 +00:00
Evgeny b2afe6f40c rfc: moving queue records to journal storage and queue blobs, expiring messages in journal storage (#1407)
* rfc: moving queue records to journal storage and queue blobs

* rfc: expiring messages in journal storage

* add comment
2024-11-28 12:22:52 +00:00
Evgeny Poberezkin 601620bdde 6.2.0.4 2024-11-22 19:50:04 +00:00
Evgeny 97104988a3 server: support server roles and operators (#1343)
* server: support server roles and operators

* make server operator optional

* allRoles

* fix test

* different server host in tests

* remove ServerCfg fields used only in UI

* comments

* choose different server for invitation when connecting via address

* fix test in ghc8107

* simplify
2024-11-22 16:43:37 +00:00
Evgeny 45333bd340 smp server: do not open/read journal message queues that are known to be empty (#1406)
* smp server: do not open/read journal message queues that are known to be empty

* cleanup

* version

* close empty queues on first subscription

* revert version
2024-11-22 12:29:31 +00:00
Evgeny bbcb1abfda agent: treat blocked STM and other critical errors that offer restart as temporary (#1405) 2024-11-21 22:01:19 +00:00
Evgeny Poberezkin a64c1aa2c4 6.2.0.3 2024-11-17 09:45:17 +00:00
Evgeny 21fbbf9106 smp server: update message counts during message expiration, increase idle interval (#1404)
* smp server: update message counts during message expiration, increase idle interval

* version

* fix

* flip results

* version
2024-11-17 09:44:40 +00:00
Evgeny 17a0be10fa smp server: expire messages in idle message queues (including not opened) (#1403)
* smp server: expire messages in idle message queues (including not opened)

* use message expiration interval

* simpler

* version

* remove version
2024-11-15 10:26:24 +00:00
Evgeny Poberezkin 3017d14392 6.2.0.2 2024-11-07 08:13:45 +00:00
Evgeny d3275cef48 smp server: combine messages and queue storage to optimise performance, prevent race condition when deleting queue and to avoid "orphan" messages. (#1395)
* smp server: combine queue and message store into one class (WIP)

* keep deleted queue tombstones to prevent race conditions and errors when restoring

* move store log from server to store implementations

* STMQueueStore type class

* fix store closed when messages expired, handle store writing errors

* types

* version

* fix recovery from missing write journal, tests

* version
2024-11-07 08:09:11 +00:00
Evgeny Poberezkin 0fd4aa1e23 6.2.0.1 2024-11-03 21:10:45 +00:00
Evgeny 7c21945569 smp server: option to skip expiring messages on start, read queue state file end only (#1400) 2024-11-03 21:08:07 +00:00
ffecf200d4 build: client_library flag to build only used modules, remove package yaml (#1394)
* move dependencies to library

* remove package.yaml

* remove auto-generated comment

* cleanup target definitions

* add executable options

* add test rtsopts

* revert common options

* don't hide unused packages warning

* Add client_only cabal flag (#1396)

---------

Co-authored-by: IC Rainbow <aenor.realm@gmail.com>
Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
2024-11-02 15:34:33 +00:00
Evgeny 58d3c160ef smp server: fix logging progress when importing journal (#1393) 2024-10-28 14:22:18 +00:00
Evgeny Poberezkin 326cf08efa 6.2.0.0 2024-10-28 10:28:54 +00:00
Evgeny Poberezkin d49dc201c3 smp server: log file name on hClose error 2024-10-28 10:26:24 +00:00
Evgeny 6ff4c3f1ce Merge pull request #1375 from simplex-chat/journal-store
smp server: journal message store
2024-10-26 17:03:19 +01:00
Evgeny 5940514f40 smp server: remove queue from map when closing, test (#1392)
* smp server: remove queue from map when closing, test

* remove print

* refactor
2024-10-26 16:14:55 +01:00
Evgeny Poberezkin 916150742e Merge branch 'master' into journal-store 2024-10-26 12:58:32 +01:00
Evgeny Poberezkin 1735b619e8 6.1.3.0 2024-10-26 12:57:43 +01:00
Evgeny 6b61d101dc smp server: fix restoring notifications (#1391) 2024-10-26 12:56:29 +01:00
Evgeny 56ca7bf30e smp server: do not log progress when server starts (#1390)
* smp server: do not log progress when server starts

* test
2024-10-26 10:33:18 +01:00
Evgeny Poberezkin 2a218675b2 Merge branch 'master' into journal-store 2024-10-26 08:12:07 +01:00
Evgeny 8b9eb49b57 smp server: log operation of restore error (#1389)
* smp server: log operation of restore error

* space

* rename

* revert version
2024-10-26 08:11:07 +01:00
Evgeny 3860341584 rfc: iOS notifications 2 (#1334) 2024-10-25 21:42:13 +04:00
Evgeny Poberezkin 9078118a6d Merge branch 'master' into journal-store 2024-10-25 15:43:04 +01:00
Evgeny Poberezkin a7f5297ad1 6.1.2.0 2024-10-25 15:41:30 +01:00
Evgeny 870a60fc5d smp server: reduce memory usage when starting, all servers: prevent losing state on termination while compacting state (#1385)
* smp server: reduce memory usage when starting

* servers: prevent losing state when compacting is incomplete (terminated abnormally)

* fix test

* fix/refactor

* message

* remove .bak

* simpler
2024-10-25 15:39:59 +01:00
spaced4ndyandEvgeny Poberezkin a8471eed5b ntf: get messages for multiple last notifications (#1378)
* ntf: get messages for multiple last notifications (#1352)

* ntf: separate get ntf conns api (#1379)

* ntf: separate get ntf conns api

* nonempty

* update

* update

* remove single get api

* fix test

* refactor

* refactor

* ntf: batch get connections (#1387)

* ntf: batch get apis

* works

* fix

* fix

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2024-10-25 15:39:41 +04:00
Evgeny a3351ad060 smp server: fix export of journal storage (#1384)
* smp: fix export of journal storage

* catch errors when exporting messages
2024-10-25 09:11:47 +01:00
Evgeny 2322f5bf59 smp server: logging format, mask/handle exceptions during journal store operations (#1381)
* smp server: fixed logging format for journal store errors

* version

* colon

* logs

* refactor

* space

* remove comment

* log file name in fixFileSize

* logError

* stricter

* process all queues more efficiently

* use monoid for queue processing

* expire messages concurrently

* concurrently 2

* Revert "concurrently 2"

This reverts commit c1aee1f22c.

* Revert "expire messages concurrently"

This reverts commit fc53137cdb.

* show queue directory or ID in errors

* foldM

* mask_

* try

* mask more

* refactor

* command to delete journal

* uninterruptibleMask_ when writing to state file

* fix ghc8.10.7

* version

* revert version
2024-10-24 19:44:47 +01:00
Evgeny c9c075fd49 smp server: merge quota messages and set queue to "over quota" state after restoring, server tests with journal and memory store (#1380)
* smp: run server tests with journal and memory store

* merge quota messages, set queue to "over quota" state after restoring

* fix test
2024-10-23 09:17:23 +01:00
Evgeny 1484523164 smp server, journal store: check file size on append, validate queue state (#1377)
* smp server: journal store queue state validation

* validate state on update, refactor

* handle message parsing errors

* typo

* fix test, throw exception when file is smaller than expected

* fix

* fix test in ghc 8.10.7
2024-10-22 12:09:51 +01:00
Evgeny dc17402896 smp server: updated journal store API (#1374)
* core: updated journal store API

* parameterize JournalState by read/write type

* collect stats when importing/expiring

* compare stored stats and store for messages and notifications

* simplify
2024-10-21 16:50:07 +01:00
Evgeny 0414ea59f0 smp server: journal message store (#1370)
* smp server: remove STM function from MsgStore

* polymorphic MsgStore

* jourmal storage for messages (WIP)

* more journal, test setup

* writeMsg

* test

* tryDelMsg

* delMsgQueue

* remove MsgStoreClass instance of existential wrapper for Msg stores

* store config

* extract common logic out of store instances

* add store type to config

* open journals, cache last message, tests pass

* CLI commands

* refactor import/export messages

* cli commands to import/export journal message store

* export journal without draining, import/export tests

* journal command

* import/export progress

* better progress info

* only log queue state once when importing

* logs

* handle IO errors in journal store, return as STORE error

* recover from state file errors

* fix message files after crash

* fix messages folder
2024-10-21 11:50:30 +01:00
Evgeny Poberezkin 967afaf802 6.1.1.0 2024-10-18 12:47:27 +01:00
Evgeny 77ee9bea38 smp protocol: add STORE error (#1372) 2024-10-18 10:13:01 +01:00
Evgeny e0cd28a65a smp server: stop server faster (#1371)
* smp server: stop server faster

* .702

* asks

* fix leak

* kill client when server stopped

* remove version

* fix version
2024-10-18 09:12:59 +01:00
Evgeny Poberezkin 7b6c86c6c1 docs: correction 2024-10-14 08:32:19 +01:00
Evgeny Poberezkin 1d0a418011 rfc: rename file 2024-10-12 17:12:45 +01:00
Evgeny Poberezkin 9253f5647a Merge branch 'stable' 2024-10-12 16:30:54 +01:00
Evgeny Poberezkin c41bfe831d 6.1.0.7: changelog for v6.1.0 2024-10-11 13:01:12 +01:00
Alexander BondarenkoandEvgeny Poberezkin c9af7e327e smp server: graceful shutdown on SIGINT (#1360)
* smp-server: graceful shutdown on SIGINT

* .501

* clean up

* remove version

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2024-10-11 12:49:15 +01:00
Evgeny 8870442830 smp server: reject SKEY with different key earlier (at verification step), add tests (#1366) 2024-10-11 12:13:52 +01:00
spaced4ndyandEvgeny Poberezkin 9ad26c97a1 agent: prepareConnectionToAccept api (#1365)
* agent: prepare conn (plan)

* implement

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2024-10-11 11:05:14 +01:00
spaced4ndy e1201f0967 agent: test db indexes (#1364) 2024-10-09 15:16:08 +04:00
Evgeny Poberezkin ca2202e3c8 6.1.0.6 2024-10-07 22:41:53 +01:00
Evgeny f24ee70138 clients: do not send SNI (#1363) 2024-10-07 22:40:30 +01:00
Evgeny Poberezkin 8981cae3c2 ci: always generate change log 2024-10-07 22:22:02 +01:00
Evgeny Poberezkin b8971a31bc 6.1.0.5 2024-10-07 10:24:19 +01:00
Evgeny e01398a31a agent: send MSGNTF on NO_MSG error (#1362)
* agent: send MSGNTF on NO_MSG error

* simplify
2024-10-07 10:22:58 +01:00
Evgeny f871f20172 smp server: fix notification delivery (#1350)
* .401

* stats for undelivered notifications

* logs, stats

* control port show ntf client IDs

* check that Ntf client is still current and that queue is not full, drop notifications otherwise

* prevent losing notifications when client is not current or queue full

* add log when no notifications, remove some logs

* reduce STM transaction

* revert version change
2024-10-07 09:01:28 +01:00
Evgeny 80d3518d55 tests: store log (#1348)
* 6.1.0.4

* tests: store log

* random

* more tests
2024-10-06 21:21:08 +01:00
spaced4ndyandEvgeny Poberezkin 49935473ae ntf: agent to notfiy MSGNTF on successful ack (#1355)
* ntf: agent to notfiy MSGNTF on successful ack

* move msgntf

* release lock earlier

* fix tests

* do not release get lock

* fix

* diff

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2024-10-06 19:48:22 +01:00
Evgeny 0705d05078 smp: transport block encryption (#1317) 2024-10-06 18:05:06 +01:00
Evgeny 97d45fb2a6 smp server: pass server information via CLI during server initialization (#1356)
* smp server: pass server information via CLI during server initialization

* more info

* enable client expiration by default, disable port 8000

* update
2024-10-06 12:34:44 +01:00
Evgeny 50e4abf836 ntf server: control port (#1354)
* ntf server: control port

* version .405

* control

* use own_server_domains from INI file

* fix subs by server in control port

* bigger queues

* ntf server: only print subscriptions per own server when they are > 0

* fix tests

* revert version change

* dont import listThreads in ghc 8.10.7
2024-10-06 12:33:14 +01:00
spaced4ndy b130ea439a server: fix msgGetNoMsg stat (#1358) 2024-10-04 17:19:05 +04:00
sh 0e921d3258 scripts: preparations for new deployments (#1357)
* scripts/install: allow specifying version

* scripts/update: allow specifying version

* scripts/services: allow 443 for smp, allow infinite startup
2024-10-04 09:57:07 +01:00
Evgeny d0f65329fb ntf server: enable pings on ntf subscriptions (#1353) 2024-10-03 12:12:55 +01:00
Evgeny Poberezkin 61b2b9df1a Re-commit: smp server: persist notifications to avoid losing them when ntf server is offline (#1336)
This reverts commit 0ba3e69872.
2024-10-02 12:23:46 +01:00
Evgeny Poberezkin 04e4a37d85 6.1.0.4 2024-10-02 09:51:29 +01:00
Evgeny Poberezkin 0ba3e69872 Revert "smp server: persist notifications to avoid losing them when ntf server is offline (#1336)"
This reverts commit 0739f7b702.
2024-10-02 09:49:43 +01:00
Evgeny Poberezkin 7488923fc3 6.0.6.0 2024-10-02 09:24:29 +01:00
Evgeny cf559ee43f smp server: fix notifiers lost when compacting store log (#1347) 2024-10-02 09:24:04 +01:00
Evgeny 2ab0c2a7c6 smp server: fix notifiers lost when compacting store log (#1347) 2024-10-01 22:28:01 +01:00
spaced4ndy 243548631a ntf: repeat failed token deletions (#1346) 2024-10-01 16:30:14 +04:00
Evgeny Poberezkin da79d544cf 6.1.0.3 2024-09-30 18:27:14 +01:00
spaced4ndy e808825c95 ntf: fix endless worker loop (#1345) 2024-09-30 15:29:14 +01:00
227 changed files with 32637 additions and 10957 deletions
+44
View File
@@ -0,0 +1,44 @@
name: 'Set Swap Space'
description: 'Add moar swap'
branding:
icon: 'crop'
color: 'orange'
inputs:
swap-size-gb:
description: 'Swap space to create, in Gigabytes.'
required: false
default: '10'
runs:
using: "composite"
steps:
- name: Swap space report before modification
shell: bash
run: |
echo "Memory and swap:"
free -h
echo
swapon --show
echo
- name: Set Swap
shell: bash
run: |
export SWAP_FILE=$(swapon --show=NAME | tail -n 1)
echo "Swap file: $SWAP_FILE"
if [ -z "$SWAP_FILE" ]; then
SWAP_FILE=/opt/swapfile
else
sudo swapoff $SWAP_FILE
sudo rm $SWAP_FILE
fi
sudo fallocate -l ${{ inputs.swap-size-gb }}G $SWAP_FILE
sudo chmod 600 $SWAP_FILE
sudo mkswap $SWAP_FILE
sudo swapon $SWAP_FILE
- name: Swap space report after modification
shell: bash
run: |
echo "Memory and swap:"
free -h
echo
swapon --show
echo
+250 -56
View File
@@ -10,62 +10,25 @@ on:
pull_request:
jobs:
build:
name: build-${{ matrix.os }}-${{ matrix.ghc }}
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
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"
# =============================
# Create release
# =============================
# Create release, but only if it's triggered by tag push.
# On pull requests/commits push, this job will always complete.
maybe-release:
runs-on: ubuntu-latest
steps:
- name: Clone project
if: startsWith(github.ref, 'refs/tags/v')
uses: actions/checkout@v3
- name: Setup Haskell
uses: haskell-actions/setup@v2
with:
ghc-version: ${{ matrix.ghc }}
cabal-version: "3.10.1.0"
- name: Cache dependencies
uses: actions/cache@v2
with:
path: |
~/.cabal/store
dist-newstyle
key: ${{ matrix.os }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
- name: Build
shell: bash
run: cabal build --enable-tests
- name: Test
timeout-minutes: 40
shell: bash
run: cabal test --test-show-details=direct
- name: Prepare binaries
if: startsWith(github.ref, 'refs/tags/v')
shell: bash
run: |
mv $(cabal list-bin smp-server) smp-server-ubuntu-${{ matrix.platform_name}}
mv $(cabal list-bin ntf-server) ntf-server-ubuntu-${{ matrix.platform_name}}
mv $(cabal list-bin xftp-server) xftp-server-ubuntu-${{ matrix.platform_name}}
mv $(cabal list-bin xftp) xftp-ubuntu-${{ matrix.platform_name}}
- name: Build changelog
if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'ubuntu-22.04'
id: build_changelog
uses: mikepenz/release-changelog-builder-action@v1
if: startsWith(github.ref, 'refs/tags/v')
uses: simplex-chat/release-changelog-builder-action@v5
with:
configuration: .github/changelog_conf.json
failOnError: true
@@ -75,8 +38,8 @@ jobs:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
- name: Create release
if: startsWith(github.ref, 'refs/tags/v') && matrix.ghc != '8.10.7'
uses: softprops/action-gh-release@v1
if: startsWith(github.ref, 'refs/tags/v')
uses: simplex-chat/action-gh-release@v2
with:
body: |
See full changelog [here](https://github.com/simplex-chat/simplexmq/blob/master/CHANGELOG.md).
@@ -86,10 +49,241 @@ jobs:
prerelease: true
files: |
LICENSE
smp-server-ubuntu-${{ matrix.platform_name}}
ntf-server-ubuntu-${{ matrix.platform_name}}
xftp-server-ubuntu-${{ matrix.platform_name}}
xftp-ubuntu-${{ matrix.platform_name}}
fail_on_unmatched_files: true
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
# =============================
# Main build job
# =============================
build:
name: "ubuntu-${{ matrix.os }}-${{ matrix.arch }}, GHC: ${{ matrix.ghc }}"
needs: maybe-release
env:
apps: "smp-server xftp-server ntf-server xftp"
runs-on: ${{ matrix.runner }}
services:
postgres:
image: postgres:15
env:
POSTGRES_HOST_AUTH_METHOD: trust # Allows passwordless access
options: >-
--health-cmd pg_isready
--health-interval 10s
--health-timeout 5s
--health-retries 5
ports:
# Maps tcp port 5432 on service container to the host
- 5432:5432
strategy:
fail-fast: false
matrix:
include:
- os: 22.04
os_underscore: 22_04
arch: x86-64
runner: "ubuntu-22.04"
ghc: "8.10.7"
should_run: ${{ !(github.ref == 'refs/heads/stable' || startsWith(github.ref, 'refs/tags/v')) }}
- os: 22.04
os_underscore: 22_04
arch: x86-64
runner: "ubuntu-22.04"
ghc: "9.6.3"
should_run: true
- os: 24.04
os_underscore: 24_04
arch: x86-64
runner: "ubuntu-24.04"
ghc: "9.6.3"
should_run: true
- os: 22.04
os_underscore: 22_04
arch: aarch64
runner: "ubuntu-22.04-arm"
ghc: "9.6.3"
should_run: true
- os: 24.04
os_underscore: 24_04
arch: aarch64
runner: "ubuntu-24.04-arm"
ghc: "9.6.3"
should_run: true
steps:
- name: Clone project
if: matrix.should_run == true
uses: actions/checkout@v3
- name: Set up Docker Buildx
if: matrix.should_run == true
uses: simplex-chat/docker-setup-buildx-action@v3
- name: Setup swap
if: matrix.ghc == '8.10.7' && matrix.should_run == true
uses: ./.github/actions/swap
with:
swap-size-gb: 20
- name: Install PostgreSQL 15 client tools
if: matrix.os == '22.04' && matrix.should_run == true
shell: bash
run: |
# Import the repository signing key
sudo install -d /usr/share/postgresql-common/pgdg
sudo curl -o /usr/share/postgresql-common/pgdg/apt.postgresql.org.asc --fail https://www.postgresql.org/media/keys/ACCC4CF8.asc
# Add the PostgreSQL APT repository
sudo sh -c 'echo "deb [signed-by=/usr/share/postgresql-common/pgdg/apt.postgresql.org.asc] https://apt.postgresql.org/pub/repos/apt $(lsb_release -cs)-pgdg main" > /etc/apt/sources.list.d/pgdg.list'
# Update repository and install postgresql tools
sudo apt update
sudo apt -y install postgresql-client-15
- name: Build and cache Docker image
if: matrix.should_run == true
uses: simplex-chat/docker-build-push-action@v6
with:
context: .
load: true
file: Dockerfile.build
tags: build/${{ matrix.os }}:latest
build-args: |
TAG=${{ matrix.os }}
GHC=${{ matrix.ghc }}
- name: Cache dependencies
if: matrix.should_run == true
uses: actions/cache@v4
with:
path: |
~/.cabal/store
dist-newstyle
key: ubuntu-${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
- name: Start container
if: matrix.should_run == true
shell: bash
run: |
docker run -t -d \
--device /dev/fuse \
--cap-add SYS_ADMIN \
--security-opt apparmor:unconfined \
--name builder \
-v ~/.cabal:/root/.cabal \
-v /home/runner/work/_temp:/home/runner/work/_temp \
-v ${{ github.workspace }}:/project \
build/${{ matrix.os }}:latest
- name: Build smp-server (postgresql) and tests
if: matrix.should_run == true
shell: docker exec -t builder sh -eu {0}
run: |
chmod -fR 777 ~/.cabal ./dist-newstyle || :; git config --global --add safe.directory '*'
cabal clean
cabal update
cabal build --jobs=$(nproc) --enable-tests -fserver_postgres
mkdir -p /out
for i in smp-server simplexmq-test; do
bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
chmod +x "$bin"
mv "$bin" /out/
done
strip /out/smp-server
- name: Copy simplexmq-test from container
if: matrix.should_run == true
shell: bash
run: |
docker cp builder:/out/simplexmq-test .
- name: Copy smp-server (postgresql) from container and prepare it
if: startsWith(github.ref, 'refs/tags/v') && matrix.should_run == true
id: prepare-postgres
shell: bash
run: |
name="smp-server-postgres-ubuntu-${{ matrix.os_underscore }}-${{ matrix.arch }}"
docker cp builder:/out/smp-server $name
path="${{ github.workspace }}/$name"
echo "bin=$path" >> $GITHUB_OUTPUT
hash="SHA2-256($name)= $(openssl sha256 $path | cut -d' ' -f 2)"
printf 'hash=%s' "$hash" >> $GITHUB_OUTPUT
- name: Build everything else (standard)
if: matrix.should_run == true
shell: docker exec -t builder sh -eu {0}
run: |
cabal build --jobs=$(nproc)
mkdir -p /out
for i in ${{ env.apps }}; do
bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
strip "$bin"
chmod +x "$bin"
mv "$bin" /out/
done
- name: Copy binaries from container and prepare them
id: prepare-regular
if: startsWith(github.ref, 'refs/tags/v') && matrix.should_run == true
shell: bash
run: |
docker cp builder:/out .
printf 'bins<<EOF\n' > bins.output
printf 'hashes<<EOF\n' > hashes.output
for i in ${{ env.apps }}; do
name="$i-ubuntu-${{ matrix.os_underscore }}-${{ matrix.arch }}"
mv ./out/$i ./$name
path="${{ github.workspace }}/$name"
hash="SHA2-256($name)= $(openssl sha256 $path | cut -d' ' -f 2)"
printf '%s\n' "$path" >> bins.output
printf '%s\n\n' "$hash" >> hashes.output
done
printf 'EOF\n' >> bins.output
printf 'EOF\n' >> hashes.output
cat bins.output >> "$GITHUB_OUTPUT"
cat hashes.output >> "$GITHUB_OUTPUT"
- name: Upload binaries
if: startsWith(github.ref, 'refs/tags/v') && matrix.should_run == true
uses: simplex-chat/action-gh-release@v2
with:
append_body: true
prerelease: true
fail_on_unmatched_files: true
body: |
${{ steps.prepare-regular.outputs.hashes }}
${{ steps.prepare-postgres.outputs.hash }}
files: |
${{ steps.prepare-regular.outputs.bins }}
${{ steps.prepare-postgres.outputs.bin }}
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
- name: Test
if: matrix.should_run == true && matrix.arch == 'x86-64'
timeout-minutes: 120
shell: bash
env:
PGHOST: localhost
run: |
i=1
attempts=1
${{ (github.ref == 'refs/heads/stable' || startsWith(github.ref, 'refs/tags/v')) }} && attempts=3
while [ "$i" -le "$attempts" ]; do
if ./simplexmq-test; then
break
else
echo "Attempt $i failed, retrying..."
i=$((i + 1))
sleep 1
fi
done
if [ "$i" -gt "$attempts" ]; then
echo "All "$attempts" attempts failed."
exit 1
fi
+6 -6
View File
@@ -14,22 +14,22 @@ jobs:
matrix:
include:
- app: smp-server
app_port: 5223
app_port: "443 5223"
- app: xftp-server
app_port: 443
app_port: 443
steps:
- name: Clone project
uses: actions/checkout@v3
uses: actions/checkout@v4
- name: Log in to Docker Hub
uses: docker/login-action@v2
uses: simplex-chat/docker-login-action@v3
with:
username: ${{ secrets.DOCKERHUB_USERNAME }}
password: ${{ secrets.DOCKERHUB_PASSWORD }}
- name: Extract metadata for Docker image
id: meta
uses: docker/metadata-action@v4
uses: simplex-chat/docker-metadata-action@v5
with:
images: ${{ secrets.DOCKERHUB_USERNAME }}/${{ matrix.app }}
flavor: |
@@ -40,7 +40,7 @@ jobs:
type=semver,pattern=v{{major}}
- name: Build and push Docker image
uses: docker/build-push-action@v4
uses: simplex-chat/docker-build-push-action@v6
with:
push: true
build-args: |
+45
View File
@@ -0,0 +1,45 @@
name: Reproduce latest release
on:
workflow_dispatch:
schedule:
- cron: '0 2 * * *' # every day at 02:00 night
jobs:
reproduce:
runs-on: ubuntu-latest
steps:
- name: Checkout code
uses: actions/checkout@v3
- name: Get latest release
shell: bash
run: |
curl --proto '=https' \
--tlsv1.2 \
-sSf -L \
'https://api.github.com/repos/simplex-chat/simplexmq/releases/latest' \
2>/dev/null | \
grep -i "tag_name" | \
awk -F \" '{print "TAG="$4}' >> $GITHUB_ENV
- name: Execute reproduce script
run: |
${GITHUB_WORKSPACE}/scripts/simplexmq-reproduce-builds.sh "$TAG" || :
- name: Check if build has been reproduced
env:
url: ${{ secrets.STATUS_SIMPLEX_WEBHOOK_URL }}
user: ${{ secrets.STATUS_SIMPLEX_WEBHOOK_USER }}
pass: ${{ secrets.STATUS_SIMPLEX_WEBHOOK_PASS }}
run: |
if [ -f "${GITHUB_WORKSPACE}/${TAG}-simplexmq/_sha256sums" ]; then
exit 0
else
curl --proto '=https' --tlsv1.2 -sSf \
-u "${user}:${pass}" \
-H 'Content-Type: application/json' \
-d '{"title": "👾 GitHub: Runner", "description": "⛔️ '"$TAG"' did not reproduce."}' \
"$url"
exit 1
fi
+175
View File
@@ -1,3 +1,178 @@
# 6.4.4
Servers:
- fix server pages when source code is not specified.
- include commit SHA in printed version and in web page (#1608).
SMP server:
- support short SimpleX addresses in server information page (#1600).
- wrap all queries in transactions (#1603).
SMP agent:
- chat relay address type for short links (#1602).
- extend xrcp certificate validity 1 hour in the past, to allow out of sync clocks (#1601).
# 6.4.3
SMP agent:
- fix some connection errors by updating contact request server hosts to match server in short link (#1597).
SMP server:
- support short link URI as queue identifier in control port commands (#1596).
# 6.4.2
SMP server:
- fix memory leak when connection interrupts straight after client connects.
- do not include repeated queue blocking into stats/quota.
XFTP server:
- prometheus metrics
# 6.4.1
SMP protocol:
- create notification credentials via NEW command that creates the queue (#1586)
SMP server:
- control port session improvements (#1591)
- additional stat counter for ntf credentials created together with the queue (#1589)
# 6.4.0
SMP protocol (server/client):
- support associated queue data and short connection links (see [RFC](./rfcs/2025-03-16-smp-queues.md)).
- service certificates to optimize subscriptions.
SMP agent:
- support retries for interactive connection handshakes.
- use web port 443 by default for preset servers.
- use static RNG function to avoid creating dynamic C stubs when generating sntrup keys (it was detected as Dynamic Code Loading in GrapheneOS).
- different timeouts for interactive and background operations.
Ntf server:
- PostgreSQL storage.
- Prometheus metrics.
- use service certificates.
- fix repeat token registration.
# 6.3.2
Servers:
- enable store log by default (#1501).
SMP server:
- reduce memory usage (#1498)
SMP agent:
- handle client/agent version downgrades after connection was established (#1508).
# 6.3.1
Servers:
- handle ECONNABORTED error on client connections.
- reproducible builds.
- blocking records for content moderation.
- update script (simplex-servers-update) downloads scripts from the specified or the latest stable tag.
SMP server:
- support for PostgreSQL database for queue records for higher traffic servers.
- fix old clients sending messages to new servers (#1443)
- remove empty journals when opening message queues and expiring idle queues (#1456, #1458).
- additional start options (#1465):
- `maintenance` to run all start/stop operations without starting server.
- `skip-warnings` to ignore the last corrupted line in store log (can happen on abnormal termination).
Ntf server:
- record date of last token activity, to allow expiring inactive tokens.
- additional token invalidation reasons in logs.
SMP agent:
- store message sent to multiple connections only once, to reduce storage when sending to groups (#1453).
- encrypt messages on delivery, to reduce database writes (#1446).
- don't block method calls on congested sockets for better concurrency (#1454).
- check notification token status on client connection.
- option to skip SQLite vacuum on migrations.
# 6.3.0
SMP agent: fix joining connection after failure by using the same ratchet.
# 6.2.2
SMP server:
- add optional Prometheus metrics (#1411).
Build:
- remove three modules from client library.
# 6.2.0
Version 6.2.0.7
Build:
- client_library flag to build only used modules in the clients, remove package yaml
SMP server:
- journal storage for messages (BETA).
- prevent race condition when deleting queue and to avoid "orphan" messages (#1395).
SMP agent:
- support SMP and XFTP server roles (storage/proxy) and operators (#1343).
- treat blocked STM and other critical errors that offer restart as temporary for message delivery (#1405).
- fix inconsistent state after app restart while accepting contact request (#1412).
# 6.1.3
SMP server: fix restoring notification credentials.
# 6.1.2
Servers: more reliable restoring of state.
SMP server: reduced memory usage and faster start.
Notifications: compensate for iOS notifications being dropped by Apple while device is offline (#1378):
- Ntf server: send multiple SMP notifications in one iOS notification.
- Agent: get multiple messages for one iOS notification.
# 6.1.1
SMP:
- stop server faster (#1371)
- add STORE error (#1372)
# 6.1.0
Version 6.1.0.7
SMP server and client:
- transport block encryption (#1317).
Agent:
- batch and optimize iOS notifications processing (#1308, #1311, #1313, #1316, #1330, #1331, #1333, #1337, #1346).
- allow receiving multiple messages from single iOS notification (#1355, #1362).
- prepare connection to accept to avoid race condition with events (#1365).
- transport isolation mode "Session" (default) to use new SOCKS credentials when client restarts or SOCKS proxy configuration changes (#1321).
Ntf server:
- control port (#1354).
- enable pings on ntf subscriptions, to resubscribe on reconnection (#1353).
SMP server:
- support multiple server ports (#1319).
- support serving HTTPS and SMP transport on the same port (#1326, #1327).
- persist iOS notifications to avoid losing them when Ntf server is offline (#1336, #1339, #1350).
- fix lost notification subscriptions (#1347).
- reject SKEY with different key earlier, at verification step (#1366).
- pass server information via CLI during server initialization (#1356).
- show version on server page (#1341).
- explicit graceful shutdown on SIGINT (#1360).
XRCP (remote access protocol):
- use SHA3-256 in hybrid key agreement (#1302).
- session encryption with forward secrecy (#1328).
# 6.0.5
SMP agent:
+31 -8
View File
@@ -1,15 +1,20 @@
ARG TAG=22.04
# syntax=docker/dockerfile:1.7.0-labs
ARG TAG=24.04
FROM ubuntu:${TAG} AS build
### Build stage
# Install curl and git and simplexmq dependencies
RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-12 llvm-12-dev libnuma-dev libssl-dev
RUN apt-get update && apt-get install -y curl git build-essential libgmp3-dev zlib1g-dev llvm-18 llvm-18-dev libnuma-dev libssl-dev
# Specify bootstrap Haskell versions
ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.3
ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.1.0
ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.12.1.0
# Do not install Stack
ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK=true
ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK=true
# Install ghcup
RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
@@ -21,26 +26,42 @@ ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
RUN ghcup set ghc "${BOOTSTRAP_HASKELL_GHC_VERSION}" && \
ghcup set cabal "${BOOTSTRAP_HASKELL_CABAL_VERSION}"
COPY . /project
# Copy only the source code
COPY apps /project/apps/
COPY cbits /project/cbits/
COPY src /project/src/
COPY cabal.project Setup.hs simplexmq.cabal LICENSE /project
WORKDIR /project
# Debug
#ARG CACHEBUST=1
#ADD --chmod=755 https://github.com/MShekow/directory-checksum/releases/download/v1.4.6/directory-checksum_1.4.6_linux_amd64 /usr/local/bin/directory-checksum
#RUN directory-checksum --max-depth 2 .
# Set build arguments and check if they exist
ARG APP
ARG APP_PORT
RUN if [ -z "$APP" ] || [ -z "$APP_PORT" ]; then printf "Please spcify \$APP and \$APP_PORT build-arg.\n"; exit 1; fi
RUN if [ -z "$APP" ]; then printf "Please spcify \$APP build-arg.\n"; exit 1; fi
# Compile app
RUN cabal update
RUN cabal build exe:$APP
# Copy scripts
COPY scripts /project/scripts/
# Create new path containing all files needed
RUN mkdir /final
WORKDIR /final
# Strip the binary from debug symbols to reduce size
RUN bin=$(find /project/dist-newstyle -name "$APP" -type f -executable) && \
RUN bin="$(find /project/dist-newstyle -name "$APP" -type f -executable)" && \
mv "$bin" ./ && \
strip ./"$APP" &&\
mv /project/scripts/docker/entrypoint-"$APP" ./entrypoint
mv /project/scripts/docker/entrypoint-"$APP" ./entrypoint &&\
mv /project/scripts/main/simplex-servers-stopscript ./simplex-servers-stopscript
### Final stage
FROM ubuntu:${TAG}
@@ -53,6 +74,8 @@ COPY --from=build /final /usr/local/bin/
# Open app listening port
ARG APP_PORT
RUN if [ -z "$APP_PORT" ]; then printf "Please spcify \$APP_PORT build-arg.\n"; exit 1; fi
EXPOSE $APP_PORT
# simplexmq requires using SIGINT to correctly preserve undelivered messages and restore them on restart
+31
View File
@@ -0,0 +1,31 @@
# syntax=docker/dockerfile:1.7.0-labs
ARG TAG=24.04
FROM ubuntu:${TAG} AS build
### Build stage
ARG GHC=9.6.3
ARG CABAL=3.14.1.1
# Install curl, git and and simplexmq dependencies
RUN apt-get update && apt-get install -y curl libpq-dev git sqlite3 libsqlite3-dev build-essential libgmp3-dev zlib1g-dev llvm llvm-dev libnuma-dev libssl-dev
# Specify bootstrap Haskell versions
ENV BOOTSTRAP_HASKELL_GHC_VERSION=${GHC}
ENV BOOTSTRAP_HASKELL_CABAL_VERSION=${CABAL}
# Do not install Stack
ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK=true
ENV BOOTSTRAP_HASKELL_INSTALL_NO_STACK_HOOK=true
# Install ghcup
RUN curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
# Adjust PATH
ENV PATH="/root/.cabal/bin:/root/.ghcup/bin:$PATH"
# Set both as default
RUN ghcup set ghc "${GHC}" && \
ghcup set cabal "${CABAL}"
WORKDIR /project
+15 -8
View File
@@ -1,6 +1,6 @@
# SimpleXMQ
[![GitHub build](https://github.com/simplex-chat/simplexmq/workflows/build/badge.svg)](https://github.com/simplex-chat/simplexmq/actions?query=workflow%3Abuild)
[![GitHub build](https://github.com/simplex-chat/simplexmq/actions/workflows/build.yml/badge.svg)](https://github.com/simplex-chat/simplexmq/actions/workflows/build.yml)
[![GitHub release](https://img.shields.io/github/v/release/simplex-chat/simplexmq)](https://github.com/simplex-chat/simplexmq/releases)
📢 SimpleXMQ v1 is released - with many security, privacy and efficiency improvements, new functionality - see [release notes](https://github.com/simplex-chat/simplexmq/releases/tag/v1.0.0).
@@ -116,7 +116,7 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
2. Run your Docker container.
- `smp-server`
You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
```sh
docker run -d \
@@ -129,7 +129,7 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
```
- `xftp-server`
You must change **your_ip_or_domain** and **maximum_storage**.
```sh
docker run -d \
@@ -149,8 +149,15 @@ On Linux, you can deploy smp and xftp server using Docker. This will download im
You can install and setup servers automatically using our script:
```sh
curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh \
&& if echo 'c90886104cd640b2ed64921dba80e90691db36788e8d6dcc13d8f33f92f0ea54 simplex-server-install.sh' | sha256sum -c; then chmod +x ./simplex-server-install.sh && ./simplex-server-install.sh; rm ./simplex-server-install.sh; else echo "SHA-256 checksum is incorrect!" && rm ./simplex-server-install.sh; fi
curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/install.sh -o simplex-server-install.sh &&\
if echo '53fcdb4ceab324316e2c4cda7e84dbbb344f32550a65975a7895425e5a1be757 simplex-server-install.sh' | sha256sum -c; then
chmod +x ./simplex-server-install.sh
./simplex-server-install.sh
rm ./simplex-server-install.sh
else
echo "SHA-256 checksum is incorrect!"
rm ./simplex-server-install.sh
fi
```
### Build from source
@@ -180,7 +187,7 @@ On Linux, you can build smp server using Docker.
3. Run your Docker container.
- `smp-server`
You must change **your_ip_or_domain**. `-e "pass=password"` is optional variable to password-protect your `smp` server:
```sh
docker run -d \
@@ -193,7 +200,7 @@ On Linux, you can build smp server using Docker.
```
- `xftp-server`
You must change **your_ip_or_domain** and **maximum_storage**.
```sh
docker run -d \
@@ -240,7 +247,7 @@ On Linux, you can build smp server using Docker.
`xftp-server`
```sh
cabal list-bin exe:xftp-server
cabal list-bin exe:xftp-server
```
- Initialize SMP server with `smp-server init [-l] -n <fqdn>` or `smp-server init [-l] --ip <ip>` - depending on how you initialize it, either FQDN or IP will be used for server's address.
-1
View File
@@ -15,7 +15,6 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
main :: IO ()
main = do
setLogLevel LogInfo
cfgPath <- getEnvPath "NTF_SERVER_CFG_PATH" defaultCfgPath
logPath <- getEnvPath "NTF_SERVER_LOG_PATH" defaultLogPath
withGlobalLogging logCfg $ ntfServerCLI cfgPath logPath
-1
View File
@@ -16,7 +16,6 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
main :: IO ()
main = do
setLogLevel LogDebug
cfgPath <- getEnvPath "SMP_SERVER_CFG_PATH" defaultCfgPath
logPath <- getEnvPath "SMP_SERVER_LOG_PATH" defaultLogPath
withGlobalLogging logCfg $ smpServerCLI_ Static.generateSite Static.serveStaticFiles Static.attachStaticFiles cfgPath logPath
@@ -0,0 +1,49 @@
{
"applinks": {
"details": [
{
"appIDs": [
"5NN7GUYB6T.chat.simplex.app"
],
"components": [
{
"/": "/contact/*"
},
{
"/": "/contact"
},
{
"/": "/invitation/*"
},
{
"/": "/invitation"
},
{
"/": "/a/*"
},
{
"/": "/a"
},
{
"/": "/c/*"
},
{
"/": "/c"
},
{
"/": "/g/*"
},
{
"/": "/g"
},
{
"/": "/i/*"
},
{
"/": "/i"
}
]
}
]
}
}
@@ -0,0 +1,16 @@
[
{
"relation": [
"delegate_permission/common.handle_all_urls"
],
"target": {
"namespace": "android_app",
"package_name": "chat.simplex.app",
"sha256_cert_fingerprints": [
"5E:3E:DC:C2:00:FB:A8:D5:F4:88:F3:CA:4C:32:5B:05:78:C5:6A:9C:03:A1:CC:B5:92:9C:D7:5C:7E:57:E2:4D",
"3C:52:C4:FD:3C:AD:1C:07:C9:B0:0A:70:80:E3:58:FA:B9:FE:FC:B8:AF:5A:EC:14:77:65:F1:6D:0F:21:AD:85",
"AE:C1:95:DC:FD:46:14:BD:3A:91:EC:26:D1:D5:14:C8:75:71:C5:CC:8D:CF:48:08:3F:92:83:14:3C:A2:B9:A6"
]
}
}
]
+1
View File
@@ -0,0 +1 @@
../link.html
+1
View File
@@ -0,0 +1 @@
../link.html
+1
View File
@@ -0,0 +1 @@
../link.html
+11 -2
View File
@@ -223,11 +223,14 @@
<table id="public-info">
<tr class="text-grey-black dark:text-white text-base">
<td>Server version:</td>
<td>${version}</td>
<td>${version}<x-commit> / <a href="${commitSourceCode}/commit/${commit}" target="_blank">${shortCommit}</a></x-commit></td>
</tr>
<tr class="text-grey-black dark:text-white text-base">
<td>Source code:</td>
<td><a href="${sourceCode}" target="_blank">${sourceCode}</a></td>
<td>
<x-sourceCode><a href="${sourceCode}" target="_blank">${sourceCode}</a></x-sourceCode>
<x-noSourceCode>add to smp-server.ini (required by <a href="https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE" target="_blank">AGPLv3</a>)</x-noSourceCode>
</td>
</tr>
<x-website>
<tr class="text-grey-black dark:text-white text-base">
@@ -295,6 +298,12 @@
<td>${hostingEntity} (${hostingCountry})</td>
</tr>
</x-hosting>
<x-hostingType>
<tr class="text-grey-black dark:text-white text-base">
<td>Hosting type:</td>
<td>${hostingType}</td>
</tr>
</x-hostingType>
<x-serverCountry>
<tr class="text-grey-black dark:text-white text-base">
<td>Server country:</td>
+14 -13
View File
@@ -142,8 +142,7 @@
class="hidden xl:block h-screen pt-[66px] bg-white dark:bg-gradient-radial-mobile dark:lg:bg-gradient-radial">
<div class="container m-auto h-full flex items-center justify-between px-5">
<div class="flex flex-col items-start justify-center w-full">
<h1 class="text-[38px] leading-[43px] font-bold max-w-[500px] mb-[30px] primary-header-contact">You received a
1-time link to connect on SimpleX Chat</h1>
<h1 class="text-[38px] leading-[43px] font-bold max-w-[500px] mb-[30px] primary-header-contact">This is a one-time link of the SimpleX&nbsp;network user</h1>
<h2
class="text-[20px] leading-[28px] text-[#606C71] dark:text-white font-bold max-w-[475px] mb-[80px] secondary-header-contact">
Scan the QR code with the SimpleX Chat app on your phone or tablet.</h2>
@@ -184,10 +183,8 @@
class="block xl:hidden pt-[106px] py-[90px] bg-white dark:bg-gradient-radial-mobile dark:lg:bg-gradient-radial">
<div class="container m-auto px-5">
<div class="flex flex-col items-center">
<h1 class="text-[28px] font-bold text-center max-w-[602px] mb-[40px] primary-header-contact">You received a
1-time link to connect on SimpleX Chat</h1>
<p class="text-[20px] leading-[28px] text-grey-black dark:text-white font-medium mb-[30px]">To make a
connection:</p>
<h1 class="text-[28px] font-bold text-center max-w-[602px] mb-[40px] primary-header-contact">This is a one-time link of the SimpleX&nbsp;network user</h1>
<p class="text-[20px] leading-[28px] text-grey-black dark:text-white font-medium mb-[30px]">To make a connection:</p>
<div
class="flex flex-col justify-center items-center p-4 w-full max-w-[468px] min-h-[131px] rounded-[30px] border-[1px] border-[#A8B0B4] dark:border-white border-opacity-60 mb-6 relative">
<p class="text-xl font-medium text-grey-black dark:text-white mb-4">Install SimpleX app</p>
@@ -506,13 +503,17 @@
const url = window.location.href
const messageElements = document.getElementsByClassName('primary-header-contact')
if (url.includes('/invitation')) {
for (let element of messageElements) {
element.textContent = 'You received a 1-time link to connect on SimpleX Chat'
}
} else {
for (let element of messageElements) {
element.textContent = 'You received an address to connect on SimpleX Chat'
for (let element of messageElements) {
if (url.includes('/g') || url.includes('&data=%7B%22groupLinkId%22%3A')) {
element.innerHTML = 'This is a public group address on SimpleX&nbsp;network'
} else if (url.includes('/a') || url.includes('/contact')) {
element.innerHTML = 'This is a public address of the SimpleX&nbsp;network user'
} else if (url.includes('/i') || url.includes('/invitation')) {
element.innerHTML = 'This is a one-time link of the SimpleX&nbsp;network user'
} else if (url.includes('/c')) {
element.innerHTML = 'This is a public channel address on SimpleX&nbsp;network'
} else if (url.includes('/r')) {
element.innerHTML = 'This is a chat relay address on SimpleX&nbsp;network'
}
}
</script>
+12 -1
View File
@@ -20,7 +20,18 @@
parsedURI.pathname = "/" + action
connURI = parsedURI.toString()
console.log("connection URI: ", connURI)
mobileConnURIanchor.href = "simplex:" + parsedURI.pathname + parsedURI.hash
const hash = parsedURI.hash
const hostname = parsedURI.hostname
let appURI = "simplex:" + parsedURI.pathname
appURI += action.length > 1 // not short link
? hash
: !hash.includes("?") // otherwise add server hostname
? hash + "?h=" + hostname // no parameters
: !hash.includes("?h=") && !hash.includes("&h=")
? hash + "&h=" + hostname // no "h" parameter
: hash.replace(/([?&])h=([^&]+)/, `$1h=${hostname},$2`) // add as the first hostname to "h" parameter
mobileConnURIanchor.href = appURI
console.log("app URI: ", appURI)
connURIel.innerText = "/c " + connURI
for (const connQRCode of connQRCodes) {
try {
+59 -23
View File
@@ -8,20 +8,24 @@ import Control.Logger.Simple
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (toUpper)
import Data.IORef (readIORef)
import Data.Maybe (fromMaybe)
import Data.String (fromString)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Network.Socket (getPeerName)
import Network.Wai (Application)
import Network.Wai (Application, Request (..))
import Network.Wai.Application.Static (StaticSettings (..))
import qualified Network.Wai.Application.Static as S
import qualified Network.Wai.Handler.Warp as W
import qualified Network.Wai.Handler.Warp.Internal as WI
import qualified Network.Wai.Handler.WarpTLS as WT
import Simplex.Messaging.Encoding.String (strEncode)
import Simplex.Messaging.Server (AttachHTTP)
import Simplex.Messaging.Server.CLI (simplexmqCommit)
import Simplex.Messaging.Server.Information
import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..))
import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..), simplexmqSource)
import Simplex.Messaging.Transport (simplexMQVersion)
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Util (tshow)
@@ -30,34 +34,34 @@ import System.Directory (createDirectoryIfMissing)
import System.FilePath
import UnliftIO.Concurrent (forkFinally)
import UnliftIO.Exception (bracket, finally)
import qualified WaiAppStatic.Types as WAT
serveStaticFiles :: EmbeddedWebParams -> IO ()
serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams} = do
forM_ webHttpPort $ \port -> flip forkFinally (\e -> logError $ "HTTP server crashed: " <> tshow e) $ do
logInfo $ "Serving static site on port " <> tshow port
W.runSettings (mkSettings port) (S.staticApp $ S.defaultFileServerSettings webStaticPath)
W.runSettings (mkSettings port) app
forM_ webHttpsParams $ \WebHttpsParams {port, cert, key} -> flip forkFinally (\e -> logError $ "HTTPS server crashed: " <> tshow e) $ do
logInfo $ "Serving static site on port " <> tshow port <> " (TLS)"
WT.runTLS (WT.tlsSettings cert key) (mkSettings port) app
where
app = staticFiles webStaticPath
mkSettings port = W.setPort port W.defaultSettings
mkSettings port = W.setPort port warpSettings
-- | Prepare context and prepare HTTP handler for TLS connections that already passed TLS.handshake and ALPN check.
attachStaticFiles :: FilePath -> (AttachHTTP -> IO ()) -> IO ()
attachStaticFiles path action =
-- Initialize global internal state for http server.
WI.withII settings $ \ii -> do
WI.withII warpSettings $ \ii -> do
action $ \socket cxt -> do
-- Initialize internal per-connection resources.
addr <- getPeerName socket
withConnection addr cxt $ \(conn, transport) ->
withTimeout ii conn $ \th ->
-- Run Warp connection handler to process HTTP requests for static files.
WI.serveConnection conn ii th addr transport settings app
WI.serveConnection conn ii th addr transport warpSettings app
where
app = staticFiles path
settings = W.defaultSettings
-- from warp-tls
withConnection socket cxt = bracket (WT.attachConn socket cxt) (terminate . fst)
-- from warp
@@ -68,29 +72,54 @@ attachStaticFiles path action =
-- shared clean up
terminate conn = WI.connClose conn `finally` (readIORef (WI.connWriteBuffer conn) >>= WI.bufFree)
warpSettings :: W.Settings
warpSettings = W.setGracefulShutdownTimeout (Just 1) W.defaultSettings
staticFiles :: FilePath -> Application
staticFiles root = S.staticApp settings
staticFiles root = S.staticApp settings . changeWellKnownPath
where
settings = (S.defaultFileServerSettings root)
{ S.ssListing = Nothing
}
settings = defSettings {ssListing = Nothing, ssGetMimeType = getMimeType}
defSettings = S.defaultFileServerSettings root
getMimeType f
| WAT.fromPiece (WAT.fileName f) == "apple-app-site-association" = pure "application/json"
| otherwise = (ssGetMimeType defSettings) f
changeWellKnownPath req = case pathInfo req of
".well-known" : rest ->
req
{ pathInfo = "well-known" : rest,
rawPathInfo = "/well-known/" <> B.drop pfxLen (rawPathInfo req)
}
_ -> req
pfxLen = B.length "/.well-known/"
generateSite :: ServerInformation -> Maybe TransportHost -> FilePath -> IO ()
generateSite si onionHost sitePath = do
createDirectoryIfMissing True sitePath
B.writeFile (sitePath </> "index.html") $ serverInformation si onionHost
createDirectoryIfMissing True $ sitePath </> "media"
forM_ E.mediaContent $ \(path, bs) -> B.writeFile (sitePath </> "media" </> path) bs
createDirectoryIfMissing True $ sitePath </> "contact"
B.writeFile (sitePath </> "contact" </> "index.html") E.linkHtml
createDirectoryIfMissing True $ sitePath </> "invitation"
B.writeFile (sitePath </> "invitation" </> "index.html") E.linkHtml
copyDir "media" E.mediaContent
-- `.well-known` path is re-written in changeWellKnownPath,
-- staticApp does not allow hidden folders.
copyDir "well-known" E.wellKnown
createLinkPage "contact"
createLinkPage "invitation"
createLinkPage "a"
createLinkPage "c"
createLinkPage "g"
createLinkPage "r"
createLinkPage "i"
logInfo $ "Generated static site contents at " <> tshow sitePath
where
copyDir dir content = do
createDirectoryIfMissing True $ sitePath </> dir
forM_ content $ \(path, s) -> B.writeFile (sitePath </> dir </> path) s
createLinkPage path = do
createDirectoryIfMissing True $ sitePath </> path
B.writeFile (sitePath </> path </> "index.html") E.linkHtml
serverInformation :: ServerInformation -> Maybe TransportHost -> ByteString
serverInformation ServerInformation {config, information} onionHost = render E.indexHtml substs
where
substs = substConfig <> maybe [] substInfo information <> [("onionHost", strEncode <$> onionHost)]
substs = substConfig <> substInfo <> [("onionHost", strEncode <$> onionHost)]
substConfig =
[ ( "persistence",
Just $ case persistence config of
@@ -105,7 +134,7 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
]
yesNo True = "Yes"
yesNo False = "No"
substInfo spi =
substInfo =
concat
[ basic,
maybe [("usageConditions", Nothing), ("usageAmendments", Nothing)] conds (usageConditions spi),
@@ -117,10 +146,16 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
]
where
basic =
[ ("sourceCode", Just . encodeUtf8 $ sourceCode spi),
[ ("sourceCode", if T.null sc then Nothing else Just (encodeUtf8 sc)),
("noSourceCode", if T.null sc then Just "none" else Nothing),
("version", Just $ B.pack simplexMQVersion),
("commitSourceCode", Just $ encodeUtf8 $ maybe (T.pack simplexmqSource) sourceCode information),
("shortCommit", Just $ B.pack $ take 7 simplexmqCommit),
("commit", Just $ B.pack simplexmqCommit),
("website", encodeUtf8 <$> website spi)
]
spi = fromMaybe (emptyServerInfo "") information
sc = sourceCode spi
conds ServerConditions {conditions, amendments} =
[ ("usageConditions", Just $ encodeUtf8 conditions),
("usageAmendments", encodeUtf8 <$> amendments)
@@ -150,7 +185,8 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
("hostingCountry", encodeUtf8 <$> country)
]
server =
[ ("serverCountry", fmap encodeUtf8 $ serverCountry =<< information)
[ ("serverCountry", encodeUtf8 <$> serverCountry spi),
("hostingType", (\s -> maybe s (\(c, rest) -> toUpper c `B.cons` rest) $ B.uncons s) . strEncode <$> hostingType spi)
]
-- Copy-pasted from simplex-chat Simplex.Chat.Types.Preferences
@@ -201,8 +237,8 @@ section_ label content' src =
(inside, next') ->
let next = B.drop (B.length endMarker) next'
in case content' of
Nothing -> before <> next -- collapse section
Just content -> before <> item_ label content inside <> section_ label content' next
Just content | not (B.null content) -> before <> item_ label content inside <> section_ label content' next
_ -> before <> next -- collapse section
where
startMarker = "<x-" <> label <> ">"
endMarker = "</x-" <> label <> ">"
+3
View File
@@ -13,3 +13,6 @@ linkHtml = $(embedFile "apps/smp-server/static/link.html")
mediaContent :: [(FilePath, ByteString)]
mediaContent = $(embedDir "apps/smp-server/static/media/")
wellKnown :: [(FilePath, ByteString)]
wellKnown = $(embedDir "apps/smp-server/static/.well-known/")
+9
View File
@@ -4,6 +4,15 @@ packages: .
-- packages: . ../http2
-- packages: . ../network-transport
-- uncomment two sections below to run tests with coverage
-- package *
-- coverage: True
-- library-coverage: True
-- package attoparsec
-- coverage: False
-- library-coverage: False
index-state: 2023-12-12T00:00:00Z
package cryptostore
+24 -14
View File
@@ -2,9 +2,6 @@
set -eu
# Links to scripts/configs
bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
scripts_systemd_smp="$scripts/smp-server.service"
scripts_systemd_xftp="$scripts/xftp-server.service"
@@ -57,7 +54,7 @@ ${GRN}1.${NC} Install latest binaries from GitHub releases:
${GRN}2.${NC} Create server directories:
- smp: ${YLW}${path_conf_smp}${NC}
- xftp: ${YLW}${path_conf_xftp}${NC}
${GRN}3.${NC} Setup user for each server:
${GRN}3.${NC} Setup user for server:
- xmp: ${YLW}${user_smp}${NC}
- xftp: ${YLW}${user_xftp}${NC}
${GRN}4.${NC} Create systemd services:
@@ -67,9 +64,8 @@ ${GRN}5.${NC} Install stopscript (systemd), update and uninstallation script:
- all: ${YLW}${path_bin_update}${NC}, ${YLW}${path_bin_uninstall}${NC}, ${YLW}${path_bin_stopscript}${NC}
Press:
- ${GRN}ENTER${NC} to continue installing both xftp and smp servers
- ${GRN}1${NC} to install only smp server
- ${GRN}2${NC} to install only xftp server
- ${GRN}1${NC} to install smp server
- ${GRN}2${NC} to install xftp server
- ${RED}Ctrl+C${NC} to cancel installation
Selection: "
@@ -83,6 +79,21 @@ Please checkout our server guides:
To uninstall with full clean-up, simply run: ${YLW}sudo /usr/local/bin/simplex-servers-uninstall${NC}
"
set_version() {
ver="${VER:-latest}"
case "$ver" in
latest)
bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
;;
*)
bin="https://github.com/simplex-chat/simplexmq/releases/download/${ver}"
remote_version="${ver}"
;;
esac
}
os_test() {
. /etc/os-release
@@ -155,6 +166,7 @@ checks() {
exit 1
fi
set_version
os_test
mkdir -p $path_conf_info
@@ -166,13 +178,11 @@ main() {
printf "%b\n%b" "${BLU}$logo${NC}" "$welcome"
read ans
if [ "$ans" = '1' ]; then
setup='smp'
elif [ "$ans" = '2' ]; then
setup='xftp'
else
setup='smp xftp'
fi
case "$ans" in
1) setup='smp' ;;
2) setup='xftp' ;;
*) printf 'Installation aborted.\n' && exit 0 ;;
esac
printf "Installing binaries..."
-223
View File
@@ -1,223 +0,0 @@
name: simplexmq
version: 6.1.0.2
synopsis: SimpleXMQ message broker
description: |
This package includes <./docs/Simplex-Messaging-Server.html server>,
<./docs/Simplex-Messaging-Client.html client> and
<./docs/Simplex-Messaging-Agent.html agent> for SMP protocols:
.
* <https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md SMP protocol>
* <https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md SMP agent protocol>
.
See <https://github.com/simplex-chat/simplex-chat terminal chat prototype> built with SimpleXMQ broker.
homepage: https://github.com/simplex-chat/simplexmq#readme
license: AGPL-3
author: simplex.chat
maintainer: chat@simplex.chat
copyright: 2020-2022 simplex.chat
category: Chat, Network, Web, System, Cryptography
extra-source-files:
- README.md
- CHANGELOG.md
- cbits/sha512.h
- cbits/sntrup761.h
- apps/smp-server/static/*.html
- apps/smp-server/static/media/*
dependencies:
- aeson == 2.2.*
- ansi-terminal >= 0.10 && < 0.12
- asn1-encoding == 0.9.*
- asn1-types == 0.3.*
- async == 2.2.*
- attoparsec == 0.14.*
- base >= 4.14 && < 5
- base64-bytestring >= 1.0 && < 1.3
- case-insensitive == 1.2.*
- composition == 1.0.*
- constraints >= 0.12 && < 0.14
- containers == 0.6.*
- crypton == 0.34.*
- crypton-x509 == 1.7.*
- crypton-x509-store == 1.6.*
- crypton-x509-validation == 1.6.*
- cryptostore == 0.3.*
- data-default == 0.7.*
- direct-sqlcipher == 2.3.*
- directory == 1.3.*
- filepath == 1.4.*
- hashable == 1.4.*
- hourglass == 0.2.*
- http-types == 0.12.*
- http2 >= 4.2.2 && < 4.3
- ini == 0.4.1
- iproute == 1.7.*
- iso8601-time == 0.1.*
- memory == 0.18.*
- mtl >= 2.3.1 && < 3.0
- network >= 3.1.2.7 && < 3.2
- network-info >= 0.2 && < 0.3
- network-transport == 0.5.6
- network-udp >= 0.0 && < 0.1
- optparse-applicative >= 0.15 && < 0.17
- process == 1.6.*
- random >= 1.1 && < 1.3
- simple-logger == 0.1.*
- socks == 0.6.*
- sqlcipher-simple == 0.4.*
- stm == 2.5.*
- temporary == 1.3.*
- time == 1.12.*
- time-manager == 0.0.*
- tls >= 1.9.0 && < 1.10
- transformers == 0.6.*
- unliftio == 0.2.*
- unliftio-core == 0.2.*
- websockets == 0.12.*
- yaml == 0.11.*
- zstd == 0.1.3.*
flags:
swift:
description: Enable swift JSON format
manual: True
default: False
use_crypton:
description: Use crypton etc. in cryptostore
manual: True
default: True
# cpp-options:
# - -Dslow_servers
when:
- condition: flag(swift)
cpp-options:
- -DswiftJSON
- condition: impl(ghc >= 9.6.2)
dependencies:
- bytestring == 0.11.*
- template-haskell == 2.20.*
- text >= 2.0.1 && < 2.2
- condition: impl(ghc < 9.6.2)
dependencies:
- bytestring == 0.10.*
- template-haskell == 2.16.*
- text >= 1.2.3.0 && < 1.3
library:
source-dirs: src
c-sources:
- cbits/sha512.c
- cbits/sntrup761.c
include-dirs: cbits
extra-libraries: crypto
executables:
smp-server:
source-dirs:
- apps/smp-server
- apps/smp-server/web
main: Main.hs
dependencies:
- file-embed
- simplexmq
- wai
- wai-app-static
- warp ==3.3.30 # the last one before http2-5.0
- warp-tls ==3.4.7 # extra internals exposed
ghc-options:
- -threaded
- -rtsopts
ntf-server:
source-dirs: apps/ntf-server
main: Main.hs
dependencies:
- simplexmq
ghc-options:
- -threaded
- -rtsopts
xftp-server:
source-dirs: apps/xftp-server
main: Main.hs
dependencies:
- simplexmq
ghc-options:
- -threaded
- -rtsopts
xftp:
source-dirs: apps/xftp
main: Main.hs
dependencies:
- simplexmq
ghc-options:
- -threaded
- -rtsopts
tests:
simplexmq-test:
source-dirs:
- tests
- apps/smp-server/web
main: Test.hs
dependencies:
- deepseq == 1.4.*
- file-embed
- generic-random == 1.5.*
- hspec == 2.11.*
- hspec-core == 2.11.*
- http-client
- http-client-tls
- HUnit == 1.6.*
- main-tester == 0.2.*
- QuickCheck == 2.14.*
- silently == 1.2.*
- simplexmq
- timeit == 2.0.*
- unordered-containers
- wai
- wai-app-static
- warp
- warp-tls
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-A64M
- -with-rtsopts=-N1
ghc-options:
# - -haddock
- -Weverything
- -Wno-missing-exported-signatures
- -Wno-missing-import-lists
- -Wno-missed-specialisations
- -Wno-all-missed-specialisations
- -Wno-unsafe
- -Wno-safe
- -Wno-missing-local-signatures
- -Wno-missing-kind-signatures
- -Wno-missing-deriving-strategies
- -Wno-monomorphism-restriction
- -Wno-prepositive-qualified-module
- -Wno-unused-packages
- -Wno-implicit-prelude
- -Wno-missing-safe-haskell-mode
- -Wno-missing-export-lists
- -Wno-partial-fields
- -Wcompat
- -Werror=incomplete-record-updates
- -Werror=incomplete-patterns
- -Werror=incomplete-uni-patterns
- -Werror=missing-methods
- -Werror=tabs
- -Wredundant-constraints
- -Wincomplete-record-updates
- -Wunused-type-patterns
- -O2
default-extensions:
- StrictData
+5 -3
View File
@@ -559,11 +559,13 @@ In current implementation of XFTP protocol in SimpleX Chat clients don't use FAC
- perform traffic correlation attacks against senders and recipients and correlate senders and recipients within the monitored set, frustrated by the number of users on the servers.
- observe how much traffic is being sent, and make guesses as to its purpose
- observe how much traffic is being sent, and make guesses as to its purpose.
*cannot, even in case of a compromised transport protocol:*
- in case of a compromised transport protocol, correlate file senders and receivers.
- perform traffic correlation attacks with any increase in efficiency over a non-compromised transport protocol
*cannot, in case of a non-compromised transport protocol:*
- perform traffic correlation attacks.
#### XFTP server
@@ -96,7 +96,7 @@ else if write_msg = max_queue_messages:
add quota_exceeded message to write_file
update queue state: write_msg += 1
append updated queue state to queue.log
else ]
else
// It is required that `max_queue_messages < max_file_messages`,
// so that we never need more than one additional write file.
if write_msg >= max_file_messages: // queue file rotation
+49
View File
@@ -0,0 +1,49 @@
# iOS notifications delivery
## Problem
For iOS notifications to be delivered the client has to create credentials for notification subscription on SMP server using NKEY command and after that create a subscription on notification server using SNEW command. These two commands are sent in sequence, after the connections are created, and for it to happen the client needs to be online and in foreground.
iOS users tend to close the app when it is not used, and iOS has very limited permissions for background activities, so these notification subscriptions are created with a substantial delay, and notifications do not work.
This problem is distinct from and probably more common than other problems affecting notifications delivery described [here](./2024-07-06-ios-notifications.md).
## Solution
1. When the new connection is created, the client already knows if it needs to create notification subscription or not, based on the conversation setting (e.g., if the group is muted, the client will not create notification subscription as well.). We should extend NEW command to avoid the need to send additional NKEY command with an option to create notification subscription at the point where connection is created. NDEL would still be used to disable this notification, and NKEY will be used to re-enable it.
2. In the same way we stopped using SDEL command (NDEL sends notification DELD to subscribed notification server) to delete notificaiton subscriptions from notification server, we should delegate creating notification subscription on notification server to SMP servers. Clients could use keys agreed with ntf server for e2e encryption and for command authorization to encrypt and sign instruction to create notification subscription that will be forwarded to notification server using protocol similar to SMP proxies. This will avoid the need for clients to separately contact notification servers that won't happen until they are online.
3. Instead of making Ntf server trust DELD notifications, we could send deletion instructions signed by the client, which will only fail to send in case notification server is down (and they won't be sent later after server restart).
Cons:
- If SMP servers were to retain in the storage the information about which notification server is used for which queue, it would reduce metadata privacy. While currently it is not an issue, as all notification servers are known and operated by us, once there are other client apps, this can be used for app users fingerprinting, which would act as a deterrence from using new apps but only if app users use servers of operators who are different from the app provider. To mitigate it, we could only store it in server memory and include notification instruction in subscription commands (SUB) and include notification subscription status in SUB responses. We don't need to mitigate the problem of server being able to store this information, as messaging servers can observe which notification servers connect to them anyway.
- If SMP server is restarted before the subscription request is forwared to the notification server, then it will have to be forwarded again, once the client subscribes. The problem here is that if the client is offline, it will neither subscribe to the queue to send notification subscription request, nor receive notifications from this queue. Storing notification server and subscription request would mitigate that, as in this case we could send all pending requests on server start, without depending on client subscriptions.
- "Small" agent will need to support connections to ntf servers and manage workers that retry sending pending subscription requests.
- Until the client learns the public keys of notification server, it will not be able to decrypt notifications. It potentially can be mitigated by using the public key of the server returned when token is created, in this way different client keys (per-queue) will be combined with the same ntf server key (per-token).
## Implementation details
1. NEW and NKEY commands will need to be extended to include notification subscription request. As the notifier ID needs to be sent to notification server, this notifier ID will have to be client-generated and supplied as part of NEW command.
now:
```haskell
NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Command Recipient
NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Command Recipient
```
extended:
```haskell
NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Maybe NtfRequest -> Command Recipient
data NtfRequest = NtfRequest NotifierId NtfPublicAuthKey RcvNtfPublicDhKey NtfServerRequest
data NtfServerRequest = NtfServerRequest NtfServer EncSingedNtfCmd
NKEY :: NtfPublicAuthKey -> RcvNtfPublicDhKey -> Maybe NtfServerRequest -> Command Recipient
-- NotifierID is passed in entity ID field of the transmission
```
2. Notification server will need to support an additional command to receive "proxied" subscription commands, `SFWD`, that would include `NtfServerRequest`. This command can include both `SNEW` and `SDEL` commands.
+15
View File
@@ -0,0 +1,15 @@
# Expiring messages in journal storage
## Problem
The journal storage servers recently migrated to do not delete delivered or expired messages, they only update pointers to journal file lines. The messages are actually deleted when the whole journal file is deleted (when fully deleted or fully expired).
The problem is that in case the queue stops receiving the new messages then writing of messages won't switch to the new journal file, and the current journal file containing delivered or expired messages would never be deleted.
## Solution
Remove current journal file and update queue_state.log during message expiration of "idle" queue (that is, without any new messages received or delivered within 3 hours) in case when:
- the queue is "empty" after the expiration
- the queue contains only quota marker(s), in which case move them to a new journal file and update the queue_state accordingly. Quota markers can be kept indefinitely to prevent writing the new messages to the dormant queues that reached capacity, so it's important to handle this case.
Also remove current journal file when the queue is opened in case it is empty (as it would not be ever expired in case it remains empty), and also update queue_state.log
+58
View File
@@ -0,0 +1,58 @@
# Blob extensions for SMP queues 2 and queue storage
This document evolves the design proposed [here](./2024-09-09-smp-blobs.md).
## Problems
In addition to problems in the first doc, we have these issues with in-memory queue record storage:
- many queues are idle or rarely used, but they are loaded to memory, and currently just loading all queues uses 20gb RAM on each server, and takes 10 min to process, increasing downtimes during restarts.
- adding blobs to memory would make this problem much worse.
## Proposed solution
Move queues to the same journalling approach as [used for messages](./2024-09-01-smp-message-storage.md) now, with independent file names in the same folders.
Each queue change would be logged to its own file, and every time the queue is opened the whole file will be read and compacted to a single line - replacing one store log for all queues, with individual log files for each queue.
Queue deletion would not be making a record in the file, instead it would be deleting the entire folder - it would reduce retention period for any metadata of deleted queues.
We could additionally record deletions to the central log, for debugging, and reset it on every start. But in this case we should not remove folders at the point of deletion, but rather mark them as deleted and delete on restart. TBC
It would also allow simplifying blob storage by having only one blob per queue - for example, limied to 16kb (a bit smaller to fit in block) for contact address queues and 4-8kb for invitations (to fit PQ keys and conversation preferences).
We would also need to be able to lookup recipient ID via sender/notifier/link IDs.
One possible solution is to use and load to memory a central index file. But it is likely to also consume a lot of memory and result in slow starts.
Another solution that is probably better is to use the same folder structure and put notifier/sender/link files with the ID of the recipient queue inside the files. So to locate recipient queue the sender would have to locate folder containing the reference file pointing to the recipient queue and then to locate the actual queue data.
## Implementation details
Each queue folder would these files:
- queue_state.log (and timestamped backups) - to store pointers to message journals (already implemented)
- messages.randomBase64.log - message journals (already implemented)
- queue_rec.log (and timestamped backups) - to log complete queue record every time it is changed (so only the last line needs to be read following the same logic as with queue_state.log, to prevent file corruption).
- blob.data, blob.data.bak, blob.timestamp.data - files for data blobs (to make sure some copy of this file is readable/correct in case of write corruption) - the same two step overwrite process will be used as currently with store log compacting:
- on write: 1. if file exists, move it to .bak, 2. store new blob to .data, 3. move .bak to .timestamp.data
- on read: 1. if .bak exists, move it to .data 2. use .data
Additional suggestion to reduce probability of queue_state.log and queue_rec.log file corruption is to do one of the following:
- log end of lines in the beginning of the output, not in the end, to prevent the last line from being corrupted in case the previous line was not fully stored. The downside is that the file will not be EOL terminated, and there will be no confirmation that the output was fully made.
- log EOL both in the beginning and at the end of output, and ignore empty lines in between - this would both confirm that the last line is fully logged and prevent corruption of the next line in case it was not.
- check the last byte of the file and log EOL if it is not EOL. Probably cleanest approach, but with a small performance cost.
If queue folder is a reference to the queue, it may have one of these files:
- notifier.id
- sender.id
- link.id
These files would contain a one line with the recipient ID of the queue. These files would never change, they can only be deleted when queue is deleted or when notifier/link is deleted.
There is logic in code preventing using the same ID in different contexts, and the ID size is large enough to make any collisions unlikely (192 bits), so with correctly working code the queue folder would either have one of reference files, and nothing else, or the queue and message files from the beginning of this section. But even if the same ID is re-used in different context, it should not cause any problems as file names don't overlap.
While we could store different types of references in different types of folders, it would have additional costs of maintaining 4 folder hierarchies. Instead we could use the fact that it is one hierarchy to prevent using the same ID in different contexts.
## Protocol
The only change in protocol is that there will be only one blob per queue, without markers (see the previous doc). Otherwise the protocol and proposed privacy improvement seem reasonable.
+290
View File
@@ -0,0 +1,290 @@
# Protocol changes for creating and connecting to SMP queues
## Problems
This change is related to these problems:
- differentiating queue retention time,
- supporting MITM-resistant short connection links,
This RFC is based on the previous discussions about short links, blob storage and notifications ([1](./2024-06-21-short-links.md), [2](./2024-09-09-smp-blobs.md), [3](./2024-11-25-queue-blobs-2.md), [4](./2024-09-25-ios-notifications-2.md)).
SMP protocol supports two types of queues - queues to send messages (messaging queues) and queues to send invitations to connect (contact queues). While SMP protocol was originally "unaware" of these queue types, it could differentiate it by message flow, and with the recent addition of SKEY command to allow securing the queue by the sender this difference became persistent.
Simply designating queue types would allow to use this information to decide for how long to retain queues, and potentially extending it:
- unsecured 1-time invitation queues with sndSecure (support of securing by sender) - e.g., 3 months.
- contact address queues without sndSecure - e.g., 3 years without activity.
- Possibly, "queues" that prohibit messages and used only as blob storage - they would be used to store group profiles and super-peer addresses for the group.
## Design objectives
We want to achieve these objectives for short links and associated queue data:
1. no possibility to provide incorrect SenderId inside link data (e.g. from another queue).
2. link data cannot be accessed by the server unless it has the link.
3. prevent MITM attack by the server, including the server that obtained the link.
4. prevent changing of connection request by the user (to prevent MITM via break-in attack in the originating client).
5. for one-time links, prevent accessing link data by link observers who did not compromise the server.
6. allow changing the user-defined part of link data.
7. avoid changing the link when user-defined part of link data changes, while preventing MITM attack by the server on user-defined part, even if it has the link.
8. retain the quality that it is impossible to check the existence of secured queue from having any of its temporary visible IDs (sender ID and link ID in 1-time invitations) - it requires that these IDs remain server-generated (contrary to the previous RFCs).
To achieve these objectives the queue data will include fixed (immutable) and user-defined (mutable) parts.
Fixed part would include:
- full connection request (the current long link with all keys, including PQ keys). This includes SenderId that must match server response.
- public signature key to verify mutable part of link data.
Signed mutable part would include:
- any links to chat relays that should be contacted instead of this queue (not in this RFC), to allow delegating group connections and contact request connections to prevent spam, hiding online presence, etc.
- and user-defined data - user profile or group profile, chat preferences, welcome message, etc.
The link itself should include both the key and auth tag from the encryption of immutable part. Accessing one-time link data should require providing sender key and signing the command (`LKEY`).
## Solution
Current NEW and NKEY commands:
```haskell
NEW :: RcvPublicAuthKey -> RcvPublicDhKey -> Maybe BasicAuth -> SubscriptionMode -> SenderCanSecure -> Command Recipient
-- | Queue IDs and keys, returned in IDS response
data QueueIdsKeys = QIK
{ rcvId :: RecipientId,
sndId :: SenderId,
rcvPublicDhKey :: RcvPublicDhKey,
sndSecure :: SenderCanSecure
}
```
Proposed NEW command replaces SenderCanSecure with QueueMode, adds link data, and combines NKEY command:
```haskell
NEW :: NewQueueRequest -> Command Recipient
data NewQueueReq = NewQueueReq
{ rcvAuthKey :: RcvPublicAuthKey,
rcvDhKey :: RcvPublicDhKey,
auth_ :: Maybe BasicAuth,
subMode :: SubscriptionMode,
queueReqData :: Maybe QueueReqData,
}
-- QRMessaging implies that sender can secure the queue.
-- LinkId is not used with QRMessaging, to prevent the possibility of checking when connection is established by re-using the same link ID when creating another queue the creating would have to fail if it is used.
-- LinkId is required with QRContact, to have shorter link - it will be derived from the link_uri. And in this case we do not need to prevent checks that this queue exists.
data QueueReqData
= QRMessaging (Maybe (SenderId, QueueLinkData))
| QRContact (Maybe (LinkId, (SenderId, QueueLinkData)))
-- SenderId should be computed client-side as the first 24 bytes of sha3-384(correlation_id),
-- The server must verify it and reject if it is not.
-- It allows to include sender ID inside encrypted associated link data as part of full connection URI without requesting it from the server, but prevents checking if a given sender ID exists (queue creation would fail for a duplicate sender ID), as sha3-384 derivation is not reversible.
type QueueLinkData = (EncFixedLinkData, EncUserDataBytes)
type EncFixedLinkData = ByteString
type EncUserDataBytes = ByteString
-- We need to use binary encoding for ConnectionRequestUri to reduce its size
-- The clients would reject changed immutable data and
-- ConnectionRequestUri where server or SenderId of the queue do not match.
data FixedLinkData c = FixedLinkData
{ agentVRange :: VersionRangeSMPA,
rootKey :: C.PublicKeyEd25519,
connReq :: ConnectionRequestUri c
}
data ConnLinkData c where
InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
ContactLinkData ::
{ agentVRange :: VersionRangeSMPA,
-- direct connection via connReq in fixed data is allowed.
direct :: Bool,
-- additional owner keys to sign changes of mutable data.
owners :: [OwnerAuth],
-- alternative addresses of chat relays that receive requests for this contact address.
relays :: [ConnShortLink 'CMContact],
userData :: UserLinkData
} -> ConnLinkData 'CMContact
newtype UserLinkData = UserLinkData ByteString
-- | Updated queue IDs and keys, returned in IDS response
data QueueIdsKeys = QIK
{ rcvId :: RecipientId, -- server-generated
sndId :: SenderId, -- server-generated
rcvPublicDhKey :: RcvPublicDhKey,
sndSecure :: SenderCanSecure, -- possibly, can be removed? or implied?
linkId :: Maybe LinkId -- server-generated
}
```
In addition to that we add the command allowing to update and also to retrieve and secure the queue and get link data in one request, to have only one request:
```haskell
-- This command allows to set all data or to update mutable part of contact address queue.
-- This command should fail on queues that support sndSecure and also on new queues created with QRMessaging.
-- This should fail if LinkId or immutable part of data is changed with the update, but will succeed if only mutable part is updated, so it can be retried.
-- Entity ID is RecipientId.
-- The response to this command is `OK`.
LSET :: LinkId -> QueueLinkData -> Command Recipient
-- Delete should link and associated data
-- Entity ID is RecipientId
LDEL :: Command Recipient
-- To be used with 1-time links.
-- Sender's key provided on the first request prevents observers from undetectably accessing 1-time link data.
-- If queue mode is QRContact (and queue does NOT allow sndSecure) the command will fail, same as SKEY.
-- Once queue is secured, the key must be the same in subsequent requests - to allow retries in case of network failures, and to prevent passive attacks.
-- The difference with securing queues is that queues allow sending unsecured messages to queues that allow sndSecure (for backwards compatibility), and 1-time links will NOT allow retrieving link data without securing the queue at the same time, preventing undetected access by observers.
-- Entity ID is LinkId
LKEY :: SndPublicAuthKey -> Command Sender
-- If queue mode is QRMessaging the command will fail.
-- Entity ID is LinkId
LGET :: Command Sender
-- Response to LGET and LSET
-- Entity ID is the same as in the command
LNK :: SenderId -> QueueLinkData -> BrokerMsg
```
To both include sender_id into the full link before the server response, and to prevent "oracle attack" when a failure to create the queue with the supplied `sender_id` can be used as a proof of queue existence, it is proposed that `sender_id` is computed client-side as the first 24 bytes of 48 in `sha3-384(correlation_id)` and validated server-side, where `corelation_id` is the transmission correlation ID.
To allow retries, every time the command is sent a new random `correlation_id` and new `sender_id` (and for contact queue, also `link_id`, which would be random as it is derived from hash of fixed link data that includes a random signature key) should be used on each attempt, because other IDs would be generated randomly on the server, and in case the previous command succeeded on the server but failed to be communicated to the client, the retry will fail if the same ID is used.
Alternative solutions that would allow retries that were considered and rejected:
- additional request to save queue data, after `sender_id` is returned by the server. The scenarios that require short links are interactive - creating user addresses and 1-time invitations - so making two requests instead of one would make the UX worse.
- include empty sender_id in the immutable data and have it replaced by the accepting party with `sender_id` received in `LINK` response - both a weird design, and might create possibility for some attacks via server, especially for contact addresses.
- making NEW commands idempotent. Doing it would require generating all IDs client-side, not only `sender_id`. It increases complexity, and it is not really necessary as the only scenarios when retries are needed are async NEW commands, that do not require short links. For future short links of chat relays the retries are much less likely, as chat relays will have good network connections.
## Algorithm to prepare and to interpret queue link data.
For contact addresses this approach follows the design proposed in [Short links](./2024-06-21-short-links.md) RFC - when link id is derived from the same random binary as key. For 1-time invitations link ID is independent and server-generated, to prevent existence checks (oracle attack).
This scheme results in 32 byte binary size for contact addresses and 56 bytes for 1-time invitation links.
For fixed link data.
1. Generate random `nonce` (also used as a correlation ID for server command) and signature key (public `rootKey` included in fixed data).
2. Compute sender ID from `nonce` as the first 24 bytes of sha3-384 of `nonce`.
3. Generate other keys for queue address, including queue e2e encryption keys and double ratchet connection e2e encryption keys.
4. Construct the full connection address to be included in fixed data.
5. `link_key = SHA3-256(fixed_data)` - used as part of the link, and to derive the key to encrypt content.
6. HKDF:
1) contact address: `(link_id, key) = HKDF(link_key, 56 bytes)`.
2) 1-time invitation: `key = HKDF(link_key, 32 bytes)`, `link-id` - server-generated.
7. Encrypt: `(ct1, tag1) = secret_box(fixed_data, key, nonce1)`, where `nonce1` is a random nonce
5. Store: `(nonce1, ct1, tag1)` stored as fixed link data.
For mutable user data:
1. Random `nonce2` and the same key are used.
2. Sign `user_data` with key included in `fixed_data`.
3. Encrypt: `(ct2, tag2) = secret_box(signed_used_data, key, nonce2)`.
4. Store: `(nonce2, ct2, tag2)`
Link recipient:
1. Receives `link_key` in the link, for 1-time invitations also `link_id`.
2. HKDF:
1) contact address: `(link_id, key) = HKDF(link_key, 56 bytes)`.
2) 1-time invitation: `key = HKDF(link_key, 32 bytes)`.
3. Retrieves via `link_id`: `(nonce1, ct1, tag1)` and `(nonce2, ct2, tag2)`:
1) contact address: `LGET` command, that allows retrieving link data multiple times.
2) 1-time invitation: `LKEY` command, that non-optionally secures the queue, and only allows repeated link data retrievals if the same sender's key is provided and signs the transmission. This prevents link data retrieval by link observers.
4. Decrypt: `(signature1, fixed_data) = decrypt (nonce1, ct1, tag1)`.
5. Verify: `SHA3-256(fixed_data) == link_key`, abort if not.
6. Decrypt: `(signature2, used_data) = decrypt(nonce2, ct2, tag2)`.
7. Verify signatures using key in the fixed data, abort if they don't match.
While using content hash as encryption key is unconventional, it is not completely unusual - e.g., it is used in convergent encryption (although in our case using random nonce makes it not convergent, but other use cases suggest that this approach preserves encryption security). It is particularly acceptable for our use case, as `fixed_data` contains mostly random keys.
## Threat model
**Compromised SMP server**
can:
- delete link data.
- hide link data selectively for some or for all requests.
cannot:
- undetectably replace link data, even if it has the link (objective 3).
- access unencrypted link data, whether it was or was not accessed by the accepting party, provided it has no link (objective 2).
- observe IP addresses of the users accessing link data, if private routing is used.
**Passive observer who observed short link**:
can:
- access original unencrypted link data for contact address links.
cannot:
- undetectably access observed 1-time link data, accessing the link would make the link inaccessible to the sender (objective 5).
- undetectably check the existence of messaging queue or 1-time link (objective 8).
- replace or delete the link data.
**Queue owner who did not compromise the server**:
cannot:
- redirect connecting user to another queue, on the same or on another server (objective 1).
- replace connection request in the link (objective 4).
## Correlation of design objectives with design elements
1. The presence of `SenderId` in `LNK` response from the server.
2. Encryption of link data with crypto_box.
3. Deriving encryption key from the hash of fixed data prevents it being modified by the server - any change would be detected and rejected by the client, as the hash of fixed data won't match the link. Signature verification with the key from fixed data, and signing of mutable data prevents server modification of mutable data.
4. No server command to change fixed data once it's set. Also, changing fixed data would require changing the link.
5. 1-time link data can only be accessed with `LKEY` command, that while allows retries to mitigate network failures, will require the same key for retries.
6. `LSET` command.
7. The link is derived from fixed data only, so it does not change when mutable link data changes. Mutable part is signed preventing server MITM attacks.
8. SenderId is derived from request correlation ID, so it cannot be arbitrary defined to check existence of some known queue. LinkId for 1-time invitation is generated server-side, so it cannot be provided by the client when creating the queues to check if these IDs are used.
## Syntax for short links
The syntax:
```abnf
shortConnectionLink = uriAuthority "/" linkUri [ "?" param *( "&" param ) ]
uriAuthority = %s"https://" smpServerHost / "simplex:" ; using simplex: scheme requires including host in the parameter hostParam
smpServerHost = <hostname> ; RFC1123, RFC5891
linkUri = %s"i#" oneTimeLink / contactType "#" contactLink
contactType = %s"a" / %s"g" / %s"c" ; contact / group / channel address, respectively
oneTimeLink = <base64url(linkId)> "/" <base64url(linkKey)> ; 56 bytes / 75 base64 encoded characters
contactLink = <base64url(linkKey)> ; 32 bytes / 43 base64 encoded characters
; linkId - 192 bits/24 bytes
; linkKey - 256 bits/32 bytes
param = hostsParam / portParam / certHashParam
hostsParam = %s"h=" host *("," host) ; additional hostnames, e.g. onion
portParam = %s"p=" 1*DIGIT ; server port
certHashParam = %s"c=" <base64url(server offline certificate fingerprint)>
```
To have shorter links fingerprint and additional server hostnames do not need to be specified for pre-configured servers, even if they are disabled - they can be used from the client code. Any user defined servers will require including additional hosts and server fingerprint.
Example one-time link for preset server (104 characters):
```
https://smp12.simplex.im/i#abcdefghij0123456789abcdefghij01/23456789abcdefghij0123456789abcdefghij01234
```
Example contact link for preset server (71 characters):
```
https://smp12.simplex.im/c#abcdefghij0123456789abcdefghij0123456789abc
```
Example contact link for user-defined server (with fingerprint, but without onion hostname - 117 characters):
```
https://smp1.example.com/c#abcdefghij0123456789abcdefghij0123456789abc?c=0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU
```
Example contact link for user-defined server (with fingerprint ant onion hostname - 182 characters):
```
https://smp1.example.com/c#abcdefghij0123456789abcdefghij0123456789abc?c=0YuTwO05YJWS8rkjn9eLJDjQhFKvIYd8d4xG8X1blIU&h=beccx4yfxxbvyhqypaavemqurytl6hozr47wfc7uuecacjqdvwpw2xid.onion
```
For the links to work in the browser the servers must provide server pages.
+93
View File
@@ -0,0 +1,93 @@
# New notifications protocol
## Problem
iOS notifications have these problems:
- iOS notification service crashes exceeding memory limit. This is being addressed by changes in GHC RTS.
- there is a large number of connections, because each member in a group requires individual connection. This will improve with chat relays when each group would require 2-3 connections.
- some notification may be not shown if notification with reply/mention is skipped, and instead some other message is delivered, which may be muted. This would not improve without some changes, as notifications may be skipped anyway.
- client devices delay communication with ntf server because it is done in background, and by that time the app may be suspended.
- notification server represents a bottleneck, as it has to be owned by the app vendor, and the current design when ntf server subscribes to notifications scales very badly.
This RFC is based on the previous [RFC related to notifications](./2024-09-25-ios-notifications-2.md).
## Solution
As notification server has to know client token and currently it associates subscriptions with this token anyway, we are not gaining any privacy and security by using per-subscription keys - both authorization and encryption keys of notification subscription can be dropped.
We still need to store the list of queue IDs associated with the token on the notification server, but we do not need any per-queue keys on the notification server, and we don't need subscriptions - it's effectively a simple set of IDs, with no other information.
In this case, when queue is created the client would supply notifier ID - it has to be derived from correlation ID, to prevent existense check (see previous RFC). As we also supply sender ID, instead of deriving it as sha3-192 of correlation ID, they both can be derived as sha3-384 and split to two IDs - 24 bytes each.
The notification server will maintain a rotating list of server keys with the latest key communicated to the client every time the token is registered and checked. The keys would expire after, say, 1 week or 1 month, and removed from notification server on expiration.
The packet containing association between notifier queue ID and token will be crypto_box encrypted using key agreement between identified notification server master key and an ephemeral per packet (effectively, per-queue) client-key.
Deleting the queue may also include encrypted packet that would verify that the client deleted the queue.
Instead of notification server subscribing to the notifications creating a lot of traffic for the queues without messages, the SMP server would push notifications via NTF server connection (whether via NTF or via SMP protocol). This could be used as a mechanism to migrate existing queues when with the next subscription the notification server would communicate it's address to SMP server and this association would be stored together with the queue.
## Protocol design
Additional/changed SMP commands:
```haskell
-- register notification server
-- should be signed with server key
NSRV :: NtfServerCreds -> Command NtfServer
-- response
NSID :: NtfServerId -> BrokerMsg
-- to communicate which server is responsible for the queue
-- should be signed with queue key
NSUB :: Maybe NtfServerId -> Command Notifier
-- subscribe to notificaions from all queues associated with the server
-- should be signed with server key
-- entity ID - NtfServerId
NSSUB :: Command NtfServer
data NtfServerCreds = NtfServerCreds
{ server :: NtfServer,
-- NTF server certificate chain that should match fingerpring in address
cert :: X.CertificateChain,
-- server autorizatio key to sign server subscription requests
authKey :: X.SignedExact X.PubKey
}
-- entity ID is recipient ID
NSKEY :: NtfSubscription -> Command Recipient
data NtfSubscription = NtfSubscription
-- key to encrypt notifications e2e with the client
{ ntfPubDbKey :: RcvNtfPublicDhKey,
ntfServer :: NtfServer,
-- should be linked to correlation ID to prevent existense check
-- the ID sent to notification server could be its hash?
ntfId :: NotifierId,
encNtfTokenAssoc :: EncDataBytes
}
-- before the encryption - equivalent to NSUB command, but without key to authorize requests to specific queue
data NtfTokenAssoc = NtfTokenAssoc
{ signature :: SignatureEd25519,
tknId :: NtfTokenId,
ntfQueue :: SMPQueueNtf
}
```
SMP server will need to maintain the list of Ntf servers and their credentials, and when NSSUB arrives to make only one subscription. When message arrives it would deliver notification to the correct connection via queue / ntf server association.
Ntf server needs to maintain three indices to the same data:
- `(smpServer, queueId) -> tokenId` - to deliver notification to the correct token
- `tokenId -> [smpServer -> [queueId]]` - to remove all queues when token is removed, and to store/update these associations effficiently - store log may have one compact line per token (after compacting), or per token/server combination.
- `[smpServer]` - array of SMP servers to subscribe to.
## Mention notifications
Currently we are marking messages with T (true) for messages that require notifications and F (false) for messages that don't require. Sender does not know whether the recipient has notifications disabled, enabled or in mentions-only mode.
The proposal is to:
- add additional values to this metadata, e.g. 2 (priority) and 3 (high priority) (and T/F could be sent as 0/1 respectively) - that is, to deliver notifications even if notifications are generally disabled (they can still be further filtered by the client).
- instead of deleting notification credentials when notifications are disabled - which is costly - communicate to SMP server the change of notificaion priority level, e.g. the client could set minimal notification priority to deliver notifications, where 0 would mean disabling it completely, 1 enable for all, 2 for priority 2+, 3 for priority 3. The downside here is that it could be used for timing correlation of queues in the group, but it already can be used on bulk deletions of ntf credentials for these queues and when sending messages.
+159
View File
@@ -0,0 +1,159 @@
# Using short links as group links
## Problem
To use the short links for groups these problems has to be / can be solved:
1. recognizing link as a group link.
2. permanent link with the ability to change chat relays.
3. binding owners signatures to the link.
4. allowing to add/remove owners, both to share ownership and for reliability in case of one owner losing keys/access.
While current short links solve problems 1-3 (via contact type, and via extension of user data in the link), the problem 4 is solved only partially.
We could include the current list of root owners in the user data, and we could send any history of ownership changes from this baseline as a short blockchain on joining the group, we still requrie one master owner to retain access to the queue associated with the group.
## Possible solution approaches
1. "Kick this can down the road" - ignore this problem until there is a namespace, and a group name can be associated with multiple queues.
Pros: simple and reasonable, and it suggests postponing multisig for owners too. The users can still see the list of owners and their keys in user data of the link, and receive admin roster signed by owners on joining.
Cons: if this "master owner" loses the access to the device, no further changes to group profile will be possible.
2. The queue access can be shared by sharing the key and recipient IDs with all owners.
The problems:
- preventing MITM attack between owners (this protect exists for other solutions too).
- protecting these credentials from chat relays. So somehow there should be direct key agreement between members allowing to send e2e encrypted message inaccessible to chat relays.
Pros: simpler than alternatives, and still provides protection against losing the key.
Cons:
- quite clunky, and requires the new primitive anyway (e2e encryption).
- no multisig
This could possibly be evolved into the requirement to have a direct connection with other owners, and verifying the security code before they have access to group.
3. Allow "joint management" of SMP queues.
SMP servers can support multiple recipients for contact queues:\
- subscription would be possible to the "subscriber recipient".
- all other changes (update data, change subscriber recipient, add or remove recipients) would require multiple recipient signatures on SMP command in line with n-of-m multisig rules, that the command sender would have to collect out-of-band (from SMP protocol point of view).
Pros: allows joint ownership, and protects from losing access to master owner device.
Cons:
- complicates queue abstraction with approach that is not needed for most queues.
- still retains the server as a single point of failure.
4. Introduce "group" as a new type of entity managed by SMP servers.
SMP servers would provide a separate set of commands for managing group records that would include in an encrypted container:
- the group profile
- the list of chat relay links
- the list of owner member IDs with their public keys
- multisig rules
- alternative group entity locations
- possibly, a globally unique group identity (as the hash of the initial/seed group data).
While the server domain would be used as the hostname in group link, it may contain alternative hosts (not just hostnames of the same server), both in the link and in the group record data.
Pros: separates additional complexity to where it is needed, allowing reliability and redundancy for group ownership.
Cons: complexity, coupling between SMP and chat protocol.
## Design for channel/group as a separate queue mode
Option 1.
A queue mode "channel" when owners are represented by their individual queues (either a separate mode, or a submode of "channel", or just normal contact address queues). In this case sending message to channel queue would broadcast message to queue owners, without exposing even the number of owners.
Pros:
- allows chat relays to send messages to all owners (e.g., channel can be secured with the list of snd keys, one per relay).
- quite easy to evolve from the current design.
- extensible.
Cons:
- close to "solution in search of a problem".
- does not require data model changes - channel queue would simply have a list of owner "recipient IDs", and each owner queue would also point to channel.
Option 2.
Also a separate queue mode "channel", but instead of having a linked owner queues, it would simply maintain a list of owner keys to maintain the data. In this case, messages cannot be sent to this "queue" at all.
Pros:
- simpler design.
- we could allow sending messages to it too, with the "main" owner receiving them. This could be negotiated in the protocol.
- it may be easier to migrate the current groups, as the admin link would be this queue (although for public groups in directory it would have to be recreated anyway).
- Possibly, when queue is created there should be a flag whether it should accept unsigned messages - then contact addresses would be created with unsigned messages ON, messages queues, once SKEY is universally supported, with unsigned messages OFF, and channel queues with unsigned messages OFF too for new public queues.
Cons:
- if no messages are accepted, this is not even a queue.
- no way to directly contact owners (maybe it is not a downside, as for relays there would be a communication channel anyway as part of the group).
Option 2 looks more simple and attractive, implementing server broadcast for SMP seems unnecessary, as while it could have been used for simple groups, it does not solve such problems as spam and pre-moderation anyway - it requires a higher level protocol.
The command to update owner keys would be `RKEY` with the list of keys, and we can make `NEW` accept multiple keys too, although the use case here is less clear.
## Multiple owners managing queue data.
Option 1: Use the same keys in SMP as when signing queue data.
Option 2: Use different keys.
The value here could be that the server could validate these signatures too, and also maintain the chain of key changes. While tempting, it is probably unnecessary, and this chain of ownership is better to be maintained on chat relay level, as there are no size constraints on the size of this chain. Also, it is better for metadata privacy to not couple transport and chat protocol keys.
We still need to bind the mutable data updates to the "genesis" signature key (the one included in the immutable data).
The proposed design:
- when mutable data is signed by genesis key, then it is bound, and no changes is needed.
- mutable data may be signed by the key of the new owner, in which case mutable part itself must contain the binding. We could also use ring signature to sign the mutable data, concealing which owner signed the data - that would increase the signature size from 64 bytes to `32 * (n + 1)` bytes.
Current mutable data:
```haskell
data UserLinkData = UserLinkData
{ agentVRange :: VersionRangeSMPA,
userData :: ConnInfo
}
```
Proposed mutable data:
```haskell
data UserLinkData = UserLinkData
{ agentVRange :: VersionRangeSMPA,
owners :: [OwnerInfo]
userData :: ConnInfo
}
type OwnerId = ByteString
data OwnerInfo = OwnerInfo
{ ownerId :: OwnerId, -- unique in the list, application specific - e.g., MemberId
ownerKey :: PublicKeyEd25519,
-- owner signature of sender ID,
-- confirms that the owner agreed with being the owner,
-- prevents a member being added as an owner without consent.
ownerSig :: SignatureEd25519,
-- owner authorization, sig(ownerId || ownerKey, prevKey), where prevKey is either a "genesis key" or some other key previously signed by the genesis key.
authOwnerId :: OwnerId, -- null for "genesis"
authOwnerSig :: SignatureEd25519
}
```
The size of the OwnerInfo record encoding is:
- ownerId: 1 + 12
- ownerKey: 1 + 32
- ownerSig: 1 + 64
- ownerAuthId: 1 + 12
- ownerAuthSig: 1 + 64
~189 bytes, so we should practically limit the number of owners to say 8 - 1 original + 7 addiitonal. Original creator could use a different key as a "genesis" key, to conceal creator identity from other members, and it needs to include the record with memberId anyway.
The structure is simplified, and it does not allow arbitrary ownership changes. Its purpose is not to comprehensively manage ownership changes - while it is possible with a generic blockchain, it seems not appropriate at this stage, - but rather to ensure access continuity and that the server cannot modify the data (although nothing prevents the server from removing the data completely or from serving the previous version of the data).
For example it would only allow any given owner to remove subsequenty added owners, preserving the group link and identity, but it won't allow removing owners that signed this owner authorization. So owners are not equal, with the creator having the highest rank and being able to remove all additional owners, and owners authorise by creator can remove all other owners but themselves and creator, and so on - they have to maintain the chain that authorized themselves, at least. We could explicitely include owner rank into OwnerInfo, or we could require that they are sorted by rank, or the rank can be simply derived from signatures.
When additional owners want to be added to the group, they would have to provide any of the current owners:
- the key for SMP commands authorization - this will be passed to SMP server together with other keys. There could be either RKEY to pass all keys (some risk to miss some, or of race conditions), or RADD/RGET/RDEL to add and remove recipient keys, which has no risk of race conditions.
- the signature of the immutable data by their member key included in their profile.
- the current owner would then include their member key into the queue data, and update it with LSET command. In any case there should be some simple consensus protocol between owners for owner changes, and it has to be maintained as a blockchain by owners and by chat relays, as otherwise it may lead to race conditions with LSET command.
Potentially, there could be one command to update keys and link data, so that they are consistent.
+142
View File
@@ -0,0 +1,142 @@
# Service certificates for high volume servers and services connecting to SMP servers
## Problem
The absense of user and client identification benefits privacy, but it requires separately authorizing subscription for each messaging queue, that doesn't scale when a high volume server or service acts as a client for SMP server even for the current traffic and network size.
These servers/services include:
- operators' chat relays (aka super-peers),
- notification servers,
- high-traffic service chat bots,
- high-traffic business support clients.
The future chat relays would reduce the number of subscriptions required for the usual clients, by replacing connections with each group member to 1-3 connections with chat relays per group/community, it would shift the burden to the chat relays, that are also clients.
Self-hosted chat relays may want to retain privacy, so they will not use client certificates, but this privacy is not needed (and counter-productive) for the chat relays provided by network operators.
Even today, directory service subscribing to all queues may take 15-20 minutes, which is experienced as downtime by the end users.
Notification servers also acting as clients to messaging servers also take 15-20 minutes to subscribe to all notifications, during which time notifications are not delivered.
Not only these subscription take a lot of time, they also consume a large amount of memory both in the clients and in the servers, as association between clients and queues is currently session-scoped and not persisted anywhere (and it should not be, because end-users' clients do need privacy).
## Solution
High volume "clients" (operators' chat relays, directory service, SimpleX Chat team support client, SimpleX Status bot, etc.) that don't need privacy will identify themselves to the messaging servers at a point of connection by providing client sertificate, both in TLS handshake and in SMP handshake (the same certificate must be provided).
All the new queues and subscriptions made in this session will be creating a permanent association of the messaging queue with the client, and on subsequent reconnections the client can "subscribe" to all their queues with a single client subscription command.
This will save a lot of time subscribing and resubscribing on server and client restarts, servers' bandwidth, servers' traffic spikes, and memory of both clients and servers.
## Protocol
An ephemeral per-session signature key signed by long-term client certificate is used for client authorization this session signature key will be passed in SMP handshake.
To transition existing queues, the subscription command will have to be double-signed - by the queue key, and then by client key.
When server receives such "hand-over" subscription it would create a permanent association between the client certificate and the queue, and on subsequent re-connections the client can subscribe to all the existing queues still associated with the client with one command.
The server will respond to the client with the number of queues it was subscribed to - it would both inform the client that it has to re-connect in case of interruption, and can be used for client and server statistics.
When client creates a new queue, it would also sign the request with both keys, per-queue and client's. Other queue operations (e.g., deletion, or changing associated queue data for short links) would still require two signatures, both the queue key and the client key.
The open question is whether there is any value in allowing to remove the association between the client and the queue. Probably not, as threat model should assume that the server would retain this information, and the use-case for users controlling their servers is narrow.
## Protocol connection handshake
Currently, the types for handshakes are:
```haskell
data ServerHandshake = ServerHandshake
{ smpVersionRange :: VersionRangeSMP,
sessionId :: SessionId,
-- pub key to agree shared secrets for command authorization and entity ID encryption.
-- todo C.PublicKeyX25519
authPubKey :: Maybe (X.CertificateChain, X.SignedExact X.PubKey)
}
data ClientHandshake = ClientHandshake
{ -- | agreed SMP server protocol version
smpVersion :: VersionSMP,
-- | server identity - CA certificate fingerprint
keyHash :: C.KeyHash,
-- | pub key to agree shared secret for entity ID encryption, shared secret for command authorization is agreed using per-queue keys.
authPubKey :: Maybe C.PublicKeyX25519,
-- | Whether connecting client is a proxy server (send from SMP v12).
-- This property, if True, disables additional transport encrytion inside TLS.
-- (Proxy server connection already has additional encryption, so this layer is not needed there).
proxyServer :: Bool
}
```
`ServerHandshake` already contains `authPubKey` with the server certificate chain and the signed key for connection encryption and creating a shared secret for denable authorization (with client entity key) and session encryption layer.
`ClientHandshake` contains only ephemeral `authPubKey` to compute a shared secret for session encryption layer, so we need an additional field for an optional client certificate:
```haskell
serviceCertKey :: Maybe (X.CertificateChain, X.SignedExact X.PubKey)
```
Certificate here defines client identity. The actual key to be used to sign commands is session-scoped, and is signed by the certificate key. In case of notification server it MUST be the same certificate that is used for server TLS connections.
For operators' clients we may optionally include operators' certificate in the chain, and that would allow servers to identify operators if either wants to. This would improve end-user security, as not only the server would validate that its certificate matches the address, but it would also validate that it is operated by SimpleX Chat or by Flux, preventing any server impersonation (e.g., via DNS manipulations) - the client could then report that the files are hosted on SimpleX Chat servers, but then can stop and show additional warning in case certificate does not match the domain - same as the browsers do with CA stores in the client.
## Protocol transmissions
Each transport block can contain one or several protocol transmissions.
Each transmission has this structure:
```abnf
transmission = authenticator authorized
; authenticator - Ed25519 signature for recipients or X25519 authenticator for senders, to provide repudiation.
; authenticator authorizes the rest of the transmission.
authorized = sessId corrId entityId command.
; sessId is tls-unique channel binding, its presense in the transmission prevents replay attacks.
```
The proposed change would replace authenticator with exactly one or two authenticators, where the first one will remain resource-level authorization (queue key), and the optional second one will be client authorization with the client key.
```abnf
authenticator = queue_authenticator ("0" / "1" service_authenticator)
; "0" and "1" characters (digit characters, not x00 or x01) are conventionally used for Maybe types in the protocol.
```
In case service_authenticator is present, queue_authenticator should authorize over `fingerprint authorized` (concatenation of service identity certificate fingerprint and the rest of the transmission).
All queues created with client key will have to be double-authorized with both the queue key and the client key - both the client and the server would have to maintain this knowledge, whether the queue is associated with the client or not.
Asymmetric retries have to be supported - the first request creating this association may succeed on the server and timeout on the client.
## Subscription
To subscribe to all associated queues the client has to send a single command authorized with the client key passed in handshake.
The command and response:
```haskell
SUBS :: Command Recipient -- to enable all client subscriptions, empty entity ID in the transmission, signed by client key - it must be the same as was used in handover subscription signature.
NSUBS :: Command Recipient -- notification subscription
SOK :: Maybe ServiceId -- new subscription response
SOKS :: Int64 -> BrokerMsg -- response from the server, includes the number of subscribed queues
ENDS :: Int64 -> BrokerMsg -- when another session subscribes with the same certificate
```
Open questions:
- What should used as an entity ID for `SUBS` transmission - certificate fingerprint or an empty string?
- Should there be a command to get the list of all associated queues? It is likely to be useful for debugging?
- What should happen when `SUB` is sent for a single already associated queue? What if it is signed with the correct session key, but that is different from existing association? The current approach is that once associated, this associaiton would require authorization for single subscriptions, with the same certificate as already associated.
## Ephemeral client-session association
This was considered to reduce costs for the usual clients to re-subscribe. Currently it's a big problem, because of groups, and with transition to chat relays it won't be.
For some very busy end-user clients it may help.
Given that server has access to an ephemeral association between recipient client session and queues anyway (even with clients connecting via Tor, unless per-connection transport isolation is used), introducing `sessionPubKey` to allow resubscription to the previously subscribed queues may reduce the traffic. This won't change threat model as the server would only keep this association in memory, and not persist it. Clients on another hand may safely persist this association for fast resubscription on client restarts.
This is not planned for the forseable future, as migrating to chat relays would solve most of the problem.
Assuming an average active user has 20 contacts and 20 groups, and they would need ~3 subscriptions for each (for redundancy), so about 120 subscription to reconnect. The single 16kb transport block allows to send ~136 subscriptions. Which means that ephemeral sessions would create no value for clients at all, unless they are super active.
Further, improving transport efficiency for super-active non-identified clients may help network abuse, so ephemeral sessions may have negative value.
+104
View File
@@ -0,0 +1,104 @@
# Using the same profile from multiple devices
## Problem
Double Ratchet algorithm makes it hard to send/receive messages sent to the user from different devices, as each message changes the state of Double Ratchet keys, and these state changes must be strictly sequential and they cannot be reversed (although skipping is possible).
Traditional approach for multi-device converts each direct conversation into a group, where each device participates as a member. Likewise, for group conversations each device also participates as a member. While these members *look* as if they are the same user to others, a very simple client app modification may show device ID for each message, and the communication peers, both in direct chats and in groups would know how many devices a user has and which device the user sent the message from. In addition to that, with this approach communication peers can send different messages to different devices (it can be prevented by provider who would request that only message key is encrypted with DR, while the encrypted message is the same) or withheld from some devices (it cannot be prevented by provider, as it cannot add key to the communication in case it is missing, and cannot withhold the message completely too). These opens various vectors for targeted attacks, e.g.:
- tracking movements of the user: once each devices is identified as "desk" and "phone" it would allow to know where the user is at a given time.
- manipulating information by sending messages to one device (to have proof it was sent) and withholding from others, or sending different messages if the protocol allows it.
In addition to that, the specific implementation of this approach in Signal compromises break-in recovery property (aka post-compromise security) of Double-Ratchet algorithm, making its design ineffective - the only reason to have the second ratchet in DR algorithm is to provide break-in recovery, without it a much simpler design with a single ratchet is sufficient. See [this paper](https://eprint.iacr.org/2021/626.pdf) for details.
While this limitation can be addressed with notifications when a new device is added and per-device keys, we still find the remaining attack vectors on user security and privacy to be unacceptable, and opening unsuspecting users to various criminal actions - and it is wrong to say that would only affect security conscious users, and most people would not be affected by these risks. Allowing potential criminals in groups to know which device you are currently using is a real risk for all users.
Another approach was offered by Threema that is ["mediator" server](https://threema.com/en/blog/md-architectural-overview) where the state of encryption ratchets is stored server-side. While it protects the user from their communication peers, it increases required level of trust to the servers, and in case of SimpleX network it would expose the knowledge of who communicates to whom. So while the idea of server-side storage of encryption state is promising, it has to be per-connection, to retain "no-accounts" property of SimpleX messaging network.
Also see [FAQ](https://simplex.chat/faq/#why-cant-i-use-the-same-profile-on-different-devices) and [this issue](https://github.com/simplex-chat/simplex-chat/issues/444#issuecomment-3066968358).
## Proposed solution
One of the ideas presented in FAQ - to store the state of Double Ratchet algorithm in the encrypted container on the server seems promising. The RFC develops this idea.
### Considerations for the design
1. The largest ratchet state size with the current implementation is less than 8kb (which is achieved when both sides shared PQ keys and ciphertexts), so while it cannot fit in the same transport blocks together with sent and received messages, it would fit in one transport block.
2. Protocol commands and events may be changed (even if at the cost of slightly reducing message size) can fit the hash of the ratchet state (32 bytes sha256 would be sufficient), so that the client can determine whether it has the most recent ratchet state or if it needs to retrieve the latest copy. Message size reduction won't affect the users because we use compression, and there is a substantial reserve.
3. Client commands that modify ratchet state would include the hash of the previous ratchet state so that the server can reject or ignore the command in case the previous ratchet state is different or in case command is repeated in case of lost response).
4. The client does not need to retrieve message state for each encryption and decryption operation - it can "speculatively" use the ratchet state it has, and receive correct ratchet state in the "error" response after attempting encryption based on incorrect ratchet state.
## Proposed protocol design
Ratchet state will be stored on the same server that stores message queue, as part of message queue record. 8kb is a sufficient size for this blob (the actual max size is 7800 bytes). The server would also store the hashes of the current and, possibly, the previous ratchet states (TBC).
While ratchet is used for duplex connection, the connection still has primary queue, and with redundancy the same ratchet state can be stored on all secondary queues.
Ratchet state will be encrypted using secret_box - a symmetric encryption scheme, so PQ-resistant. If ratchet state is stored on more than one server, it has to be encrypted with a different key for each server.
Questions: how to rotate the key used to store ratchet? Should key used to encrypt ratchet rotate at the same time when queue is rotated? The latter is a logical option, as it prevents additional complexity and solves the problem anyway. A possible option is to have "ratchet version" that will be used to advance the key used to encrypt ratchet via HKDF.
Security considerations: the scheme may reduce break-in recovery to the points queues are rotated, unless there is some randomness mixed-in into the key derivation (the key used to encrypt ratchet state). But including randomness would defeat the purpose, as other devices wouldn't be able to access the ratchets. Another approach would be to have each device use its own key for encryption, and encrypt to all keys of all devices (or to encrypt key, to avoid size increase). Having multiple encryptions would show how many devices use the queue, but servers already can observe it, so it is a better tradeoff. Another idea would be to rotate the key used to authorize queue commands - we already support multiple recipient keys, and it can be used for multi-device scenario. That would partially mitigate break-in attacks as the attacker who obtained the key from ratchet state would be able to decrypt it, but won't be able to decrypt it (the attacker collusion with the server is not mitigated). Yet another idea would be for each party (device) to share its private (or encapsulation) key and to have a symmetric key (used to encrypt the ratchet state) encrypted (encapsulated) separately for each device. This would reduce the size of the stored data to `ratchet size` + `encrypted key size` * N, so even in case of PQ encryption (e.g. sntrup) the size required to store the ratchet would be under transport block size, while limiting it to say 4-8 devices, which is sufficient.
To participate in multi-device scheme the devices would join the usual group that will be used to share public (encapsulation) device keys and to communicate updates to conversations that were received by the currently "active" device. "Active" means the device that received or sent and processed the message, and while only one device can receive messages from a given queue, device "active" state may be determined per queue, allowing concurrent usage.
The scheme must be resilient to state updates being lost, and in case of direct messages it would result in some messages not being shown (or shown as skipped), while conversation preference and profile updates can be re-requested from peers, while the current profile of the user would become the latest. Likewise, for groups state updates ca be requested from super-peers or for decentralized groups - from owners. Maintaining chat state consistency is an important consideration, but is not a focus of this RFC - the focus is managing message delivery and DR encryption for multiple devices. Other multi-device schemes have the same issues with state consistency. Partially, the profile state consistency can be improved by using a single shared queue (or set of queues) to store user's profile and chat preferences to synchronize profile updates asynchronously between the devices.
## The protocol to send the message
`rsi` - ratchet state on device `i`.
`enc(rs)` - current authoritative ratchet state on the server.
`pt` and `ct` - plaintext and ciphertext messages.
Encryption is a state transition function ratchetEnc: `(ct, rs') = ratchetEnc(pt, rs)`.
1. Device encrypts the message using the stored ratchet state: `(ct, rsi') = ratchetEnc(pt, rsi)`
2. Device sends modified encrypted ratchet state and the hash of the previous encrypted state to the server that stores the queue: `RSET (hash(enc(rsi)), enc(rsi'))`.
3. If the hash of the previous state matches state stored on the server (`hash(enc(rsi)) == hash(enc(rs))`), the server updates the state and responds with `ratchet_ok` (that may include the current state or it's hash, for validation). If the hash is different, the server responds with `bad_ratchet(enc(rs))` message that includes the correct ratchet state. These updates must be atomic. In this case device has to update the local ratchet state (provided it can decrypt it), and repeat encryption attempt. If device cannot decrypt the provided ratchet state, it means that the connection is disrupted (possibly, device is removed from device group, but missed the notifications).
4. After successful state update in primary receiving queue, the device would update it in secondary receiving queues.
5. Device sends encrypted message as usual, via proxy that must be different both from the server that stores the ratchet and from the destination server.
6. Device broadcasts sent message and new ratchet state to other devices in the device group.
This protocol is simple, and it minimizes requests when sending the message to one additional request to update ratchet state in most cases, only requiring two requests when device state was not updated via device group prior to message sending attempt.
## The protocol to receive the message
Decryption is also a state transition function: `(pt, rs') = ratchetDec(ct, rs)`
1. Server sends the message to the device (can be in response to SUB or ACK commands, or with active subscription). Pushed message would include the hash of the currently stored ratchet state: `hash(enc(rs))`.
2. If device has the ratchet state with the same hash (`hash(enc(rs)) == hash(enc(rsi))`), it decrypts the message: `(pt, rsi') = ratchetDec(ct, rsi)`.
3. If device has ratchet state with a different hash, it requests ratchet from the server with additional protocol command `RGET` with response `RCHT (enc(rs))` and updates the local state.
4. Device decrypts the message `(pt, rsi') = ratchetDec(ct, rsi)` and processes it as usual.
5. Device sends acknowledgement to the server as usual, but now it includes the new ratchet state and the hash of the previous state: `ACK msgId (hash(enc(rsi)), enc(rsi'))`
6. The server compares ratchet state with stored state hash, and in case it matches it processes `ACK` and responds with `OK` as usual (or `NO_MSG` in case msgId is incorrect, also as usual - it would happen in repeated ACK requests). If ratchet state hash does not match, the server would respond with `bad_ratchet(enc(rs))` - which means that the message was already processed by another device and ratchet was advanced. This is a complex scenario, as the client has to either revert the change from message processing or somehow combine the change with the updates communicated via device group (as a side note, device group can simply re-broadcast messages, not state updates, but it will result in state divergence between devices when different messages are lost).
Unlike sending messages, this flow does not require any additional requests in most cases, only requiring requesting message state reconciliation when the same message was received and processed by more than one client, but it does not require re-acknowledgement.
## Challenges
This is an idea of the design rather than the actual design, as it requires more thinking about:
- how to handle concurrent ratchet state updates,
- "active" status transitions per queue,
- avoiding concurrent subscriptions to queues from multiple devices,
- state updates and synchronization between devices,
- handling skipped messages,
- costs to update ratchets in bulk send scenario - this scheme would substantially increase costs of preparing large broadcasts, and it makes this scheme not acceptable for chat relays. Which means that "profile" on desktop used as chat relay won't be synched to other devices.
- etc.
## Advantages
The communication peers won't know how many devices the user has, and which device was used to send the message. Also, the communication peers won't be able to send different messages to different user's devices, or to withhold messages from some devices.
+1 -1
View File
@@ -53,7 +53,7 @@ The session invitation contains this data:
- CA TLS certificate fingerprint of the controller - this is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements.
- Session Ed25519 public key used to verify the announcement and commands - this mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first.
- Long-term Ed25519 public key used to verify the announcement and commands - this is part of the long term controller identity.
- Session X25519 DH key and sntrup761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. These DH public key and KEM encapsulation key are always sent unencrypted. NaCL Cryptobox is used for encryption.
- Session X25519 DH key and sntrup761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. This DH public key is always sent unencrypted. NaCL Cryptobox is used for encryption.
Host device decrypts (except the first session) and validates the invitation:
- Session signature is valid.
@@ -0,0 +1,67 @@
name: SimpleX Chat - smp-server
services:
oneshot:
image: ubuntu:latest
environment:
CADDYCONF: |
${CADDY_OPTS:-}
http://{$$ADDR} {
redir https://{$$ADDR}{uri} permanent
}
{$$ADDR}:8443 {
tls {
key_type rsa4096
}
}
command: sh -c 'if [ ! -f /etc/caddy/Caddyfile ]; then printf "$${CADDYCONF}" > /etc/caddy/Caddyfile; fi'
volumes:
- ./caddy_conf:/etc/caddy
caddy:
image: caddy:latest
depends_on:
oneshot:
condition: service_completed_successfully
cap_add:
- NET_ADMIN
environment:
ADDR: ${ADDR?"Please specify the domain."}
volumes:
- ./caddy_conf:/etc/caddy
- caddy_data:/data
- caddy_config:/config
ports:
- 80:80
restart: unless-stopped
healthcheck:
test: "test -d /data/caddy/certificates/${CERT_PATH:-acme-v02.api.letsencrypt.org-directory}/${ADDR} || exit 1"
interval: 1s
retries: 60
smp-server:
image: ${SIMPLEX_IMAGE:-simplexchat/smp-server:latest}
depends_on:
caddy:
condition: service_healthy
environment:
ADDR: ${ADDR?"Please specify the domain."}
PASS: ${PASS:-}
volumes:
- ./smp_configs:/etc/opt/simplex
- ./smp_state:/var/opt/simplex
- type: volume
source: caddy_data
target: /certificates
volume:
subpath: "caddy/certificates/${CERT_PATH:-acme-v02.api.letsencrypt.org-directory}/${ADDR}"
ports:
- 443:443
- 5223:5223
restart: unless-stopped
volumes:
caddy_data:
caddy_config:
@@ -0,0 +1,15 @@
name: SimpleX Chat - smp-server
services:
smp-server:
image: ${SIMPLEX_IMAGE:-simplexchat/smp-server:latest}
environment:
WEB_MANUAL: ${WEB_MANUAL:-1}
ADDR: ${ADDR?"Please specify the domain."}
PASS: ${PASS:-}
volumes:
- ./smp_configs:/etc/opt/simplex
- ./smp_state:/var/opt/simplex
ports:
- 5223:5223
restart: unless-stopped
+11
View File
@@ -0,0 +1,11 @@
# Mandatory
ADDR=your_ip_or_addr
# Optional
#PASS='123123'
#WEB_MANUAL=1
# Debug
#SIMPLEX_SMP_IMAGE=smp-server-dev
#CERT_PATH=acme-staging-v02.api.letsencrypt.org-directory
#CADDY_OPTS='{\n acme_ca https://acme-staging-v02.api.letsencrypt.org/directory\n}'
+9
View File
@@ -0,0 +1,9 @@
# Mandatory
ADDR=your_ip_or_addr
QUOTA=120gb
# Optional
#PASS='123123'
# Debug
#SIMPLEX_XFTP_IMAGE=xftp-server-dev
+16
View File
@@ -0,0 +1,16 @@
name: SimpleX Chat - xftp-server
services:
xftp-server:
image: ${SIMPLEX_XFTP_IMAGE:-simplexchat/xftp-server:latest}
environment:
ADDR: ${ADDR?"Please specify the domain."}
QUOTA: ${QUOTA?"Please specify disk quota."}
PASS: ${PASS:-}
volumes:
- ./xftp_configs:/etc/opt/simplex-xftp
- ./xftp_state:/var/opt/simplex-xftp
- ./xftp_files:/srv/xftp
ports:
- 443:443
restart: unless-stopped
+62 -23
View File
@@ -1,48 +1,87 @@
#!/usr/bin/env sh
set -e
confd='/etc/opt/simplex'
logd='/var/opt/simplex/'
cert_path='/certificates'
# Check if server has been initialized
if [ ! -f "${confd}/smp-server.ini" ]; then
# If not, determine ip or domain
case "${ADDR}" in
'') printf 'Please specify $ADDR environment variable.\n'; exit 1 ;;
'')
printf 'Please specify $ADDR environment variable.\n'
exit 1
;;
# Determine domain or IPv6
*[a-zA-Z]*)
case "${ADDR}" in
*:*) set -- --ip "${ADDR}" ;;
*) set -- -n "${ADDR}" ;;
# IPv6
*:*)
set -- --ip "${ADDR}"
;;
# Domain
*)
case "${ADDR}" in
# It's in domain format
*.*)
# Determine the base domain
ADDR_BASE="$(printf '%s' "$ADDR" | awk -F. '{print $(NF-1)"."$NF}')"
set -- --fqdn "${ADDR}" --own-domains="${ADDR_BASE}"
;;
# Incorrect domain
*)
printf 'Incorrect $ADDR environment variable. Please specify the correct one in format: smp1.example.org / example.org \n'
exit 1
;;
esac
esac
;;
*) set -- --ip "${ADDR}" ;;
# Assume everything else is IPv4
*)
set -- --ip "${ADDR}" ;;
esac
# Optionally, set password
case "${PASS}" in
'') set -- "$@" --no-password ;;
*) set -- "$@" --password "${PASS}" ;;
# Empty value = no password
'')
set -- "$@" --no-password
;;
# Assume that everything else is a password
*)
set -- "$@" --password "${PASS}"
;;
esac
# And init certificates and configs
smp-server init -y -l "$@"
smp-server init --yes \
--store-log \
--daily-stats \
--source-code \
"$@" > /dev/null 2>&1
# Fix path to certificates
if [ -n "${WEB_MANUAL}" ]; then
sed -i -e 's|^[^#]*https: |#&|' \
-e 's|^[^#]*cert: |#&|' \
-e 's|^[^#]*key: |#&|' \
-e 's|^port:.*|port: 5223|' \
"${confd}/smp-server.ini"
else
sed -i -e "s|cert: /etc/opt/simplex/web.crt|cert: $cert_path/$ADDR.crt|" \
-e "s|key: /etc/opt/simplex/web.key|key: $cert_path/$ADDR.key|" \
"${confd}/smp-server.ini"
fi
fi
# Backup store log just in case
#
# Uses the UTC (universal) time zone and this
# format: YYYY-mm-dd'T'HH:MM:SS
# year, month, day, letter T, hour, minute, second
#
# This is the ISO 8601 format without the time zone at the end.
#
_file="${logd}/smp-server-store.log"
if [ -f "${_file}" ]; then
_backup_extension="$(date -u '+%Y-%m-%dT%H:%M:%S')"
cp -v -p "${_file}" "${_file}.${_backup_extension:-date-failed}"
unset -v _backup_extension
fi
unset -v _file
DOCKER=true /usr/local/bin/simplex-servers-stopscript smp-server
# Finally, run smp-sever. Notice that "exec" here is important:
# smp-server replaces our helper script, so that it can catch INT signal
exec smp-server start +RTS -N -RTS
+66 -26
View File
@@ -1,50 +1,90 @@
#!/usr/bin/env sh
set -eu
confd='/etc/opt/simplex-xftp'
logd='/var/opt/simplex-xftp'
# Check if server has been initialized
if [ ! -f "${confd}/file-server.ini" ]; then
# If not, determine ip or domain
case "${ADDR}" in
'') printf 'Please specify $ADDR environment variable.\n'; exit 1 ;;
'')
printf 'Please specify $ADDR environment variable.\n'
exit 1
;;
# Determine domain or IPv6
*[a-zA-Z]*)
case "${ADDR}" in
*:*) set -- --ip "${ADDR}" ;;
*) set -- -n "${ADDR}" ;;
# IPv6
*:*)
set -- --ip "${ADDR}"
;;
# Domain
*)
case "${ADDR}" in
# Check if format is correct
*.*)
set -- --fqdn "${ADDR}"
;;
# Incorrect domain
*)
printf 'Incorrect $ADDR environment variable. Please specify the correct one in format: smp1.example.org / example.org \n'
exit 1
;;
esac
;;
esac
;;
*) set -- --ip "${ADDR}" ;;
# Assume everything else is IPv4
*)
set -- --ip "${ADDR}"
;;
esac
# Set quota
# Set global disk quota
case "${QUOTA}" in
'') printf 'Please specify $QUOTA environment variable.\n'; exit 1 ;;
*GB) QUOTA="$(printf ${QUOTA} | tr '[:upper:]' '[:lower:]')"; set -- "$@" --quota "${QUOTA}" ;;
*gb) set -- "$@" --quota "${QUOTA}" ;;
*) printf 'Wrong format. Format should be: 1gb, 10gb, 100gb.\n'; exit 1 ;;
'')
printf 'Please specify $QUOTA environment variable.\n'
exit 1
;;
# Incorrect format in uppercase, but automagically workaround this, replacing characters to lowercase
*GB)
QUOTA="$(printf '%s' "${QUOTA}" | tr '[:upper:]' '[:lower:]')"
set -- "$@" --quota "${QUOTA}"
;;
# Correct format
*gb)
set -- "$@" --quota "${QUOTA}"
;;
# Incorrect format
*)
printf 'Wrong format. Format should be: 1gb, 10gb, 100gb.\n'
exit 1
;;
esac
# Init the certificates and configs
xftp-server init -l -p /srv/xftp "$@"
xftp-server init --store-log \
--path /srv/xftp \
"$@" > /dev/null 2>&1
# Optionally, set password
if [ -n "${PASS}" ]; then
sed -i -e "/^# create_password:/a create_password: $PASS" \
"${confd}/file-server.ini"
fi
fi
# Backup store log just in case
#
# Uses the UTC (universal) time zone and this
# format: YYYY-mm-dd'T'HH:MM:SS
# year, month, day, letter T, hour, minute, second
#
# This is the ISO 8601 format without the time zone at the end.
#
_file="${logd}/file-server-store.log"
if [ -f "${_file}" ]; then
_backup_extension="$(date -u '+%Y-%m-%dT%H:%M:%S')"
cp -v -p "${_file}" "${_file}.${_backup_extension:-date-failed}"
unset -v _backup_extension
fi
unset -v _file
DOCKER=true /usr/local/bin/simplex-servers-stopscript xftp-server
# Finally, run xftp-sever. Notice that "exec" here is important:
# smp-server replaces our helper script, so that it can catch INT signal
exec xftp-server start +RTS -N -RTS
+4 -2
View File
@@ -148,8 +148,10 @@ xftp_cleanup() {
main() {
type="${1:-}"
checks
if [ -z "${DOCKER+x}" ]; then
checks
fi
case "$type" in
smp-server)
+512 -157
View File
@@ -1,15 +1,8 @@
#!/usr/bin/env sh
set -eu
# Links to scripts/configs
bin="https://github.com/simplex-chat/simplexmq/releases/latest/download"
scripts="https://raw.githubusercontent.com/simplex-chat/simplexmq/stable/scripts/main"
scripts_systemd_smp="$scripts/smp-server.service"
scripts_systemd_xftp="$scripts/xftp-server.service"
scripts_update="$scripts/simplex-servers-update"
scripts_uninstall="$scripts/simplex-servers-uninstall"
scripts_stopscript="$scripts/simplex-servers-stopscript"
# Make sure that PATH variable contains /usr/local/bin
PATH="/usr/local/bin:$PATH"
# Default installation paths
path_bin="/usr/local/bin"
@@ -24,7 +17,9 @@ path_systemd_smp="$path_systemd/smp-server.service"
path_systemd_xftp="$path_systemd/xftp-server.service"
# Temporary paths
path_tmp_bin="$(mktemp -d)"
path_tmp_bin="/tmp/simplex-servers"
path_tmp_bin_smp="$path_tmp_bin/smp-server"
path_tmp_bin_xftp="$path_tmp_bin/xftp-server"
path_tmp_bin_update="$path_tmp_bin/simplex-servers-update"
path_tmp_bin_uninstall="$path_tmp_bin/simplex-servers-uninstall"
path_tmp_bin_stopscript="$path_tmp_bin/simplex-servers-stopscript"
@@ -39,189 +34,549 @@ BLU='\033[1;36m'
YLW='\033[1;33m'
RED='\033[0;31m'
NC='\033[0m'
BLD='\033[1m'
UNDRL='\033[4m'
NL='
'
# Set VER globally and only once
VER="${VER:-latest}"
# Currently, XFTP default to v0.1.0, so it doesn't make sense to check its version
os_test() {
. /etc/os-release
######################
### Misc functions ###
######################
case "$VERSION_ID" in
20.04|22.04) : ;;
24.04) VERSION_ID='22.04' ;;
*) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
esac
# Checks "sanity" of downloaded thing, e.g. if it's really a script or binary
check_sanity() {
path="$1"
criteria="$2"
version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
arch="$(uname -p)"
case "$criteria" in
string:*)
pattern="$(printf '%s' "$criteria" | awk '{print $2}')"
if grep -q "$pattern" "$path"; then
sane=0
else
sane=1
fi
;;
file:*)
pattern="$(printf '%s' "$criteria" | awk '{print $2}')"
case "$arch" in
x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
*) printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
esac
if file "$path" | grep -q "$pattern"; then
sane=0
else
sane=1
fi
;;
*) printf 'Unknown criteria.\n'; sane=1 ;;
esac
bin_smp="$bin/smp-server-ubuntu-${version}-${arch}"
bin_xftp="$bin/xftp-server-ubuntu-${version}-${arch}"
unset path string
return "$sane"
}
installed_test() {
# Checks if old thing and new thing is different
change_check() {
old="$1"
new="$2"
if [ -x "$new" ] || [ -f "$new" ]; then
type="$(file $new)"
else
type='string'
fi
case "$type" in
*script*|*text*)
if diff -q "$old" "$new" > /dev/null 2>&1; then
changed=1
else
changed=0
fi
;;
string)
if [ "$old" = "$new" ]; then
changed=1
else
changed=0
fi
;;
esac
return "$changed"
}
##########################
### Misc functions END ###
##########################
#########################
### Support functions ###
#########################
# Sets local/remote versions and "apps" variables
check_versions() {
# Sets:
# - ver
# - bin_url
# - remote_version
# - local_version
# - apps
case "$VER" in
latest)
remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest 2>/dev/null | grep -i "tag_name" | awk -F \" '{print $4}')"
if [ -z "$remote_version" ]; then
printf "${RED}Something went wrong when ${YLW}resolving the lastest version${NC}: either you don't have connection to Github or you're rate-limited.\n"
exit 1
fi
;;
*)
# Check if this version really exist
ver_check="https://github.com/simplex-chat/simplexmq/releases/tag/${VER}"
if curl -o /dev/null --proto '=https' --tlsv1.2 -sf -L "${ver_check}"; then
remote_version="${VER}"
else
printf "Provided version ${BLU}%s${NC} ${RED}doesn't exist${NC}! Switching to ${BLU}latest${NC}.\n" "${VER}"
VER='latest'
# Re-execute check
check_versions
# Everything has been done, so return from the function
return 0
fi
;;
esac
# Links to scripts/configs
bin_url="https://github.com/simplex-chat/simplexmq/releases/download/${remote_version}"
scripts_url="https://raw.githubusercontent.com/simplex-chat/simplexmq/refs/tags/${remote_version}/scripts/main"
scripts_url_systemd_smp="$scripts_url/smp-server.service"
scripts_url_systemd_xftp="$scripts_url/xftp-server.service"
scripts_url_update="$scripts_url/simplex-servers-update"
scripts_url_uninstall="$scripts_url/simplex-servers-uninstall"
scripts_url_stopscript="$scripts_url/simplex-servers-stopscript"
set +u
for i in $path_conf_etc/*; do
if [ -d "$i" ]; then
case "$i" in
*simplex) apps="smp $apps" ;;
*simplex-xftp) apps="xftp $apps" ;;
esac
for i in smp xftp; do
# Only check local directory where binaries are installed by the script
if command -v "/usr/local/bin/$i-server" >/dev/null; then
apps="$i $apps"
fi
done
set -u
}
update_scripts() {
curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_update" -o "$path_tmp_bin_update" && chmod +x "$path_tmp_bin_update"
curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_uninstall" -o "$path_tmp_bin_uninstall" && chmod +x "$path_tmp_bin_uninstall"
curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_stopscript" -o "$path_tmp_bin_stopscript" && chmod +x "$path_tmp_bin_stopscript"
if diff -q "$path_bin_uninstall" "$path_tmp_bin_uninstall" > /dev/null 2>&1; then
printf -- "- ${YLW}Uninstall script is up-to-date${NC}.\n"
rm "$path_tmp_bin_uninstall"
else
printf -- "- Updating uninstall script..."
mv "$path_tmp_bin_uninstall" "$path_bin_uninstall"
printf "${GRN}Done!${NC}\n"
if [ -z "$apps" ]; then
printf "${RED}No simplex servers installed! Aborting.${NC}\n"
exit 1
fi
if diff -q "$path_bin_stopscript" "$path_tmp_bin_stopscript" > /dev/null 2>&1; then
printf -- "- ${YLW}Stopscript script is up-to-date${NC}.\n"
rm "$path_tmp_bin_stopscript"
else
printf -- "- Updating stopscript script..."
mv "$path_tmp_bin_stopscript" "$path_bin_stopscript"
printf "${GRN}Done!${NC}\n"
fi
for server in $apps; do
# Check if info file is present
if [ -f "$path_conf_info/release" ]; then
# If present, source it
. "$path_conf_info/release" 2>/dev/null
if diff -q "$path_bin_update" "$path_tmp_bin_update" > /dev/null 2>&1; then
printf -- "- ${YLW}Update script is up-to-date${NC}.\n"
rm "$path_tmp_bin_update"
else
printf -- "- Updating update script..."
mv "$path_tmp_bin_update" "$path_bin_update"
printf "${GRN}Done!${NC}\n"
printf -- "- Re-executing Update script with latest updates..."
exec sh "$path_bin_update" "continue"
fi
}
update_systemd() {
service="${1}-server"
eval "scripts_systemd=\$scripts_systemd_${1}"
eval "path_systemd=\$path_systemd_${1}"
eval "path_tmp_systemd=\$path_tmp_systemd_${1}"
curl --proto '=https' --tlsv1.2 -sSf -L "$scripts_systemd" -o "$path_tmp_systemd"
if diff -q "$path_systemd" "$path_tmp_systemd" > /dev/null 2>&1; then
printf -- "- ${YLW}%s service is up-to-date${NC}.\n" "$service"
rm "$path_tmp_systemd"
else
printf -- "- Updating %s service..." "$service"
mv "$path_tmp_systemd" "$path_systemd"
systemctl daemon-reload
printf "${GRN}Done!${NC}\n"
fi
unset service scripts_systemd path_systemd path_tmp_systemd
}
update_bins() {
service="${1}-server"
eval "bin=\$bin_${1}"
eval "path_bin=\$path_bin_${1}"
remote_version="$(curl --proto '=https' --tlsv1.2 -sSf -L https://api.github.com/repos/simplex-chat/simplexmq/releases/latest | grep -i "tag_name" | awk -F \" '{print $4}')"
set_ver() {
local_version='unset'
sed -i -- "s/local_version_${1}=.*/local_version_${1}='${remote_version}'/" "$path_conf_info/release"
}
if [ -f "$path_conf_info/release" ]; then
. "$path_conf_info/release" 2>/dev/null
set +u
eval "local_version=\$local_version_${1}"
set -u
if [ -z "${local_version}" ]; then
set_ver "$1"
fi
else
printf 'local_version_xftp=\nlocal_version_smp=\n' > "$path_conf_info/release"
set_ver "$1"
fi
if [ "$local_version" != "$remote_version" ]; then
if systemctl is-active --quiet "$service"; then
printf -- "- Stopping %s service..." "$service"
systemctl stop "$service"
printf "${GRN}Done!${NC}\n"
printf -- "- Updating %s to %s..." "$service" "$remote_version"
curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
printf "${GRN}Done!${NC}\n"
printf -- "- Starting %s service..." "$service"
systemctl start "$service"
printf "${GRN}Done!${NC}\n"
# Check if line containing local version exists in file
if grep -q "local_version_${server}" "$path_conf_info/release"; then
# if exists, set the var
eval "local_version=\$local_version_${server}"
else
# If it doesn't, append it to file
printf "local_version_${server}=unset\n" >> "$path_conf_info/release"
# And set it in script (so we don't have to re-source the file)
eval "local_version_${server}=unset"
fi
else
printf -- "- Updating %s to %s..." "$service" "$remote_version"
curl --proto '=https' --tlsv1.2 -sSf -L "$bin" -o "$path_bin" && chmod +x "$path_bin"
printf "${GRN}Done!${NC}\n"
# If there isn't info file, populate it
printf "local_version_${server}=unset\n" >> "$path_conf_info/release"
fi
else
printf -- "- ${YLW}%s is up-to-date${NC}.\n" "$service"
fi
done
set_ver "$1"
unset service bin path_bin local_version
# Return
return 0
}
# Checks the distro and sets the urls variables
check_distro() {
. /etc/os-release
case "$VERSION_ID" in
20.04|22.04) : ;;
24.04) VERSION_ID='22.04' ;;
*) printf "${RED}Unsupported Ubuntu version!${NC}\nPlease file Github issue with request to support Ubuntu %s: https://github.com/simplex-chat/simplexmq/issues/new\n" "$VERSION_ID" && exit 1 ;;
esac
version="$(printf '%s' "$VERSION_ID" | tr '.' '_')"
arch="$(uname -p)"
case "$arch" in
x86_64) arch="$(printf '%s' "$arch" | tr '_' '-')" ;;
*) printf "${RED}Unsupported architecture!${NC}\nPlease file Github issue with request to support %s architecture: https://github.com/simplex-chat/simplexmq/issues/new" "$arch" && exit 1 ;;
esac
bin_url_smp="$bin_url/smp-server-ubuntu-${version}-${arch}"
bin_url_xftp="$bin_url/xftp-server-ubuntu-${version}-${arch}"
return 0
}
# General checks that must be performed on the initial execution of script
checks() {
if [ "$(id -u)" -ne 0 ]; then
printf "This script is intended to be run with root privileges. Please re-run script using sudo.\n"
exit 1
fi
os_test
installed_test
check_versions
check_distro
mkdir -p $path_conf_info
mkdir -p $path_conf_info $path_tmp_bin
return 0
}
main() {
checks
#############################
### Support functions END ###
#############################
set +u
if [ "$1" != "continue" ]; then
set -u
printf "Updating scripts...\n"
update_scripts
else
set -u
######################
### Main functions ###
######################
# Downloads thing to directory and checks its sanity
download_thing() {
thing="$1"
path="$2"
check_pattern="$3"
err_msg="$4"
if ! curl --proto '=https' --tlsv1.2 -sSf -L "$thing" -o "$path"; then
printf "${RED}Something went wrong when downloading ${YLW}%s${NC}: either you don't have connection to Github or you're rate-limited.\n" "$err_msg"
exit 1
fi
type="$(file "$path")"
case "$type" in
*script*|*executable*) chmod +x "$path" ;;
esac
if ! check_sanity "$path" "$check_pattern"; then
printf "${RED}Something went wrong with downloaded ${YLW}%s${NC}: file is corrupted.\n" "$err_msg"
exit 1
fi
return 0
}
# Downloads all necessary files to temp dir and set update messages for the menu
download_all() {
download_thing "$scripts_url_update" "$path_tmp_bin_update" 'string: /usr/bin/env' 'Update script'
if change_check "$path_tmp_bin_update" "$path_bin_update"; then
msg_scripts="${msg_scripts+$msg_scripts, }${YLW}simplex-servers-update${NC}"
msg_scripts_raw="${msg_scripts_raw+$msg_scripts_raw/}update"
fi
download_thing "$scripts_url_stopscript" "$path_tmp_bin_stopscript" 'string: /usr/bin/env' 'Stop script'
if change_check "$path_tmp_bin_stopscript" "$path_bin_stopscript"; then
msg_scripts="${msg_scripts+$msg_scripts, }${YLW}simplex-servers-stopscript${NC}"
msg_scripts_raw="${msg_scripts_raw+$msg_scripts_raw/}stop"
fi
download_thing "$scripts_url_uninstall" "$path_tmp_bin_uninstall" 'string: /usr/bin/env' 'Uninstall script'
if change_check "$path_tmp_bin_uninstall" "$path_bin_uninstall"; then
msg_scripts="${msg_scripts+$msg_scripts, }${YLW}simplex-servers-uninstall${NC}"
msg_scripts_raw="${msg_scripts_raw+$msg_scripts_raw/}uninstall"
fi
for i in $apps; do
service="${i}-server"
eval "scripts_url_systemd_final=\$scripts_url_systemd_${i}"
eval "path_tmp_systemd_final=\$path_tmp_systemd_${i}"
eval "path_systemd_final=\$path_systemd_${i}"
download_thing "$scripts_url_systemd_final" "$path_tmp_systemd_final" 'string: [Unit]' "$service systemd service"
if change_check "$path_tmp_systemd_final" "$path_systemd_final"; then
msg_services="${msg_services+$msg_services, }${YLW}$service.service${NC}"
msg_services_raw="${msg_services_raw+$msg_services_raw/}$service"
fi
done
for i in $apps; do
service="${i}-server"
eval "local_version=\$local_version_${i}"
if change_check "$local_version" "$remote_version"; then
msg_bins="${msg_bins+$msg_bins$NL} - ${YLW}$service${NC}: from ${BLU}$local_version${NC} to ${BLU}$remote_version${NC}"
msg_bins_alt="${msg_bins_alt+$msg_bins_alt, }${YLW}$service${NC}"
msg_bins_raw="${msg_bins_raw+$msg_bins_raw/}$service"
fi
done
return 0
}
# Updates systemd and scripts. This function depends om variables from "download_all"
update_misc() {
OLD_IFS="$IFS"
IFS='/'
for script in ${msg_scripts_raw:-}; do
case "$script" in
update)
printf -- "- Updating update script..."
mv "$path_tmp_bin_update" "$path_bin_update"
printf "${GRN}Done!${NC}\n"
printf -- "- Re-executing Update script..."
exec env UPDATE_SCRIPT_DONE=1 VER="$remote_version" "$path_bin_update" "${selection}"
;;
stop)
printf -- "- Updating stopscript script..."
mv "$path_tmp_bin_stopscript" "$path_bin_stopscript"
printf "${GRN}Done!${NC}\n"
;;
uninstall)
printf -- "- Updating uninstall script..."
mv "$path_tmp_bin_uninstall" "$path_bin_uninstall"
printf "${GRN}Done!${NC}\n"
;;
esac
done
for service in ${msg_services_raw:-}; do
app="${service%%-*}"
eval "path_systemd=\$path_systemd_${app}"
eval "path_tmp_systemd=\$path_tmp_systemd_${app}"
printf -- "- Updating %s service..." "$service"
mv "$path_tmp_systemd" "$path_systemd"
systemctl daemon-reload
printf "${GRN}Done!${NC}\n"
done
IFS="$OLD_IFS"
return 0
}
# Updates binaries. This function depends on variables from "download_all"
update_bins() {
OLD_IFS="$IFS"
IFS='/'
for service in ${msg_bins_raw:-}; do
app="${service%%-*}"
eval "local_version=\$local_version_${app}"
eval "bin_url_final=\$bin_url_${app}"
eval "path_tmp_bin_final=\$path_tmp_bin_${app}"
eval "path_bin_final=\$path_bin_${app}"
# If systemd service is active
if systemctl is-active --quiet "$service"; then
printf -- "- Stopping %s service..." "$service"
systemctl stop "$service"
printf "${GRN}Done!${NC}\n"
printf -- "- Updating ${YLW}%s${NC} from ${BLU}%s${NC} to ${BLU}%s${NC}..." "$service" "$local_version" "$remote_version"
download_thing "$bin_url_final" "$path_tmp_bin_final" 'file: ELF' "$service"
mv "$path_tmp_bin_final" "$path_bin_final"
printf "${GRN}Done!${NC}\n"
printf -- "- Starting %s service..." "$service"
systemctl start "$service"
printf "${GRN}Done!${NC}\n"
else
# If systemd service is NOT active
printf -- "- Updating ${YLW}%s${NC} from ${BLU}%s${NC} to ${BLU}%s${NC}..." "$service" "$local_version" "$remote_version"
download_thing "$bin_url_final" "$path_tmp_bin_final" 'file: ELF' "$service"
mv "$path_tmp_bin_final" "$path_bin_final"
printf "${GRN}Done!${NC}\n"
fi
# Don't forget to set version
sed -i -- "s|local_version_${app}=.*|local_version_${app}='${remote_version}'|" "$path_conf_info/release"
done
IFS="$OLD_IFS"
return 0
}
# Just download binaries
download_bins() {
OLD_IFS="$IFS"
IFS='/'
for service in ${msg_bins_raw:-}; do
app="${service%%-*}"
eval "local_version=\$local_version_${app}"
eval "bin_url_final=\$bin_url_${app}"
eval "path_tmp_bin_final=\$path_tmp_bin_${app}"
eval "path_bin_final=\$path_bin_${app}"
printf -- "- Downloading ${YLW}%s${NC} binary..." "$service"
download_thing "$bin_url_final" "$path_tmp_bin_final" 'file: ELF' "$service"
printf "${GRN}Done!${NC}\n"
done
IFS="$OLD_IFS"
return 0
}
menu_init_help() {
menu_help="Update script for SimpleX servers and scripts.${NL}${NL}"
menu_help="${menu_help}${BLD}${UNDRL}Usage:${NC} [<VARIABLE>] ${BLD}simplex-servers-update${NC}${NL} [<VARIABLE>] ${BLD}simplex-servers-update${NC} [<SUBCOMMAND>]${NL}${NL}"
menu_help="${menu_help}${BLD}${UNDRL}Subcommands:${NC}${NL}"
menu_help_sub=" ${BLD}[a]ll${NC} Update everything without confirmation${NL}"
menu_help_sub="${menu_help_sub} ${BLD}[b]inaries${NC} Update binaries only without confirmation${NL}"
menu_help_sub="${menu_help_sub} ${BLD}[d]ownload${NC} Download everything without updating${NL}"
menu_help_sub="${menu_help_sub} ${BLD}[h]elp${NC} Print this message${NL}${NL}"
menu_help="${menu_help}${menu_help_sub}"
menu_help="${menu_help}${BLD}${UNDRL}Variables:${NC}${NL}"
menu_help="${menu_help} ${BLD}VER=v3.2.1-beta.0${NC} Update binaries to specified version${NL}"
return 0
}
menu_init() {
menu_end="${RED}x${NC}) Exit${NL}${NL}Selection: "
menu_option_download="${GRN}d${NC}) Download files only${NL}"
if [ -n "${msg_scripts:-}" ]; then
menu_option_misc_raw="${menu_option_misc_raw+${menu_option_misc_raw}${NL}} - script(s): ${msg_scripts}"
fi
if [ -n "${msg_services:-}" ]; then
menu_option_misc_raw="${menu_option_misc_raw+${menu_option_misc_raw}${NL}} - systemd service file(s): ${msg_services}"
fi
menu_option_all="${GRN}a${NC}) Update all: ${BLU}(recommended)${NC}${NL}${menu_option_misc_raw+${menu_option_misc_raw}${NL}}${msg_bins+${msg_bins}${NL}}"
if [ -n "${msg_bins:-}" ]; then
menu_option_bins="${GRN}b${NC}) Update server binaries: ${msg_bins_alt}${NL}"
fi
# Abort early if there's neither update binaries, nor update scripts options
if [ -z "${menu_option_bins:-}" ] && [ -z "${menu_option_misc_raw:-}" ]; then
printf "${YLW}Everything is up-to-date${NC}.\n"
exit 0
fi
menu="${menu_option_all}${menu_option_bins:-}${menu_option_download}${menu_end}"
return 0
}
options_parse() {
selection="$1"
case "$selection" in
a|all)
check=0
if [ -z "${menu_option_misc_raw:-}" ] && [ -z "${menu_option_bins:-}" ]; then
printf "${YLW}Everything is up-to-date${NC}.\n"
else
if [ -n "${menu_option_misc_raw:-}" ]; then
update_misc
fi
if [ -n "${menu_option_bins:-}" ]; then
update_bins
fi
fi
;;
b|binaries)
check=0
if [ -n "${menu_option_bins:-}" ]; then
update_bins
else
printf "${YLW}Binaries is up-to-date${NC}.\n"
fi
;;
d|download)
check=0
if [ -n "${menu_option_bins:-}" ]; then
download_bins
fi
printf "\n${YLW}Scripts${NC}/${YLW}services${NC}/${YLW}binaries${NC} has been downloaded to ${BLU}%s${NC}\n" "$path_tmp_bin"
;;
x)
check=0
;;
*)
check=1
;;
esac
return "$check"
}
##########################
### Main functions END ###
##########################
############
### Init ###
############
main() {
# Early hook to print Done after script re-execution
if [ -n "${UPDATE_SCRIPT_DONE:-}" ]; then
printf "${GRN}Done!${NC}\n"
fi
printf "Updating systemd services...\n"
for i in $apps; do
update_systemd "$i"
done
printf "Updating simplex servers...\n"
for i in $apps; do
update_bins "$i"
done
# Early help menu
menu_init_help
rm -rf "$path_tmp_bin"
case "${1:-}" in
h|help)
printf '%b' "$menu_help"
exit 0
;;
esac
checks
download_all
menu_init
onetime=0
while true; do
if [ "$onetime" = 0 ]; then
onetime=1
if [ -n "${1:-}" ]; then
selection="$1"
else
printf '%b' "$menu"
read selection
fi
else
read selection
fi
if options_parse "$selection"; then
break
else
# Rerender whole menu if the first non-interactive option was bogus
if [ -n "${1:-}" ]; then
onetime=0
shift 1
else
# Erase last line
printf '\e[A\e[K'
# Only rerended selection
printf 'Selection: '
fi
fi
done
}
main "$@"
+11
View File
@@ -5,11 +5,22 @@ Description=SMP server
User=smp
Group=smp
Type=simple
ExecStart=/usr/local/bin/smp-server start +RTS -N -RTS
ExecStopPost=/usr/local/bin/simplex-servers-stopscript smp-server
LimitNOFILE=65535
KillSignal=SIGINT
TimeoutStartSec=infinity
TimeoutStopSec=infinity
Restart=on-failure
RestartSec=10s
StartLimitBurst=3
StartLimitInterval=60s
AmbientCapabilities=CAP_NET_BIND_SERVICE
[Install]
WantedBy=multi-user.target
+10
View File
@@ -5,11 +5,21 @@ Description=XFTP server
User=xftp
Group=xftp
Type=simple
ExecStart=/usr/local/bin/xftp-server start +RTS -N -RTS
ExecStopPost=/usr/local/bin/simplex-servers-stopscript xftp-server
LimitNOFILE=65535
KillSignal=SIGINT
TimeoutStartSec=infinity
TimeoutStopSec=infinity
Restart=on-failure
RestartSec=10s
StartLimitBurst=3
StartLimitInterval=60s
AmbientCapabilities=CAP_NET_BIND_SERVICE
[Install]
+139
View File
@@ -0,0 +1,139 @@
#!/usr/bin/env sh
set -eu
TAG="$1"
tempdir="$(mktemp -d)"
init_dir="$PWD"
repo_name="simplexmq"
repo="https://github.com/simplex-chat/${repo_name}"
export DOCKER_BUILDKIT=1
cleanup() {
docker exec -t builder sh -c 'rm -rf ./dist-newstyle' 2>/dev/null || :
rm -rf -- "$tempdir"
docker rm --force builder 2>/dev/null || :
docker image rm local 2>/dev/null || :
cd "$init_dir"
}
trap 'cleanup' EXIT INT
mkdir -p "$init_dir/$TAG-$repo_name/from-source" "$init_dir/$TAG-$repo_name/prebuilt"
git -C "$tempdir" clone "$repo.git" &&\
cd "$tempdir/${repo_name}" &&\
git checkout "$TAG"
for os in 22.04 24.04; do
os_url="$(printf '%s' "$os" | tr '.' '_')"
# Build image
docker build \
--no-cache \
--build-arg TAG=${os} \
--build-arg GHC=9.6.3 \
-f "$tempdir/simplexmq/Dockerfile.build" \
-t local \
.
# Run container in background
docker run -t -d \
--name builder \
-v "$tempdir/${repo_name}:/project" \
local
# PostgreSQL build (only smp-server)
docker exec \
-t \
builder \
sh -c 'git config --global --add safe.directory \*; cabal update && cabal build --jobs=$(nproc) --enable-tests -fserver_postgres && mkdir -p /out && for i in smp-server simplexmq-test; do bin=$(find /project/dist-newstyle -name "$i" -type f -executable) && chmod +x "$bin" && mv "$bin" /out/; done && strip /out/smp-server'
# Copy smp-server postgresql binary and prepare it
docker cp \
builder:/out/smp-server \
"$init_dir/$TAG-$repo_name/from-source/smp-server-postgres-ubuntu-${os_url}-x86-64"
# Download prebuilt postgresql binary
curl -L \
--output-dir "$init_dir/$TAG-$repo_name/prebuilt/" \
-O \
"$repo/releases/download/${TAG}/smp-server-postgres-ubuntu-${os_url}-x86-64"
# Regular build (all)
apps='smp-server xftp-server ntf-server xftp'
docker exec \
-t \
-e apps="$apps" \
builder \
sh -c 'cabal build --jobs=$(nproc) && mkdir -p /out && for i in $apps; do bin=$(find /project/dist-newstyle -name "$i" -type f -executable) && strip "$bin" && chmod +x "$bin" && mv "$bin" /out/; done'
# Copy regular binaries
docker cp \
builder:/out \
out-${os}
# Prepare regular binaries and download the prebuilt ones
for app in $apps; do
curl -L \
--output-dir "$init_dir/$TAG-$repo_name/prebuilt/" \
-O \
"$repo/releases/download/${TAG}/${app}-ubuntu-${os_url}-x86-64"
mv "./out-${os}/$app" "$init_dir/$TAG-$repo_name/from-source/${app}-ubuntu-${os_url}-x86-64"
done
# Important! Remove dist-newstyle for the next interation
docker exec \
-t \
builder \
sh -c 'rm -rf ./dist-newstyle'
# Also restore git to previous state
git reset --hard && git clean -dfx
# Stop containers, delete images
docker stop builder
docker rm --force builder
docker image rm local
done
# Cleanup
rm -rf -- "$tempdir"
cd "$init_dir"
# Final stage: compare hashes
# Path to binaries
path_bin="$init_dir/$TAG-$repo_name"
# Assume everything is okay for now
bad=0
# Check hashes for all binaries
for file in "$path_bin"/from-source/*; do
# Extract binary name
app="$(basename $file)"
# Compute hash for compiled binary
compiled=$(sha256sum "$path_bin/from-source/$app" | awk '{print $1}')
# Compute hash for prebuilt binary
prebuilt=$(sha256sum "$path_bin/prebuilt/$app" | awk '{print $1}')
# Compare
if [ "$compiled" != "$prebuilt" ]; then
# If hashes doesn't match, set bad...
bad=1
# ... and print affected binary
printf "%s - sha256sum hash doesn't match\n" "$app"
fi
done
# If everything is still okay, compute checksums file
if [ "$bad" = 0 ]; then
sha256sum "$path_bin"/from-source/* | sed -e "s|$PWD/||g" -e 's|from-source/||g' -e "s|-$repo_name||g" > "$path_bin/_sha256sums"
printf 'Checksums computed - %s\n' "$path_bin/_sha256sums"
fi
+277 -413
View File
@@ -1,11 +1,7 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.35.0.
--
-- see: https://github.com/sol/hpack
name: simplexmq
version: 6.1.0.2
version: 6.5.0.3
synopsis: SimpleXMQ message broker
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
<./docs/Simplex-Messaging-Client.html client> and
@@ -66,24 +62,31 @@ flag use_crypton
manual: True
default: True
flag client_library
description: Don't build server-related code.
manual: True
default: False
flag client_postgres
description: Build with PostgreSQL instead of SQLite.
manual: True
default: False
flag server_postgres
description: Build server with support of PostgreSQL.
manual: True
default: False
library
exposed-modules:
Simplex.FileTransfer.Agent
Simplex.FileTransfer.Chunks
Simplex.FileTransfer.Client
Simplex.FileTransfer.Client.Agent
Simplex.FileTransfer.Client.Main
Simplex.FileTransfer.Client.Presets
Simplex.FileTransfer.Crypto
Simplex.FileTransfer.Description
Simplex.FileTransfer.Protocol
Simplex.FileTransfer.Server
Simplex.FileTransfer.Server.Control
Simplex.FileTransfer.Server.Env
Simplex.FileTransfer.Server.Main
Simplex.FileTransfer.Server.Stats
Simplex.FileTransfer.Server.Store
Simplex.FileTransfer.Server.StoreLog
Simplex.FileTransfer.Transport
Simplex.FileTransfer.Types
Simplex.FileTransfer.Util
@@ -97,45 +100,16 @@ library
Simplex.Messaging.Agent.RetryInterval
Simplex.Messaging.Agent.Stats
Simplex.Messaging.Agent.Store
Simplex.Messaging.Agent.Store.SQLite
Simplex.Messaging.Agent.Store.SQLite.Common
Simplex.Messaging.Agent.Store.SQLite.DB
Simplex.Messaging.Agent.Store.SQLite.Migrations
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
Simplex.Messaging.Agent.TRcvQueues
Simplex.Messaging.Agent.Store.AgentStore
Simplex.Messaging.Agent.Store.Common
Simplex.Messaging.Agent.Store.DB
Simplex.Messaging.Agent.Store.Entity
Simplex.Messaging.Agent.Store.Interface
Simplex.Messaging.Agent.Store.Migrations
Simplex.Messaging.Agent.Store.Migrations.App
Simplex.Messaging.Agent.Store.Postgres.Options
Simplex.Messaging.Agent.Store.Shared
Simplex.Messaging.Agent.TSessionSubs
Simplex.Messaging.Client
Simplex.Messaging.Client.Agent
Simplex.Messaging.Compression
@@ -148,39 +122,22 @@ library
Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
Simplex.Messaging.Crypto.ShortLink
Simplex.Messaging.Encoding
Simplex.Messaging.Encoding.String
Simplex.Messaging.Notifications.Client
Simplex.Messaging.Notifications.Protocol
Simplex.Messaging.Notifications.Server
Simplex.Messaging.Notifications.Server.Env
Simplex.Messaging.Notifications.Server.Main
Simplex.Messaging.Notifications.Server.Push.APNS
Simplex.Messaging.Notifications.Server.Push.APNS.Internal
Simplex.Messaging.Notifications.Server.Stats
Simplex.Messaging.Notifications.Server.Store
Simplex.Messaging.Notifications.Server.StoreLog
Simplex.Messaging.Notifications.Transport
Simplex.Messaging.Notifications.Types
Simplex.Messaging.Parsers
Simplex.Messaging.Protocol
Simplex.Messaging.Server
Simplex.Messaging.Server.CLI
Simplex.Messaging.Server.Control
Simplex.Messaging.Server.Env.STM
Simplex.Messaging.Protocol.Types
Simplex.Messaging.Server.Expiration
Simplex.Messaging.Server.Information
Simplex.Messaging.Server.Main
Simplex.Messaging.Server.MsgStore
Simplex.Messaging.Server.MsgStore.STM
Simplex.Messaging.Server.NtfStore
Simplex.Messaging.Server.QueueStore
Simplex.Messaging.Server.QueueStore.Postgres.Config
Simplex.Messaging.Server.QueueStore.QueueInfo
Simplex.Messaging.Server.QueueStore.STM
Simplex.Messaging.Server.Stats
Simplex.Messaging.Server.StoreLog
Simplex.Messaging.ServiceScheme
Simplex.Messaging.Session
Simplex.Messaging.SystemTime
Simplex.Messaging.TMap
Simplex.Messaging.Transport
Simplex.Messaging.Transport.Buffer
@@ -192,7 +149,7 @@ library
Simplex.Messaging.Transport.HTTP2.Server
Simplex.Messaging.Transport.KeepAlive
Simplex.Messaging.Transport.Server
Simplex.Messaging.Transport.WebSockets
Simplex.Messaging.Transport.Shared
Simplex.Messaging.Util
Simplex.Messaging.Version
Simplex.Messaging.Version.Internal
@@ -201,13 +158,132 @@ library
Simplex.RemoteControl.Discovery.Multicast
Simplex.RemoteControl.Invitation
Simplex.RemoteControl.Types
if flag(client_postgres)
exposed-modules:
Simplex.Messaging.Agent.Store.Postgres.Migrations.App
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251009_queue_to_subscribe
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251010_client_notices
else
exposed-modules:
Simplex.Messaging.Agent.Store.SQLite
Simplex.Messaging.Agent.Store.SQLite.Common
Simplex.Messaging.Agent.Store.SQLite.DB
Simplex.Messaging.Agent.Store.SQLite.Migrations
Simplex.Messaging.Agent.Store.SQLite.Migrations.App
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251009_queue_to_subscribe
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251010_client_notices
if flag(client_postgres) || flag(server_postgres)
exposed-modules:
Simplex.Messaging.Agent.Store.Postgres
Simplex.Messaging.Agent.Store.Postgres.Common
Simplex.Messaging.Agent.Store.Postgres.DB
Simplex.Messaging.Agent.Store.Postgres.Migrations
Simplex.Messaging.Agent.Store.Postgres.Util
if !flag(client_library)
exposed-modules:
Simplex.FileTransfer.Client.Main
Simplex.FileTransfer.Server
Simplex.FileTransfer.Server.Control
Simplex.FileTransfer.Server.Env
Simplex.FileTransfer.Server.Main
Simplex.FileTransfer.Server.Prometheus
Simplex.FileTransfer.Server.Stats
Simplex.FileTransfer.Server.Store
Simplex.FileTransfer.Server.StoreLog
Simplex.Messaging.Server
Simplex.Messaging.Server.CLI
Simplex.Messaging.Server.Control
Simplex.Messaging.Server.Env.STM
Simplex.Messaging.Server.Information
Simplex.Messaging.Server.Main
Simplex.Messaging.Server.Main.GitCommit
Simplex.Messaging.Server.Main.Init
Simplex.Messaging.Server.MsgStore
Simplex.Messaging.Server.MsgStore.Journal
Simplex.Messaging.Server.MsgStore.Journal.SharedLock
Simplex.Messaging.Server.MsgStore.STM
Simplex.Messaging.Server.MsgStore.Types
Simplex.Messaging.Server.NtfStore
Simplex.Messaging.Server.Prometheus
Simplex.Messaging.Server.QueueStore
Simplex.Messaging.Server.QueueStore.STM
Simplex.Messaging.Server.QueueStore.Types
Simplex.Messaging.Server.Stats
Simplex.Messaging.Server.StoreLog
Simplex.Messaging.Server.StoreLog.ReadWrite
Simplex.Messaging.Server.StoreLog.Types
Simplex.Messaging.Transport.WebSockets
if flag(server_postgres)
exposed-modules:
Simplex.Messaging.Notifications.Server
Simplex.Messaging.Notifications.Server.Control
Simplex.Messaging.Notifications.Server.Env
Simplex.Messaging.Notifications.Server.Main
Simplex.Messaging.Notifications.Server.Prometheus
Simplex.Messaging.Notifications.Server.Push
Simplex.Messaging.Notifications.Server.Push.APNS
Simplex.Messaging.Notifications.Server.Push.WebPush
Simplex.Messaging.Notifications.Server.Push.APNS.Internal
Simplex.Messaging.Notifications.Server.Stats
Simplex.Messaging.Notifications.Server.Store
Simplex.Messaging.Notifications.Server.Store.Migrations
Simplex.Messaging.Notifications.Server.Store.Postgres
Simplex.Messaging.Notifications.Server.Store.Types
Simplex.Messaging.Notifications.Server.StoreLog
Simplex.Messaging.Server.MsgStore.Postgres
Simplex.Messaging.Server.QueueStore.Postgres
Simplex.Messaging.Server.QueueStore.Postgres.Migrations
other-modules:
Paths_simplexmq
hs-source-dirs:
src
default-extensions:
StrictData
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-home-modules -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2
include-dirs:
cbits
c-sources:
@@ -217,31 +293,29 @@ library
crypto
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
, asn1-encoding ==0.9.*
, asn1-types ==0.3.*
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.14 && <5
, base64-bytestring >=1.0 && <1.3
, case-insensitive ==1.2.*
, binary ==0.8.*
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, crypton ==0.34.*
, crypton-x509 ==1.7.*
, crypton-x509-system ==1.6.*
, crypton-x509-store ==1.6.*
, crypton-x509-validation ==1.6.*
, cryptostore ==0.3.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, hashable ==1.4.*
, hourglass ==0.2.*
, http-client ==0.7.*
, http-types ==0.12.*
, http2 >=4.2.2 && <4.3
, ini ==0.4.1
, iproute ==1.7.*
, iso8601-time ==0.1.*
, memory ==0.18.*
@@ -250,26 +324,47 @@ library
, network-info ==0.2.*
, network-transport ==0.5.6
, network-udp ==0.0.*
, optparse-applicative >=0.15 && <0.17
, process ==1.6.*
, random >=1.1 && <1.3
, scientific ==0.3.7.*
, simple-logger ==0.1.*
, socks ==0.6.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.9.0 && <1.10
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, websockets ==0.12.*
, yaml ==0.11.*
, zstd ==0.1.3.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
if !flag(client_library)
build-depends:
case-insensitive ==1.2.*
, hashable ==1.4.*
, ini ==0.4.1
, http-client-tls ==0.3.6.*
, optparse-applicative >=0.15 && <0.17
, process ==1.6.*
, temporary ==1.3.*
, websockets ==0.12.*
if flag(client_postgres) || flag(server_postgres)
build-depends:
postgresql-libpq >=0.10.0.0
, postgresql-simple ==0.7.*
, raw-strings-qq ==1.1.*
if flag(client_postgres)
cpp-options: -DdbPostgres
else
build-depends:
direct-sqlcipher ==2.3.*
, sqlcipher-simple ==0.4.*
if flag(server_postgres)
cpp-options: -DdbServerPostgres
build-depends:
hex-text ==0.1.*
if impl(ghc >= 9.6.2)
build-depends:
bytestring ==0.11.*
@@ -282,6 +377,12 @@ library
, text >=1.2.3.0 && <1.3
executable ntf-server
if flag(client_library)
buildable: False
if flag(server_postgres)
cpp-options: -DdbServerPostgres
else
buildable: False
main-is: Main.hs
other-modules:
Paths_simplexmq
@@ -289,75 +390,18 @@ executable ntf-server
apps/ntf-server
default-extensions:
StrictData
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
, asn1-encoding ==0.9.*
, asn1-types ==0.3.*
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.14 && <5
, base64-bytestring >=1.0 && <1.3
, case-insensitive ==1.2.*
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, crypton ==0.34.*
, crypton-x509 ==1.7.*
, crypton-x509-store ==1.6.*
, crypton-x509-validation ==1.6.*
, cryptostore ==0.3.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, hashable ==1.4.*
, hourglass ==0.2.*
, http-types ==0.12.*
, http2 >=4.2.2 && <4.3
, ini ==0.4.1
, iproute ==1.7.*
, iso8601-time ==0.1.*
, memory ==0.18.*
, mtl >=2.3.1 && <3.0
, network >=3.1.2.7 && <3.2
, network-info ==0.2.*
, network-transport ==0.5.6
, network-udp ==0.0.*
, optparse-applicative >=0.15 && <0.17
, process ==1.6.*
, random >=1.1 && <1.3
, simple-logger ==0.1.*
base
, simple-logger
, simplexmq
, socks ==0.6.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.9.0 && <1.10
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, websockets ==0.12.*
, yaml ==0.11.*
, zstd ==0.1.3.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
if impl(ghc >= 9.6.2)
build-depends:
bytestring ==0.11.*
, template-haskell ==2.20.*
, text >=2.0.1 && <2.2
if impl(ghc < 9.6.2)
build-depends:
bytestring ==0.10.*
, template-haskell ==2.16.*
, text >=1.2.3.0 && <1.3
executable smp-server
if flag(client_library)
buildable: False
if flag(server_postgres)
cpp-options: -DdbServerPostgres
main-is: Main.hs
other-modules:
Static
@@ -368,80 +412,27 @@ executable smp-server
apps/smp-server/web
default-extensions:
StrictData
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
, asn1-encoding ==0.9.*
, asn1-types ==0.3.*
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.14 && <5
, base64-bytestring >=1.0 && <1.3
, case-insensitive ==1.2.*
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, crypton ==0.34.*
, crypton-x509 ==1.7.*
, crypton-x509-store ==1.6.*
, crypton-x509-validation ==1.6.*
, cryptostore ==0.3.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
base
, bytestring
, directory
, file-embed
, filepath ==1.4.*
, hashable ==1.4.*
, hourglass ==0.2.*
, http-types ==0.12.*
, http2 >=4.2.2 && <4.3
, ini ==0.4.1
, iproute ==1.7.*
, iso8601-time ==0.1.*
, memory ==0.18.*
, mtl >=2.3.1 && <3.0
, network >=3.1.2.7 && <3.2
, network-info ==0.2.*
, network-transport ==0.5.6
, network-udp ==0.0.*
, optparse-applicative >=0.15 && <0.17
, process ==1.6.*
, random >=1.1 && <1.3
, simple-logger ==0.1.*
, filepath
, network
, simple-logger
, simplexmq
, socks ==0.6.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.9.0 && <1.10
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, text
, unliftio
, wai
, wai-app-static
, warp ==3.3.30
, warp-tls ==3.4.7
, websockets ==0.12.*
, yaml ==0.11.*
, zstd ==0.1.3.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
if impl(ghc >= 9.6.2)
build-depends:
bytestring ==0.11.*
, template-haskell ==2.20.*
, text >=2.0.1 && <2.2
if impl(ghc < 9.6.2)
build-depends:
bytestring ==0.10.*
, template-haskell ==2.16.*
, text >=1.2.3.0 && <1.3
executable xftp
if flag(client_library)
buildable: False
main-is: Main.hs
other-modules:
Paths_simplexmq
@@ -449,75 +440,15 @@ executable xftp
apps/xftp
default-extensions:
StrictData
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
, asn1-encoding ==0.9.*
, asn1-types ==0.3.*
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.14 && <5
, base64-bytestring >=1.0 && <1.3
, case-insensitive ==1.2.*
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, crypton ==0.34.*
, crypton-x509 ==1.7.*
, crypton-x509-store ==1.6.*
, crypton-x509-validation ==1.6.*
, cryptostore ==0.3.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, hashable ==1.4.*
, hourglass ==0.2.*
, http-types ==0.12.*
, http2 >=4.2.2 && <4.3
, ini ==0.4.1
, iproute ==1.7.*
, iso8601-time ==0.1.*
, memory ==0.18.*
, mtl >=2.3.1 && <3.0
, network >=3.1.2.7 && <3.2
, network-info ==0.2.*
, network-transport ==0.5.6
, network-udp ==0.0.*
, optparse-applicative >=0.15 && <0.17
, process ==1.6.*
, random >=1.1 && <1.3
, simple-logger ==0.1.*
base
, simplexmq
, socks ==0.6.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.9.0 && <1.10
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, websockets ==0.12.*
, yaml ==0.11.*
, zstd ==0.1.3.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
if impl(ghc >= 9.6.2)
build-depends:
bytestring ==0.11.*
, template-haskell ==2.20.*
, text >=2.0.1 && <2.2
if impl(ghc < 9.6.2)
build-depends:
bytestring ==0.10.*
, template-haskell ==2.16.*
, text >=1.2.3.0 && <1.3
executable xftp-server
if flag(client_library)
buildable: False
main-is: Main.hs
other-modules:
Paths_simplexmq
@@ -525,75 +456,16 @@ executable xftp-server
apps/xftp-server
default-extensions:
StrictData
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
build-depends:
aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
, asn1-encoding ==0.9.*
, asn1-types ==0.3.*
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.14 && <5
, base64-bytestring >=1.0 && <1.3
, case-insensitive ==1.2.*
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, crypton ==0.34.*
, crypton-x509 ==1.7.*
, crypton-x509-store ==1.6.*
, crypton-x509-validation ==1.6.*
, cryptostore ==0.3.*
, data-default ==0.7.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
, filepath ==1.4.*
, hashable ==1.4.*
, hourglass ==0.2.*
, http-types ==0.12.*
, http2 >=4.2.2 && <4.3
, ini ==0.4.1
, iproute ==1.7.*
, iso8601-time ==0.1.*
, memory ==0.18.*
, mtl >=2.3.1 && <3.0
, network >=3.1.2.7 && <3.2
, network-info ==0.2.*
, network-transport ==0.5.6
, network-udp ==0.0.*
, optparse-applicative >=0.15 && <0.17
, process ==1.6.*
, random >=1.1 && <1.3
, simple-logger ==0.1.*
base
, simple-logger
, simplexmq
, socks ==0.6.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, tls >=1.9.0 && <1.10
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, websockets ==0.12.*
, yaml ==0.11.*
, zstd ==0.1.3.*
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
if impl(ghc >= 9.6.2)
build-depends:
bytestring ==0.11.*
, template-haskell ==2.20.*
, text >=2.0.1 && <2.2
if impl(ghc < 9.6.2)
build-depends:
bytestring ==0.10.*
, template-haskell ==2.16.*
, text >=1.2.3.0 && <1.3
test-suite simplexmq-test
if flag(client_library)
buildable: False
type: exitcode-stdio-1.0
main-is: Test.hs
other-modules:
@@ -603,22 +475,21 @@ test-suite simplexmq-test
AgentTests.EqInstances
AgentTests.FunctionalAPITests
AgentTests.MigrationTests
AgentTests.NotificationTests
AgentTests.SchemaDump
AgentTests.SQLiteTests
AgentTests.ServerChoice
AgentTests.ShortLinkTests
CLITests
CoreTests.BatchingTests
CoreTests.CryptoFileTests
CoreTests.CryptoTests
CoreTests.EncodingTests
CoreTests.MsgStoreTests
CoreTests.RetryIntervalTests
CoreTests.SOCKSSettings
CoreTests.TRcvQueuesTests
CoreTests.StoreLogTests
CoreTests.TSessionSubs
CoreTests.UtilTests
CoreTests.VersionRangeTests
FileDescriptionTests
NtfClient
NtfServerTests
RemoteControl
ServerTests
SMPAgentClient
@@ -632,92 +503,85 @@ test-suite simplexmq-test
Static
Static.Embedded
Paths_simplexmq
if flag(client_postgres)
other-modules:
Fixtures
else
other-modules:
AgentTests.SchemaDump
AgentTests.SQLiteTests
if flag(server_postgres)
other-modules:
AgentTests.NotificationTests
NtfClient
NtfServerTests
NtfWPTests
PostgresSchemaDump
hs-source-dirs:
tests
apps/smp-server/web
default-extensions:
StrictData
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
-- add -fhpc to ghc-options to run tests with coverage
ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts -with-rtsopts=-A64M -with-rtsopts=-N1
build-depends:
HUnit ==1.6.*
, QuickCheck ==2.14.*
, aeson ==2.2.*
, ansi-terminal >=0.10 && <0.12
, asn1-encoding ==0.9.*
, asn1-types ==0.3.*
, async ==2.2.*
, attoparsec ==0.14.*
, base >=4.14 && <5
, base64-bytestring >=1.0 && <1.3
, case-insensitive ==1.2.*
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
, crypton ==0.34.*
, crypton-x509 ==1.7.*
, crypton-x509-store ==1.6.*
, crypton-x509-validation ==1.6.*
, cryptostore ==0.3.*
, data-default ==0.7.*
, deepseq ==1.4.*
, direct-sqlcipher ==2.3.*
, directory ==1.3.*
base
, aeson
, async
, base64-bytestring
, bytestring
, containers
, crypton
, crypton-x509
, crypton-x509-store
, crypton-x509-validation
, directory
, file-embed
, filepath ==1.4.*
, filepath
, generic-random ==1.5.*
, hashable ==1.4.*
, hourglass ==0.2.*
, hashable
, hspec ==2.11.*
, hspec-core ==2.11.*
, http-client
, http-client-tls
, http-types ==0.12.*
, http2 >=4.2.2 && <4.3
, ini ==0.4.1
, iproute ==1.7.*
, iso8601-time ==0.1.*
, http-types
, http2
, HUnit ==1.6.*
, ini
, iso8601-time
, main-tester ==0.2.*
, memory ==0.18.*
, mtl >=2.3.1 && <3.0
, network >=3.1.2.7 && <3.2
, network-info ==0.2.*
, network-transport ==0.5.6
, network-udp ==0.0.*
, optparse-applicative >=0.15 && <0.17
, process ==1.6.*
, random >=1.1 && <1.3
, mtl
, network
, QuickCheck ==2.14.*
, random
, silently ==1.2.*
, simple-logger ==0.1.*
, simple-logger
, simplexmq
, socks ==0.6.*
, sqlcipher-simple ==0.4.*
, stm ==2.5.*
, temporary ==1.3.*
, time ==1.12.*
, time-manager ==0.0.*
, stm
, text
, time
, timeit ==2.0.*
, tls >=1.9.0 && <1.10
, transformers ==0.6.*
, unliftio ==0.2.*
, unliftio-core ==0.2.*
, transformers
, unliftio
, unliftio-core
, unordered-containers
, wai
, wai-app-static
, warp
, warp-tls
, websockets ==0.12.*
, yaml ==0.11.*
, zstd ==0.1.3.*
, yaml
default-language: Haskell2010
if flag(swift)
cpp-options: -DswiftJSON
if impl(ghc >= 9.6.2)
if flag(server_postgres)
cpp-options: -DdbServerPostgres
if flag(client_postgres)
cpp-options: -DdbPostgres
else
build-depends:
bytestring ==0.11.*
, template-haskell ==2.20.*
, text >=2.0.1 && <2.2
if impl(ghc < 9.6.2)
memory
, sqlcipher-simple
if !flag(client_postgres) || flag(client_postgres) || flag(server_postgres)
build-depends:
bytestring ==0.10.*
, template-haskell ==2.16.*
, text >=1.2.3.0 && <1.3
deepseq ==1.4.*
, process
if flag(client_postgres) || flag(server_postgres)
build-depends:
postgresql-simple ==0.7.*
+21 -22
View File
@@ -51,8 +51,7 @@ import Data.Text (Text)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format (defaultTimeLocale, formatTime)
import Simplex.FileTransfer.Chunks (toKB)
import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
import Simplex.FileTransfer.Client.Main
import Simplex.FileTransfer.Client (XFTPChunkSpec (..), getChunkDigest, prepareChunkSizes, prepareChunkSpecs, singleChunkSize)
import Simplex.FileTransfer.Crypto
import Simplex.FileTransfer.Description
import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
@@ -66,8 +65,8 @@ import Simplex.Messaging.Agent.Env.SQLite
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.RetryInterval
import Simplex.Messaging.Agent.Stats
import Simplex.Messaging.Agent.Store.SQLite
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.AgentStore
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
import qualified Simplex.Messaging.Crypto.File as CF
@@ -76,7 +75,7 @@ import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String (strDecode, strEncode)
import Simplex.Messaging.Protocol (ProtocolServer, ProtocolType (..), XFTPServer)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Util (catchAll_, liftError, tshow, unlessM, whenM)
import Simplex.Messaging.Util (allFinally, catchAll_, catchAllErrors, liftError, tshow, unlessM, whenM)
import System.FilePath (takeFileName, (</>))
import UnliftIO
import UnliftIO.Directory
@@ -199,10 +198,10 @@ runXFTPRcvWorker c srv Worker {doWork} = do
liftIO $ waitForUserNetwork c
atomically $ incXFTPServerStat c userId srv downloadAttempts
downloadFileChunk fc replica approvedRelays
`catchAgentError` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
`catchAllErrors` \e -> retryOnError "XFTP rcv worker" (retryLoop loop e delay') (retryDone e) e
where
retryLoop loop e replicaDelay = do
flip catchAgentError (\_ -> pure ()) $ do
flip catchAllErrors (\_ -> pure ()) $ do
when (serverHostError e) $ notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFWARN e)
liftIO $ closeXFTPServerClient c userId server digest
withStore' c $ \db -> updateRcvChunkReplicaDelay db rcvChunkReplicaId replicaDelay
@@ -281,7 +280,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
runXFTPOperation AgentConfig {rcvFilesTTL} =
withWork c doWork (`getNextRcvFileToDecrypt` rcvFilesTTL) $
\f@RcvFile {rcvFileId, rcvFileEntityId, tmpPath, redirect} ->
decryptFile f `catchAgentError` rcvWorkerInternalError c rcvFileId rcvFileEntityId (redirectEntityId <$> redirect) tmpPath
decryptFile f `catchAllErrors` rcvWorkerInternalError c rcvFileId rcvFileEntityId (redirectEntityId <$> redirect) tmpPath
decryptFile :: RcvFile -> AM ()
decryptFile RcvFile {rcvFileId, rcvFileEntityId, size, digest, key, nonce, tmpPath, saveFile, status, chunks, redirect} = do
let CryptoFile savePath cfArgs = saveFile
@@ -308,7 +307,7 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
liftIO $ waitUntilForeground c
withStore' c (`updateRcvFileComplete` rcvFileId)
-- proceed with redirect
yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `agentFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `allFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
next@FileDescription {chunks = nextChunks} <- case strDecode (LB.toStrict yaml) of
-- TODO switch to another error constructor
Left _ -> throwE . FILE $ REDIRECT "decode error"
@@ -400,7 +399,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
runXFTPOperation cfg@AgentConfig {sndFilesTTL} =
withWork c doWork (`getNextSndFileToPrepare` sndFilesTTL) $
\f@SndFile {sndFileId, sndFileEntityId, prefixPath} ->
prepareFile cfg f `catchAgentError` sndWorkerInternalError c sndFileId sndFileEntityId prefixPath
prepareFile cfg f `catchAllErrors` sndWorkerInternalError c sndFileId sndFileEntityId prefixPath
prepareFile :: AgentConfig -> SndFile -> AM ()
prepareFile _ SndFile {prefixPath = Nothing} =
throwE $ INTERNAL "no prefix path"
@@ -461,26 +460,26 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
pure srv
where
tryCreate = do
usedSrvs <- newTVarIO ([] :: [XFTPServer])
triedHosts <- newTVarIO S.empty
let AgentClient {xftpServers} = c
userSrvCount <- liftIO $ length <$> TM.lookupIO userId xftpServers
withRetryIntervalCount (riFast ri) $ \n _ loop -> do
liftIO $ waitWhileSuspended c
liftIO $ waitForUserNetwork c
let triedAllSrvs = n > userSrvCount
createWithNextSrv usedSrvs
`catchAgentError` \e -> retryOnError "XFTP prepare worker" (retryLoop loop triedAllSrvs e) (throwE e) e
createWithNextSrv triedHosts
`catchAllErrors` \e -> retryOnError "XFTP prepare worker" (retryLoop loop triedAllSrvs e) (throwE e) e
where
-- we don't do closeXFTPServerClient here to not risk closing connection for concurrent chunk upload
retryLoop loop triedAllSrvs e = do
flip catchAgentError (\_ -> pure ()) $ do
flip catchAllErrors (\_ -> pure ()) $ do
when (triedAllSrvs && serverHostError e) $ notify c sndFileEntityId $ SFWARN e
liftIO $ assertAgentForeground c
loop
createWithNextSrv usedSrvs = do
createWithNextSrv triedHosts = do
deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
when deleted $ throwE $ FILE NO_FILE
withNextSrv c userId usedSrvs [] $ \srvAuth -> do
withNextSrv c userId storageSrvs triedHosts [] $ \srvAuth -> do
replica <- agentXFTPNewChunk c ch numRecipients' srvAuth
pure (replica, srvAuth)
@@ -509,10 +508,10 @@ runXFTPSndWorker c srv Worker {doWork} = do
liftIO $ waitForUserNetwork c
atomically $ incXFTPServerStat c userId srv uploadAttempts
uploadFileChunk cfg fc replica
`catchAgentError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
`catchAllErrors` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
where
retryLoop loop e replicaDelay = do
flip catchAgentError (\_ -> pure ()) $ do
flip catchAllErrors (\_ -> pure ()) $ do
when (serverHostError e) $ notify c sndFileEntityId $ SFWARN e
liftIO $ closeXFTPServerClient c userId server digest
withStore' c $ \db -> updateSndChunkReplicaDelay db sndChunkReplicaId replicaDelay
@@ -546,8 +545,8 @@ runXFTPSndWorker c srv Worker {doWork} = do
withStore' c $ \db -> updateSndFileComplete db sndFileId
where
addRecipients :: SndFileChunk -> SndFileChunkReplica -> AM SndFileChunkReplica
addRecipients ch@SndFileChunk {numRecipients} cr@SndFileChunkReplica {rcvIdsKeys}
| length rcvIdsKeys > numRecipients = throwE $ INTERNAL "too many recipients"
addRecipients ch@SndFileChunk {numRecipients} cr@SndFileChunkReplica {sndChunkReplicaId, rcvIdsKeys}
| length rcvIdsKeys > numRecipients = throwE $ INTERNAL ("too many recipients, sndChunkReplicaId = " <> show sndChunkReplicaId)
| length rcvIdsKeys == numRecipients = pure cr
| otherwise = do
let numRecipients' = min (numRecipients - length rcvIdsKeys) maxRecipients
@@ -682,10 +681,10 @@ runXFTPDelWorker c srv Worker {doWork} = do
liftIO $ waitForUserNetwork c
atomically $ incXFTPServerStat c userId srv deleteAttempts
deleteChunkReplica
`catchAgentError` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
`catchAllErrors` \e -> retryOnError "XFTP del worker" (retryLoop loop e delay') (retryDone e) e
where
retryLoop loop e replicaDelay = do
flip catchAgentError (\_ -> pure ()) $ do
flip catchAllErrors (\_ -> pure ()) $ do
when (serverHostError e) $ notify c "" $ SFWARN e
liftIO $ closeXFTPServerClient c userId server chunkDigest
withStore' c $ \db -> updateDeletedSndChunkReplicaDelay db deletedSndChunkReplicaId replicaDelay
+70 -20
View File
@@ -20,26 +20,33 @@ import Data.Bifunctor (first)
import Data.ByteString.Builder (Builder, byteString)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as LB
import Data.Int (Int64)
import Data.List (foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (listToMaybe)
import Data.Time.Clock (UTCTime)
import Data.Word (Word32)
import qualified Data.X509 as X
import qualified Data.X509.Validation as XV
import qualified Network.HTTP.Types as N
import qualified Network.HTTP2.Client as H
import Network.Socket (HostName)
import Simplex.FileTransfer.Chunks
import Simplex.FileTransfer.Protocol
import Simplex.FileTransfer.Server.Env (supportedXFTPhandshakes)
import Simplex.FileTransfer.Transport
import Simplex.Messaging.Client
( NetworkConfig (..),
NetworkRequestMode (..),
ProtocolClientError (..),
TransportSession,
netTimeoutInt,
chooseTransportHost,
defaultNetworkConfig,
transportClientConfig,
clientSocksCredentials,
unexpectedResponse,
useWebPort,
)
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -52,9 +59,11 @@ import Simplex.Messaging.Protocol
RecipientId,
SenderId,
pattern NoEntity,
NetworkError (..),
toNetworkError,
)
import Simplex.Messaging.Transport (ALPN, HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost, alpn)
import Simplex.Messaging.Transport (ALPN, CertChainPubKey (..), HandshakeError (..), THandleAuth (..), THandleParams (..), TransportError (..), TransportPeer (..), defaultSupportedParams)
import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost)
import Simplex.Messaging.Transport.HTTP2
import Simplex.Messaging.Transport.HTTP2.Client
import Simplex.Messaging.Transport.HTTP2.File
@@ -96,15 +105,16 @@ defaultXFTPClientConfig =
XFTPClientConfig
{ xftpNetworkConfig = defaultNetworkConfig,
serverVRange = supportedFileServerVRange,
clientALPN = Just supportedXFTPhandshakes
clientALPN = Just alpnSupportedXFTPhandshakes
}
getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} proxySessTs disconnected = runExceptT $ do
getXFTPClient :: TransportSession FileResponse -> XFTPClientConfig -> [HostName] -> UTCTime -> (XFTPClient -> IO ()) -> IO (Either XFTPClientError XFTPClient)
getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN, xftpNetworkConfig, serverVRange} presetDomains proxySessTs disconnected = runExceptT $ do
let socksCreds = clientSocksCredentials xftpNetworkConfig proxySessTs transportSession
ProtocolServer _ host port keyHash = srv
useALPN = if useWebPort xftpNetworkConfig presetDomains srv then Just [httpALPN11] else clientALPN
useHost <- liftEither $ chooseTransportHost xftpNetworkConfig host
let tcConfig = (transportClientConfig xftpNetworkConfig useHost True) {alpn = clientALPN}
let tcConfig = transportClientConfig xftpNetworkConfig NRMBackground useHost False useALPN
http2Config = xftpHTTP2Config tcConfig config
clientVar <- newTVarIO Nothing
let usePort = if null port then "443" else port
@@ -113,10 +123,11 @@ getXFTPClient transportSession@(_, srv, _) config@XFTPClientConfig {clientALPN,
let HTTP2Client {sessionId, sessionALPN} = http2Client
v = VersionXFTP 1
thServerVRange = versionToRange v
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, batch = True}
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
logDebug $ "Client negotiated handshake protocol: " <> tshow sessionALPN
thParams@THandleParams {thVersion} <- case sessionALPN of
Just "xftp/1" -> xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
xftpClientHandshakeV1 serverVRange keyHash http2Client thParams0
_ -> pure thParams0
logDebug $ "Client negotiated protocol: " <> tshow thVersion
let c = XFTPClient {http2Client, thParams, transportSession, config}
@@ -129,7 +140,8 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
(vr, sk) <- processServerHandshake shs
let v = maxVersion vr
sendClientHandshake XFTPClientHandshake {xftpVersion = v, keyHash}
pure thParams0 {thAuth = Just THAuthClient {serverPeerPubKey = sk, serverCertKey = ck, sessSecret = Nothing}, thVersion = v, thServerVRange = vr}
let thAuth = Just THAuthClient {peerServerPubKey = sk, peerServerCertKey = ck, clientService = Nothing, sessSecret = Nothing}
pure thParams0 {thAuth, thVersion = v, thServerVRange = vr}
where
getServerHandshake :: ExceptT XFTPClientError IO XFTPServerHandshake
getServerHandshake = do
@@ -144,12 +156,12 @@ xftpClientHandshakeV1 serverVRange keyHash@(C.KeyHash kh) c@HTTP2Client {session
Nothing -> throwE $ PCETransportError TEVersion
Just (Compatible vr) ->
fmap (vr,) . liftTransportErr (TEHandshake BAD_AUTH) $ do
let (X.CertificateChain cert, exact) = serverAuth
let CertChainPubKey (X.CertificateChain cert) exact = serverAuth
case cert of
[_leaf, ca] | XV.Fingerprint kh == XV.getFingerprint ca X.HashSHA256 -> pure ()
_ -> throwError "bad certificate"
pubKey <- maybe (throwError "bad server key type") (`C.verifyX509` exact) serverKey
C.x509ToPublic (pubKey, []) >>= C.pubKey
C.x509ToPublic' pubKey
sendClientHandshake :: XFTPClientHandshake -> ExceptT XFTPClientError IO ()
sendClientHandshake chs = do
chs' <- liftTransportErr TELargeMsg $ C.pad (smpEncode chs) xftpBlockSize
@@ -174,14 +186,14 @@ xftpHTTP2Config transportConfig XFTPClientConfig {xftpNetworkConfig = NetworkCon
defaultHTTP2ClientConfig
{ bodyHeadSize = xftpBlockSize,
suportedTLSParams = defaultSupportedParams,
connTimeout = tcpConnectTimeout,
connTimeout = netTimeoutInt tcpConnectTimeout NRMBackground,
transportConfig
}
xftpClientError :: HTTP2ClientError -> XFTPClientError
xftpClientError = \case
HCResponseTimeout -> PCEResponseTimeout
HCNetworkError -> PCENetworkError
HCNetworkError e -> PCENetworkError e
HCIOError e -> PCEIOError e
sendXFTPCommand :: forall p. FilePartyI p => XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> FileCommand p -> Maybe XFTPChunkSpec -> ExceptT XFTPClientError IO (FileResponse, HTTP2Body)
@@ -200,7 +212,7 @@ sendXFTPTransmission XFTPClient {config, thParams, http2Client} t chunkSpec_ = d
HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- withExceptT xftpClientError . ExceptT $ sendRequest http2Client req (Just reqTimeout)
when (B.length bodyHead /= xftpBlockSize) $ throwE $ PCEResponseError BLOCK
-- TODO validate that the file ID is the same as in the request?
(_, _, (_, _fId, respOrErr)) <- liftEither . first PCEResponseError $ xftpDecodeTransmission thParams bodyHead
(_, _fId, respOrErr) <-liftEither $ first PCEResponseError $ xftpDecodeTClient thParams bodyHead
case respOrErr of
Right r -> case protocolError r of
Just e -> throwE $ PCEProtocolError e
@@ -251,9 +263,9 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {
ExceptT (sequence <$> (t `timeout` (download cbState `catches` errors))) >>= maybe (throwE PCEResponseTimeout) pure
where
errors =
[ Handler $ \(_e :: H.HTTP2Error) -> pure $ Left PCENetworkError,
Handler $ \(e :: IOException) -> pure $ Left (PCEIOError e),
Handler $ \(_e :: SomeException) -> pure $ Left PCENetworkError
[ Handler $ \(e :: H.HTTP2Error) -> pure $ Left $ PCENetworkError $ NEConnectError $ displayException e,
Handler $ \(e :: IOException) -> pure $ Left $ PCEIOError e,
Handler $ \(e :: SomeException) -> pure $ Left $ PCENetworkError $ toNetworkError e
]
download cbState =
runExceptT . withExceptT PCEResponseError $
@@ -264,11 +276,11 @@ downloadXFTPChunk g c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {
xftpReqTimeout :: XFTPClientConfig -> Maybe Word32 -> Int
xftpReqTimeout cfg@XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpTimeout}} chunkSize_ =
maybe tcpTimeout (chunkTimeout cfg) chunkSize_
maybe (netTimeoutInt tcpTimeout NRMBackground) (chunkTimeout cfg) chunkSize_
chunkTimeout :: XFTPClientConfig -> Word32 -> Int
chunkTimeout XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpTimeout, tcpTimeoutPerKb}} sz =
tcpTimeout + fromIntegral (min ((fromIntegral sz `div` 1024) * tcpTimeoutPerKb) (fromIntegral (maxBound :: Int)))
netTimeoutInt tcpTimeout NRMBackground + fromIntegral (min ((fromIntegral sz `div` 1024) * tcpTimeoutPerKb) (fromIntegral (maxBound :: Int)))
deleteXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> SenderId -> ExceptT XFTPClientError IO ()
deleteXFTPChunk c spKey sId = sendXFTPCommand c spKey sId FDEL Nothing >>= okResponse
@@ -299,3 +311,41 @@ noFile HTTP2Body {bodyPart} a = case bodyPart of
-- FACK :: FileCommand Recipient
-- PING :: FileCommand Recipient
singleChunkSize :: Int64 -> Maybe Word32
singleChunkSize size' =
listToMaybe $ dropWhile (< chunkSize) serverChunkSizes
where
chunkSize = fromIntegral size'
prepareChunkSizes :: Int64 -> [Word32]
prepareChunkSizes size' = prepareSizes size'
where
(smallSize, bigSize)
| size' > size34 chunkSize3 = (chunkSize2, chunkSize3)
| size' > size34 chunkSize2 = (chunkSize1, chunkSize2)
| otherwise = (chunkSize0, chunkSize1)
size34 sz = (fromIntegral sz * 3) `div` 4
prepareSizes 0 = []
prepareSizes size
| size >= fromIntegral bigSize = replicate (fromIntegral n1) bigSize <> prepareSizes remSz
| size > size34 bigSize = [bigSize]
| otherwise = replicate (fromIntegral n2') smallSize
where
(n1, remSz) = size `divMod` fromIntegral bigSize
n2' = let (n2, remSz2) = (size `divMod` fromIntegral smallSize) in if remSz2 == 0 then n2 else n2 + 1
prepareChunkSpecs :: FilePath -> [Word32] -> [XFTPChunkSpec]
prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) chunkSizes
where
addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
addSpec (chunkOffset, specs) sz =
let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = sz}
in (chunkOffset + fromIntegral sz, spec : specs)
getChunkDigest :: XFTPChunkSpec -> IO ByteString
getChunkDigest XFTPChunkSpec {filePath = chunkPath, chunkOffset, chunkSize} =
withFile chunkPath ReadMode $ \h -> do
hSeek h AbsoluteSeek $ fromIntegral chunkOffset
chunk <- LB.hGet h (fromIntegral chunkSize)
pure $! LC.sha256Hash chunk
+4 -4
View File
@@ -19,7 +19,7 @@ import Data.Text.Encoding (decodeUtf8)
import Data.Time.Clock (UTCTime, getCurrentTime)
import Simplex.FileTransfer.Client
import Simplex.Messaging.Agent.RetryInterval
import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientError (..), temporaryClientError)
import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), ProtocolClientError (..), netTimeoutInt, temporaryClientError)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
import Simplex.Messaging.TMap (TMap)
@@ -71,7 +71,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, startedAt, config} srv = do
connectClient =
ExceptT $
first (XFTPClientAgentError srv)
<$> getXFTPClient (1, srv, Nothing) (xftpConfig config) startedAt clientDisconnected
<$> getXFTPClient (1, srv, Nothing) (xftpConfig config) [] startedAt clientDisconnected
clientDisconnected :: XFTPClient -> IO ()
clientDisconnected _ = do
@@ -90,7 +90,7 @@ getXFTPServerClient XFTPClientAgent {xftpClients, startedAt, config} srv = do
waitForXFTPClient :: XFTPClientVar -> ME XFTPClient
waitForXFTPClient clientVar = do
let XFTPClientConfig {xftpNetworkConfig = NetworkConfig {tcpConnectTimeout}} = xftpConfig config
client_ <- liftIO $ tcpConnectTimeout `timeout` atomically (readTMVar clientVar)
client_ <- liftIO $ netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar clientVar)
liftEither $ case client_ of
Just (Right c) -> Right c
Just (Left e) -> Left e
@@ -127,6 +127,6 @@ closeXFTPServerClient XFTPClientAgent {xftpClients, config} srv =
where
closeClient cVar = do
let NetworkConfig {tcpConnectTimeout} = xftpNetworkConfig $ xftpConfig config
tcpConnectTimeout `timeout` atomically (readTMVar cVar) >>= \case
netTimeoutInt tcpConnectTimeout NRMBackground `timeout` atomically (readTMVar cVar) >>= \case
Just (Right client) -> closeXFTPClient client `catchAll_` pure ()
_ -> pure ()
+8 -75
View File
@@ -19,11 +19,7 @@ module Simplex.FileTransfer.Client.Main
singleChunkSize,
prepareChunkSizes,
prepareChunkSpecs,
maxFileSize,
maxFileSizeHard,
fileSizeLen,
getChunkDigest,
SentRecipientReplica (..),
)
where
@@ -34,7 +30,6 @@ import Control.Monad.Trans.Except
import Crypto.Random (ChaChaDRG)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (first)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (toLower)
@@ -45,7 +40,7 @@ import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Word (Word32)
import GHC.Records (HasField (getField))
@@ -80,20 +75,6 @@ import UnliftIO.Directory
xftpClientVersion :: String
xftpClientVersion = "1.0.1"
-- | Soft limit for XFTP clients. Should be checked and reported to user.
maxFileSize :: Int64
maxFileSize = gb 1
maxFileSizeStr :: String
maxFileSizeStr = B.unpack . strEncode $ FileSize maxFileSize
-- | Hard internal limit for XFTP agent after which it refuses to prepare chunks.
maxFileSizeHard :: Int64
maxFileSizeHard = gb 5
fileSizeLen :: Int64
fileSizeLen = 8
newtype CLIError = CLIError String
deriving (Eq, Show, Exception)
@@ -231,16 +212,6 @@ data SentFileChunkReplica = SentFileChunkReplica
}
deriving (Show)
data SentRecipientReplica = SentRecipientReplica
{ chunkNo :: Int,
server :: XFTPServer,
rcvNo :: Int,
replicaId :: ChunkReplicaId,
replicaKey :: C.APrivateAuthKey,
digest :: FileDigest,
chunkSize :: FileSize Word32
}
logCfg :: LogConfig
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
@@ -309,7 +280,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
let chunkSpecs = prepareChunkSpecs encPath chunkSizes
fdRcv = FileDescription {party = SFRecipient, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = [], redirect = Nothing}
fdSnd = FileDescription {party = SFSender, size = FileSize encSize, digest = FileDigest digest, key, nonce, chunkSize = FileSize defChunkSize, chunks = [], redirect = Nothing}
logInfo $ "encrypted file to " <> tshow encPath
logDebug $ "encrypted file to " <> tshow encPath
pure (encPath, fdRcv, fdSnd, chunkSpecs, encSize)
uploadFile :: TVar ChaChaDRG -> [XFTPChunkSpec] -> TVar [Int64] -> Int64 -> ExceptT CLIError IO [SentFileChunk]
uploadFile g chunks uploadedChunks encSize = do
@@ -322,14 +293,14 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
-- TODO shuffle/unshuffle chunks
-- the reason we don't do pooled downloads here within one server is that http2 library doesn't handle cleint concurrency, even though
-- upload doesn't allow other requests within the same client until complete (but download does allow).
logInfo $ "uploading " <> tshow (length chunks) <> " chunks..."
logDebug $ "uploading " <> tshow (length chunks) <> " chunks..."
(errs, rs) <- partitionEithers . concat <$> liftIO (pooledForConcurrentlyN 16 chunks' . mapM $ runExceptT . uploadFileChunk a)
mapM_ throwE errs
pure $ map snd (sortOn fst rs)
where
uploadFileChunk :: XFTPClientAgent -> (Int, XFTPChunkSpec, XFTPServerWithAuth) -> ExceptT CLIError IO (Int, SentFileChunk)
uploadFileChunk a (chunkNo, chunkSpec@XFTPChunkSpec {chunkSize}, ProtoServerWithAuth xftpServer auth) = do
logInfo $ "uploading chunk " <> tshow chunkNo <> " to " <> showServer xftpServer <> "..."
logDebug $ "uploading chunk " <> tshow chunkNo <> " to " <> showServer xftpServer <> "..."
(sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
rKeys <- atomically $ L.fromList <$> replicateM numRecipients (C.generateAuthKeyPair C.SEd25519 g)
digest <- liftIO $ getChunkDigest chunkSpec
@@ -337,7 +308,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
c <- withRetry retryCount $ getXFTPServerClient a xftpServer
(sndId, rIds) <- withRetry retryCount $ createXFTPChunk c spKey ch (L.map fst rKeys) auth
withReconnect a xftpServer retryCount $ \c' -> uploadXFTPChunk c' spKey sndId chunkSpec
logInfo $ "uploaded chunk " <> tshow chunkNo
logDebug $ "uploaded chunk " <> tshow chunkNo
uploaded <- atomically . stateTVar uploadedChunks $ \cs ->
let cs' = fromIntegral chunkSize : cs in (sum cs', cs')
liftIO $ do
@@ -414,13 +385,6 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
B.writeFile fdSndPath $ strEncode fdSnd
pure (fdRcvPaths, fdSndPath)
getChunkDigest :: XFTPChunkSpec -> IO ByteString
getChunkDigest XFTPChunkSpec {filePath = chunkPath, chunkOffset, chunkSize} =
withFile chunkPath ReadMode $ \h -> do
hSeek h AbsoluteSeek $ fromIntegral chunkOffset
chunk <- LB.hGet h (fromIntegral chunkSize)
pure $! LC.sha256Hash chunk
cliReceiveFile :: ReceiveOptions -> ExceptT CLIError IO ()
cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath, verbose, yes} =
getFileDescription' fileDescription >>= receive
@@ -454,11 +418,11 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
downloadFileChunk :: TVar ChaChaDRG -> XFTPClientAgent -> FilePath -> FileSize Int64 -> TVar [Int64] -> FileChunk -> ExceptT CLIError IO (Int, FilePath)
downloadFileChunk g a encPath (FileSize encSize) downloadedChunks FileChunk {chunkNo, chunkSize, digest, replicas = replica : _} = do
let FileChunkReplica {server, replicaId, replicaKey} = replica
logInfo $ "downloading chunk " <> tshow chunkNo <> " from " <> showServer server <> "..."
logDebug $ "downloading chunk " <> tshow chunkNo <> " from " <> showServer server <> "..."
chunkPath <- uniqueCombine encPath $ show chunkNo
let chunkSpec = XFTPRcvChunkSpec chunkPath (unFileSize chunkSize) (unFileDigest digest)
withReconnect a server retryCount $ \c -> downloadXFTPChunk g c replicaKey (unChunkReplicaId replicaId) chunkSpec
logInfo $ "downloaded chunk " <> tshow chunkNo <> " to " <> T.pack chunkPath
logDebug $ "downloaded chunk " <> tshow chunkNo <> " to " <> T.pack chunkPath
downloaded <- atomically . stateTVar downloadedChunks $ \cs ->
let cs' = fromIntegral (unFileSize chunkSize) : cs in (sum cs', cs')
liftIO $ do
@@ -503,7 +467,7 @@ cliDeleteFile DeleteOptions {fileDescription, retryCount, yes} = do
deleteFileChunk a FileChunk {chunkNo, replicas = replica : _} = do
let FileChunkReplica {server, replicaId, replicaKey} = replica
withReconnect a server retryCount $ \c -> deleteXFTPChunk c replicaKey (unChunkReplicaId replicaId)
logInfo $ "deleted chunk " <> tshow chunkNo <> " from " <> showServer server
logDebug $ "deleted chunk " <> tshow chunkNo <> " from " <> showServer server
deleteFileChunk _ _ = throwE $ CLIError "chunk has no replicas"
cliFileDescrInfo :: InfoOptions -> ExceptT CLIError IO ()
@@ -536,37 +500,6 @@ getFileDescription' path =
getFileDescription path >>= \case
AVFD fd -> either (throwE . CLIError) pure $ checkParty fd
singleChunkSize :: Int64 -> Maybe Word32
singleChunkSize size' =
listToMaybe $ dropWhile (< chunkSize) serverChunkSizes
where
chunkSize = fromIntegral size'
prepareChunkSizes :: Int64 -> [Word32]
prepareChunkSizes size' = prepareSizes size'
where
(smallSize, bigSize)
| size' > size34 chunkSize3 = (chunkSize2, chunkSize3)
| size' > size34 chunkSize2 = (chunkSize1, chunkSize2)
| otherwise = (chunkSize0, chunkSize1)
size34 sz = (fromIntegral sz * 3) `div` 4
prepareSizes 0 = []
prepareSizes size
| size >= fromIntegral bigSize = replicate (fromIntegral n1) bigSize <> prepareSizes remSz
| size > size34 bigSize = [bigSize]
| otherwise = replicate (fromIntegral n2') smallSize
where
(n1, remSz) = size `divMod` fromIntegral bigSize
n2' = let (n2, remSz2) = (size `divMod` fromIntegral smallSize) in if remSz2 == 0 then n2 else n2 + 1
prepareChunkSpecs :: FilePath -> [Word32] -> [XFTPChunkSpec]
prepareChunkSpecs filePath chunkSizes = reverse . snd $ foldl' addSpec (0, []) chunkSizes
where
addSpec :: (Int64, [XFTPChunkSpec]) -> Word32 -> (Int64, [XFTPChunkSpec])
addSpec (chunkOffset, specs) sz =
let spec = XFTPChunkSpec {filePath, chunkOffset, chunkSize = sz}
in (chunkOffset + fromIntegral sz, spec : specs)
getEncPath :: MonadIO m => Maybe FilePath -> String -> m FilePath
getEncPath path name = (`uniqueCombine` (name <> ".encrypted")) =<< maybe (liftIO getCanonicalTemporaryDirectory) pure path
+26 -8
View File
@@ -9,6 +9,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
@@ -37,6 +38,10 @@ module Simplex.FileTransfer.Description
FileClientData,
fileDescriptionURI,
qrSizeLimit,
maxFileSize,
maxFileSizeStr,
maxFileSizeHard,
fileSizeLen,
)
where
@@ -62,11 +67,10 @@ import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word32)
import qualified Data.Yaml as Y
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.FileTransfer.Chunks
import Simplex.FileTransfer.Protocol
import Simplex.Messaging.Agent.QueryString
import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, parseAll)
@@ -109,6 +113,9 @@ fdSeparator = "################################\n"
newtype FileDigest = FileDigest {unFileDigest :: ByteString}
deriving (Eq, Show)
deriving newtype (FromField)
instance ToField FileDigest where toField (FileDigest s) = toField $ Binary s
instance StrEncoding FileDigest where
strEncode (FileDigest fd) = strEncode fd
@@ -122,10 +129,6 @@ instance ToJSON FileDigest where
toJSON = strToJSON
toEncoding = strToJEncoding
instance FromField FileDigest where fromField f = FileDigest <$> fromField f
instance ToField FileDigest where toField (FileDigest s) = toField s
data FileChunk = FileChunk
{ chunkNo :: Int,
chunkSize :: FileSize Word32,
@@ -266,6 +269,21 @@ instance StrEncoding FileDescriptionURI where
qrSizeLimit :: Int
qrSizeLimit = 1002 -- ~2 chunks in URLencoded YAML with some spare size for server hosts
-- | Soft limit for XFTP clients. Should be checked and reported to user.
maxFileSize :: Int64
maxFileSize = gb 1
maxFileSizeStr :: String
maxFileSizeStr = B.unpack . strEncode $ FileSize maxFileSize
-- | Hard internal limit for XFTP agent after which it refuses to prepare chunks.
maxFileSizeHard :: Int64
maxFileSizeHard = gb 5
fileSizeLen :: Int64
fileSizeLen = 8
instance (Integral a, Show a) => StrEncoding (FileSize a) where
strEncode (FileSize b)
| b' /= 0 = bshow b
@@ -288,9 +306,9 @@ instance (Integral a, Show a) => StrEncoding (FileSize a) where
instance (Integral a, Show a) => IsString (FileSize a) where
fromString = either error id . strDecode . B.pack
instance FromField a => FromField (FileSize a) where fromField f = FileSize <$> fromField f
deriving newtype instance FromField a => FromField (FileSize a)
instance ToField a => ToField (FileSize a) where toField (FileSize s) = toField s
deriving newtype instance ToField a => ToField (FileSize a)
groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [NonEmpty FileServerReplica]
groupReplicasByServer defChunkSize =
+40 -20
View File
@@ -25,7 +25,7 @@ import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isNothing)
import Data.Type.Equality
import Data.Word (Word32)
import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPVersion, xftpClientHandshakeStub)
import Simplex.FileTransfer.Transport (XFTPErrorType (..), XFTPVersion, blockedFilesXFTPVersion, xftpClientHandshakeStub)
import Simplex.Messaging.Client (authTransmission)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
@@ -44,8 +44,9 @@ import Simplex.Messaging.Protocol
EntityId (..),
RecipientId,
SenderId,
RawTransmission,
SentRawTransmission,
SignedTransmission,
SignedTransmissionOrError,
SndPublicAuthKey,
Transmission,
TransmissionForAuth (..),
@@ -53,7 +54,8 @@ import Simplex.Messaging.Protocol
encodeTransmission,
encodeTransmissionForAuth,
messageTagP,
tDecodeParseValidate,
tDecodeServer,
tDecodeClient,
tEncodeBatch1,
tParse,
)
@@ -144,10 +146,15 @@ instance Protocol XFTPVersion XFTPErrorType FileResponse where
type ProtoCommand FileResponse = FileCmd
type ProtoType FileResponse = 'PXFTP
protocolClientHandshake = xftpClientHandshakeStub
{-# INLINE protocolClientHandshake #-}
useServiceAuth _ = False
{-# INLINE useServiceAuth #-}
protocolPing = FileCmd SFRecipient PING
{-# INLINE protocolPing #-}
protocolError = \case
FRErr e -> Just e
_ -> Nothing
{-# INLINE protocolError #-}
data FileCommand (p :: FileParty) where
FNEW :: FileInfo -> NonEmpty RcvPublicAuthKey -> Maybe BasicAuth -> FileCommand FSender
@@ -192,7 +199,7 @@ instance FilePartyI p => ProtocolEncoding XFTPVersion XFTPErrorType (FileCommand
fromProtocolError = fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
{-# INLINE fromProtocolError #-}
checkCredentials (auth, _, EntityId fileId, _) cmd = case cmd of
checkCredentials auth (EntityId fileId) cmd = case cmd of
-- FNEW must not have signature and chunk ID
FNEW {}
| isNothing auth -> Left $ CMD NO_AUTH
@@ -226,7 +233,8 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileCmd where
fromProtocolError = fromProtocolError @XFTPVersion @XFTPErrorType @FileResponse
{-# INLINE fromProtocolError #-}
checkCredentials t (FileCmd p c) = FileCmd p <$> checkCredentials t c
checkCredentials tAuth entId (FileCmd p c) = FileCmd p <$> checkCredentials tAuth entId c
{-# INLINE checkCredentials #-}
instance Encoding FileInfo where
smpEncode FileInfo {sndKey, size, digest} = smpEncode (sndKey, size, digest)
@@ -276,12 +284,14 @@ data FileResponse
instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
type Tag FileResponse = FileResponseTag
encodeProtocol _v = \case
encodeProtocol v = \case
FRSndIds fId rIds -> e (FRSndIds_, ' ', fId, rIds)
FRRcvIds rIds -> e (FRRcvIds_, ' ', rIds)
FRFile rDhKey nonce -> e (FRFile_, ' ', rDhKey, nonce)
FROk -> e FROk_
FRErr err -> e (FRErr_, ' ', err)
FRErr err -> case err of
BLOCKED _ | v < blockedFilesXFTPVersion -> e (FRErr_, ' ', AUTH)
_ -> e (FRErr_, ' ', err)
FRPong -> e FRPong_
where
e :: Encoding a => a -> ByteString
@@ -302,7 +312,7 @@ instance ProtocolEncoding XFTPVersion XFTPErrorType FileResponse where
PEBlock -> BLOCK
{-# INLINE fromProtocolError #-}
checkCredentials (_, _, EntityId entId, _) cmd = case cmd of
checkCredentials _ (EntityId entId) cmd = case cmd of
FRSndIds {} -> noEntity
-- ERR response does not always have entity ID
FRErr _ -> Right cmd
@@ -327,25 +337,35 @@ checkParty' c = case testEquality (sFileParty @p) (sFileParty @p') of
Just Refl -> Just c
_ -> Nothing
xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
xftpEncodeAuthTransmission thParams@THandleParams {thAuth} pKey (corrId, fId, msg) = do
let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (corrId, fId, msg)
xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth (Just pKey) (C.cbNonce $ bs corrId) tForAuth
xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
xftpEncodeAuthTransmission thParams@THandleParams {thAuth} pKey t@(corrId, _, _) = do
let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams t
xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth False (Just pKey) (C.cbNonce $ bs corrId) tForAuth
xftpEncodeTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
xftpEncodeTransmission thParams (corrId, fId, msg) = do
let t = encodeTransmission thParams (corrId, fId, msg)
xftpEncodeBatch1 (Nothing, t)
xftpEncodeTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
xftpEncodeTransmission thParams t = xftpEncodeBatch1 (Nothing, encodeTransmission thParams t)
-- this function uses batch syntax but puts only one transmission in the batch
xftpEncodeBatch1 :: SentRawTransmission -> Either TransportError ByteString
xftpEncodeBatch1 t = first (const TELargeMsg) $ C.pad (tEncodeBatch1 t) xftpBlockSize
xftpEncodeBatch1 t = first (const TELargeMsg) $ C.pad (tEncodeBatch1 False t) xftpBlockSize
xftpDecodeTransmission :: ProtocolEncoding XFTPVersion e c => THandleParams XFTPVersion p -> ByteString -> Either XFTPErrorType (SignedTransmission e c)
xftpDecodeTransmission thParams t = do
xftpDecodeTServer :: THandleParams XFTPVersion 'TServer -> ByteString -> Either XFTPErrorType (SignedTransmissionOrError XFTPErrorType FileCmd)
xftpDecodeTServer = xftpDecodeTransmission tDecodeServer
{-# INLINE xftpDecodeTServer #-}
xftpDecodeTClient :: THandleParams XFTPVersion 'TClient -> ByteString -> Either XFTPErrorType (Transmission (Either XFTPErrorType FileResponse))
xftpDecodeTClient = xftpDecodeTransmission tDecodeClient
{-# INLINE xftpDecodeTClient #-}
xftpDecodeTransmission ::
(THandleParams XFTPVersion p -> Either TransportError RawTransmission -> r) ->
THandleParams XFTPVersion p ->
ByteString ->
Either XFTPErrorType r
xftpDecodeTransmission tDecode thParams t = do
t' <- first (const BLOCK) $ C.unPad t
case tParse thParams t' of
t'' :| [] -> Right $ tDecodeParseValidate thParams t''
t'' :| [] -> Right $ tDecode thParams t''
_ -> Left BLOCK
$(J.deriveJSON (enumJSON $ dropPrefix "F") ''FileParty)
+129 -79
View File
@@ -26,12 +26,12 @@ import Data.ByteString.Builder (Builder, byteString)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import Data.Word (Word32)
@@ -45,6 +45,7 @@ import Network.Socket
import Simplex.FileTransfer.Protocol
import Simplex.FileTransfer.Server.Control
import Simplex.FileTransfer.Server.Env
import Simplex.FileTransfer.Server.Prometheus
import Simplex.FileTransfer.Server.Stats
import Simplex.FileTransfer.Server.Store
import Simplex.FileTransfer.Server.StoreLog
@@ -53,14 +54,16 @@ import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Lazy as LC
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (CorrId (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, TransmissionAuth, pattern NoEntity)
import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
import Simplex.Messaging.Protocol (BlockingInfo, EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, SignedTransmission, pattern NoEntity)
import Simplex.Messaging.Server (controlPortAuth, dummyVerifyCmd, verifyCmdAuthorization)
import Simplex.Messaging.Server.Control (CPClientRole (..))
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, getRoundedSystemTime)
import Simplex.Messaging.Server.QueueStore (ServerEntityStatus (..))
import Simplex.Messaging.Server.Stats
import Simplex.Messaging.SystemTime
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (ALPN, SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
import Simplex.Messaging.Transport (CertChainPubKey (..), SessionId, THandleAuth (..), THandleParams (..), TransportPeer (..), defaultSupportedParams)
import Simplex.Messaging.Transport.Buffer (trimCR)
import Simplex.Messaging.Transport.HTTP2
import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize)
@@ -68,6 +71,7 @@ import Simplex.Messaging.Transport.HTTP2.Server
import Simplex.Messaging.Transport.Server (runLocalTCPServer)
import Simplex.Messaging.Util
import Simplex.Messaging.Version
import System.Environment (lookupEnv)
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (hPrint, hPutStrLn, universalNewlineMode)
@@ -91,39 +95,46 @@ data XFTPTransportRequest = XFTPTransportRequest
runXFTPServer :: XFTPServerConfig -> IO ()
runXFTPServer cfg = do
started <- newEmptyTMVarIO
runXFTPServerBlocking started cfg $ Just supportedXFTPhandshakes
runXFTPServerBlocking started cfg
runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> Maybe [ALPN] -> IO ()
runXFTPServerBlocking started cfg alpn_ = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started alpn_)
runXFTPServerBlocking :: TMVar Bool -> XFTPServerConfig -> IO ()
runXFTPServerBlocking started cfg = newXFTPServerEnv cfg >>= runReaderT (xftpServer cfg started)
data Handshake
= HandshakeSent C.PrivateKeyX25519
| HandshakeAccepted (THandleParams XFTPVersion 'TServer)
xftpServer :: XFTPServerConfig -> TMVar Bool -> Maybe [ALPN] -> M ()
xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started alpn_ = do
xftpServer :: XFTPServerConfig -> TMVar Bool -> M ()
xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpiration, fileExpiration, xftpServerVRange} started = do
mapM_ (expireServerFiles Nothing) fileExpiration
restoreServerStats
raceAny_ (runServer : expireFilesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg) `finally` stopServer
raceAny_
( runServer
: expireFilesThread_ cfg
<> serverStatsThread_ cfg
<> prometheusMetricsThread_ cfg
<> controlPortThread_ cfg
)
`finally` stopServer
where
runServer :: M ()
runServer = do
srvCreds@(chain, pk) <- asks tlsServerCreds
signKey <- liftIO $ case C.x509ToPrivate (pk, []) >>= C.privKey of
signKey <- liftIO $ case C.x509ToPrivate' pk of
Right pk' -> pure pk'
Left e -> putStrLn ("servers has no valid key: " <> show e) >> exitFailure
Left e -> putStrLn ("Server has no valid key: " <> show e) >> exitFailure
env <- ask
sessions <- liftIO TM.emptyIO
let cleanup sessionId = atomically $ TM.delete sessionId sessions
liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize defaultSupportedParams srvCreds alpn_ transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize defaultSupportedParams srvCreds transportConfig inactiveClientExpiration cleanup $ \sessionId sessionALPN r sendResponse -> do
reqBody <- getHTTP2Body r xftpBlockSize
let v = VersionXFTP 1
thServerVRange = versionToRange v
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, batch = True}
thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, batch = True, serviceAuth = False}
req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse}
flip runReaderT env $ case sessionALPN of
Nothing -> processRequest req0
Just "xftp/1" ->
Just alpn | alpn == xftpALPNv1 || alpn == httpALPN11 ->
xftpServerHandshakeV1 chain signKey sessions req0 >>= \case
Nothing -> pure () -- handshake response sent
Just thParams -> processRequest req0 {thParams} -- proceed with new version (XXX: may as well switch the request handler here)
@@ -141,7 +152,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
unless (B.null bodyHead) $ throwE HANDSHAKE
(k, pk) <- atomically . C.generateKeyPair =<< asks random
atomically $ TM.insert sessionId (HandshakeSent pk) sessions
let authPubKey = (chain, C.signX509 serverSignKey $ C.publicToX509 k)
let authPubKey = CertChainPubKey chain (C.signX509 serverSignKey $ C.publicToX509 k)
let hs = XFTPServerHandshake {xftpVersionRange = xftpServerVRange, sessionId, authPubKey}
shs <- encodeXftp hs
#ifdef slow_servers
@@ -157,7 +168,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
unless (keyHash == kh) $ throwE HANDSHAKE
case compatibleVRange' xftpServerVRange v of
Just (Compatible vr) -> do
let auth = THAuthServer {serverPrivKey = pk, sessSecret' = Nothing}
let auth = THAuthServer {serverPrivKey = pk, peerClientService = Nothing, sessSecret' = Nothing}
thParams = thParams0 {thAuth = Just auth, thVersion = v, thServerVRange = vr}
atomically $ TM.insert sessionId (HandshakeAccepted thParams) sessions
#ifdef slow_servers
@@ -180,6 +191,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
stopServer = do
withFileLog closeStoreLog
saveServerStats
logNote "Server stopped"
expireFilesThread_ :: XFTPServerConfig -> [M ()]
expireFilesThread_ XFTPServerConfig {fileExpiration = Just fileExp} = [expireFiles fileExp]
@@ -219,25 +231,49 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
fileDownloadAcks' <- atomicSwapIORef fileDownloadAcks 0
filesCount' <- readIORef filesCount
filesSize' <- readIORef filesSize
hPutStrLn h $
intercalate
T.hPutStrLn h $
T.intercalate
","
[ iso8601Show $ utctDay fromTime',
show filesCreated',
show fileRecipients',
show filesUploaded',
show filesDeleted',
[ T.pack $ iso8601Show $ utctDay fromTime',
tshow filesCreated',
tshow fileRecipients',
tshow filesUploaded',
tshow filesDeleted',
dayCount files,
weekCount files,
monthCount files,
show fileDownloads',
show fileDownloadAcks',
show filesCount',
show filesSize',
show filesExpired'
tshow fileDownloads',
tshow fileDownloadAcks',
tshow filesCount',
tshow filesSize',
tshow filesExpired'
]
liftIO $ threadDelay' interval
prometheusMetricsThread_ :: XFTPServerConfig -> [M ()]
prometheusMetricsThread_ XFTPServerConfig {prometheusInterval = Just interval, prometheusMetricsFile} =
[savePrometheusMetrics interval prometheusMetricsFile]
prometheusMetricsThread_ _ = []
savePrometheusMetrics :: Int -> FilePath -> M ()
savePrometheusMetrics saveInterval metricsFile = do
labelMyThread "savePrometheusMetrics"
liftIO $ putStrLn $ "Prometheus metrics saved every " <> show saveInterval <> " seconds to " <> metricsFile
ss <- asks serverStats
rtsOpts <- liftIO $ maybe ("set " <> rtsOptionsEnv) T.pack <$> lookupEnv (T.unpack rtsOptionsEnv)
let interval = 1000000 * saveInterval
liftIO $ forever $ do
threadDelay interval
ts <- getCurrentTime
sm <- getFileServerMetrics ss rtsOpts
T.writeFile metricsFile $ xftpPrometheusMetrics sm ts
getFileServerMetrics :: FileServerStats -> T.Text -> IO FileServerMetrics
getFileServerMetrics ss rtsOptions = do
d <- getFileServerStatsData ss
let fd = periodStatDataCounts $ _filesDownloaded d
pure FileServerMetrics {statsData = d, filesDownloadedPeriods = fd, rtsOptions}
controlPortThread_ :: XFTPServerConfig -> [M ()]
controlPortThread_ XFTPServerConfig {controlPort = Just port} = [runCPServer port]
controlPortThread_ _ = []
@@ -275,21 +311,22 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
CPSkip -> False
_ -> True
processCP h role = \case
CPAuth auth -> atomically $ writeTVar role $! newRole cfg
CPAuth auth -> controlPortAuth h user admin role auth
where
newRole XFTPServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
| Just auth == admin = CPRAdmin
| Just auth == user = CPRUser
| otherwise = CPRNone
XFTPServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin} = cfg
CPStatsRTS -> E.tryAny getRTSStats >>= either (hPrint h) (hPrint h)
CPDelete fileId -> withUserRole $ unliftIO u $ do
fs <- asks store
r <- runExceptT $ do
let asSender = ExceptT . atomically $ getFile fs SFSender fileId
let asRecipient = ExceptT . atomically $ getFile fs SFRecipient fileId
(fr, _) <- asSender `catchError` const asRecipient
(fr, _) <- ExceptT $ atomically $ getFile fs SFRecipient fileId
ExceptT $ deleteServerFile_ fr
liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
CPBlock fileId info -> withUserRole $ unliftIO u $ do
fs <- asks store
r <- runExceptT $ do
(fr, _) <- ExceptT $ atomically $ getFile fs SFRecipient fileId
ExceptT $ blockServerFile fr info
liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
CPHelp -> hPutStrLn h "commands: stats-rts, delete, help, quit"
CPQuit -> pure ()
CPSkip -> pure ()
@@ -311,22 +348,20 @@ data ServerFile = ServerFile
processRequest :: XFTPTransportRequest -> M ()
processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse}
| B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
| otherwise = do
case xftpDecodeTransmission thParams bodyHead of
Right (sig_, signed, (corrId, fId, cmdOrErr)) ->
case cmdOrErr of
Right cmd -> do
let THandleParams {thAuth} = thParams
verifyXFTPTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) sig_ signed fId cmd >>= \case
VRVerified req -> uncurry send =<< processXFTPRequest body req
VRFailed -> send (FRErr AUTH) Nothing
Left e -> send (FRErr e) Nothing
| otherwise =
case xftpDecodeTServer thParams bodyHead of
Right (Right t@(_, _, (corrId, fId, _))) -> do
let THandleParams {thAuth} = thParams
verifyXFTPTransmission thAuth t >>= \case
VRVerified req -> uncurry send =<< processXFTPRequest body req
VRFailed e -> send (FRErr e) Nothing
where
send resp = sendXFTPResponse (corrId, fId, resp)
Right (Left (corrId, fId, e)) -> sendXFTPResponse (corrId, fId, FRErr e) Nothing
Left e -> sendXFTPResponse ("", NoEntity, FRErr e) Nothing
where
sendXFTPResponse (corrId, fId, resp) serverFile_ = do
let t_ = xftpEncodeTransmission thParams (corrId, fId, resp)
sendXFTPResponse t' serverFile_ = do
let t_ = xftpEncodeTransmission thParams t'
#ifdef slow_servers
randomDelay
#endif
@@ -353,10 +388,10 @@ randomDelay = do
threadDelay $ (d * (1000 + pc)) `div` 1000
#endif
data VerificationResult = VRVerified XFTPRequest | VRFailed
data VerificationResult = VRVerified XFTPRequest | VRFailed XFTPErrorType
verifyXFTPTransmission :: Maybe (THandleAuth 'TServer, C.CbNonce) -> Maybe TransmissionAuth -> ByteString -> XFTPFileId -> FileCmd -> M VerificationResult
verifyXFTPTransmission auth_ tAuth authorized fId cmd =
verifyXFTPTransmission :: Maybe (THandleAuth 'TServer) -> SignedTransmission FileCmd -> M VerificationResult
verifyXFTPTransmission thAuth (tAuth, authorized, (corrId, fId, cmd)) =
case cmd of
FileCmd SFSender (FNEW file rcps auth') -> pure $ XFTPReqNew file rcps auth' `verifyWith` sndKey file
FileCmd SFRecipient PING -> pure $ VRVerified XFTPReqPing
@@ -365,13 +400,19 @@ verifyXFTPTransmission auth_ tAuth authorized fId cmd =
verifyCmd :: SFileParty p -> M VerificationResult
verifyCmd party = do
st <- asks store
atomically $ verify <$> getFile st party fId
atomically $ verify =<< getFile st party fId
where
verify = \case
Right (fr, k) -> XFTPReqCmd fId fr cmd `verifyWith` k
_ -> maybe False (dummyVerifyCmd Nothing authorized) tAuth `seq` VRFailed
Right (fr, k) -> result <$> readTVar (fileStatus fr)
where
result = \case
EntityActive -> XFTPReqCmd fId fr cmd `verifyWith` k
EntityBlocked info -> VRFailed $ BLOCKED info
EntityOff -> noFileAuth
Left _ -> pure noFileAuth
noFileAuth = dummyVerifyCmd thAuth tAuth authorized corrId `seq` VRFailed AUTH
-- TODO verify with DH authorization
req `verifyWith` k = if verifyCmdAuthorization auth_ tAuth authorized k then VRVerified req else VRFailed
req `verifyWith` k = if verifyCmdAuthorization thAuth tAuth authorized corrId k then VRVerified req else VRFailed AUTH
processXFTPRequest :: HTTP2Body -> XFTPRequest -> M (FileResponse, Maybe ServerFile)
processXFTPRequest HTTP2Body {bodyPart} = \case
@@ -388,7 +429,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
FACK -> noFile =<< ackFileReception fId fr
-- it should never get to the commands below, they are passed in other constructors of XFTPRequest
FNEW {} -> noFile $ FRErr INTERNAL
PING -> noFile FRPong
PING -> noFile $ FRErr INTERNAL
XFTPReqPing -> noFile FRPong
where
noFile resp = pure (resp, Nothing)
@@ -403,7 +444,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
sId <- ExceptT $ addFileRetry st file 3 ts
rcps <- mapM (ExceptT . addRecipientRetry st 3 sId) rks
lift $ withFileLog $ \sl -> do
logAddFile sl sId file ts
logAddFile sl sId file ts EntityActive
logAddRecipients sl sId rcps
stats <- asks serverStats
lift $ incFileStat filesCreated
@@ -411,10 +452,10 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
pure $ FRSndIds sId rIds
pure $ either FRErr id r
addFileRetry :: FileStore -> FileInfo -> Int -> RoundedSystemTime -> M (Either XFTPErrorType XFTPFileId)
addFileRetry :: FileStore -> FileInfo -> Int -> RoundedFileTime -> M (Either XFTPErrorType XFTPFileId)
addFileRetry st file n ts =
retryAdd n $ \sId -> runExceptT $ do
ExceptT $ addFile st sId file ts
ExceptT $ addFile st sId file ts EntityActive
pure sId
addRecipientRetry :: FileStore -> Int -> XFTPFileId -> RcvPublicAuthKey -> M (Either XFTPErrorType FileRecipient)
addRecipientRetry st n sId rpk =
@@ -516,22 +557,31 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
pure FROk
deleteServerFile_ :: FileRec -> M (Either XFTPErrorType ())
deleteServerFile_ FileRec {senderId, fileInfo, filePath} = do
deleteServerFile_ fr@FileRec {senderId} = do
withFileLog (`logDeleteFile` senderId)
runExceptT $ do
path <- readTVarIO filePath
stats <- asks serverStats
ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
st <- asks store
void $ atomically $ deleteFile st senderId
lift $ incFileStat filesDeleted
deleteOrBlockServerFile_ fr filesDeleted (`deleteFile` senderId)
-- this also deletes the file from storage, but doesn't include it in delete statistics
blockServerFile :: FileRec -> BlockingInfo -> M (Either XFTPErrorType ())
blockServerFile fr@FileRec {senderId} info = do
withFileLog $ \sl -> logBlockFile sl senderId info
deleteOrBlockServerFile_ fr filesBlocked $ \st -> blockFile st senderId info True
deleteOrBlockServerFile_ :: FileRec -> (FileServerStats -> IORef Int) -> (FileStore -> STM (Either XFTPErrorType ())) -> M (Either XFTPErrorType ())
deleteOrBlockServerFile_ FileRec {filePath, fileInfo} stat storeAction = runExceptT $ do
path <- readTVarIO filePath
stats <- asks serverStats
ExceptT $ first (\(_ :: SomeException) -> FILE_IO) <$> try (forM_ path $ \p -> whenM (doesFileExist p) (removeFile p >> deletedStats stats))
st <- asks store
void $ atomically $ storeAction st
lift $ incFileStat stat
where
deletedStats stats = do
liftIO $ atomicModifyIORef'_ (filesCount stats) (subtract 1)
liftIO $ atomicModifyIORef'_ (filesSize stats) (subtract $ fromIntegral $ size fileInfo)
getFileTime :: IO RoundedSystemTime
getFileTime = getRoundedSystemTime fileTimePrecision
getFileTime :: IO RoundedFileTime
getFileTime = getRoundedSystemTime
expireServerFiles :: Maybe Int -> ExpirationConfig -> M ()
expireServerFiles itemDelay expCfg = do
@@ -539,13 +589,13 @@ expireServerFiles itemDelay expCfg = do
usedStart <- readTVarIO $ usedStorage st
old <- liftIO $ expireBeforeEpoch expCfg
files' <- readTVarIO (files st)
logInfo $ "Expiration check: " <> tshow (M.size files') <> " files"
logNote $ "Expiration check: " <> tshow (M.size files') <> " files"
forM_ (M.keys files') $ \sId -> do
mapM_ threadDelay itemDelay
atomically (expiredFilePath st sId old)
>>= mapM_ (maybeRemove $ delete st sId)
usedEnd <- readTVarIO $ usedStorage st
logInfo $ "Used " <> mbs usedStart <> " -> " <> mbs usedEnd <> ", " <> mbs (usedStart - usedEnd) <> " reclaimed."
logNote $ "Used " <> mbs usedStart <> " -> " <> mbs usedEnd <> ", " <> mbs (usedStart - usedEnd) <> " reclaimed."
where
mbs bs = tshow (bs `div` 1048576) <> "mb"
maybeRemove del = maybe del (remove del)
@@ -579,15 +629,15 @@ saveServerStats =
>>= mapM_ (\f -> asks serverStats >>= liftIO . getFileServerStatsData >>= liftIO . saveStats f)
where
saveStats f stats = do
logInfo $ "saving server stats to file " <> T.pack f
logNote $ "saving server stats to file " <> T.pack f
B.writeFile f $ strEncode stats
logInfo "server stats saved"
logNote "server stats saved"
restoreServerStats :: M ()
restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStats
where
restoreStats f = whenM (doesFileExist f) $ do
logInfo $ "restoring server stats from file " <> T.pack f
logNote $ "restoring server stats from file " <> T.pack f
liftIO (strDecode <$> B.readFile f) >>= \case
Right d@FileServerStatsData {_filesCount = statsFilesCount, _filesSize = statsFilesSize} -> do
s <- asks serverStats
@@ -596,10 +646,10 @@ restoreServerStats = asks (serverStatsBackupFile . config) >>= mapM_ restoreStat
_filesSize <- readTVarIO usedStorage
liftIO $ setFileServerStats s d {_filesCount, _filesSize}
renameFile f $ f <> ".bak"
logInfo "server stats restored"
logNote "server stats restored"
when (statsFilesCount /= _filesCount) $ logWarn $ "Files count differs: stats: " <> tshow statsFilesCount <> ", store: " <> tshow _filesCount
when (statsFilesSize /= _filesSize) $ logWarn $ "Files size differs: stats: " <> tshow statsFilesSize <> ", store: " <> tshow _filesSize
logInfo $ "Restored " <> tshow (_filesSize `div` 1048576) <> " MBs in " <> tshow _filesCount <> " files"
logNote $ "Restored " <> tshow (_filesSize `div` 1048576) <> " MBs in " <> tshow _filesCount <> " files"
Left e -> do
logInfo $ "error restoring server stats: " <> T.pack e
logNote $ "error restoring server stats: " <> T.pack e
liftIO exitFailure
+4 -3
View File
@@ -6,14 +6,13 @@ module Simplex.FileTransfer.Server.Control where
import qualified Data.Attoparsec.ByteString.Char8 as A
import Simplex.FileTransfer.Protocol (XFTPFileId)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (BasicAuth)
data CPClientRole = CPRNone | CPRUser | CPRAdmin
import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo)
data ControlProtocol
= CPAuth BasicAuth
| CPStatsRTS
| CPDelete XFTPFileId
| CPBlock XFTPFileId BlockingInfo
| CPHelp
| CPQuit
| CPSkip
@@ -23,6 +22,7 @@ instance StrEncoding ControlProtocol where
CPAuth tok -> "auth " <> strEncode tok
CPStatsRTS -> "stats-rts"
CPDelete fId -> strEncode (Str "delete", fId)
CPBlock fId info -> strEncode (Str "block", fId, info)
CPHelp -> "help"
CPQuit -> "quit"
CPSkip -> ""
@@ -31,6 +31,7 @@ instance StrEncoding ControlProtocol where
"auth" -> CPAuth <$> _strP
"stats-rts" -> pure CPStatsRTS
"delete" -> CPDelete <$> _strP
"block" -> CPBlock <$> _strP <*> _strP
"help" -> pure CPHelp
"quit" -> pure CPQuit
"" -> pure CPSkip
+5 -7
View File
@@ -28,7 +28,6 @@ import Simplex.FileTransfer.Transport (VersionRangeXFTP)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Protocol (BasicAuth, RcvPublicAuthKey)
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Transport (ALPN)
import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), loadFingerprint, loadServerCredential)
import Simplex.Messaging.Util (tshow)
import System.IO (IOMode (..))
@@ -65,6 +64,8 @@ data XFTPServerConfig = XFTPServerConfig
logStatsStartTime :: Int64,
serverStatsLogFile :: FilePath,
serverStatsBackupFile :: Maybe FilePath,
prometheusInterval :: Maybe Int,
prometheusMetricsFile :: FilePath,
transportConfig :: TransportServerConfig,
responseDelay :: Int
}
@@ -72,7 +73,7 @@ data XFTPServerConfig = XFTPServerConfig
defaultInactiveClientExpiration :: ExpirationConfig
defaultInactiveClientExpiration =
ExpirationConfig
{ ttl = 43200, -- seconds, 12 hours
{ ttl = 21600, -- seconds, 6 hours
checkInterval = 3600 -- seconds, 1 hours
}
@@ -96,9 +97,6 @@ defaultFileExpiration =
checkInterval = 2 * 3600 -- seconds, 2 hours
}
supportedXFTPhandshakes :: [ALPN]
supportedXFTPhandshakes = ["xftp/1"]
newXFTPServerEnv :: XFTPServerConfig -> IO XFTPEnv
newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCredentials} = do
random <- C.newRandom
@@ -107,8 +105,8 @@ newXFTPServerEnv config@XFTPServerConfig {storeLogFile, fileSizeQuota, xftpCrede
used <- countUsedStorage <$> readTVarIO (files store)
atomically $ writeTVar (usedStorage store) used
forM_ fileSizeQuota $ \quota -> do
logInfo $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
when (quota < used) $ logInfo "WARNING: storage quota is less than used storage, no files can be uploaded!"
logNote $ "Total / available storage: " <> tshow quota <> " / " <> tshow (quota - used)
when (quota < used) $ logWarn "WARNING: storage quota is less than used storage, no files can be uploaded!"
tlsServerCreds <- loadServerCredential xftpCredentials
Fingerprint fp <- loadFingerprint xftpCredentials
serverStats <- newFileServerStats =<< getCurrentTime
+40 -20
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -20,16 +21,16 @@ import Simplex.FileTransfer.Chunks
import Simplex.FileTransfer.Description (FileSize (..))
import Simplex.FileTransfer.Server (runXFTPServer)
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration)
import Simplex.FileTransfer.Transport (supportedFileServerVRange)
import Simplex.FileTransfer.Transport (supportedFileServerVRange, alpnSupportedXFTPhandshakes)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer)
import Simplex.Messaging.Server.CLI
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Transport (simplexMQVersion)
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
import Simplex.Messaging.Transport.HTTP2 (httpALPN)
import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FilePath (combine)
import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
@@ -51,13 +52,15 @@ xftpServerCLI cfgPath logPath = do
True -> readIniFile iniFile >>= either exitError runServer
_ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `" <> executableName <> " init`."
Delete -> do
confirmOrExit "WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
confirmOrExit
"WARNING: deleting the server will make all queues inaccessible, because the server identity (certificate fingerprint) will change.\nTHIS CANNOT BE UNDONE!"
"Server NOT deleted"
deleteDirIfExists cfgPath
deleteDirIfExists logPath
putStrLn "Deleted configuration and log files"
where
iniFile = combine cfgPath "file-server.ini"
serverVersion = "SimpleX XFTP server v" <> simplexMQVersion
serverVersion = "SimpleX XFTP server v" <> simplexmqVersionCommit
defaultServerPort = "443"
executableName = "file-server"
storeLogFilePath = combine logPath "file-server-store.log"
@@ -86,6 +89,9 @@ xftpServerCLI cfgPath logPath = do
<> "# Expire files after the specified number of hours.\n"
<> ("expire_files_hours: " <> tshow defFileExpirationHours <> "\n\n")
<> "log_stats: off\n\
\\n\
\# Log interval for real-time Prometheus metrics\n\
\# prometheus_interval: 60\n\
\\n\
\[AUTH]\n\
\# Set new_files option to off to completely prohibit uploading new files.\n\
@@ -101,6 +107,7 @@ xftpServerCLI cfgPath logPath = do
\\n\
\# control_port_admin_password:\n\
\# control_port_user_password:\n\
\\n\
\[TRANSPORT]\n\
\# host is only used to print server address on start\n"
<> ("host: " <> T.pack host <> "\n")
@@ -184,10 +191,13 @@ xftpServerCLI cfgPath logPath = do
logStatsStartTime = 0, -- seconds from 00:00 UTC
serverStatsLogFile = combine logPath "file-server-stats.daily.log",
serverStatsBackupFile = logStats $> combine logPath "file-server-stats.log",
prometheusInterval = eitherToMaybe $ read . T.unpack <$> lookupValue "STORE_LOG" "prometheus_interval" ini,
prometheusMetricsFile = combine logPath "xftp-server-metrics.txt",
transportConfig =
defaultTransportServerConfig
{ logTLSErrors = fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini
},
mkTransportServerConfig
(fromMaybe False $ iniOnOff "TRANSPORT" "log_tls_errors" ini)
(Just $ alpnSupportedXFTPhandshakes <> httpALPN)
False,
responseDelay = 0
}
@@ -217,14 +227,19 @@ cliCommandP cfgPath logPath iniFile =
)
where
initP :: Parser InitOptions
initP =
InitOptions
<$> switch
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence"
initP = do
enableStoreLog <-
flag' False
( long "disable-store-log"
<> help "Disable store log for persistence (enabled by default)"
)
<*> option
<|> flag True True
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence (DEPRECATED, enabled by default)"
)
signAlgorithm <-
option
(maybeReader readMaybe)
( long "sign-algorithm"
<> short 'a'
@@ -233,7 +248,8 @@ cliCommandP cfgPath logPath iniFile =
<> showDefault
<> metavar "ALG"
)
<*> strOption
ip <-
strOption
( long "ip"
<> help
"Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
@@ -241,22 +257,26 @@ cliCommandP cfgPath logPath iniFile =
<> showDefault
<> metavar "IP"
)
<*> (optional . strOption)
fqdn <-
(optional . strOption)
( long "fqdn"
<> short 'n'
<> help "Server FQDN used as Common Name for TLS online certificate"
<> showDefault
<> metavar "FQDN"
)
<*> strOption
filesPath <-
strOption
( long "path"
<> short 'p'
<> help "Path to the directory to store files"
<> metavar "PATH"
)
<*> strOption
fileSizeQuota <-
strOption
( long "quota"
<> short 'q'
<> help "File storage quota (e.g. 100gb)"
<> metavar "QUOTA"
)
pure InitOptions {enableStoreLog, signAlgorithm, ip, fqdn, filesPath, fileSizeQuota}
@@ -0,0 +1,134 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
module Simplex.FileTransfer.Server.Prometheus where
import Data.Int (Int64)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime (..), diffUTCTime)
import Data.Time.Clock.System (systemEpochDay)
import Data.Time.Format.ISO8601 (iso8601Show)
import Simplex.FileTransfer.Server.Stats
import Simplex.Messaging.Server.Stats (PeriodStatCounts (..))
import Simplex.Messaging.Transport (simplexMQVersion)
import Simplex.Messaging.Util (tshow)
data FileServerMetrics = FileServerMetrics
{ statsData :: FileServerStatsData,
filesDownloadedPeriods :: PeriodStatCounts,
rtsOptions :: Text
}
rtsOptionsEnv :: Text
rtsOptionsEnv = "XFTP_RTS_OPTIONS"
{-# FOURMOLU_DISABLE\n#-}
xftpPrometheusMetrics :: FileServerMetrics -> UTCTime -> Text
xftpPrometheusMetrics sm ts =
time <> files <> info
where
FileServerMetrics {statsData, filesDownloadedPeriods, rtsOptions} = sm
FileServerStatsData
{ _fromTime,
_filesCreated,
_fileRecipients,
_filesUploaded,
_filesExpired,
_filesDeleted,
_filesBlocked,
_fileDownloads,
_fileDownloadAcks,
_filesCount,
_filesSize
} = statsData
time =
"# Recorded at: " <> T.pack (iso8601Show ts) <> "\n\
\# Stats from: " <> T.pack (iso8601Show _fromTime) <> "\n\
\\n"
files =
"# Files\n\
\# -----\n\
\\n\
\# HELP simplex_xftp_files_created Created files\n\
\# TYPE simplex_xftp_files_created counter\n\
\simplex_xftp_files_created " <> mshow _filesCreated <> "\n\
\# filesCreated\n\
\\n\
\# HELP simplex_xftp_files_recipients Files recipients\n\
\# TYPE simplex_xftp_files_recipients counter\n\
\simplex_xftp_files_recipients " <> mshow _fileRecipients <> "\n\
\# fileRecipients\n\
\\n\
\# HELP simplex_xftp_files_uploaded Uploaded files\n\
\# TYPE simplex_xftp_files_uploaded counter\n\
\simplex_xftp_files_uploaded " <> mshow _filesUploaded <> "\n\
\# filesUploaded\n\
\\n\
\# HELP simplex_xftp_files_expired Expired files\n\
\# TYPE simplex_xftp_files_expired counter\n\
\simplex_xftp_files_expired " <> mshow _filesExpired <> "\n\
\# filesExpired\n\
\\n\
\# HELP simplex_xftp_files_deleted Deleted files\n\
\# TYPE simplex_xftp_files_deleted counter\n\
\simplex_xftp_files_deleted " <> mshow _filesDeleted <> "\n\
\# filesDeleted\n\
\\n\
\# HELP simplex_xftp_files_blocked Blocked files\n\
\# TYPE simplex_xftp_files_blocked counter\n\
\simplex_xftp_files_blocked " <> mshow _filesBlocked <> "\n\
\# filesBlocked\n\
\\n\
\# HELP simplex_xftp_file_downloads File downloads\n\
\# TYPE simplex_xftp_file_downloads counter\n\
\simplex_xftp_file_downloads " <> mshow _fileDownloads <> "\n\
\# fileDownloads\n\
\\n\
\# HELP simplex_xftp_file_download_acks File download ACKs\n\
\# TYPE simplex_xftp_file_download_acks counter\n\
\simplex_xftp_file_download_acks " <> mshow _fileDownloadAcks <> "\n\
\# fileDownloadAcks\n\
\\n\
\# HELP simplex_xftp_files_count_total Total files count \n\
\# TYPE simplex_xftp_files_count_total gauge\n\
\simplex_xftp_files_count_total " <> mshow _filesCount <> "\n\
\# filesCount\n\
\\n\
\# HELP simplex_xftp_files_size Size of files \n\
\# TYPE simplex_xftp_files_size gauge\n\
\simplex_xftp_files_size " <> mshow _filesSize <> "\n\
\# filesSize \n\
\\n\
\# HELP simplex_xftp_files_count_daily Daily files count\n\
\# TYPE simplex_xftp_files_count_daily gauge\n\
\simplex_xftp_files_count_daily " <> mstr (dayCount filesDownloadedPeriods) <> "\n\
\# filesDownloaded.dayCount\n\
\\n\
\# HELP simplex_xftp_files_count_weekly Weekly files count\n\
\# TYPE simplex_xftp_files_count_weekly gauge\n\
\simplex_xftp_files_count_weekly " <> mstr (weekCount filesDownloadedPeriods) <> "\n\
\# filesDownloaded.weekCount\n\
\\n\
\# HELP simplex_xftp_files_count_monthly Monthly files count\n\
\# TYPE simplex_xftp_files_count_monthly gauge\n\
\simplex_xftp_files_count_monthly " <> mstr (monthCount filesDownloadedPeriods) <> "\n\
\# filesDownloaded.monthCount\n\
\\n"
info =
"# Info\n\
\# ----\n\
\\n\
\# HELP simplex_xftp_info Server information. RTS options have to be passed via " <> rtsOptionsEnv <> " env var\n\
\# TYPE simplex_xftp_info gauge\n\
\simplex_xftp_info{version=\"" <> T.pack simplexMQVersion <> "\",rts_options=\"" <> rtsOptions <> "\"} 1\n\
\\n"
mstr a = a <> " " <> tsEpoch
mshow :: Show a => a -> Text
mshow = mstr . tshow
tsEpoch = tshow @Int64 $ floor @Double $ realToFrac (ts `diffUTCTime` epoch) * 1000
epoch = UTCTime systemEpochDay 0
{-# FOURMOLU_ENABLE\n#-}
+13 -4
View File
@@ -20,6 +20,7 @@ data FileServerStats = FileServerStats
filesUploaded :: IORef Int,
filesExpired :: IORef Int,
filesDeleted :: IORef Int,
filesBlocked :: IORef Int,
filesDownloaded :: PeriodStats,
fileDownloads :: IORef Int,
fileDownloadAcks :: IORef Int,
@@ -34,6 +35,7 @@ data FileServerStatsData = FileServerStatsData
_filesUploaded :: Int,
_filesExpired :: Int,
_filesDeleted :: Int,
_filesBlocked :: Int,
_filesDownloaded :: PeriodStatsData,
_fileDownloads :: Int,
_fileDownloadAcks :: Int,
@@ -50,12 +52,13 @@ newFileServerStats ts = do
filesUploaded <- newIORef 0
filesExpired <- newIORef 0
filesDeleted <- newIORef 0
filesBlocked <- newIORef 0
filesDownloaded <- newPeriodStats
fileDownloads <- newIORef 0
fileDownloadAcks <- newIORef 0
filesCount <- newIORef 0
filesSize <- newIORef 0
pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
pure FileServerStats {fromTime, filesCreated, fileRecipients, filesUploaded, filesExpired, filesDeleted, filesBlocked, filesDownloaded, fileDownloads, fileDownloadAcks, filesCount, filesSize}
getFileServerStatsData :: FileServerStats -> IO FileServerStatsData
getFileServerStatsData s = do
@@ -65,12 +68,13 @@ getFileServerStatsData s = do
_filesUploaded <- readIORef $ filesUploaded s
_filesExpired <- readIORef $ filesExpired s
_filesDeleted <- readIORef $ filesDeleted s
_filesBlocked <- readIORef $ filesBlocked s
_filesDownloaded <- getPeriodStatsData $ filesDownloaded s
_fileDownloads <- readIORef $ fileDownloads s
_fileDownloadAcks <- readIORef $ fileDownloadAcks s
_filesCount <- readIORef $ filesCount s
_filesSize <- readIORef $ filesSize s
pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
-- this function is not thread safe, it is used on server start only
setFileServerStats :: FileServerStats -> FileServerStatsData -> IO ()
@@ -81,6 +85,7 @@ setFileServerStats s d = do
writeIORef (filesUploaded s) $! _filesUploaded d
writeIORef (filesExpired s) $! _filesExpired d
writeIORef (filesDeleted s) $! _filesDeleted d
writeIORef (filesBlocked s) $! _filesBlocked d
setPeriodStats (filesDownloaded s) $! _filesDownloaded d
writeIORef (fileDownloads s) $! _fileDownloads d
writeIORef (fileDownloadAcks s) $! _fileDownloadAcks d
@@ -88,7 +93,7 @@ setFileServerStats s d = do
writeIORef (filesSize s) $! _filesSize d
instance StrEncoding FileServerStatsData where
strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =
strEncode FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize} =
B.unlines
[ "fromTime=" <> strEncode _fromTime,
"filesCreated=" <> strEncode _filesCreated,
@@ -96,6 +101,7 @@ instance StrEncoding FileServerStatsData where
"filesUploaded=" <> strEncode _filesUploaded,
"filesExpired=" <> strEncode _filesExpired,
"filesDeleted=" <> strEncode _filesDeleted,
"filesBlocked=" <> strEncode _filesBlocked,
"filesCount=" <> strEncode _filesCount,
"filesSize=" <> strEncode _filesSize,
"filesDownloaded:",
@@ -110,9 +116,12 @@ instance StrEncoding FileServerStatsData where
_filesUploaded <- "filesUploaded=" *> strP <* A.endOfLine
_filesExpired <- "filesExpired=" *> strP <* A.endOfLine <|> pure 0
_filesDeleted <- "filesDeleted=" *> strP <* A.endOfLine
_filesBlocked <- opt "filesBlocked="
_filesCount <- "filesCount=" *> strP <* A.endOfLine <|> pure 0
_filesSize <- "filesSize=" *> strP <* A.endOfLine <|> pure 0
_filesDownloaded <- "filesDownloaded:" *> A.endOfLine *> strP <* A.endOfLine
_fileDownloads <- "fileDownloads=" *> strP <* A.endOfLine
_fileDownloadAcks <- "fileDownloadAcks=" *> strP <* A.endOfLine
pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
pure FileServerStatsData {_fromTime, _filesCreated, _fileRecipients, _filesUploaded, _filesExpired, _filesDeleted, _filesBlocked, _filesDownloaded, _fileDownloads, _fileDownloadAcks, _filesCount, _filesSize}
where
opt s = A.string s *> strP <* A.endOfLine <|> pure 0
+27 -9
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -8,11 +9,13 @@ module Simplex.FileTransfer.Server.Store
( FileStore (..),
FileRec (..),
FileRecipient (..),
RoundedFileTime,
newFileStore,
addFile,
setFilePath,
addRecipient,
deleteFile,
blockFile,
deleteRecipient,
expiredFilePath,
getFile,
@@ -22,6 +25,7 @@ module Simplex.FileTransfer.Server.Store
where
import Control.Concurrent.STM
import Control.Monad
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Int (Int64)
import Data.Set (Set)
@@ -30,8 +34,9 @@ import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..), XFTPFileId
import Simplex.FileTransfer.Transport (XFTPErrorType (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
import Simplex.Messaging.Server.QueueStore (RoundedSystemTime (..))
import Simplex.Messaging.Protocol (BlockingInfo, RcvPublicAuthKey, RecipientId, SenderId)
import Simplex.Messaging.Server.QueueStore (ServerEntityStatus (..))
import Simplex.Messaging.SystemTime
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Util (ifM, ($>>=))
@@ -47,13 +52,17 @@ data FileRec = FileRec
fileInfo :: FileInfo,
filePath :: TVar (Maybe FilePath),
recipientIds :: TVar (Set RecipientId),
createdAt :: RoundedSystemTime
createdAt :: RoundedFileTime,
fileStatus :: TVar ServerEntityStatus
}
type RoundedFileTime = RoundedSystemTime 3600
fileTimePrecision :: Int64
fileTimePrecision = 3600 -- truncate creation time to 1 hour
data FileRecipient = FileRecipient RecipientId RcvPublicAuthKey
deriving (Show)
instance StrEncoding FileRecipient where
strEncode (FileRecipient rId rKey) = strEncode rId <> ":" <> strEncode rKey
@@ -66,18 +75,19 @@ newFileStore = do
usedStorage <- newTVarIO 0
pure FileStore {files, recipients, usedStorage}
addFile :: FileStore -> SenderId -> FileInfo -> RoundedSystemTime -> STM (Either XFTPErrorType ())
addFile FileStore {files} sId fileInfo createdAt =
addFile :: FileStore -> SenderId -> FileInfo -> RoundedFileTime -> ServerEntityStatus -> STM (Either XFTPErrorType ())
addFile FileStore {files} sId fileInfo createdAt status =
ifM (TM.member sId files) (pure $ Left DUPLICATE_) $ do
f <- newFileRec sId fileInfo createdAt
f <- newFileRec sId fileInfo createdAt status
TM.insert sId f files
pure $ Right ()
newFileRec :: SenderId -> FileInfo -> RoundedSystemTime -> STM FileRec
newFileRec senderId fileInfo createdAt = do
newFileRec :: SenderId -> FileInfo -> RoundedFileTime -> ServerEntityStatus -> STM FileRec
newFileRec senderId fileInfo createdAt status = do
recipientIds <- newTVar S.empty
filePath <- newTVar Nothing
pure FileRec {senderId, fileInfo, filePath, recipientIds, createdAt}
fileStatus <- newTVar status
pure FileRec {senderId, fileInfo, filePath, recipientIds, createdAt, fileStatus}
setFilePath :: FileStore -> SenderId -> FilePath -> STM (Either XFTPErrorType ())
setFilePath st sId fPath =
@@ -108,6 +118,14 @@ deleteFile FileStore {files, recipients, usedStorage} senderId = do
pure $ Right ()
_ -> pure $ Left AUTH
-- this function must be called after the file is deleted from the file system
blockFile :: FileStore -> SenderId -> BlockingInfo -> Bool -> STM (Either XFTPErrorType ())
blockFile st@FileStore {usedStorage} senderId info deleted =
withFile st senderId $ \FileRec {fileInfo, fileStatus} -> do
when deleted $ modifyTVar' usedStorage $ subtract (fromIntegral $ size fileInfo)
writeTVar fileStatus $! EntityBlocked info
pure $ Right ()
deleteRecipient :: FileStore -> RecipientId -> FileRec -> STM ()
deleteRecipient FileStore {recipients} rId FileRec {recipientIds} = do
TM.delete rId recipients
+25 -21
View File
@@ -14,16 +14,18 @@ module Simplex.FileTransfer.Server.StoreLog
logPutFile,
logAddRecipients,
logDeleteFile,
logBlockFile,
logAckFile,
)
where
import Control.Applicative ((<|>))
import Control.Concurrent.STM
import Control.Monad.Except
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Composition ((.:), (.:.))
import Data.Composition ((.:), (.::))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
@@ -31,41 +33,44 @@ import qualified Data.Map.Strict as M
import Simplex.FileTransfer.Protocol (FileInfo (..))
import Simplex.FileTransfer.Server.Store
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (RcvPublicAuthKey, RecipientId, SenderId)
import Simplex.Messaging.Server.QueueStore (RoundedSystemTime)
import Simplex.Messaging.Protocol (BlockingInfo, RcvPublicAuthKey, RecipientId, SenderId)
import Simplex.Messaging.Server.QueueStore (ServerEntityStatus (..))
import Simplex.Messaging.Server.StoreLog
import Simplex.Messaging.Util (bshow, whenM)
import System.Directory (doesFileExist, renameFile)
import Simplex.Messaging.Util (bshow)
import System.IO
data FileStoreLogRecord
= AddFile SenderId FileInfo RoundedSystemTime
= AddFile SenderId FileInfo RoundedFileTime ServerEntityStatus
| PutFile SenderId FilePath
| AddRecipients SenderId (NonEmpty FileRecipient)
| DeleteFile SenderId
| AckFile RecipientId
| BlockFile SenderId BlockingInfo
| AckFile RecipientId -- TODO add senderId as well?
deriving (Show)
instance StrEncoding FileStoreLogRecord where
strEncode = \case
AddFile sId file createdAt -> strEncode (Str "FNEW", sId, file, createdAt)
AddFile sId file createdAt status -> strEncode (Str "FNEW", sId, file, createdAt, status)
PutFile sId path -> strEncode (Str "FPUT", sId, path)
AddRecipients sId rcps -> strEncode (Str "FADD", sId, rcps)
DeleteFile sId -> strEncode (Str "FDEL", sId)
BlockFile sId info -> strEncode (Str "FBLK", sId, info)
AckFile rId -> strEncode (Str "FACK", rId)
strP =
A.choice
[ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP),
[ "FNEW " *> (AddFile <$> strP_ <*> strP_ <*> strP <*> (_strP <|> pure EntityActive)),
"FPUT " *> (PutFile <$> strP_ <*> strP),
"FADD " *> (AddRecipients <$> strP_ <*> strP),
"FDEL " *> (DeleteFile <$> strP),
"FBLK " *> (BlockFile <$> strP_ <*> strP),
"FACK " *> (AckFile <$> strP)
]
logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO ()
logFileStoreRecord = writeStoreLogRecord
logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> RoundedSystemTime -> IO ()
logAddFile s = logFileStoreRecord s .:. AddFile
logAddFile :: StoreLog 'WriteMode -> SenderId -> FileInfo -> RoundedFileTime -> ServerEntityStatus -> IO ()
logAddFile s = logFileStoreRecord s .:: AddFile
logPutFile :: StoreLog 'WriteMode -> SenderId -> FilePath -> IO ()
logPutFile s = logFileStoreRecord s .: PutFile
@@ -76,17 +81,14 @@ logAddRecipients s = logFileStoreRecord s .: AddRecipients
logDeleteFile :: StoreLog 'WriteMode -> SenderId -> IO ()
logDeleteFile s = logFileStoreRecord s . DeleteFile
logBlockFile :: StoreLog 'WriteMode -> SenderId -> BlockingInfo -> IO ()
logBlockFile s fId = logFileStoreRecord s . BlockFile fId
logAckFile :: StoreLog 'WriteMode -> RecipientId -> IO ()
logAckFile s = logFileStoreRecord s . AckFile
readWriteFileStore :: FilePath -> FileStore -> IO (StoreLog 'WriteMode)
readWriteFileStore f st = do
whenM (doesFileExist f) $ do
readFileStore f st
renameFile f $ f <> ".bak"
s <- openWriteStoreLog f
writeFileStore s st
pure s
readWriteFileStore = readWriteStoreLog readFileStore writeFileStore
readFileStore :: FilePath -> FileStore -> IO ()
readFileStore f st = mapM_ (addFileLogRecord . LB.toStrict) . LB.lines =<< LB.readFile f
@@ -98,10 +100,11 @@ readFileStore f st = mapM_ (addFileLogRecord . LB.toStrict) . LB.lines =<< LB.re
Left e -> B.putStrLn $ "Log processing error (" <> bshow e <> "): " <> B.take 100 s
_ -> pure ()
addToStore = \case
AddFile sId file createdAt -> addFile st sId file createdAt
AddFile sId file createdAt status -> addFile st sId file createdAt status
PutFile qId path -> setFilePath st qId path
AddRecipients sId rcps -> runExceptT $ addRecipients sId rcps
DeleteFile sId -> deleteFile st sId
BlockFile sId info -> blockFile st sId info True
AckFile rId -> ackFile st rId
addRecipients sId rcps = mapM_ (ExceptT . addRecipient st sId) rcps
@@ -111,8 +114,9 @@ writeFileStore s FileStore {files, recipients} = do
readTVarIO files >>= mapM_ (logFile allRcps)
where
logFile :: Map RecipientId (SenderId, RcvPublicAuthKey) -> FileRec -> IO ()
logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds, createdAt} = do
logAddFile s senderId fileInfo createdAt
logFile allRcps FileRec {senderId, fileInfo, filePath, recipientIds, createdAt, fileStatus} = do
status <- readTVarIO fileStatus
logAddFile s senderId fileInfo createdAt status
(rcpErrs, rcps) <- M.mapEither getRcp . M.fromSet id <$> readTVarIO recipientIds
mapM_ (logAddRecipients s senderId) $ L.nonEmpty $ M.elems rcps
mapM_ (B.putStrLn . ("Error storing log: " <>)) rcpErrs
+61 -19
View File
@@ -11,7 +11,10 @@
module Simplex.FileTransfer.Transport
( supportedFileServerVRange,
authCmdsXFTPVersion,
blockedFilesXFTPVersion,
xftpClientHandshakeStub,
alpnSupportedXFTPhandshakes,
xftpALPNv1,
XFTPClientHandshake (..),
-- xftpClientHandshake,
XFTPServerHandshake (..),
@@ -32,7 +35,6 @@ module Simplex.FileTransfer.Transport
)
where
import Control.Applicative ((<|>))
import qualified Control.Exception as E
import Control.Logger.Simple
import Control.Monad
@@ -41,7 +43,7 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import qualified Data.Aeson.TH as J
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (bimap, first)
import Data.Bifunctor (first)
import qualified Data.ByteArray as BA
import Data.ByteString.Builder (Builder, byteString)
import Data.ByteString.Char8 (ByteString)
@@ -49,15 +51,14 @@ import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Functor (($>))
import Data.Word (Word16, Word32)
import qualified Data.X509 as X
import Network.HTTP2.Client (HTTP2Error)
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Lazy as LC
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers
import Simplex.Messaging.Protocol (CommandError)
import Simplex.Messaging.Transport (SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
import Simplex.Messaging.Protocol (BlockingInfo, CommandError)
import Simplex.Messaging.Transport (ALPN, CertChainPubKey, ServiceCredentials, SessionId, THandle (..), THandleParams (..), TransportError (..), TransportPeer (..))
import Simplex.Messaging.Transport.HTTP2.File
import Simplex.Messaging.Util (bshow, tshow)
import Simplex.Messaging.Version
@@ -91,21 +92,30 @@ initialXFTPVersion = VersionXFTP 1
authCmdsXFTPVersion :: VersionXFTP
authCmdsXFTPVersion = VersionXFTP 2
blockedFilesXFTPVersion :: VersionXFTP
blockedFilesXFTPVersion = VersionXFTP 3
currentXFTPVersion :: VersionXFTP
currentXFTPVersion = VersionXFTP 2
currentXFTPVersion = VersionXFTP 3
supportedFileServerVRange :: VersionRangeXFTP
supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion
-- XFTP protocol does not use this handshake method
xftpClientHandshakeStub :: c -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
xftpClientHandshakeStub _c _ks _keyHash _xftpVRange = throwE TEVersion
xftpClientHandshakeStub :: c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
xftpClientHandshakeStub _c _ks _keyHash _xftpVRange _proxyServer _serviceKeys = throwE TEVersion
alpnSupportedXFTPhandshakes :: [ALPN]
alpnSupportedXFTPhandshakes = [xftpALPNv1]
xftpALPNv1 :: ALPN
xftpALPNv1 = "xftp/1"
data XFTPServerHandshake = XFTPServerHandshake
{ xftpVersionRange :: VersionRangeXFTP,
sessionId :: SessionId,
-- | pub key to agree shared secrets for command authorization and entity ID encryption.
authPubKey :: (X.CertificateChain, X.SignedExact X.PubKey)
authPubKey :: CertChainPubKey
}
data XFTPClientHandshake = XFTPClientHandshake
@@ -125,15 +135,12 @@ instance Encoding XFTPClientHandshake where
instance Encoding XFTPServerHandshake where
smpEncode XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey} =
smpEncode (xftpVersionRange, sessionId, auth)
where
auth = bimap C.encodeCertChain C.SignedObject authPubKey
smpEncode (xftpVersionRange, sessionId, authPubKey)
smpP = do
(xftpVersionRange, sessionId) <- smpP
cert <- C.certChainP
C.SignedObject key <- smpP
authPubKey <- smpP
Tail _compat <- smpP
pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey = (cert, key)}
pure XFTPServerHandshake {xftpVersionRange, sessionId, authPubKey}
sendEncFile :: Handle -> (Builder -> IO ()) -> LC.SbState -> Word32 -> IO ()
sendEncFile h send = go
@@ -207,6 +214,8 @@ data XFTPErrorType
CMD {cmdErr :: CommandError}
| -- | command authorization error - bad signature or non-existing SMP queue
AUTH
| -- | command with the entity that was blocked
BLOCKED {blockInfo :: BlockingInfo}
| -- | incorrent file size
SIZE
| -- | storage quota exceeded
@@ -227,15 +236,46 @@ data XFTPErrorType
INTERNAL
| -- | used internally, never returned by the server (to be removed)
DUPLICATE_ -- not part of SMP protocol, used internally
deriving (Eq, Read, Show)
deriving (Eq, Show)
instance StrEncoding XFTPErrorType where
strEncode = \case
BLOCK -> "BLOCK"
SESSION -> "SESSION"
HANDSHAKE -> "HANDSHAKE"
CMD e -> "CMD " <> bshow e
e -> bshow e
AUTH -> "AUTH"
BLOCKED info -> "BLOCKED " <> strEncode info
SIZE -> "SIZE"
QUOTA -> "QUOTA"
DIGEST -> "DIGEST"
CRYPTO -> "CRYPTO"
NO_FILE -> "NO_FILE"
HAS_FILE -> "HAS_FILE"
FILE_IO -> "FILE_IO"
TIMEOUT -> "TIMEOUT"
INTERNAL -> "INTERNAL"
DUPLICATE_ -> "DUPLICATE_"
strP =
"CMD " *> (CMD <$> parseRead1)
<|> parseRead1
A.takeTill (== ' ') >>= \case
"BLOCK" -> pure BLOCK
"SESSION" -> pure SESSION
"HANDSHAKE" -> pure HANDSHAKE
"CMD" -> CMD <$> parseRead1
"AUTH" -> pure AUTH
"BLOCKED" -> BLOCKED <$> _strP
"SIZE" -> pure SIZE
"QUOTA" -> pure QUOTA
"DIGEST" -> pure DIGEST
"CRYPTO" -> pure CRYPTO
"NO_FILE" -> pure NO_FILE
"HAS_FILE" -> pure HAS_FILE
"FILE_IO" -> pure FILE_IO
"TIMEOUT" -> pure TIMEOUT
"INTERNAL" -> pure INTERNAL
"DUPLICATE_" -> pure DUPLICATE_
_ -> fail "bad error type"
instance Encoding XFTPErrorType where
smpEncode = \case
@@ -244,6 +284,7 @@ instance Encoding XFTPErrorType where
HANDSHAKE -> "HANDSHAKE"
CMD err -> "CMD " <> smpEncode err
AUTH -> "AUTH"
BLOCKED info -> "BLOCKED " <> smpEncode info
SIZE -> "SIZE"
QUOTA -> "QUOTA"
DIGEST -> "DIGEST"
@@ -262,6 +303,7 @@ instance Encoding XFTPErrorType where
"HANDSHAKE" -> pure HANDSHAKE
"CMD" -> CMD <$> _smpP
"AUTH" -> pure AUTH
"BLOCKED" -> BLOCKED <$> _smpP
"SIZE" -> pure SIZE
"QUOTA" -> pure QUOTA
"DIGEST" -> pure DIGEST
+11 -2
View File
@@ -13,10 +13,9 @@ import Data.Int (Int64)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word32)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
import Simplex.FileTransfer.Description
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..))
import Simplex.Messaging.Encoding
@@ -246,6 +245,16 @@ data DeletedSndChunkReplica = DeletedSndChunkReplica
}
deriving (Show)
data SentRecipientReplica = SentRecipientReplica
{ chunkNo :: Int,
server :: XFTPServer,
rcvNo :: Int,
replicaId :: ChunkReplicaId,
replicaKey :: C.APrivateAuthKey,
digest :: FileDigest,
chunkSize :: FileSize Word32
}
data FileErrorType
= -- | cannot proceed with download from not approved relays without proxy
NOT_APPROVED
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+52 -56
View File
@@ -17,18 +17,16 @@ module Simplex.Messaging.Agent.Env.SQLite
AgentConfig (..),
InitialAgentServers (..),
ServerCfg (..),
ServerRoles (..),
OperatorId,
UserServers (..),
NetworkConfig (..),
presetServerCfg,
enabledServerCfg,
allRoles,
mkUserServers,
serverHosts,
defaultAgentConfig,
defaultReconnectInterval,
tryAgentError,
tryAgentError',
catchAgentError,
catchAgentError',
agentFinally,
Env (..),
newSMPAgentEnv,
createAgentStore,
@@ -48,12 +46,13 @@ import Control.Monad.Reader
import Crypto.Random
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson.TH as JQ
import Data.ByteArray (ScrubbedBytes)
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Time.Clock (NominalDiffTime, nominalDay)
import Data.Time.Clock.System (SystemTime (..))
import Data.Word (Word16)
@@ -62,8 +61,10 @@ import Numeric.Natural
import Simplex.FileTransfer.Client (XFTPClientConfig (..), defaultXFTPClientConfig)
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.RetryInterval
import Simplex.Messaging.Agent.Store.SQLite
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
import Simplex.Messaging.Agent.Store (createStore)
import Simplex.Messaging.Agent.Store.Common (DBStore)
import Simplex.Messaging.Agent.Store.Interface (DBOpts)
import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..))
import Simplex.Messaging.Client
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRange)
@@ -71,14 +72,13 @@ import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
import Simplex.Messaging.Notifications.Transport (NTFVersion)
import Simplex.Messaging.Notifications.Types
import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth, ProtocolServer, ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI, VersionRangeSMPC, XFTPServer, supportedSMPClientVRange)
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (SMPVersion)
import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors')
import Simplex.Messaging.Transport.Client (TransportHost)
import System.Mem.Weak (Weak)
import System.Random (StdGen, newStdGen)
import UnliftIO (SomeException)
import UnliftIO.STM
type AM' a = ReaderT Env IO a
@@ -89,34 +89,49 @@ data InitialAgentServers = InitialAgentServers
{ smp :: Map UserId (NonEmpty (ServerCfg 'PSMP)),
ntf :: [NtfServer],
xftp :: Map UserId (NonEmpty (ServerCfg 'PXFTP)),
netCfg :: NetworkConfig
netCfg :: NetworkConfig,
presetDomains :: [HostName],
presetServers :: [SMPServer]
}
data ServerCfg p = ServerCfg
{ server :: ProtoServerWithAuth p,
preset :: Bool,
tested :: Maybe Bool,
enabled :: Bool
operator :: Maybe OperatorId,
enabled :: Bool,
roles :: ServerRoles
}
deriving (Show)
enabledServerCfg :: ProtoServerWithAuth p -> ServerCfg p
enabledServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
data ServerRoles = ServerRoles
{ storage :: Bool,
proxy :: Bool
}
deriving (Show)
presetServerCfg :: Bool -> ProtoServerWithAuth p -> ServerCfg p
presetServerCfg enabled server = ServerCfg {server, preset = True, tested = Nothing, enabled}
allRoles :: ServerRoles
allRoles = ServerRoles True True
presetServerCfg :: Bool -> ServerRoles -> Maybe OperatorId -> ProtoServerWithAuth p -> ServerCfg p
presetServerCfg enabled roles operator server =
ServerCfg {server, operator, enabled, roles}
data UserServers p = UserServers
{ enabledSrvs :: NonEmpty (ProtoServerWithAuth p),
knownSrvs :: NonEmpty (ProtocolServer p)
{ storageSrvs :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p),
proxySrvs :: NonEmpty (Maybe OperatorId, ProtoServerWithAuth p),
knownHosts :: Set TransportHost
}
type OperatorId = Int64
-- This function sets all servers as enabled in case all passed servers are disabled.
mkUserServers :: NonEmpty (ServerCfg p) -> UserServers p
mkUserServers srvs = UserServers {enabledSrvs, knownSrvs}
mkUserServers srvs = UserServers {storageSrvs = filterSrvs storage, proxySrvs = filterSrvs proxy, knownHosts}
where
enabledSrvs = L.map (\ServerCfg {server} -> server) $ fromMaybe srvs $ L.nonEmpty $ L.filter (\ServerCfg {enabled} -> enabled) srvs
knownSrvs = L.map (\ServerCfg {server = ProtoServerWithAuth srv _} -> srv) srvs
filterSrvs role = L.map (\ServerCfg {operator, server} -> (operator, server)) $ fromMaybe srvs $ L.nonEmpty $ L.filter (\ServerCfg {enabled, roles} -> enabled && role roles) srvs
knownHosts = S.unions $ L.map (\ServerCfg {server = ProtoServerWithAuth srv _} -> serverHosts srv) srvs
serverHosts :: ProtocolServer p -> Set TransportHost
serverHosts ProtocolServer {host} = S.fromList $ L.toList host
data AgentConfig = AgentConfig
{ tcpPort :: Maybe ServiceName,
@@ -152,6 +167,7 @@ data AgentConfig = AgentConfig
ntfBatchSize :: Int,
ntfSubFirstCheckInterval :: NominalDiffTime,
ntfSubCheckInterval :: NominalDiffTime,
maxPendingSubscriptions :: Int,
caCertificateFile :: FilePath,
privateKeyFile :: FilePath,
certificateFile :: FilePath,
@@ -223,6 +239,7 @@ defaultAgentConfig =
ntfBatchSize = 150,
ntfSubFirstCheckInterval = nominalDay,
ntfSubCheckInterval = 3 * nominalDay,
maxPendingSubscriptions = 35000,
-- CA certificate private key is not needed for initialization
-- ! we do not generate these
caCertificateFile = "/etc/opt/simplex-agent/ca.crt",
@@ -235,7 +252,7 @@ defaultAgentConfig =
data Env = Env
{ config :: AgentConfig,
store :: SQLiteStore,
store :: DBStore,
random :: TVar ChaChaDRG,
randomServer :: TVar StdGen,
ntfSupervisor :: NtfSupervisor,
@@ -243,7 +260,7 @@ data Env = Env
multicastSubscribers :: TMVar Int
}
newSMPAgentEnv :: AgentConfig -> SQLiteStore -> IO Env
newSMPAgentEnv :: AgentConfig -> DBStore -> IO Env
newSMPAgentEnv config store = do
random <- C.newRandom
randomServer <- newTVarIO =<< liftIO newStdGen
@@ -252,14 +269,15 @@ newSMPAgentEnv config store = do
multicastSubscribers <- newTMVarIO 0
pure Env {config, store, random, randomServer, ntfSupervisor, xftpAgent, multicastSubscribers}
createAgentStore :: FilePath -> ScrubbedBytes -> Bool -> MigrationConfirmation -> IO (Either MigrationError SQLiteStore)
createAgentStore dbFilePath dbKey keepKey = createSQLiteStore dbFilePath dbKey keepKey Migrations.app
createAgentStore :: DBOpts -> MigrationConfig -> IO (Either MigrationError DBStore)
createAgentStore = createStore
data NtfSupervisor = NtfSupervisor
{ ntfTkn :: TVar (Maybe NtfToken),
ntfSubQ :: TBQueue (NtfSupervisorCommand, NonEmpty ConnId),
ntfWorkers :: TMap NtfServer Worker,
ntfSMPWorkers :: TMap SMPServer Worker
ntfSMPWorkers :: TMap SMPServer Worker,
ntfTknDelWorkers :: TMap NtfServer Worker
}
data NtfSupervisorCommand = NSCCreate | NSCSmpDelete | NSCDeleteSub
@@ -271,7 +289,8 @@ newNtfSubSupervisor qSize = do
ntfSubQ <- newTBQueueIO qSize
ntfWorkers <- TM.emptyIO
ntfSMPWorkers <- TM.emptyIO
pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers}
ntfTknDelWorkers <- TM.emptyIO
pure NtfSupervisor {ntfTkn, ntfSubQ, ntfWorkers, ntfSMPWorkers, ntfTknDelWorkers}
data XFTPAgent = XFTPAgent
{ -- if set, XFTP file paths will be considered as relative to this directory
@@ -289,31 +308,6 @@ newXFTPAgent = do
xftpDelWorkers <- TM.emptyIO
pure XFTPAgent {xftpWorkDir, xftpRcvWorkers, xftpSndWorkers, xftpDelWorkers}
tryAgentError :: AM a -> AM (Either AgentErrorType a)
tryAgentError = tryAllErrors mkInternal
{-# INLINE tryAgentError #-}
-- unlike runExceptT, this ensures we catch IO exceptions as well
tryAgentError' :: AM a -> AM' (Either AgentErrorType a)
tryAgentError' = tryAllErrors' mkInternal
{-# INLINE tryAgentError' #-}
catchAgentError :: AM a -> (AgentErrorType -> AM a) -> AM a
catchAgentError = catchAllErrors mkInternal
{-# INLINE catchAgentError #-}
catchAgentError' :: AM a -> (AgentErrorType -> AM' a) -> AM' a
catchAgentError' = catchAllErrors' mkInternal
{-# INLINE catchAgentError' #-}
agentFinally :: AM a -> AM b -> AM a
agentFinally = allFinally mkInternal
{-# INLINE agentFinally #-}
mkInternal :: SomeException -> AgentErrorType
mkInternal = INTERNAL . show
{-# INLINE mkInternal #-}
data Worker = Worker
{ workerId :: Int,
doWork :: TMVar (),
@@ -333,6 +327,8 @@ updateRestartCount t (RestartCount minute count) = do
$(pure [])
$(JQ.deriveJSON defaultJSON ''ServerRoles)
instance ProtocolTypeI p => ToJSON (ServerCfg p) where
toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)
+13 -6
View File
@@ -1,10 +1,12 @@
module Simplex.Messaging.Agent.Lock
( Lock,
createLock,
createLockIO,
withLock,
withLock',
withGetLock,
withGetLocks,
getPutLock,
)
where
@@ -14,34 +16,39 @@ import Control.Monad.IO.Unlift
import Data.Functor (($>))
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import UnliftIO.Async (forConcurrently)
import qualified UnliftIO.Exception as E
import UnliftIO.STM
type Lock = TMVar String
type Lock = TMVar Text
createLock :: STM Lock
createLock = newEmptyTMVar
{-# INLINE createLock #-}
withLock :: MonadUnliftIO m => Lock -> String -> ExceptT e m a -> ExceptT e m a
createLockIO :: IO Lock
createLockIO = newEmptyTMVarIO
{-# INLINE createLockIO #-}
withLock :: MonadUnliftIO m => Lock -> Text -> ExceptT e m a -> ExceptT e m a
withLock lock name = ExceptT . withLock' lock name . runExceptT
{-# INLINE withLock #-}
withLock' :: MonadUnliftIO m => Lock -> String -> m a -> m a
withLock' :: MonadUnliftIO m => Lock -> Text -> m a -> m a
withLock' lock name =
E.bracket_
(atomically $ putTMVar lock name)
(void . atomically $ takeTMVar lock)
withGetLock :: MonadUnliftIO m => (k -> STM Lock) -> k -> String -> m a -> m a
withGetLock :: MonadUnliftIO m => (k -> STM Lock) -> k -> Text -> m a -> m a
withGetLock getLock key name a =
E.bracket
(atomically $ getPutLock getLock key name)
(atomically . takeTMVar)
(const a)
withGetLocks :: MonadUnliftIO m => (k -> STM Lock) -> Set k -> String -> m a -> m a
withGetLocks :: MonadUnliftIO m => (k -> STM Lock) -> Set k -> Text -> m a -> m a
withGetLocks getLock keys name = E.bracket holdLocks releaseLocks . const
where
holdLocks = forConcurrently (S.toList keys) $ \key -> atomically $ getPutLock getLock key name
@@ -49,5 +56,5 @@ withGetLocks getLock keys name = E.bracket holdLocks releaseLocks . const
-- getLock and putTMVar can be in one transaction on the assumption that getLock doesn't write in case the lock already exists,
-- and in case it is created and added to some shared resource (we use TMap) it also helps avoid contention for the newly created lock.
getPutLock :: (k -> STM Lock) -> k -> String -> STM Lock
getPutLock :: (k -> STM Lock) -> k -> Text -> STM Lock
getPutLock getLock key name = getLock key >>= \l -> putTMVar l name $> l
+77 -17
View File
@@ -14,7 +14,9 @@ module Simplex.Messaging.Agent.NtfSubSupervisor
nsUpdateToken,
nsRemoveNtfToken,
sendNtfSubCommand,
hasInstantNotifications,
instantNotifications,
deleteToken,
closeNtfSupervisor,
getNtfServer,
)
@@ -42,14 +44,15 @@ import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.RetryInterval
import Simplex.Messaging.Agent.Stats
import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Agent.Store.SQLite
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.AgentStore
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Client (NetworkRequestMode (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Notifications.Protocol
import Simplex.Messaging.Notifications.Types
import Simplex.Messaging.Protocol (NtfServer, sameSrvAddr)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Util (diffToMicroseconds, threadDelay', tshow)
import Simplex.Messaging.Util (catchAllErrors, diffToMicroseconds, threadDelay', tryAllErrors, tshow, whenM)
import System.Random (randomR)
import UnliftIO
import UnliftIO.Concurrent (forkIO)
@@ -58,6 +61,9 @@ import qualified UnliftIO.Exception as E
runNtfSupervisor :: AgentClient -> AM' ()
runNtfSupervisor c = do
ns <- asks ntfSupervisor
runExceptT startTknDelete >>= \case
Left e -> notifyErr e
Right _ -> pure ()
forever $ do
cmd <- atomically . readTBQueue $ ntfSubQ ns
handleErr . agentOperationBracket c AONtfNetwork waitUntilActive $
@@ -65,6 +71,10 @@ runNtfSupervisor c = do
Left e -> notifyErr e
Right _ -> return ()
where
startTknDelete :: AM ()
startTknDelete = do
pendingDelServers <- withStore' c getPendingDelTknServers
lift . forM_ pendingDelServers $ getNtfTknDelWorker True c
handleErr :: AM' () -> AM' ()
handleErr = E.handle $ \(e :: E.SomeException) -> do
logError $ "runNtfSupervisor error " <> tshow e
@@ -190,6 +200,11 @@ getNtfSMPWorker hasWork c server = do
ws <- asks $ ntfSMPWorkers . ntfSupervisor
getAgentWorker "ntf_smp" hasWork c server ws $ runNtfSMPWorker c server
getNtfTknDelWorker :: Bool -> AgentClient -> NtfServer -> AM' Worker
getNtfTknDelWorker hasWork c server = do
ws <- asks $ ntfTknDelWorkers . ntfSupervisor
getAgentWorker "ntf_tkn_del" hasWork c server ws $ runNtfTknDelWorker c server
withTokenServer :: (NtfServer -> AM ()) -> AM ()
withTokenServer action = lift getNtfToken >>= mapM_ (\NtfToken {ntfServer} -> action ntfServer)
@@ -202,12 +217,12 @@ runNtfWorker c srv Worker {doWork} =
runNtfOperation :: AM ()
runNtfOperation = do
ntfBatchSize <- asks $ ntfBatchSize . config
withWorkItems c doWork (\db -> getNextNtfSubNTFActions db srv ntfBatchSize) $ \nextSubs -> do
withWorkItems c doWork (withStore' c $ \db -> getNextNtfSubNTFActions db srv ntfBatchSize) $ \nextSubs -> do
logInfo $ "runNtfWorker - length nextSubs = " <> tshow (length nextSubs)
currTs <- liftIO getCurrentTime
let (creates, checks, deletes, rotates) = splitActions currTs nextSubs
if null creates && null checks && null deletes && null rotates
then
then
let (_, _, firstActionTs) = L.head nextSubs
in lift $ rescheduleWork doWork currTs firstActionTs
else do
@@ -342,7 +357,7 @@ runNtfWorker c srv Worker {doWork} =
runCatching :: (NtfSubscription -> AM (Maybe NtfSubscription)) -> NtfSubscription -> AM' (Maybe NtfSubscription)
runCatching action sub@NtfSubscription {connId} =
fromRight Nothing
<$> runExceptT (action sub `catchAgentError` \e -> workerInternalError c connId (show e) $> Nothing)
<$> runExceptT (action sub `catchAllErrors` \e -> workerInternalError c connId (show e) $> Nothing)
-- deleteNtfSub is only used in NSADelete and NSARotate, so also deprecated
deleteNtfSub :: NtfSubscription -> AM () -> AM (Maybe NtfSubscription)
deleteNtfSub sub@NtfSubscription {userId, ntfSubId} continue = case ntfSubId of
@@ -350,7 +365,7 @@ runNtfWorker c srv Worker {doWork} =
lift getNtfToken >>= \case
Just tkn@NtfToken {ntfServer} -> do
atomically $ incNtfServerStat c userId ntfServer ntfDelAttempts
tryAgentError (agentNtfDeleteSubscription c nSubId tkn) >>= \case
tryAllErrors (agentNtfDeleteSubscription c nSubId tkn) >>= \case
Right _ -> do
atomically $ incNtfServerStat c userId ntfServer ntfDeleted
continue'
@@ -370,7 +385,7 @@ runNtfSMPWorker c srv Worker {doWork} = forever $ do
runNtfSMPOperation :: AM ()
runNtfSMPOperation = do
ntfBatchSize <- asks $ ntfBatchSize . config
withWorkItems c doWork (\db -> getNextNtfSubSMPActions db srv ntfBatchSize) $ \nextSubs -> do
withWorkItems c doWork (withStore' c $ \db -> getNextNtfSubSMPActions db srv ntfBatchSize) $ \nextSubs -> do
logInfo $ "runNtfSMPWorker - length nextSubs = " <> tshow (length nextSubs)
let (creates, deletes) = splitActions nextSubs
retrySubActions c creates createNotifierKeys
@@ -498,7 +513,7 @@ notifyInternalError' AgentClient {subQ} internalErrStr = atomically $ writeTBQue
{-# INLINE notifyInternalError' #-}
notifyErrs :: MonadIO m => AgentClient -> [(ConnId, AgentErrorType)] -> m ()
notifyErrs AgentClient {subQ} connErrs = unless (null connErrs) $ atomically $ writeTBQueue subQ ("", "", AEvt SAENone $ ERRS connErrs)
notifyErrs c = mapM_ (notifySub c . ERRS) . L.nonEmpty
{-# INLINE notifyErrs #-}
getNtfToken :: AM' (Maybe NtfToken)
@@ -512,20 +527,65 @@ nsUpdateToken ns tkn = writeTVar (ntfTkn ns) $ Just tkn
nsRemoveNtfToken :: NtfSupervisor -> STM ()
nsRemoveNtfToken ns = writeTVar (ntfTkn ns) Nothing
sendNtfSubCommand :: NtfSupervisor -> (NtfSupervisorCommand, NonEmpty ConnId) -> STM ()
sendNtfSubCommand ns cmd = do
tkn <- readTVar (ntfTkn ns)
when (instantNotifications tkn) $ writeTBQueue (ntfSubQ ns) cmd
sendNtfSubCommand :: NtfSupervisor -> (NtfSupervisorCommand, NonEmpty ConnId) -> IO ()
sendNtfSubCommand ns cmd =
whenM (hasInstantNotifications ns) $ atomically $ writeTBQueue (ntfSubQ ns) cmd
instantNotifications :: Maybe NtfToken -> Bool
instantNotifications = \case
Just NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} -> True
_ -> False
hasInstantNotifications :: NtfSupervisor -> IO Bool
hasInstantNotifications ns = do
tkn <- readTVarIO $ ntfTkn ns
pure $ maybe False instantNotifications tkn
instantNotifications :: NtfToken -> Bool
instantNotifications NtfToken {ntfTknStatus = NTActive, ntfMode = NMInstant} = True
instantNotifications _ = False
{-# INLINE instantNotifications #-}
deleteToken :: AgentClient -> NtfToken -> AM ()
deleteToken c tkn@NtfToken {ntfServer, ntfTokenId, ntfPrivKey} = do
setToDelete <- withStore' c $ \db -> do
removeNtfToken db tkn
case ntfTokenId of
Just tknId -> addNtfTokenToDelete db ntfServer ntfPrivKey tknId $> True
Nothing -> pure False
ns <- asks ntfSupervisor
atomically $ nsRemoveNtfToken ns
when setToDelete $ void $ lift $ getNtfTknDelWorker True c ntfServer
runNtfTknDelWorker :: AgentClient -> NtfServer -> Worker -> AM ()
runNtfTknDelWorker c srv Worker {doWork} =
forever $ do
waitForWork doWork
ExceptT $ agentOperationBracket c AONtfNetwork throwWhenInactive $ runExceptT runNtfOperation
where
runNtfOperation :: AM ()
runNtfOperation =
withWork c doWork (`getNextNtfTokenToDelete` srv) $
\nextTknToDelete -> do
logInfo $ "runNtfTknDelWorker, nextTknToDelete " <> tshow nextTknToDelete
ri <- asks $ reconnectInterval . config
withRetryInterval ri $ \_ loop -> do
liftIO $ waitWhileSuspended c
liftIO $ waitForUserNetwork c
processTknToDelete nextTknToDelete `catchAllErrors` retryTmpError loop nextTknToDelete
retryTmpError :: AM () -> NtfTokenToDelete -> AgentErrorType -> AM ()
retryTmpError loop (tknDbId, _, _) e = do
logError $ "ntf tkn del error: " <> tshow e
if temporaryOrHostError e
then retryNetworkLoop c loop
else do
withStore' c $ \db -> deleteNtfTokenToDelete db tknDbId
notifyInternalError' c (show e)
processTknToDelete :: NtfTokenToDelete -> AM ()
processTknToDelete (tknDbId, ntfPrivKey, tknId) = do
agentNtfDeleteToken c NRMBackground srv ntfPrivKey tknId
withStore' c $ \db -> deleteNtfTokenToDelete db tknDbId
closeNtfSupervisor :: NtfSupervisor -> IO ()
closeNtfSupervisor ns = do
stopWorkers $ ntfWorkers ns
stopWorkers $ ntfSMPWorkers ns
stopWorkers $ ntfTknDelWorkers ns
where
stopWorkers workers = atomically (swapTVar workers M.empty) >>= mapM_ (liftIO . cancelWorker)
File diff suppressed because it is too large Load Diff
+3 -4
View File
@@ -10,11 +10,10 @@ import qualified Data.Aeson.TH as J
import Data.Int (Int64)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Messaging.Agent.Protocol (UserId)
import Simplex.Messaging.Parsers (defaultJSON, fromTextField_)
import Simplex.Messaging.Protocol (SMPServer, XFTPServer, NtfServer)
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.Protocol (NtfServer, SMPServer, XFTPServer)
import Simplex.Messaging.Util (decodeJSON, encodeJSON)
import UnliftIO.STM
+169 -55
View File
@@ -29,8 +29,13 @@ import Data.Time (UTCTime)
import Data.Type.Equality
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.RetryInterval (RI2State)
import Simplex.Messaging.Agent.Store.Entity
import Simplex.Messaging.Agent.Store.Common
import Simplex.Messaging.Agent.Store.Interface (createDBStore)
import Simplex.Messaging.Agent.Store.Migrations.App (appMigrations)
import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport, RatchetX448)
import Simplex.Messaging.Crypto.Ratchet (MsgEncryptKeyX448, PQEncryption, PQSupport, RatchetX448)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol
( MsgBody,
@@ -39,36 +44,27 @@ import Simplex.Messaging.Protocol
NotifierId,
NtfPrivateAuthKey,
NtfPublicAuthKey,
QueueMode,
RcvDhSecret,
RcvNtfDhSecret,
RcvPrivateAuthKey,
SndPrivateAuthKey,
SndPublicAuthKey,
SenderCanSecure,
VersionSMPC,
)
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Util (AnyError (..), bshow)
createStore :: DBOpts -> MigrationConfig -> IO (Either MigrationError DBStore)
createStore dbOpts = createDBStore dbOpts appMigrations
-- * Queue types
data QueueStored = QSStored | QSNew
type RcvQueue = StoredRcvQueue 'DBStored
data SQueueStored (q :: QueueStored) where
SQSStored :: SQueueStored 'QSStored
SQSNew :: SQueueStored 'QSNew
data DBQueueId (q :: QueueStored) where
DBQueueId :: Int64 -> DBQueueId 'QSStored
DBNewQueue :: DBQueueId 'QSNew
deriving instance Show (DBQueueId q)
type RcvQueue = StoredRcvQueue 'QSStored
type NewRcvQueue = StoredRcvQueue 'QSNew
type NewRcvQueue = StoredRcvQueue 'DBNew
-- | A receive queue. SMP queue through which the agent receives messages from a sender.
data StoredRcvQueue (q :: QueueStored) = RcvQueue
data StoredRcvQueue (q :: DBStored) = RcvQueue
{ userId :: UserId,
connId :: ConnId,
server :: SMPServer,
@@ -85,11 +81,19 @@ data StoredRcvQueue (q :: QueueStored) = RcvQueue
-- | sender queue ID
sndId :: SMP.SenderId,
-- | sender can secure the queue
sndSecure :: SenderCanSecure,
queueMode :: Maybe QueueMode,
-- | short link ID and credentials
shortLink :: Maybe ShortLinkCreds,
-- | associated client service
clientService :: Maybe (StoredClientService q),
-- | queue status
status :: QueueStatus,
-- | to enable notifications for this queue - this field is duplicated from ConnData
enableNtfs :: Bool,
-- | client notice
clientNoticeId :: Maybe NoticeId,
-- | database queue ID (within connection)
dbQueueId :: DBQueueId q,
dbQueueId :: DBEntityId' q,
-- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
primary :: Bool,
-- | database queue ID to replace, Nothing if this queue is not replacing another, `Just Nothing` is used for replacing old queues
@@ -103,9 +107,40 @@ data StoredRcvQueue (q :: QueueStored) = RcvQueue
}
deriving (Show)
rcvQueueInfo :: RcvQueue -> RcvQueueInfo
rcvQueueInfo rq@RcvQueue {server, rcvSwchStatus} =
RcvQueueInfo {rcvServer = server, rcvSwitchStatus = rcvSwchStatus, canAbortSwitch = canAbortRcvSwitch rq}
data RcvQueueSub = RcvQueueSub
{ userId :: UserId,
connId :: ConnId,
server :: SMPServer,
rcvId :: SMP.RecipientId,
rcvPrivateKey :: RcvPrivateAuthKey,
status :: QueueStatus,
enableNtfs :: Bool,
clientNoticeId :: Maybe NoticeId,
dbQueueId :: Int64,
primary :: Bool,
dbReplaceQueueId :: Maybe Int64
}
deriving (Show)
rcvQueueSub :: RcvQueue -> RcvQueueSub
rcvQueueSub RcvQueue {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId = DBEntityId dbQueueId, primary, dbReplaceQueueId} =
RcvQueueSub {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId}
data ShortLinkCreds = ShortLinkCreds
{ shortLinkId :: SMP.LinkId,
shortLinkKey :: LinkKey,
linkPrivSigKey :: C.PrivateKeyEd25519,
linkEncFixedData :: SMP.EncFixedDataBytes
}
deriving (Show)
clientServiceId :: RcvQueue -> Maybe ClientServiceId
clientServiceId = fmap dbServiceId . clientService
{-# INLINE clientServiceId #-}
rcvSMPQueueAddress :: RcvQueue -> SMPQueueAddress
rcvSMPQueueAddress RcvQueue {server, sndId, e2ePrivKey, queueMode} =
SMPQueueAddress server sndId (C.publicKey e2ePrivKey) queueMode
canAbortRcvSwitch :: RcvQueue -> Bool
canAbortRcvSwitch = maybe False canAbort . rcvSwchStatus
@@ -130,22 +165,32 @@ data ClientNtfCreds = ClientNtfCreds
}
deriving (Show)
type SndQueue = StoredSndQueue 'QSStored
-- This record is stored in inv_short_links table.
-- It is needed only for 1-time invitation links because of "secure-on-read" property of link data,
-- that prevents undetected access to link data from link observers.
data InvShortLink = InvShortLink
{ server :: SMPServer,
linkId :: SMP.LinkId,
linkKey :: LinkKey,
sndPrivateKey :: SndPrivateAuthKey, -- stored to allow retries
sndId :: Maybe SMP.SenderId
}
deriving (Show)
type NewSndQueue = StoredSndQueue 'QSNew
type SndQueue = StoredSndQueue 'DBStored
type NewSndQueue = StoredSndQueue 'DBNew
-- | A send queue. SMP queue through which the agent sends messages to a recipient.
data StoredSndQueue (q :: QueueStored) = SndQueue
data StoredSndQueue (q :: DBStored) = SndQueue
{ userId :: UserId,
connId :: ConnId,
server :: SMPServer,
-- | sender queue ID
sndId :: SMP.SenderId,
-- | sender can secure the queue
sndSecure :: SenderCanSecure,
-- | key pair used by the sender to authorize transmissions
-- TODO combine keys to key pair so that types match
sndPublicKey :: SndPublicAuthKey,
queueMode :: Maybe QueueMode,
-- | sender key used to authorize transmissions
sndPrivateKey :: SndPrivateAuthKey,
-- | DH public key used to negotiate per-queue e2e encryption
e2ePubKey :: Maybe C.PublicKeyX25519,
@@ -154,7 +199,7 @@ data StoredSndQueue (q :: QueueStored) = SndQueue
-- | queue status
status :: QueueStatus,
-- | database queue ID (within connection)
dbQueueId :: DBQueueId q,
dbQueueId :: DBEntityId' q,
-- | True for a primary or a next primary queue of the connection (next if dbReplaceQueueId is set)
primary :: Bool,
-- | ID of the queue this one is replacing
@@ -165,10 +210,6 @@ data StoredSndQueue (q :: QueueStored) = SndQueue
}
deriving (Show)
sndQueueInfo :: SndQueue -> SndQueueInfo
sndQueueInfo SndQueue {server, sndSwchStatus} =
SndQueueInfo {sndServer = server, sndSwitchStatus = sndSwchStatus}
instance SMPQueue RcvQueue where
qServer RcvQueue {server} = server
{-# INLINE qServer #-}
@@ -181,6 +222,12 @@ instance SMPQueue NewRcvQueue where
queueId RcvQueue {rcvId} = rcvId
{-# INLINE queueId #-}
instance SMPQueue RcvQueueSub where
qServer RcvQueueSub {server} = server
{-# INLINE qServer #-}
queueId RcvQueueSub {rcvId} = rcvId
{-# INLINE queueId #-}
instance SMPQueue SndQueue where
qServer SndQueue {server} = server
{-# INLINE qServer #-}
@@ -220,6 +267,7 @@ class SMPQueue q => SMPQueueRec q where
qUserId :: q -> UserId
qConnId :: q -> ConnId
dbQId :: q -> Int64
qPrimary :: q -> Bool
dbReplaceQId :: q -> Maybe Int64
instance SMPQueueRec RcvQueue where
@@ -227,21 +275,48 @@ instance SMPQueueRec RcvQueue where
{-# INLINE qUserId #-}
qConnId RcvQueue {connId} = connId
{-# INLINE qConnId #-}
dbQId RcvQueue {dbQueueId = DBQueueId qId} = qId
dbQId RcvQueue {dbQueueId = DBEntityId qId} = qId
{-# INLINE dbQId #-}
qPrimary RcvQueue {primary} = primary
{-# INLINE qPrimary #-}
dbReplaceQId RcvQueue {dbReplaceQueueId} = dbReplaceQueueId
{-# INLINE dbReplaceQId #-}
instance SMPQueueRec RcvQueueSub where
qUserId RcvQueueSub {userId} = userId
{-# INLINE qUserId #-}
qConnId RcvQueueSub {connId} = connId
{-# INLINE qConnId #-}
dbQId RcvQueueSub {dbQueueId} = dbQueueId
{-# INLINE dbQId #-}
qPrimary RcvQueueSub {primary} = primary
{-# INLINE qPrimary #-}
dbReplaceQId RcvQueueSub {dbReplaceQueueId} = dbReplaceQueueId
{-# INLINE dbReplaceQId #-}
instance SMPQueueRec SndQueue where
qUserId SndQueue {userId} = userId
{-# INLINE qUserId #-}
qConnId SndQueue {connId} = connId
{-# INLINE qConnId #-}
dbQId SndQueue {dbQueueId = DBQueueId qId} = qId
dbQId SndQueue {dbQueueId = DBEntityId qId} = qId
{-# INLINE dbQId #-}
qPrimary SndQueue {primary} = primary
{-# INLINE qPrimary #-}
dbReplaceQId SndQueue {dbReplaceQueueId} = dbReplaceQueueId
{-# INLINE dbReplaceQId #-}
class SMPQueueRec q => SomeRcvQueue q where
rcvAuthKey :: q -> RcvPrivateAuthKey
instance SomeRcvQueue RcvQueue where
rcvAuthKey RcvQueue {rcvPrivateKey} = rcvPrivateKey
{-# INLINE rcvAuthKey #-}
instance SomeRcvQueue RcvQueueSub where
rcvAuthKey RcvQueueSub {rcvPrivateKey} = rcvPrivateKey
{-# INLINE rcvAuthKey #-}
-- * Connection types
-- | Type of a connection.
@@ -257,16 +332,18 @@ data ConnType = CNew | CRcv | CSnd | CDuplex | CContact deriving (Eq, Show)
--
-- - DuplexConnection is a connection that has both receive and send queues set up,
-- typically created by upgrading a receive or a send connection with a missing queue.
data Connection (d :: ConnType) where
NewConnection :: ConnData -> Connection CNew
RcvConnection :: ConnData -> RcvQueue -> Connection CRcv
SndConnection :: ConnData -> SndQueue -> Connection CSnd
DuplexConnection :: ConnData -> NonEmpty RcvQueue -> NonEmpty SndQueue -> Connection CDuplex
ContactConnection :: ConnData -> RcvQueue -> Connection CContact
data Connection' (d :: ConnType) rq sq where
NewConnection :: ConnData -> Connection' CNew rq sq
RcvConnection :: ConnData -> rq -> Connection' CRcv rq sq
SndConnection :: ConnData -> sq -> Connection' CSnd rq sq
DuplexConnection :: ConnData -> NonEmpty rq -> NonEmpty sq -> Connection' CDuplex rq sq
ContactConnection :: ConnData -> rq -> Connection' CContact rq sq
deriving instance Show (Connection d)
deriving instance (Show rq, Show sq) => Show (Connection' d rq sq)
toConnData :: Connection d -> ConnData
type Connection d = Connection' d RcvQueue SndQueue
toConnData :: Connection' d rq sq -> ConnData
toConnData = \case
NewConnection cData -> cData
RcvConnection cData _ -> cData
@@ -274,7 +351,7 @@ toConnData = \case
DuplexConnection cData _ _ -> cData
ContactConnection cData _ -> cData
updateConnection :: ConnData -> Connection d -> Connection d
updateConnection :: ConnData -> Connection' d rq sq -> Connection' d rq sq
updateConnection cData = \case
NewConnection _ -> NewConnection cData
RcvConnection _ rq -> RcvConnection cData rq
@@ -307,9 +384,13 @@ instance TestEquality SConnType where
-- | Connection of an unknown type.
-- Used to refer to an arbitrary connection when retrieving from store.
data SomeConn = forall d. SomeConn (SConnType d) (Connection d)
data SomeConn' rq sq = forall d. SomeConn (SConnType d) (Connection' d rq sq)
deriving instance Show SomeConn
deriving instance (Show rq, Show sq) => Show (SomeConn' rq sq)
type SomeConn = SomeConn' RcvQueue SndQueue
type SomeConnSub = SomeConn' RcvQueueSub SndQueue
data ConnData = ConnData
{ connId :: ConnId,
@@ -323,6 +404,8 @@ data ConnData = ConnData
}
deriving (Eq, Show)
type NoticeId = Int64
-- this function should be mirrored in the clients
ratchetSyncAllowed :: ConnData -> Bool
ratchetSyncAllowed ConnData {ratchetSyncState, connAgentVersion} =
@@ -486,7 +569,7 @@ data NewInvitation = NewInvitation
data Invitation = Invitation
{ invitationId :: InvitationId,
contactConnId :: ConnId,
contactConnId_ :: Maybe ConnId,
connReq :: ConnectionRequestUri 'CMInvitation,
recipientConnInfo :: ConnInfo,
ownConnInfo :: Maybe ConnInfo,
@@ -536,9 +619,17 @@ data SndMsgData = SndMsgData
msgBody :: MsgBody,
pqEncryption :: PQEncryption,
internalHash :: MsgHash,
prevMsgHash :: MsgHash
prevMsgHash :: MsgHash,
sndMsgPrepData_ :: Maybe SndMsgPrepData
}
data SndMsgPrepData = SndMsgPrepData
{ encryptKey :: MsgEncryptKeyX448,
paddedLen :: Int,
sndMsgBodyId :: Int64
}
deriving (Show)
data SndMsg = SndMsg
{ internalId :: InternalId,
internalSndId :: InternalSndId,
@@ -554,7 +645,17 @@ data PendingMsgData = PendingMsgData
msgBody :: MsgBody,
pqEncryption :: PQEncryption,
msgRetryState :: Maybe RI2State,
internalTs :: InternalTs
internalTs :: InternalTs,
internalSndId :: InternalSndId,
prevMsgHash :: PrevSndMsgHash,
pendingMsgPrepData_ :: Maybe PendingMsgPrepData
}
deriving (Show)
data PendingMsgPrepData = PendingMsgPrepData
{ encryptKey :: MsgEncryptKeyX448,
paddedLen :: Int,
sndMsgBody :: AMessage
}
deriving (Show)
@@ -619,13 +720,13 @@ data StoreError
SESndQueueExists
| -- | Wrong connection type, e.g. "send" connection when "receive" or "duplex" is expected, or vice versa.
-- 'upgradeRcvConnToDuplex' and 'upgradeSndConnToDuplex' do not allow duplex connections - they would also return this error.
SEBadConnType ConnType
SEBadConnType String ConnType
| -- | Confirmation not found.
SEConfirmationNotFound
| -- | Invitation not found
SEInvitationNotFound
SEInvitationNotFound String InvitationId
| -- | Message not found
SEMsgNotFound
SEMsgNotFound String
| -- | Command not found
SECmdNotFound
| -- | Currently not used. The intention was to pass current expected queue status in methods,
@@ -645,7 +746,20 @@ data StoreError
| -- | XFTP Deleted snd chunk replica not found.
SEDeletedSndChunkReplicaNotFound
| -- | Error when reading work item that suspends worker - do not use!
SEWorkItemError ByteString
SEWorkItemError {errContext :: String}
| -- | Servers stats not found.
SEServersStatsNotFound
deriving (Eq, Show, Exception)
instance AnyError StoreError where
fromSomeException = SEInternal . bshow
class (Show e, AnyError e) => AnyStoreError e where
isWorkItemError :: e -> Bool
mkWorkItemError :: String -> e
instance AnyStoreError StoreError where
isWorkItemError = \case
SEWorkItemError {} -> True
_ -> False
mkWorkItemError errContext = SEWorkItemError {errContext}
File diff suppressed because it is too large Load Diff
@@ -0,0 +1,14 @@
{-# LANGUAGE CPP #-}
module Simplex.Messaging.Agent.Store.Common
#if defined(dbPostgres)
( module Simplex.Messaging.Agent.Store.Postgres.Common,
)
where
import Simplex.Messaging.Agent.Store.Postgres.Common
#else
( module Simplex.Messaging.Agent.Store.SQLite.Common,
)
where
import Simplex.Messaging.Agent.Store.SQLite.Common
#endif
+18
View File
@@ -0,0 +1,18 @@
{-# LANGUAGE CPP #-}
module Simplex.Messaging.Agent.Store.DB
#if defined(dbPostgres)
( module Simplex.Messaging.Agent.Store.Postgres.DB,
FromField (..),
ToField (..),
)
where
import Simplex.Messaging.Agent.Store.Postgres.DB
#else
( module Simplex.Messaging.Agent.Store.SQLite.DB,
FromField (..),
ToField (..),
)
where
import Simplex.Messaging.Agent.Store.SQLite.DB
#endif
@@ -0,0 +1,72 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
module Simplex.Messaging.Agent.Store.Entity where
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import Data.Int (Int64)
import Data.Scientific (floatingOrInteger)
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
data DBStored = DBStored | DBNew
data SDBStored (s :: DBStored) where
SDBStored :: SDBStored 'DBStored
SDBNew :: SDBStored 'DBNew
deriving instance Show (SDBStored s)
class DBStoredI s where sdbStored :: SDBStored s
instance DBStoredI 'DBStored where sdbStored = SDBStored
instance DBStoredI 'DBNew where sdbStored = SDBNew
data DBEntityId' (s :: DBStored) where
DBEntityId :: Int64 -> DBEntityId' 'DBStored
DBNewEntity :: DBEntityId' 'DBNew
deriving instance Show (DBEntityId' s)
deriving instance Eq (DBEntityId' s)
type DBEntityId = DBEntityId' 'DBStored
type DBNewEntity = DBEntityId' 'DBNew
instance ToJSON (DBEntityId' s) where
toEncoding = \case
DBEntityId i -> toEncoding i
DBNewEntity -> JE.null_
toJSON = \case
DBEntityId i -> toJSON i
DBNewEntity -> J.Null
instance DBStoredI s => FromJSON (DBEntityId' s) where
parseJSON v = case (v, sdbStored @s) of
(J.Null, SDBNew) -> pure DBNewEntity
(J.Number n, SDBStored) -> case floatingOrInteger n of
Left (_ :: Double) -> fail "bad DBEntityId"
Right i -> pure $ DBEntityId (fromInteger i)
_ -> fail "bad DBEntityId"
omittedField = case sdbStored @s of
SDBStored -> Nothing
SDBNew -> Just DBNewEntity
instance FromField DBEntityId where
#if defined(dbPostgres)
fromField x dat = DBEntityId <$> fromField x dat
#else
fromField x = DBEntityId <$> fromField x
#endif
instance ToField DBEntityId where toField (DBEntityId i) = toField i
@@ -0,0 +1,14 @@
{-# LANGUAGE CPP #-}
module Simplex.Messaging.Agent.Store.Interface
#if defined(dbPostgres)
( module Simplex.Messaging.Agent.Store.Postgres,
)
where
import Simplex.Messaging.Agent.Store.Postgres
#else
( module Simplex.Messaging.Agent.Store.SQLite,
)
where
import Simplex.Messaging.Agent.Store.SQLite
#endif
@@ -0,0 +1,78 @@
{-# LANGUAGE LambdaCase #-}
module Simplex.Messaging.Agent.Store.Migrations
( Migration (..),
MigrationsToRun (..),
DownMigration (..),
DBMigrate (..),
sharedMigrateSchema,
-- for tests
migrationsToRun,
toDownMigration,
)
where
import Control.Monad
import Data.Char (toLower)
import Data.Functor (($>))
import Data.Maybe (isJust, isNothing, mapMaybe)
import Simplex.Messaging.Agent.Store.Shared
import System.Exit (exitFailure)
import System.IO (hFlush, stdout)
migrationsToRun :: [Migration] -> [Migration] -> Either MTRError MigrationsToRun
migrationsToRun [] [] = Right MTRNone
migrationsToRun appMs [] = Right $ MTRUp appMs
migrationsToRun [] dbMs
| length dms == length dbMs = Right $ MTRDown dms
| otherwise = Left $ MTRENoDown $ mapMaybe nameNoDown dbMs
where
dms = mapMaybe toDownMigration dbMs
nameNoDown m = if isNothing (down m) then Just $ name m else Nothing
migrationsToRun (a : as) (d : ds)
| name a == name d = migrationsToRun as ds
| otherwise = Left $ MTREDifferent (name a) (name d)
data DBMigrate = DBMigrate
{ initialize :: IO (),
getCurrent :: IO [Migration],
run :: MigrationsToRun -> IO (),
backup :: Maybe (IO ())
}
sharedMigrateSchema :: DBMigrate -> Bool -> [Migration] -> MigrationConfirmation -> IO (Either MigrationError ())
sharedMigrateSchema dbm dbNew' migrations confirmMigrations = do
initialize dbm
currentMs <- getCurrent dbm
case migrationsToRun migrations currentMs of
Left e -> do
when (confirmMigrations == MCConsole) $ confirmOrExit ("Database state error: " <> mtrErrorDescription e)
pure . Left $ MigrationError e
Right MTRNone -> pure $ Right ()
Right ms@(MTRUp ums)
| dbNew' -> run dbm ms $> Right ()
| otherwise -> case confirmMigrations of
MCYesUp -> runWithBackup ms
MCYesUpDown -> runWithBackup ms
MCConsole -> confirm' err >> runWithBackup ms
MCError -> pure $ Left err
where
err = MEUpgrade $ map upMigration ums -- "The app has a newer version than the database.\nConfirm to back up and upgrade using these migrations: " <> intercalate ", " (map name ums)
Right ms@(MTRDown dms) -> case confirmMigrations of
MCYesUpDown -> runWithBackup ms
MCConsole -> confirm' err >> runWithBackup ms
MCYesUp -> pure $ Left err
MCError -> pure $ Left err
where
err = MEDowngrade $ map downName dms
where
runWithBackup ms = sequence (backup dbm) >> run dbm ms $> Right ()
confirm' err = confirmOrExit $ migrationErrorDescription (isJust $ backup dbm) err
confirmOrExit :: String -> IO ()
confirmOrExit s = do
putStrLn s
putStr "Continue (y/N): "
hFlush stdout
ok <- getLine
when (map toLower ok /= "y") exitFailure
@@ -0,0 +1,14 @@
{-# LANGUAGE CPP #-}
module Simplex.Messaging.Agent.Store.Migrations.App
#if defined(dbPostgres)
( module Simplex.Messaging.Agent.Store.Postgres.Migrations.App,
)
where
import Simplex.Messaging.Agent.Store.Postgres.Migrations.App
#else
( module Simplex.Messaging.Agent.Store.SQLite.Migrations.App,
)
where
import Simplex.Messaging.Agent.Store.SQLite.Migrations.App
#endif
@@ -0,0 +1,137 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Messaging.Agent.Store.Postgres
( DBOpts (..),
Migrations.getCurrentMigrations,
checkSchemaExists,
migrateDBSchema,
createDBStore,
closeDBStore,
reopenDBStore,
execSQL,
)
where
import Control.Concurrent.STM
import Control.Exception (finally, onException, throwIO, uninterruptibleMask_)
import Control.Logger.Simple (logError)
import Control.Monad
import Data.ByteString (ByteString)
import Data.Functor (($>))
import Data.Text (Text)
import Database.PostgreSQL.Simple (Only (..))
import Database.PostgreSQL.Simple.Types (Query (..))
import qualified Database.PostgreSQL.Simple as PSQL
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Simplex.Messaging.Agent.Store.Migrations (DBMigrate (..), sharedMigrateSchema)
import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
import Simplex.Messaging.Agent.Store.Postgres.Common
import qualified Simplex.Messaging.Agent.Store.Postgres.DB as DB
import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationError (..))
import Simplex.Messaging.Util (ifM, safeDecodeUtf8)
import System.Exit (exitFailure)
-- | Create a new Postgres DBStore with the given connection string, schema name and migrations.
-- If passed schema does not exist in connectInfo database, it will be created.
-- Applies necessary migrations to schema.
createDBStore :: DBOpts -> [Migration] -> MigrationConfig -> IO (Either MigrationError DBStore)
createDBStore opts migrations migrationConfig = do
st <- connectPostgresStore opts
r <- migrateDBSchema st opts Nothing migrations migrationConfig `onException` closeDBStore st
case r of
Right () -> pure $ Right st
Left e -> closeDBStore st $> Left e
migrateDBSchema :: DBStore -> DBOpts -> Maybe Query -> [Migration] -> MigrationConfig -> IO (Either MigrationError ())
migrateDBSchema st _opts migrationsTable migrations MigrationConfig {confirm} =
let initialize = Migrations.initialize st migrationsTable
getCurrent = withTransaction st $ Migrations.getCurrentMigrations migrationsTable
run = Migrations.run st migrationsTable
dbm = DBMigrate {initialize, getCurrent, run, backup = Nothing}
in sharedMigrateSchema dbm (dbNew st) migrations confirm
connectPostgresStore :: DBOpts -> IO DBStore
connectPostgresStore DBOpts {connstr, schema, poolSize, createSchema} = do
dbPriorityPool <- newDBStorePool poolSize
dbPool <- newDBStorePool poolSize
dbClosed <- newTVarIO True
let dbConnect = fst <$> connectDB connstr schema False
st = DBStore {dbConnstr = connstr, dbSchema = schema, dbPoolSize = fromIntegral poolSize, dbPriorityPool, dbPool, dbConnect, dbNew = False, dbClosed}
dbNew <- connectStore st createSchema
pure st {dbNew}
-- uninterruptibleMask_ here and below is used here so that it is not interrupted half-way,
-- it relies on the assumption that when dbClosed = True, the queue is empty,
-- and when it is False, the queue is full (or will have connections returned to it by the threads that use them).
connectStore :: DBStore -> Bool -> IO Bool
connectStore DBStore {dbConnstr, dbSchema, dbPoolSize, dbPriorityPool, dbPool, dbClosed} createSchema = uninterruptibleMask_ $ do
(conn, dbNew) <- connectDB dbConnstr dbSchema createSchema -- TODO [postgres] analogue for dbBusyLoop?
writeConns dbPriorityPool . (conn :) =<< mkConns (dbPoolSize - 1)
writeConns dbPool =<< mkConns dbPoolSize
atomically $ writeTVar dbClosed False
pure dbNew
where
writeConns pool conns = mapM_ (atomically . writeTBQueue (dbPoolConns pool)) conns
mkConns n = replicateM n $ fst <$> connectDB dbConnstr dbSchema False
connectDB :: ByteString -> ByteString -> Bool -> IO (DB.Connection, Bool)
connectDB connstr schema createSchema = do
db <- PSQL.connectPostgreSQL connstr
dbNew <- prepare db `onException` PSQL.close db
pure (db, dbNew)
where
prepare db = do
void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
dbNew <- not <$> doesSchemaExist db schema
when dbNew $
if createSchema
then void $ PSQL.execute_ db $ Query $ "CREATE SCHEMA " <> schema
else do
logError $ "connectPostgresStore, schema " <> safeDecodeUtf8 schema <> " does not exist, exiting."
PSQL.close db
exitFailure
void $ PSQL.execute_ db $ Query $ "SET search_path TO " <> schema
pure dbNew
checkSchemaExists :: ByteString -> ByteString -> IO Bool
checkSchemaExists connstr schema = do
db <- PSQL.connectPostgreSQL connstr
doesSchemaExist db schema `finally` DB.close db
doesSchemaExist :: DB.Connection -> ByteString -> IO Bool
doesSchemaExist db schema = do
[Only schemaExists] <-
PSQL.query
db
[sql|
SELECT EXISTS (
SELECT 1 FROM pg_catalog.pg_namespace
WHERE nspname = ?
)
|]
(Only schema)
pure schemaExists
closeDBStore :: DBStore -> IO ()
closeDBStore DBStore {dbPoolSize, dbPriorityPool, dbPool, dbClosed} =
ifM (readTVarIO dbClosed) (putStrLn "closeDBStore: already closed") $ uninterruptibleMask_ $ do
closePool dbPriorityPool
closePool dbPool
atomically $ writeTVar dbClosed True
where
closePool pool = replicateM_ dbPoolSize $ atomically (readTBQueue $ dbPoolConns pool) >>= DB.close
reopenDBStore :: DBStore -> IO ()
reopenDBStore st =
ifM
(readTVarIO $ dbClosed st)
(void $ connectStore st False)
(putStrLn "reopenDBStore: already opened")
-- not used with postgres client (used for ExecAgentStoreSQL, ExecChatStoreSQL)
execSQL :: PSQL.Connection -> Text -> IO [Text]
execSQL _db _query = throwIO (userError "not implemented")
@@ -0,0 +1,93 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Simplex.Messaging.Agent.Store.Postgres.Common
( DBStore (..),
DBStorePool (..),
DBOpts (..),
newDBStorePool,
withConnection,
withConnection',
withTransaction,
withTransaction',
withTransactionPriority,
)
where
import Control.Concurrent.MVar
import Control.Concurrent.STM
import qualified Control.Exception as E
import Data.ByteString (ByteString)
import qualified Database.PostgreSQL.Simple as PSQL
import Numeric.Natural (Natural)
import Simplex.Messaging.Agent.Store.Postgres.Options
-- TODO [postgres] use log_min_duration_statement instead of custom slow queries (SQLite's Connection type)
data DBStore = DBStore
{ dbConnstr :: ByteString,
dbSchema :: ByteString,
dbPoolSize :: Int,
dbPriorityPool :: DBStorePool,
dbPool :: DBStorePool,
dbConnect :: IO PSQL.Connection,
dbClosed :: TVar Bool,
dbNew :: Bool
}
newDBStorePool :: Natural -> IO DBStorePool
newDBStorePool poolSize = do
dbSem <- newMVar ()
dbPoolConns <- newTBQueueIO poolSize
pure DBStorePool {dbSem, dbPoolConns}
data DBStorePool = DBStorePool
{ dbPoolConns :: TBQueue PSQL.Connection,
-- MVar is needed for fair pool distribution, without STM retry contention.
-- Only one thread can be blocked on STM read.
dbSem :: MVar ()
}
withConnectionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
withConnectionPriority DBStore {dbPriorityPool, dbPool, dbConnect} priority =
withConnectionPool (if priority then dbPriorityPool else dbPool) dbConnect
{-# INLINE withConnectionPriority #-}
withConnectionPool :: DBStorePool -> IO PSQL.Connection -> (PSQL.Connection -> IO a) -> IO a
withConnectionPool DBStorePool {dbPoolConns, dbSem} dbConnect action =
E.mask $ \restore -> do
conn <- withMVar dbSem $ \_ -> atomically $ readTBQueue dbPoolConns
r <- restore (action conn) `E.onException` reset conn
atomically $ writeTBQueue dbPoolConns conn
pure r
where
reset conn = do
conn' <- E.try dbConnect >>= \case
Right conn' -> PSQL.close conn >> pure conn'
Left (_ :: E.SomeException) -> pure conn
atomically $ writeTBQueue dbPoolConns conn'
withConnection :: DBStore -> (PSQL.Connection -> IO a) -> IO a
withConnection st = withConnectionPriority st False
{-# INLINE withConnection #-}
withConnection' :: DBStore -> (PSQL.Connection -> IO a) -> IO a
withConnection' = withConnection
{-# INLINE withConnection' #-}
withTransaction' :: DBStore -> (PSQL.Connection -> IO a) -> IO a
withTransaction' = withTransaction
{-# INLINE withTransaction' #-}
withTransaction :: DBStore -> (PSQL.Connection -> IO a) -> IO a
withTransaction st = withTransactionPriority st False
{-# INLINE withTransaction #-}
-- TODO [postgres] analogue for dbBusyLoop?
withTransactionPriority :: DBStore -> Bool -> (PSQL.Connection -> IO a) -> IO a
withTransactionPriority st priority action = withConnectionPriority st priority transaction
where
transaction conn = PSQL.withTransaction conn $ action conn
@@ -0,0 +1,89 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Messaging.Agent.Store.Postgres.DB
( BoolInt (..),
PSQL.Binary (..),
PSQL.Connection,
FromField (..),
ToField (..),
PSQL.connect,
PSQL.close,
execute,
execute_,
executeMany,
PSQL.query,
PSQL.query_,
blobFieldDecoder,
fromTextField_,
)
where
import Control.Monad (void)
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int64)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32)
import Database.PostgreSQL.Simple (ResultError (..))
import qualified Database.PostgreSQL.Simple as PSQL
import Database.PostgreSQL.Simple.FromField (Field (..), FieldParser, FromField (..), returnError)
import Database.PostgreSQL.Simple.ToField (ToField (..))
import Database.PostgreSQL.Simple.TypeInfo.Static (textOid, varcharOid)
newtype BoolInt = BI {unBI :: Bool}
instance FromField BoolInt where
fromField field dat = BI . (/= (0 :: Int)) <$> fromField field dat
{-# INLINE fromField #-}
instance ToField BoolInt where
toField (BI b) = toField ((if b then 1 else 0) :: Int)
{-# INLINE toField #-}
execute :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> q -> IO ()
execute db q qs = void $ PSQL.execute db q qs
{-# INLINE execute #-}
execute_ :: PSQL.Connection -> PSQL.Query -> IO ()
execute_ db q = void $ PSQL.execute_ db q
{-# INLINE execute_ #-}
executeMany :: PSQL.ToRow q => PSQL.Connection -> PSQL.Query -> [q] -> IO ()
executeMany db q qs = void $ PSQL.executeMany db q qs
{-# INLINE executeMany #-}
-- orphan instances
-- used in FileSize
instance FromField Word32 where
fromField field dat = do
i :: Int64 <- fromField field dat
if i >= 0 && i <= fromIntegral (maxBound :: Word32)
then pure (fromIntegral i :: Word32)
else returnError ConversionFailed field "Negative value can't be converted to Word32"
-- used in Version
instance FromField Word16 where
fromField field dat = do
i :: Int64 <- fromField field dat
if i >= 0 && i <= fromIntegral (maxBound :: Word16)
then pure (fromIntegral i :: Word16)
else returnError ConversionFailed field "Negative value can't be converted to Word16"
blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
blobFieldDecoder dec f val = do
x <- fromField f val
case dec x of
Right k -> pure k
Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
fromTextField_ :: Typeable a => (Text -> Maybe a) -> FieldParser a
fromTextField_ fromText f val =
if typeOid f `elem` [textOid, varcharOid]
then case val of
Just t -> case fromText $ decodeUtf8 t of
Just x -> pure x
_ -> returnError ConversionFailed f "invalid text value"
Nothing -> returnError UnexpectedNull f "NULL value found for non-NULL field"
else returnError Incompatible f "expecting TEXT or VARCHAR column type"
@@ -0,0 +1,63 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations
( initialize,
run,
getCurrentMigrations,
)
where
import Control.Exception (throwIO)
import Control.Monad (void)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time.Clock (getCurrentTime)
import qualified Database.PostgreSQL.LibPQ as LibPQ
import Database.PostgreSQL.Simple (Only (..), Query)
import qualified Database.PostgreSQL.Simple as PSQL
import Database.PostgreSQL.Simple.Internal (Connection (..))
import Simplex.Messaging.Agent.Store.Postgres.Common
import Simplex.Messaging.Agent.Store.Shared
import Simplex.Messaging.Util (($>>=))
import UnliftIO.MVar
initialize :: DBStore -> Maybe Query -> IO ()
initialize st migrationsTable = withTransaction' st $ \db ->
void $ PSQL.execute_ db $
"CREATE TABLE IF NOT EXISTS "
<> fromMaybe "migrations" migrationsTable
<> " (name TEXT NOT NULL PRIMARY KEY, ts TIMESTAMP NOT NULL, down TEXT)"
run :: DBStore -> Maybe Query -> MigrationsToRun -> IO ()
run st migrationsTable = \case
MTRUp [] -> pure ()
MTRUp ms -> mapM_ runUp ms
MTRDown ms -> mapM_ runDown $ reverse ms
MTRNone -> pure ()
where
table = fromMaybe "migrations" migrationsTable
runUp Migration {name, up, down} = withTransaction' st $ \db -> do
insert db
execSQL db up
where
insert db = void $ PSQL.execute db ("INSERT INTO " <> table <> " (name, down, ts) VALUES (?,?,?)") . (name,down,) =<< getCurrentTime
runDown DownMigration {downName, downQuery} = withTransaction' st $ \db -> do
execSQL db downQuery
void $ PSQL.execute db ("DELETE FROM " <> table <> " WHERE name = ?") (Only downName)
execSQL db query =
withMVar (connectionHandle db) $ \pqConn ->
LibPQ.exec pqConn (TE.encodeUtf8 query) $>>= LibPQ.resultErrorMessage >>= \case
Just e | not (B.null e) -> throwIO $ userError $ B.unpack e
_ -> pure ()
getCurrentMigrations :: Maybe Query -> PSQL.Connection -> IO [Migration]
getCurrentMigrations migrationsTable db = map toMigration <$> PSQL.query_ db ("SELECT name, down FROM " <> table <> " ORDER BY name ASC;")
where
table = fromMaybe "migrations" migrationsTable
toMigration (name, down) = Migration {name, up = T.pack "", down}
@@ -0,0 +1,29 @@
{-# LANGUAGE NamedFieldPuns #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations.App (appMigrations) where
import Data.List (sortOn)
import Data.Text (Text)
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251009_queue_to_subscribe
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251010_client_notices
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
schemaMigrations =
[ ("20241210_initial", m20241210_initial, Nothing),
("20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies),
("20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
("20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete),
("20251009_queue_to_subscribe", m20251009_queue_to_subscribe, Just down_m20251009_queue_to_subscribe),
("20251010_client_notices", m20251010_client_notices, Just down_m20251010_client_notices)
]
-- | The list of migrations in ascending order by date
appMigrations :: [Migration]
appMigrations = sortOn name $ map migration schemaMigrations
where
migration (name, up, down) = Migration {name, up, down = down}
@@ -0,0 +1,544 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20241210_initial where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20241210_initial :: Text
m20241210_initial =
[r|
CREATE TABLE users(
user_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
deleted SMALLINT NOT NULL DEFAULT 0
);
CREATE TABLE servers(
host TEXT NOT NULL,
port TEXT NOT NULL,
key_hash BYTEA NOT NULL,
PRIMARY KEY(host, port)
);
CREATE TABLE connections(
conn_id BYTEA NOT NULL PRIMARY KEY,
conn_mode TEXT NOT NULL,
last_internal_msg_id BIGINT NOT NULL DEFAULT 0,
last_internal_rcv_msg_id BIGINT NOT NULL DEFAULT 0,
last_internal_snd_msg_id BIGINT NOT NULL DEFAULT 0,
last_external_snd_msg_id BIGINT NOT NULL DEFAULT 0,
last_rcv_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
last_snd_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
smp_agent_version INTEGER NOT NULL DEFAULT 1,
duplex_handshake SMALLINT NULL DEFAULT 0,
enable_ntfs SMALLINT,
deleted SMALLINT NOT NULL DEFAULT 0,
user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
ratchet_sync_state TEXT NOT NULL DEFAULT 'ok',
deleted_at_wait_delivery TIMESTAMPTZ,
pq_support SMALLINT NOT NULL DEFAULT 0
);
CREATE TABLE rcv_queues(
host TEXT NOT NULL,
port TEXT NOT NULL,
rcv_id BYTEA NOT NULL,
conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
rcv_private_key BYTEA NOT NULL,
rcv_dh_secret BYTEA NOT NULL,
e2e_priv_key BYTEA NOT NULL,
e2e_dh_secret BYTEA,
snd_id BYTEA NOT NULL,
snd_key BYTEA,
status TEXT NOT NULL,
smp_server_version INTEGER NOT NULL DEFAULT 1,
smp_client_version INTEGER,
ntf_public_key BYTEA,
ntf_private_key BYTEA,
ntf_id BYTEA,
rcv_ntf_dh_secret BYTEA,
rcv_queue_id BIGINT NOT NULL,
rcv_primary SMALLINT NOT NULL,
replace_rcv_queue_id BIGINT NULL,
delete_errors BIGINT NOT NULL DEFAULT 0,
server_key_hash BYTEA,
switch_status TEXT,
deleted SMALLINT NOT NULL DEFAULT 0,
snd_secure SMALLINT NOT NULL DEFAULT 0,
last_broker_ts TIMESTAMPTZ,
PRIMARY KEY(host, port, rcv_id),
FOREIGN KEY(host, port) REFERENCES servers
ON DELETE RESTRICT ON UPDATE CASCADE,
UNIQUE(host, port, snd_id)
);
CREATE TABLE snd_queues(
host TEXT NOT NULL,
port TEXT NOT NULL,
snd_id BYTEA NOT NULL,
conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
snd_private_key BYTEA NOT NULL,
e2e_dh_secret BYTEA NOT NULL,
status TEXT NOT NULL,
smp_server_version INTEGER NOT NULL DEFAULT 1,
smp_client_version INTEGER NOT NULL DEFAULT 1,
snd_public_key BYTEA,
e2e_pub_key BYTEA,
snd_queue_id BIGINT NOT NULL,
snd_primary SMALLINT NOT NULL,
replace_snd_queue_id BIGINT NULL,
server_key_hash BYTEA,
switch_status TEXT,
snd_secure SMALLINT NOT NULL DEFAULT 0,
PRIMARY KEY(host, port, snd_id),
FOREIGN KEY(host, port) REFERENCES servers
ON DELETE RESTRICT ON UPDATE CASCADE
);
CREATE TABLE messages(
conn_id BYTEA NOT NULL REFERENCES connections(conn_id)
ON DELETE CASCADE,
internal_id BIGINT NOT NULL,
internal_ts TIMESTAMPTZ NOT NULL,
internal_rcv_id BIGINT,
internal_snd_id BIGINT,
msg_type BYTEA NOT NULL,
msg_body BYTEA NOT NULL DEFAULT ''::BYTEA,
msg_flags TEXT NULL,
pq_encryption SMALLINT NOT NULL DEFAULT 0,
PRIMARY KEY(conn_id, internal_id)
);
CREATE TABLE rcv_messages(
conn_id BYTEA NOT NULL,
internal_rcv_id BIGINT NOT NULL,
internal_id BIGINT NOT NULL,
external_snd_id BIGINT NOT NULL,
broker_id BYTEA NOT NULL,
broker_ts TIMESTAMPTZ NOT NULL,
internal_hash BYTEA NOT NULL,
external_prev_snd_hash BYTEA NOT NULL,
integrity BYTEA NOT NULL,
user_ack SMALLINT NULL DEFAULT 0,
rcv_queue_id BIGINT NOT NULL,
PRIMARY KEY(conn_id, internal_rcv_id),
FOREIGN KEY(conn_id, internal_id) REFERENCES messages
ON DELETE CASCADE
);
ALTER TABLE messages
ADD CONSTRAINT fk_messages_rcv_messages
FOREIGN KEY (conn_id, internal_rcv_id) REFERENCES rcv_messages
ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED;
CREATE TABLE snd_messages(
conn_id BYTEA NOT NULL,
internal_snd_id BIGINT NOT NULL,
internal_id BIGINT NOT NULL,
internal_hash BYTEA NOT NULL,
previous_msg_hash BYTEA NOT NULL DEFAULT ''::BYTEA,
retry_int_slow BIGINT,
retry_int_fast BIGINT,
rcpt_internal_id BIGINT,
rcpt_status TEXT,
PRIMARY KEY(conn_id, internal_snd_id),
FOREIGN KEY(conn_id, internal_id) REFERENCES messages
ON DELETE CASCADE
);
ALTER TABLE messages
ADD CONSTRAINT fk_messages_snd_messages
FOREIGN KEY (conn_id, internal_snd_id) REFERENCES snd_messages
ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED;
CREATE TABLE conn_confirmations(
confirmation_id BYTEA NOT NULL PRIMARY KEY,
conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
e2e_snd_pub_key BYTEA NOT NULL,
sender_key BYTEA,
ratchet_state BYTEA NOT NULL,
sender_conn_info BYTEA NOT NULL,
accepted SMALLINT NOT NULL,
own_conn_info BYTEA,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
smp_reply_queues BYTEA NULL,
smp_client_version INTEGER
);
CREATE TABLE conn_invitations(
invitation_id BYTEA NOT NULL PRIMARY KEY,
contact_conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
cr_invitation BYTEA NOT NULL,
recipient_conn_info BYTEA NOT NULL,
accepted SMALLINT NOT NULL DEFAULT 0,
own_conn_info BYTEA,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE TABLE ratchets(
conn_id BYTEA NOT NULL PRIMARY KEY REFERENCES connections
ON DELETE CASCADE,
x3dh_priv_key_1 BYTEA,
x3dh_priv_key_2 BYTEA,
ratchet_state BYTEA,
e2e_version INTEGER NOT NULL DEFAULT 1,
x3dh_pub_key_1 BYTEA,
x3dh_pub_key_2 BYTEA,
pq_priv_kem BYTEA,
pq_pub_kem BYTEA
);
CREATE TABLE skipped_messages(
skipped_message_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
conn_id BYTEA NOT NULL REFERENCES ratchets
ON DELETE CASCADE,
header_key BYTEA NOT NULL,
msg_n BIGINT NOT NULL,
msg_key BYTEA NOT NULL
);
CREATE TABLE ntf_servers(
ntf_host TEXT NOT NULL,
ntf_port TEXT NOT NULL,
ntf_key_hash BYTEA NOT NULL,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
PRIMARY KEY(ntf_host, ntf_port)
);
CREATE TABLE ntf_tokens(
provider TEXT NOT NULL,
device_token TEXT NOT NULL,
ntf_host TEXT NOT NULL,
ntf_port TEXT NOT NULL,
tkn_id BYTEA,
tkn_pub_key BYTEA NOT NULL,
tkn_priv_key BYTEA NOT NULL,
tkn_pub_dh_key BYTEA NOT NULL,
tkn_priv_dh_key BYTEA NOT NULL,
tkn_dh_secret BYTEA,
tkn_status TEXT NOT NULL,
tkn_action BYTEA,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
ntf_mode BYTEA NULL,
PRIMARY KEY(provider, device_token, ntf_host, ntf_port),
FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
ON DELETE RESTRICT ON UPDATE CASCADE
);
CREATE TABLE ntf_subscriptions(
conn_id BYTEA NOT NULL,
smp_host TEXT NULL,
smp_port TEXT NULL,
smp_ntf_id BYTEA,
ntf_host TEXT NOT NULL,
ntf_port TEXT NOT NULL,
ntf_sub_id BYTEA,
ntf_sub_status TEXT NOT NULL,
ntf_sub_action BYTEA,
ntf_sub_smp_action BYTEA,
ntf_sub_action_ts TIMESTAMPTZ,
updated_by_supervisor SMALLINT NOT NULL DEFAULT 0,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
smp_server_key_hash BYTEA,
ntf_failed SMALLINT DEFAULT 0,
smp_failed SMALLINT DEFAULT 0,
PRIMARY KEY(conn_id),
FOREIGN KEY(smp_host, smp_port) REFERENCES servers(host, port)
ON DELETE SET NULL ON UPDATE CASCADE,
FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers
ON DELETE RESTRICT ON UPDATE CASCADE
);
CREATE TABLE commands(
command_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
host TEXT,
port TEXT,
corr_id BYTEA NOT NULL,
command_tag BYTEA NOT NULL,
command BYTEA NOT NULL,
agent_version INTEGER NOT NULL DEFAULT 1,
server_key_hash BYTEA,
created_at TIMESTAMPTZ NOT NULL DEFAULT '1970-01-01 00:00:00',
failed SMALLINT DEFAULT 0,
FOREIGN KEY(host, port) REFERENCES servers
ON DELETE RESTRICT ON UPDATE CASCADE
);
CREATE TABLE snd_message_deliveries(
snd_message_delivery_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
snd_queue_id BIGINT NOT NULL,
internal_id BIGINT NOT NULL,
failed SMALLINT DEFAULT 0,
FOREIGN KEY(conn_id, internal_id) REFERENCES messages ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
);
CREATE TABLE xftp_servers(
xftp_server_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
xftp_host TEXT NOT NULL,
xftp_port TEXT NOT NULL,
xftp_key_hash BYTEA NOT NULL,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
UNIQUE(xftp_host, xftp_port, xftp_key_hash)
);
CREATE TABLE rcv_files(
rcv_file_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
rcv_file_entity_id BYTEA NOT NULL,
user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
size BIGINT NOT NULL,
digest BYTEA NOT NULL,
key BYTEA NOT NULL,
nonce BYTEA NOT NULL,
chunk_size BIGINT NOT NULL,
prefix_path TEXT NOT NULL,
tmp_path TEXT,
save_path TEXT NOT NULL,
status TEXT NOT NULL,
deleted SMALLINT NOT NULL DEFAULT 0,
error TEXT,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
save_file_key BYTEA,
save_file_nonce BYTEA,
failed SMALLINT DEFAULT 0,
redirect_id BIGINT REFERENCES rcv_files ON DELETE SET NULL,
redirect_entity_id BYTEA,
redirect_size BIGINT,
redirect_digest BYTEA,
approved_relays SMALLINT NOT NULL DEFAULT 0,
UNIQUE(rcv_file_entity_id)
);
CREATE TABLE rcv_file_chunks(
rcv_file_chunk_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
rcv_file_id BIGINT NOT NULL REFERENCES rcv_files ON DELETE CASCADE,
chunk_no BIGINT NOT NULL,
chunk_size BIGINT NOT NULL,
digest BYTEA NOT NULL,
tmp_path TEXT,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE TABLE rcv_file_chunk_replicas(
rcv_file_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
rcv_file_chunk_id BIGINT NOT NULL REFERENCES rcv_file_chunks ON DELETE CASCADE,
replica_number BIGINT NOT NULL,
xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
replica_id BYTEA NOT NULL,
replica_key BYTEA NOT NULL,
received SMALLINT NOT NULL DEFAULT 0,
delay BIGINT,
retries BIGINT NOT NULL DEFAULT 0,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE TABLE snd_files(
snd_file_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
snd_file_entity_id BYTEA NOT NULL,
user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
num_recipients BIGINT NOT NULL,
digest BYTEA,
key BYTEA NOT NUll,
nonce BYTEA NOT NUll,
path TEXT NOT NULL,
prefix_path TEXT,
status TEXT NOT NULL,
deleted SMALLINT NOT NULL DEFAULT 0,
error TEXT,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
src_file_key BYTEA,
src_file_nonce BYTEA,
failed SMALLINT DEFAULT 0,
redirect_size BIGINT,
redirect_digest BYTEA
);
CREATE TABLE snd_file_chunks(
snd_file_chunk_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
snd_file_id BIGINT NOT NULL REFERENCES snd_files ON DELETE CASCADE,
chunk_no BIGINT NOT NULL,
chunk_offset BIGINT NOT NULL,
chunk_size BIGINT NOT NULL,
digest BYTEA NOT NULL,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE TABLE snd_file_chunk_replicas(
snd_file_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
snd_file_chunk_id BIGINT NOT NULL REFERENCES snd_file_chunks ON DELETE CASCADE,
replica_number BIGINT NOT NULL,
xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
replica_id BYTEA NOT NULL,
replica_key BYTEA NOT NULL,
replica_status TEXT NOT NULL,
delay BIGINT,
retries BIGINT NOT NULL DEFAULT 0,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE TABLE snd_file_chunk_replica_recipients(
snd_file_chunk_replica_recipient_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
snd_file_chunk_replica_id BIGINT NOT NULL REFERENCES snd_file_chunk_replicas ON DELETE CASCADE,
rcv_replica_id BYTEA NOT NULL,
rcv_replica_key BYTEA NOT NULL,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE TABLE deleted_snd_chunk_replicas(
deleted_snd_chunk_replica_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
user_id BIGINT NOT NULL REFERENCES users ON DELETE CASCADE,
xftp_server_id BIGINT NOT NULL REFERENCES xftp_servers ON DELETE CASCADE,
replica_id BYTEA NOT NULL,
replica_key BYTEA NOT NULL,
chunk_digest BYTEA NOT NULL,
delay BIGINT,
retries BIGINT NOT NULL DEFAULT 0,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
failed SMALLINT DEFAULT 0
);
CREATE TABLE encrypted_rcv_message_hashes(
encrypted_rcv_message_hash_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
hash BYTEA NOT NULL,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE TABLE processed_ratchet_key_hashes(
processed_ratchet_key_hash_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
conn_id BYTEA NOT NULL REFERENCES connections ON DELETE CASCADE,
hash BYTEA NOT NULL,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE TABLE servers_stats(
servers_stats_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
servers_stats TEXT,
started_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
created_at TIMESTAMPTZ NOT NULL DEFAULT (now()),
updated_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
INSERT INTO servers_stats DEFAULT VALUES;
CREATE TABLE ntf_tokens_to_delete(
ntf_token_to_delete_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
ntf_host TEXT NOT NULL,
ntf_port TEXT NOT NULL,
ntf_key_hash BYTEA NOT NULL,
tkn_id BYTEA NOT NULL,
tkn_priv_key BYTEA NOT NULL,
del_failed SMALLINT DEFAULT 0,
created_at TIMESTAMPTZ NOT NULL DEFAULT (now())
);
CREATE UNIQUE INDEX idx_rcv_queues_ntf ON rcv_queues(host, port, ntf_id);
CREATE UNIQUE INDEX idx_rcv_queue_id ON rcv_queues(conn_id, rcv_queue_id);
CREATE UNIQUE INDEX idx_snd_queue_id ON snd_queues(conn_id, snd_queue_id);
CREATE INDEX idx_snd_message_deliveries ON snd_message_deliveries(
conn_id,
snd_queue_id
);
CREATE INDEX idx_connections_user ON connections(user_id);
CREATE INDEX idx_commands_conn_id ON commands(conn_id);
CREATE INDEX idx_commands_host_port ON commands(host, port);
CREATE INDEX idx_conn_confirmations_conn_id ON conn_confirmations(conn_id);
CREATE INDEX idx_conn_invitations_contact_conn_id ON conn_invitations(
contact_conn_id
);
CREATE INDEX idx_messages_conn_id_internal_snd_id ON messages(
conn_id,
internal_snd_id
);
CREATE INDEX idx_messages_conn_id_internal_rcv_id ON messages(
conn_id,
internal_rcv_id
);
CREATE INDEX idx_messages_conn_id ON messages(conn_id);
CREATE INDEX idx_ntf_subscriptions_ntf_host_ntf_port ON ntf_subscriptions(
ntf_host,
ntf_port
);
CREATE INDEX idx_ntf_subscriptions_smp_host_smp_port ON ntf_subscriptions(
smp_host,
smp_port
);
CREATE INDEX idx_ntf_tokens_ntf_host_ntf_port ON ntf_tokens(
ntf_host,
ntf_port
);
CREATE INDEX idx_ratchets_conn_id ON ratchets(conn_id);
CREATE INDEX idx_rcv_messages_conn_id_internal_id ON rcv_messages(
conn_id,
internal_id
);
CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id);
CREATE INDEX idx_snd_message_deliveries_conn_id_internal_id ON snd_message_deliveries(
conn_id,
internal_id
);
CREATE INDEX idx_snd_messages_conn_id_internal_id ON snd_messages(
conn_id,
internal_id
);
CREATE INDEX idx_snd_queues_host_port ON snd_queues(host, port);
CREATE INDEX idx_rcv_files_user_id ON rcv_files(user_id);
CREATE INDEX idx_rcv_file_chunks_rcv_file_id ON rcv_file_chunks(rcv_file_id);
CREATE INDEX idx_rcv_file_chunk_replicas_rcv_file_chunk_id ON rcv_file_chunk_replicas(
rcv_file_chunk_id
);
CREATE INDEX idx_rcv_file_chunk_replicas_xftp_server_id ON rcv_file_chunk_replicas(
xftp_server_id
);
CREATE INDEX idx_snd_files_user_id ON snd_files(user_id);
CREATE INDEX idx_snd_file_chunks_snd_file_id ON snd_file_chunks(snd_file_id);
CREATE INDEX idx_snd_file_chunk_replicas_snd_file_chunk_id ON snd_file_chunk_replicas(
snd_file_chunk_id
);
CREATE INDEX idx_snd_file_chunk_replicas_xftp_server_id ON snd_file_chunk_replicas(
xftp_server_id
);
CREATE INDEX idx_snd_file_chunk_replica_recipients_snd_file_chunk_replica_id ON snd_file_chunk_replica_recipients(
snd_file_chunk_replica_id
);
CREATE INDEX idx_deleted_snd_chunk_replicas_user_id ON deleted_snd_chunk_replicas(
user_id
);
CREATE INDEX idx_deleted_snd_chunk_replicas_xftp_server_id ON deleted_snd_chunk_replicas(
xftp_server_id
);
CREATE INDEX idx_rcv_file_chunk_replicas_pending ON rcv_file_chunk_replicas(
received,
replica_number
);
CREATE INDEX idx_snd_file_chunk_replicas_pending ON snd_file_chunk_replicas(
replica_status,
replica_number
);
CREATE INDEX idx_deleted_snd_chunk_replicas_pending ON deleted_snd_chunk_replicas(
created_at
);
CREATE INDEX idx_encrypted_rcv_message_hashes_hash ON encrypted_rcv_message_hashes(
conn_id,
hash
);
CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(
conn_id,
hash
);
CREATE INDEX idx_snd_messages_rcpt_internal_id ON snd_messages(
conn_id,
rcpt_internal_id
);
CREATE INDEX idx_processed_ratchet_key_hashes_created_at ON processed_ratchet_key_hashes(
created_at
);
CREATE INDEX idx_encrypted_rcv_message_hashes_created_at ON encrypted_rcv_message_hashes(
created_at
);
CREATE INDEX idx_messages_internal_ts ON messages(internal_ts);
CREATE INDEX idx_commands_server_commands ON commands(
host,
port,
created_at,
command_id
);
CREATE INDEX idx_rcv_files_status_created_at ON rcv_files(status, created_at);
CREATE INDEX idx_snd_files_status_created_at ON snd_files(status, created_at);
CREATE INDEX idx_snd_files_snd_file_entity_id ON snd_files(snd_file_entity_id);
CREATE INDEX idx_messages_snd_expired ON messages(
conn_id,
internal_snd_id,
internal_ts
);
CREATE INDEX idx_snd_message_deliveries_expired ON snd_message_deliveries(
conn_id,
snd_queue_id,
failed,
internal_id
);
CREATE INDEX idx_rcv_files_redirect_id on rcv_files(redirect_id);
|]
@@ -0,0 +1,35 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250203_msg_bodies where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20250203_msg_bodies :: Text
m20250203_msg_bodies =
[r|
ALTER TABLE snd_messages ADD COLUMN msg_encrypt_key BYTEA;
ALTER TABLE snd_messages ADD COLUMN padded_msg_len BIGINT;
CREATE TABLE snd_message_bodies (
snd_message_body_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
agent_msg BYTEA NOT NULL DEFAULT ''::BYTEA
);
ALTER TABLE snd_messages ADD COLUMN snd_message_body_id BIGINT REFERENCES snd_message_bodies ON DELETE SET NULL;
CREATE INDEX idx_snd_messages_snd_message_body_id ON snd_messages(snd_message_body_id);
|]
down_m20250203_msg_bodies :: Text
down_m20250203_msg_bodies =
[r|
DROP INDEX idx_snd_messages_snd_message_body_id;
ALTER TABLE snd_messages DROP COLUMN snd_message_body_id;
DROP TABLE snd_message_bodies;
ALTER TABLE snd_messages DROP COLUMN msg_encrypt_key;
ALTER TABLE snd_messages DROP COLUMN padded_msg_len;
|]
@@ -0,0 +1,61 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250322_short_links where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20250322_short_links :: Text
m20250322_short_links =
[r|
ALTER TABLE rcv_queues ADD COLUMN link_id BYTEA;
ALTER TABLE rcv_queues ADD COLUMN link_key BYTEA;
ALTER TABLE rcv_queues ADD COLUMN link_priv_sig_key BYTEA;
ALTER TABLE rcv_queues ADD COLUMN link_enc_fixed_data BYTEA;
CREATE UNIQUE INDEX idx_rcv_queues_link_id ON rcv_queues(host, port, link_id);
ALTER TABLE rcv_queues ADD COLUMN queue_mode TEXT;
UPDATE rcv_queues SET queue_mode = 'M' WHERE snd_secure = 1;
ALTER TABLE rcv_queues DROP COLUMN snd_secure;
ALTER TABLE snd_queues ADD COLUMN queue_mode TEXT;
UPDATE snd_queues SET queue_mode = 'M' WHERE snd_secure = 1;
ALTER TABLE snd_queues DROP COLUMN snd_secure;
CREATE TABLE inv_short_links(
inv_short_link_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
host TEXT NOT NULL,
port TEXT NOT NULL,
server_key_hash BYTEA,
link_id BYTEA NOT NULL,
link_key BYTEA NOT NULL,
snd_private_key BYTEA NOT NULL,
snd_id BYTEA,
FOREIGN KEY(host, port) REFERENCES servers ON DELETE RESTRICT ON UPDATE CASCADE
);
CREATE UNIQUE INDEX idx_inv_short_links_link_id ON inv_short_links(host, port, link_id);
|]
down_m20250322_short_links :: Text
down_m20250322_short_links =
[r|
DROP INDEX idx_rcv_queues_link_id;
ALTER TABLE rcv_queues DROP COLUMN link_id;
ALTER TABLE rcv_queues DROP COLUMN link_key;
ALTER TABLE rcv_queues DROP COLUMN link_priv_sig_key;
ALTER TABLE rcv_queues DROP COLUMN link_enc_fixed_data;
DROP INDEX idx_inv_short_links_link_id;
DROP TABLE inv_short_links;
ALTER TABLE rcv_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
UPDATE rcv_queues SET snd_secure = 1 WHERE queue_mode = 'M';
ALTER TABLE rcv_queues DROP COLUMN queue_mode;
ALTER TABLE snd_queues ADD COLUMN snd_secure INTEGER NOT NULL DEFAULT 0;
UPDATE snd_queues SET snd_secure = 1 WHERE queue_mode = 'M';
ALTER TABLE snd_queues DROP COLUMN queue_mode;
|]
@@ -0,0 +1,35 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20250702_conn_invitations_remove_cascade_delete where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20250702_conn_invitations_remove_cascade_delete :: Text
m20250702_conn_invitations_remove_cascade_delete =
[r|
ALTER TABLE conn_invitations DROP CONSTRAINT conn_invitations_contact_conn_id_fkey;
ALTER TABLE conn_invitations ALTER COLUMN contact_conn_id DROP NOT NULL;
ALTER TABLE conn_invitations
ADD CONSTRAINT conn_invitations_contact_conn_id_fkey
FOREIGN KEY (contact_conn_id)
REFERENCES connections(conn_id)
ON DELETE SET NULL;
|]
down_m20250702_conn_invitations_remove_cascade_delete :: Text
down_m20250702_conn_invitations_remove_cascade_delete =
[r|
ALTER TABLE conn_invitations DROP CONSTRAINT conn_invitations_contact_conn_id_fkey;
ALTER TABLE conn_invitations ALTER COLUMN contact_conn_id SET NOT NULL;
ALTER TABLE conn_invitations
ADD CONSTRAINT conn_invitations_contact_conn_id_fkey
FOREIGN KEY (contact_conn_id)
REFERENCES connections(conn_id)
ON DELETE CASCADE;
|]
@@ -0,0 +1,21 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251009_queue_to_subscribe where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20251009_queue_to_subscribe :: Text
m20251009_queue_to_subscribe =
[r|
ALTER TABLE rcv_queues ADD COLUMN to_subscribe SMALLINT NOT NULL DEFAULT 0;
CREATE INDEX idx_rcv_queues_to_subscribe ON rcv_queues(to_subscribe);
|]
down_m20251009_queue_to_subscribe :: Text
down_m20251009_queue_to_subscribe =
[r|
DROP INDEX idx_rcv_queues_to_subscribe;
ALTER TABLE rcv_queues DROP COLUMN to_subscribe;
|]
@@ -0,0 +1,40 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20251010_client_notices where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20251010_client_notices :: Text
m20251010_client_notices =
[r|
CREATE TABLE client_notices(
client_notice_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
protocol TEXT NOT NULL,
host TEXT NOT NULL,
port TEXT NOT NULL,
entity_id BYTEA NOT NULL,
server_key_hash BYTEA,
notice_ttl BIGINT,
created_at BIGINT NOT NULL,
updated_at BIGINT NOT NULL
);
CREATE UNIQUE INDEX idx_client_notices_entity ON client_notices(protocol, host, port, entity_id);
ALTER TABLE rcv_queues ADD COLUMN client_notice_id BIGINT
REFERENCES client_notices ON UPDATE RESTRICT ON DELETE SET NULL;
CREATE INDEX idx_rcv_queues_client_notice_id ON rcv_queues(client_notice_id);
|]
down_m20251010_client_notices :: Text
down_m20251010_client_notices =
[r|
DROP INDEX idx_rcv_queues_client_notice_id;
ALTER TABLE rcv_queues DROP COLUMN client_notice_id;
DROP INDEX idx_client_notices_entity;
DROP TABLE client_notices;
|]
@@ -0,0 +1,12 @@
module Simplex.Messaging.Agent.Store.Postgres.Options where
import Data.ByteString (ByteString)
import Numeric.Natural
data DBOpts = DBOpts
{ connstr :: ByteString,
schema :: ByteString,
poolSize :: Natural,
createSchema :: Bool
}
deriving (Show)
@@ -0,0 +1,100 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Messaging.Agent.Store.Postgres.Util
( createDBAndUserIfNotExists,
dropSchema,
dropAllSchemasExceptSystem,
dropDatabaseAndUser,
)
where
import Control.Exception (bracket)
import Control.Monad (forM_, unless, void, when)
import Data.String (fromString)
import Database.PostgreSQL.Simple (ConnectInfo (..), Only (..), defaultConnectInfo)
import qualified Database.PostgreSQL.Simple as PSQL
import Database.PostgreSQL.Simple.SqlQQ (sql)
createDBAndUserIfNotExists :: ConnectInfo -> IO ()
createDBAndUserIfNotExists ConnectInfo {connectUser = user, connectDatabase = dbName} = do
-- connect to the default "postgres" maintenance database
bracket (PSQL.connect defaultConnectInfo {connectUser = "postgres", connectDatabase = "postgres"}) PSQL.close $
\postgresDB -> do
void $ PSQL.execute_ postgresDB "SET client_min_messages TO WARNING"
-- check if the user exists, create if not
[Only userExists] <-
PSQL.query
postgresDB
[sql|
SELECT EXISTS (
SELECT 1 FROM pg_catalog.pg_roles
WHERE rolname = ?
)
|]
(Only user)
unless userExists $ void $ PSQL.execute_ postgresDB (fromString $ "CREATE USER " <> user)
-- check if the database exists, create if not
dbExists <- checkDBExists postgresDB dbName
unless dbExists $ void $ PSQL.execute_ postgresDB (fromString $ "CREATE DATABASE " <> dbName <> " OWNER " <> user)
checkDBExists :: PSQL.Connection -> String -> IO Bool
checkDBExists postgresDB dbName = do
[Only dbExists] <-
PSQL.query
postgresDB
[sql|
SELECT EXISTS (
SELECT 1 FROM pg_catalog.pg_database
WHERE datname = ?
)
|]
(Only dbName)
pure dbExists
dropSchema :: ConnectInfo -> String -> IO ()
dropSchema connectInfo schema =
bracket (PSQL.connect connectInfo) PSQL.close $
\db -> do
void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
void $ PSQL.execute_ db (fromString $ "DROP SCHEMA IF EXISTS " <> schema <> " CASCADE")
dropAllSchemasExceptSystem :: ConnectInfo -> IO ()
dropAllSchemasExceptSystem connectInfo =
bracket (PSQL.connect connectInfo) PSQL.close $
\db -> do
void $ PSQL.execute_ db "SET client_min_messages TO WARNING"
schemaNames :: [Only String] <-
PSQL.query_
db
[sql|
SELECT schema_name
FROM information_schema.schemata
WHERE schema_name NOT IN ('public', 'pg_catalog', 'information_schema')
|]
forM_ schemaNames $ \(Only schema) ->
PSQL.execute_ db (fromString $ "DROP SCHEMA " <> schema <> " CASCADE")
dropDatabaseAndUser :: ConnectInfo -> IO ()
dropDatabaseAndUser ConnectInfo {connectUser = user, connectDatabase = dbName} =
bracket (PSQL.connect defaultConnectInfo {connectUser = "postgres", connectDatabase = "postgres"}) PSQL.close $
\postgresDB -> do
void $ PSQL.execute_ postgresDB "SET client_min_messages TO WARNING"
dbExists <- checkDBExists postgresDB dbName
when dbExists $ do
void $ PSQL.execute_ postgresDB (fromString $ "ALTER DATABASE " <> dbName <> " WITH ALLOW_CONNECTIONS false")
-- terminate all connections to the database
_r :: [Only Bool] <-
PSQL.query
postgresDB
[sql|
SELECT pg_terminate_backend(pg_stat_activity.pid)
FROM pg_stat_activity
WHERE datname = ?
AND pid <> pg_backend_pid()
|]
(Only dbName)
void $ PSQL.execute_ postgresDB (fromString $ "DROP DATABASE " <> dbName)
void $ PSQL.execute_ postgresDB (fromString $ "DROP USER IF EXISTS " <> user)
File diff suppressed because it is too large Load Diff
@@ -4,7 +4,8 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Messaging.Agent.Store.SQLite.Common
( SQLiteStore (..),
( DBStore (..),
DBOpts (..),
withConnection,
withConnection',
withTransaction,
@@ -30,7 +31,7 @@ import UnliftIO.STM
storeKey :: ScrubbedBytes -> Bool -> Maybe ScrubbedBytes
storeKey key keepKey = if keepKey || BA.null key then Just key else Nothing
data SQLiteStore = SQLiteStore
data DBStore = DBStore
{ dbFilePath :: FilePath,
dbKey :: TVar (Maybe ScrubbedBytes),
dbSem :: TVar Int,
@@ -39,8 +40,16 @@ data SQLiteStore = SQLiteStore
dbNew :: Bool
}
withConnectionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
data DBOpts = DBOpts
{ dbFilePath :: FilePath,
dbKey :: ScrubbedBytes,
keepKey :: Bool,
vacuum :: Bool,
track :: DB.TrackQueries
}
withConnectionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
withConnectionPriority DBStore {dbSem, dbConnection} priority action
| priority = E.bracket_ signal release $ withMVar dbConnection action
| otherwise = lowPriority
where
@@ -50,20 +59,20 @@ withConnectionPriority SQLiteStore {dbSem, dbConnection} priority action
wait = unlessM free $ atomically $ unlessM ((0 ==) <$> readTVar dbSem) retry
free = (0 ==) <$> readTVarIO dbSem
withConnection :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
withConnection :: DBStore -> (DB.Connection -> IO a) -> IO a
withConnection st = withConnectionPriority st False
withConnection' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
withConnection' :: DBStore -> (SQL.Connection -> IO a) -> IO a
withConnection' st action = withConnection st $ action . DB.conn
withTransaction' :: SQLiteStore -> (SQL.Connection -> IO a) -> IO a
withTransaction' :: DBStore -> (SQL.Connection -> IO a) -> IO a
withTransaction' st action = withTransaction st $ action . DB.conn
withTransaction :: SQLiteStore -> (DB.Connection -> IO a) -> IO a
withTransaction :: DBStore -> (DB.Connection -> IO a) -> IO a
withTransaction st = withTransactionPriority st False
{-# INLINE withTransaction #-}
withTransactionPriority :: SQLiteStore -> Bool -> (DB.Connection -> IO a) -> IO a
withTransactionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
withTransactionPriority st priority action = withConnectionPriority st priority $ dbBusyLoop . transaction
where
transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db
+73 -33
View File
@@ -1,45 +1,69 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Simplex.Messaging.Agent.Store.SQLite.DB
( Connection (..),
( BoolInt (..),
Binary (..),
Connection (..),
SlowQueryStats (..),
TrackQueries (..),
FromField (..),
ToField (..),
open,
close,
execute,
execute_,
executeNamed,
executeMany,
query,
query_,
queryNamed,
blobFieldDecoder,
fromTextField_,
)
where
import Control.Concurrent.STM
import Control.Monad (when)
import Control.Exception
import Control.Monad (when)
import qualified Data.Aeson.TH as J
import Data.ByteString (ByteString)
import Data.Int (Int64)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (diffUTCTime, getCurrentTime)
import Database.SQLite.Simple (FromRow, NamedParam, Query, ToRow)
import Data.Typeable (Typeable)
import Database.SQLite.Simple (FromRow, ResultError (..), Query, SQLData (..), ToRow)
import qualified Database.SQLite.Simple as SQL
import Database.SQLite.Simple.FromField (FieldParser, FromField (..), returnError)
import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok (Ok (Ok))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Util (diffToMilliseconds, tshow)
import Simplex.Messaging.Util (diffToMicroseconds, tshow)
newtype BoolInt = BI {unBI :: Bool}
deriving newtype (FromField, ToField)
newtype Binary a = Binary {fromBinary :: a}
deriving newtype (FromField, ToField)
data Connection = Connection
{ conn :: SQL.Connection,
track :: TrackQueries,
slow :: TMap Query SlowQueryStats
}
data TrackQueries = TQAll | TQSlow Int64 | TQOff
deriving (Eq)
data SlowQueryStats = SlowQueryStats
{ count :: Int64,
timeMax :: Int64,
@@ -48,21 +72,29 @@ data SlowQueryStats = SlowQueryStats
}
deriving (Show)
timeIt :: TMap Query SlowQueryStats -> Query -> IO a -> IO a
timeIt slow sql a = do
t <- getCurrentTime
r <- a `catch` \e -> do
atomically $ TM.alter (Just . updateQueryErrors e) sql slow
throwIO e
t' <- getCurrentTime
let diff = diffToMilliseconds $ diffUTCTime t' t
when (diff > 1) $ atomically $ TM.alter (updateQueryStats diff) sql slow
pure r
timeIt :: Connection -> Query -> IO a -> IO a
timeIt Connection {slow, track} sql a
| track == TQOff = makeQuery
| otherwise = do
t <- getCurrentTime
r <- makeQuery
t' <- getCurrentTime
let diff = diffToMicroseconds $ diffUTCTime t' t
when (trackQuery diff) $ atomically $ TM.alter (updateQueryStats diff) sql slow
pure r
where
makeQuery =
a `catch` \e -> do
atomically $ TM.alter (Just . updateQueryErrors e) sql slow
throwIO e
trackQuery diff = case track of
TQOff -> False
TQSlow t -> diff > t
TQAll -> True
updateQueryErrors :: SomeException -> Maybe SlowQueryStats -> SlowQueryStats
updateQueryErrors e Nothing = SlowQueryStats 0 0 0 $ M.singleton (tshow e) 1
updateQueryErrors e (Just stats@SlowQueryStats {errs}) =
stats {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
updateQueryErrors e (Just st@SlowQueryStats {errs}) =
st {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff M.empty
updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg, errs}) =
@@ -74,41 +106,49 @@ timeIt slow sql a = do
errs
}
open :: String -> IO Connection
open f = do
open :: String -> TrackQueries -> IO Connection
open f track = do
conn <- SQL.open f
slow <- TM.emptyIO
pure Connection {conn, slow}
pure Connection {conn, slow, track}
close :: Connection -> IO ()
close = SQL.close . conn
execute :: ToRow q => Connection -> Query -> q -> IO ()
execute Connection {conn, slow} sql = timeIt slow sql . SQL.execute conn sql
execute c sql = timeIt c sql . SQL.execute (conn c) sql
{-# INLINE execute #-}
execute_ :: Connection -> Query -> IO ()
execute_ Connection {conn, slow} sql = timeIt slow sql $ SQL.execute_ conn sql
execute_ c sql = timeIt c sql $ SQL.execute_ (conn c) sql
{-# INLINE execute_ #-}
executeNamed :: Connection -> Query -> [NamedParam] -> IO ()
executeNamed Connection {conn, slow} sql = timeIt slow sql . SQL.executeNamed conn sql
{-# INLINE executeNamed #-}
executeMany :: ToRow q => Connection -> Query -> [q] -> IO ()
executeMany Connection {conn, slow} sql = timeIt slow sql . SQL.executeMany conn sql
executeMany c sql = timeIt c sql . SQL.executeMany (conn c) sql
{-# INLINE executeMany #-}
query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r]
query Connection {conn, slow} sql = timeIt slow sql . SQL.query conn sql
query c sql = timeIt c sql . SQL.query (conn c) sql
{-# INLINE query #-}
query_ :: FromRow r => Connection -> Query -> IO [r]
query_ Connection {conn, slow} sql = timeIt slow sql $ SQL.query_ conn sql
query_ c sql = timeIt c sql $ SQL.query_ (conn c) sql
{-# INLINE query_ #-}
queryNamed :: FromRow r => Connection -> Query -> [NamedParam] -> IO [r]
queryNamed Connection {conn, slow} sql = timeIt slow sql . SQL.queryNamed conn sql
{-# INLINE queryNamed #-}
blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
blobFieldDecoder dec = \case
f@(Field (SQLBlob b) _) ->
case dec b of
Right k -> Ok k
Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
f -> returnError ConversionFailed f "expecting SQLBlob column type"
fromTextField_ :: Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ fromText = \case
f@(Field (SQLText t) _) ->
case fromText t of
Just x -> Ok x
_ -> returnError ConversionFailed f ("invalid text: " <> T.unpack t)
f -> returnError ConversionFailed f "expecting SQLText column type"
$(J.deriveJSON defaultJSON ''SlowQueryStats)
@@ -5,206 +5,77 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations
( Migration (..),
MigrationsToRun (..),
MTRError (..),
DownMigration (..),
app,
initialize,
get,
( initialize,
run,
getCurrent,
mtrErrorDescription,
-- for unit tests
migrationsToRun,
toDownMigration,
getCurrentMigrations,
)
where
import Control.Monad (forM_, when)
import qualified Data.Aeson.TH as J
import Data.List (intercalate, sortOn)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as M
import Data.Maybe (isNothing, mapMaybe)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1)
import Data.Time.Clock (getCurrentTime)
import Database.SQLite.Simple (Connection, Only (..), Query (..))
import qualified Database.SQLite.Simple as DB
import Database.SQLite.Simple.QQ (sql)
import Database.SQLite.Simple (Only (..), Query (..))
import qualified Database.SQLite.Simple as SQL
import qualified Database.SQLite3 as SQLite3
import Simplex.Messaging.Agent.Protocol (extraSMPServerHosts)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Agent.Store.SQLite.Common
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
import Simplex.Messaging.Agent.Store.Shared
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Transport.Client (TransportHost)
data Migration = Migration {name :: String, up :: Text, down :: Maybe Text}
deriving (Eq, Show)
schemaMigrations :: [(String, Query, Maybe Query)]
schemaMigrations =
[ ("20220101_initial", m20220101_initial, Nothing),
("20220301_snd_queue_keys", m20220301_snd_queue_keys, Nothing),
("20220322_notifications", m20220322_notifications, Nothing),
("20220607_v2", m20220608_v2, Nothing),
("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode, Nothing),
("m20220811_onion_hosts", m20220811_onion_hosts, Nothing),
("m20220817_connection_ntfs", m20220817_connection_ntfs, Nothing),
("m20220905_commands", m20220905_commands, Nothing),
("m20220915_connection_queues", m20220915_connection_queues, Nothing),
("m20230110_users", m20230110_users, Nothing),
("m20230117_fkey_indexes", m20230117_fkey_indexes, Nothing),
("m20230120_delete_errors", m20230120_delete_errors, Nothing),
("m20230217_server_key_hash", m20230217_server_key_hash, Nothing),
("m20230223_files", m20230223_files, Just down_m20230223_files),
("m20230320_retry_state", m20230320_retry_state, Just down_m20230320_retry_state),
("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files),
("m20230510_files_pending_replicas_indexes", m20230510_files_pending_replicas_indexes, Just down_m20230510_files_pending_replicas_indexes),
("m20230516_encrypted_rcv_message_hashes", m20230516_encrypted_rcv_message_hashes, Just down_m20230516_encrypted_rcv_message_hashes),
("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status),
("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files),
("m20231222_command_created_at", m20231222_command_created_at, Just down_m20231222_command_created_at),
("m20231225_failed_work_items", m20231225_failed_work_items, Just down_m20231225_failed_work_items),
("m20240121_message_delivery_indexes", m20240121_message_delivery_indexes, Just down_m20240121_message_delivery_indexes),
("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats)
]
-- | The list of migrations in ascending order by date
app :: [Migration]
app = sortOn name $ map migration schemaMigrations
where
migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}
get :: SQLiteStore -> [Migration] -> IO (Either MTRError MigrationsToRun)
get st migrations = migrationsToRun migrations <$> withTransaction' st getCurrent
getCurrent :: Connection -> IO [Migration]
getCurrent db = map toMigration <$> DB.query_ db "SELECT name, down FROM migrations ORDER BY name ASC;"
getCurrentMigrations :: Maybe Query -> DB.Connection -> IO [Migration]
getCurrentMigrations migrationsTable DB.Connection {DB.conn} =
map toMigration
<$> SQL.query_ conn ("SELECT name, down FROM " <> table <> " ORDER BY name ASC;")
where
table = fromMaybe "migrations" migrationsTable
toMigration (name, down) = Migration {name, up = "", down}
run :: SQLiteStore -> MigrationsToRun -> IO ()
run st = \case
run :: DBStore -> Maybe Query -> Bool -> MigrationsToRun -> IO ()
run st migrationsTable vacuum = \case
MTRUp [] -> pure ()
MTRUp ms -> mapM_ runUp ms >> withConnection' st (`execSQL` "VACUUM;")
MTRUp ms -> do
mapM_ runUp ms
when vacuum $ withConnection' st (`execSQL` "VACUUM;")
MTRDown ms -> mapM_ runDown $ reverse ms
MTRNone -> pure ()
where
table = fromMaybe "migrations" migrationsTable
runUp Migration {name, up, down} = withTransaction' st $ \db -> do
when (name == "m20220811_onion_hosts") $ updateServers db
insert db >> execSQL db up'
where
insert db = DB.execute db "INSERT INTO migrations (name, down, ts) VALUES (?,?,?)" . (name,down,) =<< getCurrentTime
insert db = SQL.execute db ("INSERT INTO " <> table <> " (name, down, ts) VALUES (?,?,?)") . (name,down,) =<< getCurrentTime
up'
| dbNew st && name == "m20230110_users" = fromQuery new_m20230110_users
| otherwise = up
updateServers db = forM_ (M.assocs extraSMPServerHosts) $ \(h, h') ->
let hs = decodeLatin1 . strEncode $ ([h, h'] :: NonEmpty TransportHost)
in DB.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
in SQL.execute db "UPDATE servers SET host = ? WHERE host = ?" (hs, decodeLatin1 $ strEncode h)
runDown DownMigration {downName, downQuery} = withTransaction' st $ \db -> do
execSQL db downQuery
DB.execute db "DELETE FROM migrations WHERE name = ?" (Only downName)
execSQL db = SQLite3.exec $ DB.connectionHandle db
SQL.execute db ("DELETE FROM " <> table <> " WHERE name = ?") (Only downName)
execSQL db = SQLite3.exec $ SQL.connectionHandle db
initialize :: SQLiteStore -> IO ()
initialize st = withTransaction' st $ \db -> do
cs :: [Text] <- map fromOnly <$> DB.query_ db "SELECT name FROM pragma_table_info('migrations')"
initialize :: DBStore -> Maybe Query -> IO ()
initialize st migrationsTable = withTransaction' st $ \db -> do
cs :: [Text] <- map fromOnly <$> SQL.query_ db ("SELECT name FROM pragma_table_info('" <> table <> "')")
case cs of
[] -> createMigrations db
_ -> when ("down" `notElem` cs) $ DB.execute_ db "ALTER TABLE migrations ADD COLUMN down TEXT"
_ -> when ("down" `notElem` cs) $ SQL.execute_ db $ "ALTER TABLE " <> table <> " ADD COLUMN down TEXT"
where
table = fromMaybe "migrations" migrationsTable
createMigrations db =
DB.execute_
db
[sql|
CREATE TABLE IF NOT EXISTS migrations (
name TEXT NOT NULL,
ts TEXT NOT NULL,
down TEXT,
PRIMARY KEY (name)
);
|]
data DownMigration = DownMigration {downName :: String, downQuery :: Text}
deriving (Eq, Show)
toDownMigration :: Migration -> Maybe DownMigration
toDownMigration Migration {name, down} = DownMigration name <$> down
data MigrationsToRun = MTRUp [Migration] | MTRDown [DownMigration] | MTRNone
deriving (Eq, Show)
data MTRError
= MTRENoDown {dbMigrations :: [String]}
| MTREDifferent {appMigration :: String, dbMigration :: String}
deriving (Eq, Show)
mtrErrorDescription :: MTRError -> String
mtrErrorDescription = \case
MTRENoDown ms -> "database version is newer than the app, but no down migration for: " <> intercalate ", " ms
MTREDifferent a d -> "different migration in the app/database: " <> a <> " / " <> d
migrationsToRun :: [Migration] -> [Migration] -> Either MTRError MigrationsToRun
migrationsToRun [] [] = Right MTRNone
migrationsToRun appMs [] = Right $ MTRUp appMs
migrationsToRun [] dbMs
| length dms == length dbMs = Right $ MTRDown dms
| otherwise = Left $ MTRENoDown $ mapMaybe nameNoDown dbMs
where
dms = mapMaybe toDownMigration dbMs
nameNoDown m = if isNothing (down m) then Just $ name m else Nothing
migrationsToRun (a : as) (d : ds)
| name a == name d = migrationsToRun as ds
| otherwise = Left $ MTREDifferent (name a) (name d)
$(J.deriveJSON (sumTypeJSON $ dropPrefix "MTRE") ''MTRError)
SQL.execute_ db $
"CREATE TABLE IF NOT EXISTS "
<> table
<> " (name TEXT NOT NULL PRIMARY KEY, ts TEXT NOT NULL, down TEXT)"
@@ -0,0 +1,101 @@
{-# LANGUAGE NamedFieldPuns #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.App (appMigrations) where
import Data.List (sortOn)
import Database.SQLite.Simple (Query (..))
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220811_onion_hosts
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220817_connection_ntfs
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220905_commands
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220915_connection_queues
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230110_users
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230117_fkey_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230120_delete_errors
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230217_server_key_hash
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230223_files
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230320_retry_state
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230401_snd_files
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230510_files_pending_replicas_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230516_encrypted_rcv_message_hashes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230531_switch_status
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230829_crypto_files
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231222_command_created_at
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20231225_failed_work_items
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240121_message_delivery_indexes
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240124_file_redirect
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240223_connections_wait_delivery
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240225_ratchet_kem
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240417_rcv_files_approved_relays
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240624_snd_secure
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240702_servers_stats
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250322_short_links
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250702_conn_invitations_remove_cascade_delete
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251009_queue_to_subscribe
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20251010_client_notices
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
schemaMigrations =
[ ("20220101_initial", m20220101_initial, Nothing),
("20220301_snd_queue_keys", m20220301_snd_queue_keys, Nothing),
("20220322_notifications", m20220322_notifications, Nothing),
("20220607_v2", m20220608_v2, Nothing),
("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode, Nothing),
("m20220811_onion_hosts", m20220811_onion_hosts, Nothing),
("m20220817_connection_ntfs", m20220817_connection_ntfs, Nothing),
("m20220905_commands", m20220905_commands, Nothing),
("m20220915_connection_queues", m20220915_connection_queues, Nothing),
("m20230110_users", m20230110_users, Nothing),
("m20230117_fkey_indexes", m20230117_fkey_indexes, Nothing),
("m20230120_delete_errors", m20230120_delete_errors, Nothing),
("m20230217_server_key_hash", m20230217_server_key_hash, Nothing),
("m20230223_files", m20230223_files, Just down_m20230223_files),
("m20230320_retry_state", m20230320_retry_state, Just down_m20230320_retry_state),
("m20230401_snd_files", m20230401_snd_files, Just down_m20230401_snd_files),
("m20230510_files_pending_replicas_indexes", m20230510_files_pending_replicas_indexes, Just down_m20230510_files_pending_replicas_indexes),
("m20230516_encrypted_rcv_message_hashes", m20230516_encrypted_rcv_message_hashes, Just down_m20230516_encrypted_rcv_message_hashes),
("m20230531_switch_status", m20230531_switch_status, Just down_m20230531_switch_status),
("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
("m20230829_crypto_files", m20230829_crypto_files, Just down_m20230829_crypto_files),
("m20231222_command_created_at", m20231222_command_created_at, Just down_m20231222_command_created_at),
("m20231225_failed_work_items", m20231225_failed_work_items, Just down_m20231225_failed_work_items),
("m20240121_message_delivery_indexes", m20240121_message_delivery_indexes, Just down_m20240121_message_delivery_indexes),
("m20240124_file_redirect", m20240124_file_redirect, Just down_m20240124_file_redirect),
("m20240223_connections_wait_delivery", m20240223_connections_wait_delivery, Just down_m20240223_connections_wait_delivery),
("m20240225_ratchet_kem", m20240225_ratchet_kem, Just down_m20240225_ratchet_kem),
("m20240417_rcv_files_approved_relays", m20240417_rcv_files_approved_relays, Just down_m20240417_rcv_files_approved_relays),
("m20240624_snd_secure", m20240624_snd_secure, Just down_m20240624_snd_secure),
("m20240702_servers_stats", m20240702_servers_stats, Just down_m20240702_servers_stats),
("m20240930_ntf_tokens_to_delete", m20240930_ntf_tokens_to_delete, Just down_m20240930_ntf_tokens_to_delete),
("m20241007_rcv_queues_last_broker_ts", m20241007_rcv_queues_last_broker_ts, Just down_m20241007_rcv_queues_last_broker_ts),
("m20241224_ratchet_e2e_snd_params", m20241224_ratchet_e2e_snd_params, Just down_m20241224_ratchet_e2e_snd_params),
("m20250203_msg_bodies", m20250203_msg_bodies, Just down_m20250203_msg_bodies),
("m20250322_short_links", m20250322_short_links, Just down_m20250322_short_links),
("m20250702_conn_invitations_remove_cascade_delete", m20250702_conn_invitations_remove_cascade_delete, Just down_m20250702_conn_invitations_remove_cascade_delete),
("m20251009_queue_to_subscribe", m20251009_queue_to_subscribe, Just down_m20251009_queue_to_subscribe),
("m20251010_client_notices", m20251010_client_notices, Just down_m20251010_client_notices)
]
-- | The list of migrations in ascending order by date
appMigrations :: [Migration]
appMigrations = sortOn name $ map migration schemaMigrations
where
migration (name, up, down) = Migration {name, up = fromQuery up, down = fromQuery <$> down}
@@ -0,0 +1,27 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20240930_ntf_tokens_to_delete where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20240930_ntf_tokens_to_delete :: Query
m20240930_ntf_tokens_to_delete =
[sql|
CREATE TABLE ntf_tokens_to_delete (
ntf_token_to_delete_id INTEGER PRIMARY KEY,
ntf_host TEXT NOT NULL,
ntf_port TEXT NOT NULL,
ntf_key_hash BLOB NOT NULL,
tkn_id BLOB NOT NULL, -- token ID assigned by notifications server
tkn_priv_key BLOB NOT NULL, -- client's private key to sign token commands,
del_failed INTEGER DEFAULT 0,
created_at TEXT NOT NULL DEFAULT (datetime('now'))
);
|]
down_m20240930_ntf_tokens_to_delete :: Query
down_m20240930_ntf_tokens_to_delete =
[sql|
DROP TABLE ntf_tokens_to_delete;
|]
@@ -0,0 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241007_rcv_queues_last_broker_ts where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20241007_rcv_queues_last_broker_ts :: Query
m20241007_rcv_queues_last_broker_ts =
[sql|
ALTER TABLE rcv_queues ADD COLUMN last_broker_ts TEXT;
|]
down_m20241007_rcv_queues_last_broker_ts :: Query
down_m20241007_rcv_queues_last_broker_ts =
[sql|
ALTER TABLE rcv_queues DROP COLUMN last_broker_ts;
|]
@@ -0,0 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20241224_ratchet_e2e_snd_params where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20241224_ratchet_e2e_snd_params :: Query
m20241224_ratchet_e2e_snd_params =
[sql|
ALTER TABLE ratchets ADD COLUMN pq_pub_kem BLOB;
|]
down_m20241224_ratchet_e2e_snd_params :: Query
down_m20241224_ratchet_e2e_snd_params =
[sql|
ALTER TABLE ratchets DROP COLUMN pq_pub_kem;
|]
@@ -0,0 +1,33 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20250203_msg_bodies where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20250203_msg_bodies :: Query
m20250203_msg_bodies =
[sql|
ALTER TABLE snd_messages ADD COLUMN msg_encrypt_key BLOB;
ALTER TABLE snd_messages ADD COLUMN padded_msg_len INTEGER;
CREATE TABLE snd_message_bodies (
snd_message_body_id INTEGER PRIMARY KEY,
agent_msg BLOB NOT NULL DEFAULT x''
);
ALTER TABLE snd_messages ADD COLUMN snd_message_body_id INTEGER REFERENCES snd_message_bodies ON DELETE SET NULL;
CREATE INDEX idx_snd_messages_snd_message_body_id ON snd_messages(snd_message_body_id);
|]
down_m20250203_msg_bodies :: Query
down_m20250203_msg_bodies =
[sql|
DROP INDEX idx_snd_messages_snd_message_body_id;
ALTER TABLE snd_messages DROP COLUMN snd_message_body_id;
DROP TABLE snd_message_bodies;
ALTER TABLE snd_messages DROP COLUMN msg_encrypt_key;
ALTER TABLE snd_messages DROP COLUMN padded_msg_len;
|]

Some files were not shown because too many files have changed in this diff Show More