mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-10-12 11:39:56 +00:00
Compare commits
3
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 shum
|
df7bc4b54d | ||
|
shum
|
58e4f0eaa7 | ||
|
shum
|
23d912eb92 |
@@ -9,10 +9,6 @@ on:
|
||||
- "v*"
|
||||
pull_request:
|
||||
|
||||
concurrency:
|
||||
group: ${{ github.workflow }}-${{ github.ref }}
|
||||
cancel-in-progress: ${{ !startsWith(github.ref, 'refs/tags/v') }}
|
||||
|
||||
jobs:
|
||||
|
||||
# =============================
|
||||
@@ -305,30 +301,3 @@ jobs:
|
||||
echo "All "$attempts" attempts failed."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
# =============================
|
||||
# Resolver test job
|
||||
# =============================
|
||||
|
||||
# The SNRC resolver is Python, so this job needs none of the Haskell toolchain
|
||||
# above and runs independently of it.
|
||||
|
||||
resolver-test:
|
||||
name: "resolver (python)"
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Clone project
|
||||
uses: actions/checkout@v3
|
||||
|
||||
- name: Set up Python
|
||||
# Matches the runtime stage of scripts/resolver/service/Dockerfile.
|
||||
uses: actions/setup-python@v5
|
||||
with:
|
||||
python-version: "3.13"
|
||||
|
||||
- name: Install resolver dependencies
|
||||
# Must match scripts/resolver/service/pyproject.toml.
|
||||
run: python -m pip install "eth-hash[pycryptodome]>=0.7"
|
||||
|
||||
- name: Test
|
||||
run: python -m unittest discover -s scripts/resolver/service -v
|
||||
|
||||
@@ -12,4 +12,3 @@ cabal.project.local~
|
||||
*.tix
|
||||
.coverage
|
||||
|
||||
__pycache__/
|
||||
|
||||
@@ -1,200 +0,0 @@
|
||||
# SMP server database load: root causes and fixes
|
||||
|
||||
## Summary
|
||||
|
||||
The recurring `pMsgFwdsOwn_pErrorsOther` spikes are a symptom of chronic disk saturation of the
|
||||
`smp_server` PostgreSQL database, not a proxy or forwarding bug. The baseline read load is the
|
||||
Prometheus scrape running whole-table `COUNT` scans of `msg_queues` (48.5M rows) every 30 seconds,
|
||||
compounded by the message-expiration sweep. The write load comes from indexing `updated_at`:
|
||||
`updateQueueTime` stamps it on the first send to each active queue per UTC day, and these non-HOT
|
||||
updates bloat the indexes to 104 GB and amplify WAL to about 425 GB per day (37% full-page images,
|
||||
~31% from `updateQueueTime`). Because the stamp is day-granular, this write burst clusters at 00:00 UTC,
|
||||
tipping the saturated disk into the observed spike and loading the pgBackRest backup repository.
|
||||
|
||||
Code fixes replace the largest metric scan with an estimate and index the sweep and notifier counts.
|
||||
Reclaiming the index bloat, which also clears the remaining metric scan, and keeping it down are
|
||||
operator actions, because PostgreSQL never shrinks indexes automatically.
|
||||
|
||||
## Environment
|
||||
|
||||
The affected deployment runs the pure PostgreSQL backend (`store_queues: database`,
|
||||
`store_messages: database`), schema `smp_server`, `db_pool_size 20`, `prometheus_interval 30`,
|
||||
`[NAMES]` enabled, own-server proxying enabled, and forwards routed over a SOCKS proxy.
|
||||
|
||||
`msg_queues`: 48.5M live rows, 12.3% dead tuples, 14 GB heap, 104 GB indexes, 118 GB total.
|
||||
|
||||
## Evidence
|
||||
|
||||
`pg_stat_statements` over a 5 minute window, ordered by disk reads (`track_io_timing` was off, so
|
||||
`shared_blks_read` is the disk proxy; the two `EXPLAIN ANALYZE` rows are manual and excluded):
|
||||
|
||||
| query | calls | mean ms | reads | share of all reads |
|
||||
| --- | --- | --- | --- | --- |
|
||||
| `getEntityCounts` (the six-`COUNT` metric query) | 30 | 111,456 | 990 GB | 70.7% |
|
||||
| queue-record load (`SELECT recipient_id, …`) | 47,027 | 121 | 89 GB | 6.3% |
|
||||
| expiration sweep batch (`array_agg` in `expire_old_messages`) | 13 | 233,143 | 62 GB | 4.5% |
|
||||
| message peek (`DISTINCT ON (recipient_id)`) | 46,932 | 76 | 43 GB | 3.0% |
|
||||
| `updateQueueTime` (`UPDATE msg_queues SET updated_at`) | 172,885 | 4 | 7.7 GB | 0.5% |
|
||||
| `write_message` | 110,911 | 5 | 7.0 GB | 0.5% |
|
||||
|
||||
`EXPLAIN (ANALYZE, BUFFERS)` of each `msg_queues` count inside `getEntityCounts`:
|
||||
|
||||
| count | plan | time |
|
||||
| --- | --- | --- |
|
||||
| `queue_count` (`deleted_at IS NULL`) | Parallel Seq Scan | 30 s |
|
||||
| `notifier_count` (`deleted_at IS NULL AND notifier_id IS NOT NULL`) | Parallel Seq Scan | 32.6 s |
|
||||
| `ntf_service_queues_count` (`ntf_service_id IS NOT NULL AND deleted_at IS NULL`) | Parallel Seq Scan | 30.2 s |
|
||||
| `rcv_service_queues_count` (`rcv_service_id IS NOT NULL AND deleted_at IS NULL`) | Index Only Scan | 1.4 ms |
|
||||
|
||||
The expiration sweep batch: 229 s for one 10,000-row batch, walking `msg_queues_pkey` and discarding
|
||||
809,729 rows by filter to find 10,000 expirable ones.
|
||||
|
||||
`pg_stat_wal` over the measurement window: 27 TB of WAL accumulated, 37.2% of records full-page
|
||||
images, averaging about 425 GB per day; recent days reach ~470 GB (from the `archive-push` log) as
|
||||
the queue count grows.
|
||||
|
||||
Per-statement WAL from `pg_stat_statements` (`wal_bytes`), leaf statements only (this instance runs
|
||||
`pg_stat_statements.track = all`, so the `write_message` wrapper double-counts the `INSERT` and
|
||||
`UPDATE` it runs, and is excluded):
|
||||
|
||||
| category | share of WAL | main statements |
|
||||
| --- | --- | --- |
|
||||
| `msg_queues` updates | ~42% | `updateQueueTime` ~31%, `msg_can_write` flags ~9%, insert/delete ~2% |
|
||||
| `messages` insert and delete | ~34% | message `INSERT`, `DELETE` by `message_id` and `recipient_id` |
|
||||
| read path (hint bits, FPIs on SELECT) | ~24% | message peek ~15%, `msg_queue_size`, `getEntityCounts` |
|
||||
|
||||
## Root causes
|
||||
|
||||
1. Prometheus scrape. `getEntityCounts` (`QueueStore/Postgres.hs:154`) runs six `COUNT(1)` subqueries
|
||||
every `prometheus_interval` (30 s), called from the metrics path (`Server.hs:698`). Four count
|
||||
`msg_queues`; three of those seq-scan the 48.5M-row heap. At 70.7% of all reads it is the dominant
|
||||
disk consumer, and it runs continuously (mean 111 s per scrape exceeds the 30 s interval).
|
||||
|
||||
2. Message-expiration sweep. `expireMessagesThread` (`Server.hs:477`) calls the `expire_old_messages`
|
||||
procedure (`server_schema.sql`), whose inner batch query selects expirable queues ordered by
|
||||
`recipient_id`. With `oldQueue = 0` the `updated_at` filter matches everything, so the planner
|
||||
walks the primary key and filters `msg_queue_expire`, discarding ~99% of rows per batch.
|
||||
|
||||
3. Index bloat. 104 GB of indexes on a 14 GB table. `updated_at` is part of
|
||||
`idx_msg_queues_updated_at_recipient_id` (`server_schema.sql:526`) and `updateQueueTime`
|
||||
(`QueueStore/Postgres.hs:443`) updates it on the day's first send per queue (172,885 times in the
|
||||
window above). Updating an indexed column prevents HOT updates, so every update writes a new row
|
||||
version plus new entries in every index on the table, and the old index entries accumulate as bloat.
|
||||
|
||||
4. WAL amplification. Only 15.6% of `msg_queues` updates are HOT, because its composite index covers
|
||||
`updated_at` and `msg_queue_expire`, both changed on the hot path (cause 3); the rest rewrite every
|
||||
index on the table. With the 104 GB of bloated indexes and frequent checkpoints (`max_wal_size 4GB`,
|
||||
`checkpoint_timeout 5min`, `wal_compression off`), 37% of WAL records are full-page images, and the
|
||||
server generates about 425 GB of WAL per day (27 TB accumulated; recent days near 470 GB).
|
||||
`updateQueueTime`, stamping `updated_at` on the ~5.3M daily-active queues, is the single largest
|
||||
statement at ~31% of WAL (see Evidence). pgBackRest `archive-push` ships all of it, loading the
|
||||
primary disk and the backup repository. The load peaks
|
||||
at 00:00 UTC because `getSystemDate` rounds `updated_at` to the UTC day, so the first send to each
|
||||
active queue after midnight runs `updateQueueTime`, clustering these writes and the `archive-push`
|
||||
volume in the 00h hour.
|
||||
|
||||
## Index bloat and autovacuum
|
||||
|
||||
Autovacuum is running (60 runs on this table) and is not misconfigured, but two limits apply.
|
||||
|
||||
Autovacuum reclaims heap dead tuples and refreshes planner statistics; it does not shrink indexes.
|
||||
Only `REINDEX` or `pg_repack` rebuilds a bloated B-tree. Index bloat therefore has no automatic
|
||||
remedy.
|
||||
|
||||
Default autovacuum pacing assumes moderate churn. `autovacuum_vacuum_scale_factor = 0.2` waits until
|
||||
20% of the table is dead (about 9.7M rows here) before vacuuming, and cost-based throttling caps its
|
||||
I/O, so a hot table stays around 12% dead. Per-table tuning makes it run sooner and faster.
|
||||
|
||||
The amplifier is indexing `updated_at`, a column updated on every send, which the fixes and operator
|
||||
actions below address.
|
||||
|
||||
## Implemented fixes (batch 1)
|
||||
|
||||
Branch `sh/leaks-batch-1`, two commits.
|
||||
|
||||
| commit | change | effect |
|
||||
| --- | --- | --- |
|
||||
| `88673eee` | migration `20260916_prometheus_indexes` adds partial indexes `idx_msg_queues_expire (recipient_id) WHERE deleted_at IS NULL AND msg_queue_expire` and `idx_msg_queues_notifier_active (notifier_id) WHERE deleted_at IS NULL AND notifier_id IS NOT NULL` | the sweep batch and `notifier_count` become index scans |
|
||||
| `2912be1e` | `getEntityCounts.queue_count` uses `pg_class.reltuples` (`QueueStore/Postgres.hs:154`) | removes the 30 s, 990 GB whole-table `COUNT` on every scrape |
|
||||
|
||||
Verified: both indexes are created and used as index-only scans, the schema-dump test passes, and
|
||||
`smp-server` builds. `queueCount` is consumed only by metrics, logs, and display
|
||||
(`Server.hs:528,698,815,2369`), so an estimate is safe.
|
||||
|
||||
Not fixed by new indexes:
|
||||
|
||||
- `ntf_service_queues_count` seq-scans only because of index bloat; `idx_msg_queues_ntf_service_id`
|
||||
already covers it. `REINDEX` restores the index-only scan, as proven by `rcv_service_queues_count`.
|
||||
- `rcv_service_queues_count` and the two `services` counts are already cheap.
|
||||
|
||||
## Implemented fixes (batch 2)
|
||||
|
||||
Migration `20260917_msg_queues_hot` and `MsgStore/Postgres.hs`.
|
||||
|
||||
| change | effect |
|
||||
| --- | --- |
|
||||
| drop `idx_msg_queues_updated_at_recipient_id`, set `msg_queues` `fillfactor = 80` | `updateQueueTime` updates become HOT, so they rewrite no index entries; removes its index bloat and cuts its WAL |
|
||||
| remove the dead `updated_at > p_old_queue` filter and its parameter from `expire_old_messages`, matching the `CALL` (`MsgStore/Postgres.hs:113`) | the sweep query runs as an index-only scan on `idx_msg_queues_expire`; `updated_at` is no longer read on the hot path |
|
||||
| autovacuum reloptions on `msg_queues`, `messages` (and its TOAST), and `services` | keeps dead tuples and bloat low per table (see the table below) |
|
||||
|
||||
Verified on PostgreSQL 16 with the daily-active pattern (~11% of queues updated per day): `updateQueueTime`
|
||||
goes from 0% HOT (indexed `updated_at`) to 100% HOT at `fillfactor = 80` (96.7% at 90), and per-update
|
||||
WAL drops about 4x. The HOT ratio depends on how many rows per page change before autovacuum reclaims
|
||||
space, so it is workload-dependent; `fillfactor = 80` reached 100% for this fraction, and updating a much
|
||||
larger share of queues at once would need a lower value. `fillfactor` applies to pages rewritten after
|
||||
the change, so the ratio ramps up as the heap turns over, or immediately after `pg_repack`.
|
||||
|
||||
Dropping the index regresses the deprecated journal message store's expiration (`foldRecentQueueRecs`,
|
||||
`Journal.hs:434`) to a sequential scan; this is accepted because that store is being retired. The
|
||||
Postgres message store does not read `updated_at`.
|
||||
|
||||
Autovacuum reloptions applied by the migration:
|
||||
|
||||
| table | reloptions | reason |
|
||||
| --- | --- | --- |
|
||||
| `msg_queues` | `fillfactor 80`, `autovacuum_vacuum_scale_factor 0.02`, `autovacuum_analyze_scale_factor 0.01`, `autovacuum_vacuum_cost_limit 1000` | HOT headroom; vacuum/analyze at ~2%/1% churn instead of 20%/10%; faster vacuum |
|
||||
| `messages` (and TOAST) | `autovacuum_vacuum_scale_factor 0.02`, `autovacuum_analyze_scale_factor 0.01`, `toast.autovacuum_vacuum_scale_factor 0.02` | high insert and delete churn; 152 GB, mostly TOASTed message bodies |
|
||||
| `services` | `fillfactor 70`, `autovacuum_vacuum_threshold 1000`, `autovacuum_vacuum_scale_factor 0` | tiny, very hot table was autovacuumed tens of thousands of times; make updates HOT and vacuum it far less |
|
||||
|
||||
## Operator actions
|
||||
|
||||
1. Reclaim index bloat (online, no lock; needs free disk near the index size; run largest first):
|
||||
```
|
||||
REINDEX INDEX CONCURRENTLY smp_server.idx_msg_queues_updated_at_recipient_id;
|
||||
REINDEX INDEX CONCURRENTLY smp_server.idx_msg_queues_notifier_id;
|
||||
REINDEX INDEX CONCURRENTLY smp_server.idx_msg_queues_ntf_service_id;
|
||||
REINDEX INDEX CONCURRENTLY smp_server.idx_msg_queues_rcv_service_id;
|
||||
REINDEX INDEX CONCURRENTLY smp_server.idx_msg_queues_sender_id;
|
||||
REINDEX INDEX CONCURRENTLY smp_server.idx_msg_queues_link_id;
|
||||
ANALYZE smp_server.msg_queues;
|
||||
```
|
||||
Expect `pg_indexes_size('smp_server.msg_queues')` to drop from 104 GB to roughly 12 GB (measured
|
||||
after reindexing). `ANALYZE` restores the index-only scan for `ntf_service_queues_count`. With the
|
||||
batch-2 `fillfactor` the index bloat no longer rebuilds, so this is a one-time reclaim.
|
||||
|
||||
2. Autovacuum reloptions are applied by the batch-2 migration (`msg_queues`, `messages` and its TOAST,
|
||||
`services`), so no manual `ALTER TABLE` is needed. Reclaim the current `messages` bloat once with
|
||||
`pg_repack smp_server.messages` (152 GB heap and TOAST, roughly 30-50 GB reclaimable); running
|
||||
`pg_repack` on `msg_queues` also makes `fillfactor = 80` effective immediately rather than as pages
|
||||
turn over. With `fillfactor = 80` the `msg_queues` index bloat no longer rebuilds, so scheduled
|
||||
reindexing is rarely needed. To automate it anyway, run `reindexdb --concurrently` or `pg_repack`
|
||||
from a scheduler; `pg_cron` runs each job inside a transaction and cannot execute
|
||||
`REINDEX ... CONCURRENTLY`, so use `pg_cron` only for `VACUUM`/`ANALYZE` or a non-concurrent
|
||||
maintenance-window `REINDEX`.
|
||||
|
||||
3. Cut WAL and checkpoint pressure (all reloadable, no restart):
|
||||
```
|
||||
ALTER SYSTEM SET wal_compression = 'lz4';
|
||||
ALTER SYSTEM SET max_wal_size = '32GB';
|
||||
ALTER SYSTEM SET checkpoint_timeout = '30min';
|
||||
SELECT pg_reload_conf();
|
||||
```
|
||||
Fewer checkpoints produce fewer full-page images; `wal_compression` shrinks those that remain.
|
||||
Together these reduce the WAL written on the primary and shipped by `archive-push`. The message
|
||||
insert and delete volume itself is fixed by traffic, but most of its WAL cost is amplification
|
||||
(full-page images and hint-bit writes on bloated pages), which these settings and `REINDEX` reduce.
|
||||
This is separate from pgBackRest repo-side compression, which does not reduce WAL on the primary.
|
||||
Verify with `pg_stat_reset_shared('wal')`, wait, then re-check `wal_fpi` and `wal_bytes` in
|
||||
`pg_stat_wal`.
|
||||
|
||||
4. Enable `track_io_timing = on` so disk wait time is measurable in `pg_stat_statements`.
|
||||
@@ -0,0 +1,186 @@
|
||||
# SMP server: memory leaks and CPU/RAM exhaustion paths
|
||||
|
||||
Date: 2026-09-08
|
||||
Scope: server-side code at HEAD 200129af. Defensive review for the operator. All file:line references verified against the current tree.
|
||||
|
||||
## Summary
|
||||
|
||||
Scope is the PostgreSQL backend only (`store_queues: database`, `store_messages: database`), which selects `SSCDatabase` -> `PostgresMsgStore`. In that backend the queue store is created with `useCache = False` (`MsgStore/Postgres.hs:100`) and `getMsgQueue` is a no-op (`:172`), so there is no in-memory queue cache and no journal message files.
|
||||
|
||||
Consequence: the queue-cache and journal issues below do not occur on this backend. Specifically, memory-leaks 1 and 2 (queue cache) require `useCache = True`, which only the journal-with-Postgres-queues mode (`store_messages: journal`) uses; and the SUBS journal-FD spike requires journal files. On PostgreSQL, SUBS is a single streaming DB query (`MsgStore/Postgres.hs:122`), with no FD/RAM spike.
|
||||
|
||||
Real CPU/RAM issues on the PostgreSQL backend (all store-independent): unauthenticated RSLV outbound fan-out, the proxy session never torn down on forward timeout, the absence of any global connection/thread cap, and the service `subscriptions` map not pruned on ACK. Reproduction tests: `testRslvFanOut` and `testProxyForwardTimeoutStuckSession`. No fixes are applied. Verified against a local PostgreSQL (`server_postgres` build).
|
||||
|
||||
## Memory leaks
|
||||
|
||||
### 1. Queue cache retains deleted queues (not the PostgreSQL backend)
|
||||
|
||||
Only with `useCache = True` (journal-with-Postgres-queues mode). The pure PostgreSQL backend uses `useCache = False`, so the `queues` cache is never populated and nothing leaks. Documented for completeness.
|
||||
|
||||
`deleteStoreQueue` nulls the queue's `queueRec` TVar and cleans the `senders`, service, and notifier maps, but never removes the entry from the `queues` map.
|
||||
|
||||
- STM: `QueueStore/STM.hs` (no `TM.delete rId queues`).
|
||||
- Postgres: `QueueStore/Postgres.hs:451-464` (sets `deleted_at`, nulls `queueRec`, never removed from the cache; `compactQueues` at `:148-152` deletes DB rows only).
|
||||
- Add sites: STM `QueueStore/STM.hs:126`; Postgres `:182` and `:245` (any load caches).
|
||||
|
||||
Effect: each create+delete cycle leaves a permanent `STMQueue`/`JournalQueue` object with its TVars. A client looping NEW then DEL grows RAM without bound; freed only by restart. `getEntityCounts` counts `M.size queues` (`QueueStore/STM.hs:101`), so the reported `queueCount` also drifts up. Reproduced on STM, Journal, and Postgres+journal: 200 create+delete cycles retain 200 cache entries.
|
||||
|
||||
Fix direction: drop the entry from the cache on delete in both stores. Safe because `loadQueue` filters `AND deleted_at IS NULL` (`QueueStore/Postgres.hs:231,286,309`), so a deleted queue is never reloaded.
|
||||
|
||||
```haskell
|
||||
delete q = do
|
||||
writeTVar qr Nothing
|
||||
TM.delete rId $ queues st -- add: drop deleted queue from the cache
|
||||
TM.delete senderId $ senders st
|
||||
...
|
||||
```
|
||||
|
||||
### 2. Postgres queue cache has no eviction (not the pure PostgreSQL backend)
|
||||
|
||||
Only with `useCache = True` (journal-with-Postgres-queues mode). The pure PostgreSQL backend (`store_messages: database`) uses `useCache = False`, so there is no cache to grow. Documented for completeness.
|
||||
|
||||
Every distinct queue touched by SUB/SEND/NSUB/GET is cached in `queues` via `cacheQueue` (`QueueStore/Postgres.hs:245`) and removed only on delete. There is no idle or size-based eviction, so the working set trends toward every queue accessed since boot, defeating the purpose of the database backing store. `idleQueueInterval` (`Env/STM.hs:233`, 4h) closes journal message-queue handles, not this cache. Requires the Postgres backend.
|
||||
|
||||
### 3. Service subscriptions map not pruned on ACK
|
||||
|
||||
A receiving-service client's `subscriptions` map gains a `Sub` per delivered queue at `Server.hs:1896` (initial scan) and `Server.hs:2073` (`newServiceDeliverySub` on each SEND to an associated queue). `acknowledgeMsg` (`Server.hs:1929-1951`) clears delivery state but never deletes the map entry. Entries are removed only on queue delete, unassociation, or disconnect. A long-lived service session grows toward the number of associated queues regardless of ACKs.
|
||||
|
||||
### 4. Notification store grows without a subscriber (not fixed)
|
||||
|
||||
`storeNtf` prepends to a per-notifier list with no bound (`NtfStore.hs:37-42`). The list is drained only by an active notifier subscription or the notification TTL (default 24h, `Env/STM.hs:238-243`). With no notifier subscribed, one entry accumulates per notification-flagged SEND. `deleteExpiredNtfs` also leaves the emptied notifier key in the outer map (`NtfStore.hs:57-61`).
|
||||
|
||||
Not fixed here: the per-notifier list is TTL-bounded, and the empty-key retention is bounded by the number of active notifiers (freed on queue/notifier delete), so it is not truly unbounded. Removing the emptied key in `deleteExpiredNtfs` races with `storeNtf`, which reads the outer map outside a transaction; a safe fix requires making `storeNtf` fully transactional, which changes a hot path. Deferred as not worth that trade.
|
||||
|
||||
### 5. Proxy client maps grow with distinct PRXY targets
|
||||
|
||||
`smpClients` (keyed by `SMPServer`) and `smpSessions` grow per distinct proxied relay. On connect failure with `persistErrorInterval /= 0` (default 30s), the error var is kept in `smpClients` (`Client/Agent.hs:245-247`) and removed only lazily on re-query. Client-controlled `PRXY srv` targets make the target set attacker-chosen.
|
||||
|
||||
### 6. Blocked writer threads on a stuck relay
|
||||
|
||||
When a relay stops draining, the proxy client's `sndQ` fills and each further command forks a thread parked in `writeTBQueue` (`Client.hs:1367-1370`), each retaining a `Request`. This is the memory amplifier of the proxy stuck-session issue.
|
||||
|
||||
### 7. sentCommands entries leak for unanswered commands
|
||||
|
||||
`getResponse` sets `pending = False` on timeout but does not delete the `sentCommands` entry (`Client.hs:1372-1383`); removal happens only on a matching response (`Client.hs:704`). Commands a relay never answers stay for the connection lifetime.
|
||||
|
||||
## CPU/RAM exhaustion paths
|
||||
|
||||
Ranked by ease of trigger times impact.
|
||||
|
||||
1. No global connection cap plus a 120s handshake hold. Sockets are accepted and handlers forked with no admission control (`Transport/Server.hs:176-184`); the SMP handshake may hang for `smpHandshakeTimeout` (`Main.hs:535`, 120s). Unauthenticated thread, FD, and buffer exhaustion.
|
||||
2. `PRXY` establishes an outbound TLS connection to an arbitrary client-named host and port (`Server.hs:1417-1429`), which is server-side request forgery plus unbounded cached outbound sessions. Gated by `allowSMPProxy` and optional `newQueueBasicAuth`; open on public relays.
|
||||
3. `NEW` creates a persistent queue with keys, a store-log record, and disk state (`Server.hs:1569-1628`), with no maximum queue count. On public or no-password servers this is unauthenticated and compounds leak 1.
|
||||
4. `RSLV` forks up to `serverResolverConcurrency` (1000) outbound HTTP requests per connection through a per-client counter with no global cap (`Server.hs:1279,1522`, `Env/STM.hs:256`). Only when `[NAMES]` is enabled. No result cache (`Names.hs:61-74`).
|
||||
5. `SUBS` on a recipient service folds over every queue of the service and reruns on every reconnect since `hasSub` is false on a fresh connection. On the PostgreSQL backend this is one streaming DB query joining each service queue with its head message (`MsgStore/Postgres.hs:122`): O(N) DB work, but no journal opens and no FD/RAM spike (the journal-open spike, `Journal.hs:449-467`, is journal-mode only). The store-independent cost that remains is the service `subscriptions` map growing (leak 3).
|
||||
6. `RFWD` runs one X25519 DH per request inline on the connection thread before validating the inner ciphertext (`Server.hs:2129`), unauthenticated (`Server.hs:1278`).
|
||||
7. Batch multiplier: one 16 KB block carries up to 255 transmissions (`Protocol.hs:2292`), multiplying every per-command cost. Unknown-queue transmissions still run a full signature verify via the dummy-verify path (`Server.hs:1345-1350`).
|
||||
|
||||
Interaction: `RSLV` (limit 1000) and `PRXY`/`PFWD` (limit 32) share one `procThreads` counter (`Server.hs:1476-1489`), so an RSLV flood also starves proxying on the same connection.
|
||||
|
||||
## Config-gated exposure to confirm
|
||||
|
||||
- `newQueueBasicAuth`: gates NEW and PRXY. Absent on public servers by design.
|
||||
- `allowSMPProxy`: enables PRXY (hardcoded true in the default config path, `Main.hs:610`).
|
||||
- `[NAMES] enable`: gates RSLV.
|
||||
|
||||
## Reproduction tests
|
||||
|
||||
Two store-independent issues have sound reproductions on the PostgreSQL backend. Both are pending (`xit`) specs asserting the correct behavior, each verified to fail (reproduce) when activated (`it`).
|
||||
|
||||
- `tests/RSLVTests.hs`
|
||||
- `testRslvFanOut`: one connection must not fan out to many concurrent resolver requests. Verified: 64 concurrent from one connection.
|
||||
- `tests/SMPProxyTests.hs`
|
||||
- `testProxyForwardTimeoutStuckSession`: after repeated forward timeouts the session must be dropped, so a later forward returns `NO_SESSION`. Verified: all 10 forwards return `BROKER TIMEOUT` (session never torn down; the operator-reported `pMsgFwdsOwn_pErrorsOther`).
|
||||
|
||||
Running the Postgres tests requires a local PostgreSQL with roles `test_server_user` and `postgres` and database `test_server_db`, reachable via the default Unix socket (set `PGHOST`) and `localhost:5432`, plus a `-fserver_postgres` build.
|
||||
|
||||
## Sanity of the reproductions
|
||||
|
||||
Verified by tracing the exercised code path.
|
||||
|
||||
- `testRslvFanOut`: sound, store-independent, timing-based. Full E2E: real RSLV commands to a real names-enabled server; a 3s resolver delay vs a 0.8s sample separates concurrent from sequential; 64 outbound requests are in flight from one connection. `managerConnCount = 10` does not serialize them (64 confirmed). Couples to a resolver-limit the fix must add and the test set.
|
||||
- `testProxyForwardTimeoutStuckSession`: sound, store-independent. Real PFWD path; 10 forwards on one session all return `BROKER TIMEOUT`, none `NO_SESSION`, so the session is never torn down. Asserts the desired behavior, so it fails now and passes once a teardown/circuit-breaker fix lands.
|
||||
|
||||
Issues without a sound reproduction on the PostgreSQL backend:
|
||||
|
||||
- Queue cache leak / no eviction (memory-leaks 1, 2): do not occur, `useCache = False`. The earlier `testDeleteQueueNoLeak`/`testPostgresCacheBounded` only reproduced in journal/cache modes and were removed.
|
||||
- SUBS journal-FD spike: journal-mode only; `getMsgQueue` is a no-op on PostgreSQL. The earlier `testSubsServiceScanBounded` was removed.
|
||||
- Global admission control: not testable black-box. `connect()` succeeds regardless of an app-level cap (kernel backlog), and an admission fix accepts-then-closes rather than refusing the connect, so a black-box client cannot distinguish fixed from unfixed. Needs a configurable connection cap the test can set or a server-exposed active-connection metric.
|
||||
- Service `subscriptions` map not pruned on ACK (memory-leaks 3): real and store-independent, but not reproduced here; needs a messaging-service (service-cert) client that SUBS then receives and ACKs, asserting the map does not grow.
|
||||
|
||||
Note on issue 6: task 6 is "bound proxy writer threads to a stuck relay" (`nonBlockingWriteTBQueue` forking when the relay stops reading). The shipped test does not reproduce that; it reproduces the related, higher-impact and operator-observed "session not torn down on forward timeout". The writer-thread fork bomb needs a relay that accepts TCP but stops reading, and `nonBlockingWriteTBQueue` is not exported, so it is not reproduced here.
|
||||
|
||||
## Fix directions (general)
|
||||
|
||||
Sketches only, one per high-impact issue. Not applied.
|
||||
|
||||
Issue 1, drop deleted queues from the cache (both stores):
|
||||
|
||||
```haskell
|
||||
delete q = do
|
||||
writeTVar qr Nothing
|
||||
TM.delete rId $ queues st -- add
|
||||
...
|
||||
```
|
||||
|
||||
Issue 2, evict the Postgres queue cache working set (idle or bounded LRU):
|
||||
|
||||
```haskell
|
||||
-- periodic sweep, or on insert past a size bound:
|
||||
evictIdleQueues st now = atomically $
|
||||
modifyTVar' (queues st) (M.filter (not . idleSince now)) -- keep only recently used
|
||||
```
|
||||
|
||||
Issue 3, bound the SUBS scan: close each queue after peek and paginate; do not rerun the full scan on every reconnect:
|
||||
|
||||
```haskell
|
||||
f' a (q, qr) =
|
||||
(runExceptT (tryPeekMsg ms q) >>= f a (recipientId q) . ...) `finally` closeMsgQueue ms q
|
||||
```
|
||||
|
||||
Issue 4, global RSLV concurrency cap (semaphore in NamesEnv, acquired around the outbound call):
|
||||
|
||||
```haskell
|
||||
data NamesEnv = NamesEnv { ..., resolverSem :: TVar Int, resolverLimit :: Int }
|
||||
|
||||
withResolverSlot NamesEnv {resolverSem, resolverLimit} =
|
||||
bracket_ (atomically $ readTVar resolverSem >>= \n -> if n >= resolverLimit then retry else writeTVar resolverSem (n + 1))
|
||||
(atomically $ modifyTVar' resolverSem (subtract 1))
|
||||
```
|
||||
|
||||
Issue 5, global connection admission at accept (refuse beyond a cap):
|
||||
|
||||
```haskell
|
||||
-- in the accept loop: gate on a shared counter before forking the handler
|
||||
n <- atomically $ stateTVar activeConns (\n -> (n, n + 1))
|
||||
if n >= maxConns then close sock else forkHandler sock `finally` atomically (modifyTVar' activeConns (subtract 1))
|
||||
```
|
||||
|
||||
Issue 6, bound proxy writers and add a forward-timeout circuit breaker:
|
||||
|
||||
```haskell
|
||||
-- fail fast instead of forking an unbounded blocked writer:
|
||||
nonBlockingWriteTBQueue q x = atomically (tryWriteTBQueue q x)
|
||||
>>= (`unless` throwIO PCEResponseTimeout) -- or count and drop
|
||||
-- and drop the relay session after N consecutive forward timeouts (independent of received bytes)
|
||||
```
|
||||
|
||||
Also: prune the service `subscriptions` entry on ACK (leak 3, `acknowledgeMsg`); the ntf empty-key (leak 4) needs a transactional `storeNtf` first.
|
||||
|
||||
## Additional findings (verified 2026-09-09)
|
||||
|
||||
Found by a subagent sweep of the PostgreSQL backend and store-independent hot paths, then each confirmed by reading the cited code. Not yet fixed or tested (except where noted).
|
||||
|
||||
Attacker-triggerable (DoS):
|
||||
|
||||
1. Batched crypto + per-transmission DB SELECT amplification (HIGH). `dummyVerifyCmd` runs a real Ed25519/Ed448 verify or attacker-chosen X25519 DH per transmission on an unknown queue (`Server.hs:1345-1350`). SEND is a non-batch party (`batchParty` = Recipient/Notifier only, `Protocol.hs:420-423`), so it uses the per-transmission path `mapM (verifyTransmission ...)` (`Server.hs:1167`): one crypto op plus one `getQueueRec` DB SELECT (no cache) per transmission. A 16 KB block holds ~130-250 transmissions (`Protocol.hs:2292`), so one write by any handshake-completing peer causes ~130-250 asymmetric verifications and ~130-250 individual SELECTs. Testable.
|
||||
2. `clientService` handshake grows the `services` table without bound (MED-HIGH). `getClientService` accepts a self-signed chain (`CCSelf`, `Transport.hs:755-768`) and verifies an attacker cert per connection; `getCreateService` inserts a `services` row on any new cert fingerprint (`QueueStore/Postgres.hs:469-482`). A fresh self-signed cert per handshake yields an unbounded persistent row per connection, pre-auth. Testable (count rows across N handshakes).
|
||||
3. Unbounded delivery threads to a slow consumer (MED). When a subscribed recipient's `sndQ` is full, `tryDeliverMessage` forks a bare `forkIO` parked on `writeTBQueue` (`Server.hs:2068-2072,2085-2105`), not gated by `procThreads`. One blocked thread per queue for a slow consumer subscribed to many queues.
|
||||
|
||||
Operational / scale:
|
||||
|
||||
4. DB pool is the throughput ceiling (HIGH for scale). Default `poolSize=10` (`Main/Init.hs:44`), one MVar-gated pool shared by all clients. Each SEND is 3 transactions: `getQueueRec` + `deleteExpiredMsgs` + `writeMsg`, and `expireMessagesOnSend=True` by default (`Main.hs:563`, `Server.hs:2004`) forces the middle one on every SEND to a non-empty queue. A second pool (`dbPriorityPool`, another `poolSize` backends) is opened but never used by the SMP server (no `withTransactionPriority _ True` in server code) -> 2xpoolSize backends, half idle.
|
||||
5. Prometheus scrape cost (MED-HIGH, if enabled). Every `prometheus_interval` (default 60s), `getDeliveredMetrics` folds over all clients x all subscriptions in memory (`Server.hs:723-734`) and `getEntityCounts` runs 6 `COUNT(1)` scans over `msg_queues`/`services` (`QueueStore/Postgres.hs:154-170`, `Server.hs:699`).
|
||||
6. Subscription serialization bottleneck (MED). All subscription churn funnels through one `subQ` + one `serverThread` mutating the single `queueSubscribers` Map-in-a-TVar (`Server.hs:263-360`, `Env/STM.hs:375-391`); a batched SUB of N queues is N separate STM writes to one contended TVar.
|
||||
|
||||
Lower / noted (chain verified, not deep-dived): `expire_old_messages` does a full `COUNT(1) FROM messages` every 2h; legacy non-service `deliverNtfsThread` is O(ntf-clients x pending) every 1.5s; `PeriodStats` week/month `IntSet`s grow with distinct active queues; no server-side prepared statements; full-row queue decode per command.
|
||||
@@ -17,11 +17,11 @@ note over CC, HC: TLS handshake
|
||||
par
|
||||
note over CC: validate client X509 credentials
|
||||
CC->>CI: session code from tlsUnique
|
||||
CI-->>CC: user confirmation (optional if known)
|
||||
CI-->>CC: user confirmation
|
||||
and
|
||||
note over HC: validate server X509 credentials
|
||||
HC->>HI: session code from tlsUnique
|
||||
HI-->>HC: user confirmation (optional if known)
|
||||
HI-->>HC: user confirmation
|
||||
end
|
||||
|
||||
note over CI, HI: 3. Session verification and protocol negotiation
|
||||
|
||||
File diff suppressed because one or more lines are too long
|
Before Width: | Height: | Size: 31 KiB After Width: | Height: | Size: 31 KiB |
@@ -168,7 +168,7 @@ This document describes the cryptographic primitives and threat model for the Si
|
||||
|
||||
*cannot:*
|
||||
|
||||
- impersonate a sender and send messages to the user whose database was stolen, unless the database contains a new rotation queue that is not secured yet. Doing so requires also compromising the router (to place the message in the queue, that is possible until the Double-Ratchet advances forward) or the user's device at a subsequent time (to place the message in the database).
|
||||
- impersonate a sender and send messages to the user whose database was stolen. Doing so requires also compromising the router (to place the message in the queue, that is possible until the Double-Ratchet advances forward) or the user's device at a subsequent time (to place the message in the database).
|
||||
|
||||
- undetectably communicate at the same time as Alice with her contacts. Doing so would result in the contact getting different messages with repeated IDs.
|
||||
|
||||
|
||||
+43
-125
@@ -86,7 +86,7 @@ It's designed with the focus on communication security and integrity, under the
|
||||
|
||||
It is designed as a low level protocol for other application protocols to solve the problem of secure and private message transmission, making [MITM attack][1] very difficult at any part of the message transmission system.
|
||||
|
||||
This document describes SMP protocol version 22. Versions 1-5 are discontinued. The version history:
|
||||
This document describes SMP protocol version 20. Versions 1-5 are discontinued. The version history:
|
||||
|
||||
- v1: binary protocol encoding
|
||||
- v2: message flags (used to control notifications)
|
||||
@@ -108,7 +108,6 @@ This document describes SMP protocol version 22. Versions 1-5 are discontinued.
|
||||
- v19: service subscriptions to messages (SUBS, NSUBS, SOKS, ENDS, ALLS commands)
|
||||
- v20: public namespaces resolver (RSLV command, RNAME response) — direct or forwarded via PFWD
|
||||
- v21: server public information in handshake
|
||||
- v22: `RNAME` says whether a name can be registered, not only what it resolves to
|
||||
|
||||
## Introduction
|
||||
|
||||
@@ -1120,8 +1119,6 @@ When the client receives PKEY response it MUST validate that:
|
||||
- the fingerprint of the received certificate matches fingerprint in the router address - it mitigates MITM attack by proxy.
|
||||
- the router session key is correctly signed with the received certificate.
|
||||
|
||||
`smpVersionRange` in `PKEY` is not signed.
|
||||
|
||||
The proxy router may respond with error response in case the destination router is not available or in case it has an earlier version that does not support proxied commands.
|
||||
|
||||
#### Send command via proxy
|
||||
@@ -1454,150 +1451,53 @@ reads `NameRecord` from. The reference implementation forwards each RSLV to a
|
||||
companion REST resolver process (`scripts/resolver/snrc-resolve.py`) that
|
||||
queries the SNRC contract on Ethereum; alternative backings (different chains,
|
||||
DHT, etc.) are valid as long as they expose the documented HTTP shape (`GET
|
||||
/v2/resolve/<query>` returning a `NameRegistration` on 200 for every
|
||||
registration shape, 400 for unknown TLDs, 502 for upstream failures) or
|
||||
substitute a different transport returning the same JSON. The resolver API is
|
||||
versioned separately from this protocol: `/v1/resolve/<name>` returns a bare
|
||||
`NameRecord` and is what relays before v22 call as `/resolve/<name>`.
|
||||
/resolve/<name>` returning a `NameRecord` on 200, 404 / 400 for unknown names
|
||||
or TLDs, 502 for upstream RPC failures) or substitute a different transport
|
||||
while still returning a `NameRecord` matching the encoding below.
|
||||
|
||||
#### Resolve name command
|
||||
|
||||
The `RSLV` command carries the query as text, not JSON. A client sends the
|
||||
hashed form only from v22, and the name itself below it:
|
||||
The `RSLV` command carries the canonical fully-qualified name directly as the
|
||||
payload (not JSON):
|
||||
|
||||
```abnf
|
||||
rslv = %s"RSLV" SP query
|
||||
query = domain / hashed ; hashed only from v22
|
||||
domain = 1*253 OCTET ; the name as text
|
||||
hashed = "[" 64HEXDIG "]" tld ; keccak-256 of the second-level label
|
||||
tld = %s".simplex" / %s".testing"
|
||||
rslv = %s"RSLV" SP domain ; domain = canonical name as non-space bytes, consuming the remainder of the transmission
|
||||
```
|
||||
|
||||
`domain` is the UTF-8 canonical fully-qualified name with the TLD always
|
||||
explicit (e.g. `privacy.simplex`, `test.testing`, `example.com`), bounded to
|
||||
253 bytes.
|
||||
|
||||
**Hashed labels.** The query is a name, or the keccak-256 of a second-level
|
||||
label in ENS's bracketed form. A label can only be letters, digits and hyphens,
|
||||
so `[` tells the two apart and no tag is needed.
|
||||
|
||||
Only a second-level name may be hashed. A name with subnames is sent as text: it
|
||||
is resolved rather than priced, and its record names it anyway. A web TLD has no
|
||||
registry to key a hash on.
|
||||
|
||||
From v22 a client MUST send the hash. Older routers can only read the name, so a
|
||||
client on an older session sends the name. A router answering a hashed query
|
||||
does not know the label's length, so it cannot check a minimum-length policy
|
||||
either: the client does that, from the pricing it is sent.
|
||||
|
||||
The same form reaches the backing resolver, which is what its HTTP API takes, so
|
||||
the query is one string end to end.
|
||||
|
||||
A hashed query still answers with the name. The registrar records the plaintext
|
||||
label when a name is registered, keyed by the hash of that label, so a router can
|
||||
look up what the hash stands for without ever being told. The router is not
|
||||
trusted for it: a client MUST check that the record names the name it asked
|
||||
about, and reject the answer otherwise. A registry that does not record the
|
||||
label cannot answer a hashed query at all, and the router answers `ERR NAME
|
||||
RESOLVER` rather than a record it knows the client will reject. An unregistered
|
||||
name has no recorded label, so it cannot be looked up either.
|
||||
|
||||
**Server-side validation.** The names router parses `domain` as a
|
||||
fully-qualified name (TLD required — bare labels are rejected) and forwards it
|
||||
to the configured backing resolver, which is the source of truth for which
|
||||
on-chain registry maps to each TLD.
|
||||
|
||||
The names router responds with either an `RNAME` response saying what it knows
|
||||
about the name, or an `ERR NAME` error whose subcode a client iterating across
|
||||
several configured servers can act on distinctly:
|
||||
The names router responds with either an `RNAME` response carrying the resolved
|
||||
record, or an `ERR NAME` error whose subcode a client iterating across several
|
||||
configured servers can act on distinctly:
|
||||
|
||||
| Response | Condition | Client action |
|
||||
|---|---|---|
|
||||
| `RNAME` | the router read the registry | use it |
|
||||
| `ERR NAME NOT_FOUND` | below v22 only: every name that does not resolve. From v22 a router never sends it | stop, and do not read it as registrable |
|
||||
| `RNAME` | record resolved | use it |
|
||||
| `ERR NAME NOT_FOUND` | name not registered, unknown TLD, or malformed name | authoritative "no such name" — stop |
|
||||
| `ERR NAME NO_RESOLVER` | this router has no resolver (names role not enabled) | skip this server, try the next |
|
||||
| `ERR NAME RESOLVER <detail>` | the router cannot state an answer completely: no registrar or price oracle for the TLD, an unreachable chain, a transport failure, a timeout, a registration it could not date or resolve | surface `<detail>`; retry only if it reads as transient |
|
||||
| `ERR NAME RESOLVER <detail>` | transient failure: backing resolver error (upstream 5xx, transport, timeout, decode) | transient — retry or surface, do not treat as "not found" |
|
||||
|
||||
A client SHOULD NOT broadcast a `name` to further servers after a name-capable
|
||||
router has answered (`NOT_FOUND` or `RESOLVER`), since that router has already
|
||||
seen the lookup key; `NO_RESOLVER` discloses nothing about the name beyond the
|
||||
fact that this router cannot resolve, so iterating past it is safe.
|
||||
|
||||
#### Name response
|
||||
#### Name record response
|
||||
|
||||
`RNAME` answers both what a name resolves to and whether it can be registered.
|
||||
The `RNAME` response carries a JSON-encoded record as the payload:
|
||||
|
||||
```abnf
|
||||
rname = %s"RNAME" SP nameResponse
|
||||
rname = %s"RNAME" SP json-bytes ; json-bytes consumes the remainder of the transmission
|
||||
```
|
||||
|
||||
`nameResponse` is a UTF-8 JSON object consuming the remainder of the
|
||||
transmission: the `registration` below, and `lastBlockTs`, the block timestamp the
|
||||
registry was read at. Money is US cents, times are seconds since the Unix epoch, and lengths are
|
||||
characters.
|
||||
|
||||
| Field | JSON type | Constraints |
|
||||
|---|---|---|
|
||||
| `lastBlockTs` | number | block timestamp the answer was read at. Absent only from a v20/v21 router, which sent the record alone |
|
||||
| `registration` | object | below |
|
||||
|
||||
A router reads the registry through a node of its own, which can lag. A name
|
||||
registered or changed after `lastBlockTs` still reads as it did before, so a client
|
||||
MUST NOT treat an answer as current without checking it.
|
||||
|
||||
`registration`'s `type` selects which of the three answers it is.
|
||||
|
||||
| `type` | Meaning |
|
||||
|---|---|
|
||||
| `registered` | held by someone until `expires`, renewable by its owner alone until `graceUntil`. It always carries `nameRecord`: where the owner set none, every field is unset and the resolver address is zero |
|
||||
| `available` | held by nobody and registrable now, at `pricing` |
|
||||
| `reserved` | held back by the registry and not registered. It carries no price, and a router MUST NOT quote one |
|
||||
|
||||
| Field | On | JSON type | Constraints |
|
||||
|---|---|---|---|
|
||||
| `expires` | `registered` | number | absent only from a v20/v21 router, which sent the record alone |
|
||||
| `graceUntil` | `registered` | number | after `expires`; until here only the owner may renew. Absent on the same condition as `expires` |
|
||||
| `reservedReason_` | `registered` | string | a reason word, present only when the name is held back as well |
|
||||
| `nameRecord` | `registered` | object | the record, schema below |
|
||||
| `pricing` | `available` | object | `registrationPrices`, `basePrice` and `minLabelLength`, below |
|
||||
| `reservedReason` | `reserved` | string | a reason word |
|
||||
|
||||
| `pricing` field | JSON type | Constraints |
|
||||
|---|---|---|
|
||||
| `registrationPrices` | object | label length, as a decimal string, to US cents per year, for the lengths the registry prices specially |
|
||||
| `basePrice` | number | US cents per year for every other length |
|
||||
| `minLabelLength` | number | characters; the registry refuses shorter labels |
|
||||
|
||||
A reason word is `internal`, `trademark`, `community`, or a word a later version
|
||||
reserves under, at most 32 printable ASCII characters. A router truncates an
|
||||
unknown word to that and otherwise passes it through unchanged. A client MUST
|
||||
read a word it does not know as unknown and still treat the name as reserved.
|
||||
|
||||
**Computing the price.** In US cents, for a duration in seconds:
|
||||
|
||||
```
|
||||
price len duration = tier len * duration / 31536000
|
||||
tier len = the entry for len in registrationPrices, or basePrice when there is none
|
||||
```
|
||||
|
||||
The registry's minimum registration is 730 days, a contract constant, so it is
|
||||
specified here rather than sent. `registrationPrices` omits any length below
|
||||
`minLabelLength`. A client MUST NOT show a quote for a label the registry
|
||||
refuses: a hashed query carries no length, so only the client can check it.
|
||||
|
||||
Below v22, `RNAME` carries the bare record and nothing else, and every answer
|
||||
without one is `ERR NAME NOT_FOUND`. A v22 client reads such an answer as
|
||||
`registered` with no expiry, grace or reservation.
|
||||
|
||||
From v22 a client MUST NOT read `ERR NAME NOT_FOUND` as "registrable": only
|
||||
`available` says that.
|
||||
|
||||
A router that cannot state an answer completely MUST send `ERR NAME RESOLVER
|
||||
<detail>` rather than answer partially or guess. That covers a TLD with no
|
||||
registrar or price oracle, an unreachable chain, a timeout, a registration it
|
||||
could not date or resolve, and any status word it does not recognise.
|
||||
|
||||
`nameRecord` MUST be a UTF-8 JSON object with the following schema:
|
||||
`json-bytes` MUST be a UTF-8 JSON object with the following schema:
|
||||
|
||||
| Field | JSON type | Constraints |
|
||||
|---|---|---|
|
||||
@@ -1614,16 +1514,34 @@ could not date or resolve, and any status word it does not recognise.
|
||||
| `owner` | string | `"0x"` followed by 40 lowercase hex characters (20 raw bytes) |
|
||||
| `resolver` | string | `"0x"` followed by 40 lowercase hex characters; the resolver contract address that produced the record |
|
||||
|
||||
Testnet-vs-mainnet status is derived from the queried TLD, not from the record.
|
||||
Text fields (`nickname`, `website`, `location`) use the empty string `""` as
|
||||
the "unset" sentinel: a backing resolver with no value for the field MUST emit
|
||||
an empty string, not JSON `null` and not an absent key. Link fields
|
||||
(`simplexContact`, `simplexChannel`) are arrays, primary link first, and use the
|
||||
empty array `[]` when unset. Coin fields (`eth`, `btc`, `xmr`, `dot`) use JSON
|
||||
`null` as the "unset" sentinel and MAY also be absent from the object entirely.
|
||||
|
||||
Receivers MUST tolerate extra unknown fields; adding a required field is a
|
||||
breaking change requiring an SMP version bump. Receivers parse by key name, so
|
||||
peers MUST NOT rely on a byte-canonical form.
|
||||
The backing resolver filters records that are expired or otherwise unavailable
|
||||
(the names router then returns `ERR NAME NOT_FOUND` to the client), so the wire
|
||||
format carries no expiry field. Testnet-vs-mainnet status is derived from the
|
||||
queried TLD rather than an in-record flag.
|
||||
|
||||
The names router caps the resolver response it will accept
|
||||
(`resolver_max_response_bytes`, at most 16000 bytes) so the re-encoded `RNAME`
|
||||
stays within the SMP proxied transmission budget of 16224 bytes; a response over
|
||||
the cap is `ERR NAME RESOLVER`.
|
||||
Receivers MUST tolerate extra unknown fields (forward-compatibility for future
|
||||
field additions). Adding a required field is a breaking change requiring an
|
||||
SMP version bump.
|
||||
|
||||
**Field order is not significant.** Receivers parse JSON by key name, so object
|
||||
key order, insignificant whitespace, and number formatting carry no meaning;
|
||||
records are interpreted by decoded value, never compared byte-for-byte. Peers
|
||||
MUST NOT rely on a byte-canonical form — a different resolver or server may emit
|
||||
the same record with different key order or spacing. This order-independence is
|
||||
what makes the format forward-compatible (see the unknown-field rule above).
|
||||
|
||||
**Wire-size budget.** The names router caps the resolver response it will
|
||||
accept (`resolver_max_response_bytes`, ≤ 16000 bytes, the default) so the
|
||||
re-encoded `RNAME` stays within the SMP proxied transmission budget of 16224
|
||||
bytes; a response over the cap is rejected as `ERR NAME RESOLVER`. The link
|
||||
arrays are bounded by this overall budget rather than a fixed per-field count.
|
||||
|
||||
## Transport connection with the SMP router
|
||||
|
||||
|
||||
+3
-18
@@ -121,15 +121,9 @@ During TLS handshake, parties validate certificate chains against previously kno
|
||||
|
||||
### Session verification and protocol negotiation
|
||||
|
||||
Once TLS session is established, both the host and controller devices present a "session security code" to the user. The session security code must be a digest of tlsunique channel binding. As it is computed as a digest of the TLS handshake for both the controller and the host, it will validate that the same TLS certificates are used on both sides, and that the same TLS session is established, mitigating the possibility of MITM attack in the connection.
|
||||
Once TLS session is established, both the host and controller devices present a "session security code" to the user who must match them (e.g., visually or via QR code scan) and confirm on the host device. The session security code must be a digest of tlsunique channel binding. As it is computed as a digest of the TLS handshake for both the controller and the host, it will validate that the same TLS certificates are used on both sides, and that the same TLS session is established, mitigating the possibility of MITM attack in the connection.
|
||||
|
||||
To verify the session, the user matches the codes (e.g., visually or via QR code scan) and confirms the session on the host device.
|
||||
|
||||
The user MUST verify the first session with a new controller. The host stores the long-term identity of the controller (CA fingerprint and Ed25519 public key) only after this session is verified. A controller with the stored long-term identity is a known controller.
|
||||
|
||||
The user MAY verify the subsequent sessions with a known controller. In a session that the host confirms without user action, the controller is authenticated only by its long-term identity stored in the first session (see [Threat model](#threat-model)). SimpleX Chat mobile apps require user verification of sessions with known controllers only when the user enables the "Verify connections" option.
|
||||
|
||||
Once the session is confirmed, the host sends HELLO block to the controller.
|
||||
Once the session is confirmed by the user, the host sends HELLO block to the controller.
|
||||
|
||||
XRCP blocks inside TLS are padded to 16384 bytes.
|
||||
|
||||
@@ -311,7 +305,7 @@ to receive: (rcvKey', sk, nonce) = HKDF(rcvKey, "SimpleXSbChain", 88)
|
||||
- prevent host and controller devices from establishing the session
|
||||
|
||||
*cannot:*
|
||||
- same as passive adversary, provided that user visually verified session code out-of-band in the first session with the controller.
|
||||
- same as passive adversary, provided that user visually verified session code out-of-band.
|
||||
|
||||
#### An active adversary with the access to the network:
|
||||
|
||||
@@ -330,15 +324,6 @@ to receive: (rcvKey', sk, nonce) = HKDF(rcvKey, "SimpleXSbChain", 88)
|
||||
*cannot:*
|
||||
- connect to the host or make host connect to itself.
|
||||
|
||||
#### An active adversary with the access to the network who also obtained the long-term private keys of a known controller (e.g., from the controller device):
|
||||
|
||||
*can:*
|
||||
- make host connect to itself instead of the controller.
|
||||
- access any data of the controlled host application, within the capabilities of the provided API, if the host confirms the session without user action.
|
||||
|
||||
*cannot:*
|
||||
- access host application data, provided that user visually verified session code out-of-band.
|
||||
|
||||
#### Compromised controller device:
|
||||
|
||||
*can:*
|
||||
|
||||
+13
-243
@@ -62,26 +62,15 @@ curl -s -X POST http://127.0.0.1:8545 \
|
||||
**2. resolver is healthy:**
|
||||
```sh
|
||||
curl -s http://127.0.0.1:8000/health | jq
|
||||
# → {"ok": true, "rpc": "http://reth:8545", "registries": {"testing": "0x…", "simplex": ""},
|
||||
# "blockNumber": 23400000, "chainLagSeconds": 12}
|
||||
# → {"ok": true, "rpc": "http://reth:8545", "registries": {"testing": "0x…", "simplex": ""}}
|
||||
```
|
||||
|
||||
`chainLagSeconds` is how far the node is behind the wall clock. A resolver that
|
||||
is reachable and answering can still be hours behind, and every name it reports
|
||||
is that stale. `null` means the node could not be reached.
|
||||
|
||||
**3. resolver resolves a live name** (`foobar.testing` is a populated test name):
|
||||
```sh
|
||||
curl -s http://127.0.0.1:8000/resolve/foobar.testing | jq
|
||||
# → {"name":"foobar.testing","nickname":"Foo","simplexContact":["https://smp16.simplex.im/a#…"], … }
|
||||
```
|
||||
|
||||
**4. the route your router will call** (check 3 passes on an older resolver too):
|
||||
```sh
|
||||
curl -s http://127.0.0.1:8000/v2/resolve/foobar.testing | jq
|
||||
# → {"type":"registered","expires":1780000000,"graceUntil":…,"nameRecord":{…}}
|
||||
```
|
||||
|
||||
**Wire your smp-server:** in its `[NAMES]` section set
|
||||
`resolver_endpoint: http://127.0.0.1:8000` (no auth needed for loopback).
|
||||
|
||||
@@ -93,7 +82,7 @@ curl -s http://127.0.0.1:8000/v2/resolve/foobar.testing | jq
|
||||
| reth p2p | `:30303` tcp/udp | Ethereum sync (open on firewall) |
|
||||
| nimbus p2p | `:9000` tcp/udp | beacon sync (open on firewall) |
|
||||
| nimbus REST | `127.0.0.1:5052` | beacon API |
|
||||
| **resolver** | `127.0.0.1:8000` | SNRC REST (`/v2/resolve`, `/resolve`, `/health`) |
|
||||
| **resolver** | `127.0.0.1:8000` | SNRC REST (`/resolve`, `/health`) |
|
||||
|
||||
## Caveats
|
||||
|
||||
@@ -121,57 +110,7 @@ standalone for local dev (no Docker), via [`uv`](https://docs.astral.sh/uv/):
|
||||
uv run scripts/resolver/service/snrc-resolve.py # defaults to local reth + mainnet .testing
|
||||
```
|
||||
|
||||
Three routes, versioned separately from the protocol so each only changes when
|
||||
its own shape does:
|
||||
|
||||
| Route | Called by | Answers |
|
||||
|---|---|---|
|
||||
| `/v2/resolve/<query>` | routers from SMP v22 | a `NameRegistration` |
|
||||
| `/resolve/<name>` | routers before SMP v22 | a name record, flat |
|
||||
| `/health` | anyone | readiness |
|
||||
|
||||
`/v1/resolve/<name>` is an alias for `/resolve/<name>`.
|
||||
|
||||
### v2: `/v2/resolve/<query>`
|
||||
|
||||
The body is the SMP protocol's `NameResponse`, which the router decodes as is
|
||||
and forwards; translating the registry's model to it is this resolver's job. It
|
||||
is the registration below, plus `lastBlockTs`, the timestamp of the block it was read
|
||||
at: a node that lags answers with names it has not seen registered yet.
|
||||
Its `type` is `registered`, `available` or `reserved`, and the fields each one
|
||||
carries are specified once, in the **Name response** section of
|
||||
[`protocol/simplex-messaging.md`](../../protocol/simplex-messaging.md). It is
|
||||
the wire format, so it is documented with the wire.
|
||||
|
||||
Two things follow from that and are worth stating here. Expiry and grace belong
|
||||
to the registration, not to the record: `expires` and `graceUntil` sit beside
|
||||
`nameRecord`, not inside it. And a name nobody holds is not an error: it
|
||||
answers 200 with `type: available` and its price, so no status code from this
|
||||
route means "not registered".
|
||||
|
||||
| Status | Meaning |
|
||||
|---|---|
|
||||
| 200 | a registration: `registered`, `available` or `reserved` |
|
||||
| 400 | `tldNotConfigured`, `notFullyQualified` |
|
||||
| 502 | `noPriceOracle`, `labelNotRecorded`, an unreadable status, or `upstreamError` |
|
||||
|
||||
Error bodies carry `name` and a fixed `error` code to branch on. Only
|
||||
`upstreamError` adds a `message`; the v1 route always adds one.
|
||||
|
||||
`labelNotRecorded` means the registrar holds the name but never recorded its
|
||||
label, so a hashed query cannot be answered with a name. See
|
||||
[Querying by labelhash](#querying-by-labelhash).
|
||||
|
||||
A subname reports the expiry and grace of the 2LD above it, since that is what
|
||||
bounds its lifetime. A subname nobody created reports as not registered.
|
||||
|
||||
### v1: `/resolve/<name>`
|
||||
|
||||
What routers before SMP v22 call. Its shape is unrelated to v2's: the record is
|
||||
flat, and `status`, `expires`, `graceEnds`, `reasonCode` and `reason` sit
|
||||
alongside its fields.
|
||||
|
||||
#### v1 response shape
|
||||
### Response shape
|
||||
|
||||
```jsonc
|
||||
{
|
||||
@@ -180,197 +119,28 @@ alongside its fields.
|
||||
"simplexContact": ["https://smp16.simplex.im/a#…", "https://smp11…"], // primary first, fallbacks after
|
||||
"simplexChannel": [],
|
||||
"eth": null, "btc": "bc1q…", "xmr": "4ANz…", "dot": "139G…",
|
||||
"owner": "0xd83b…", "resolver": "0x80fa…",
|
||||
"status": "registered", // registered | grace | expired | unregistered | unknown
|
||||
"expires": 1780000000, // Unix seconds; when the registration ends
|
||||
"graceEnds": 1787776000, // expires + GRACE_PERIOD; last moment the owner can renew
|
||||
"reasonCode": null, // set when the name is held back as well
|
||||
"reason": null // set when the name is held back as well
|
||||
"owner": "0xd83b…", "resolver": "0x80fa…"
|
||||
}
|
||||
```
|
||||
|
||||
`simplexContact`/`simplexChannel` are arrays (a name can advertise multiple SMP
|
||||
servers; clients try them in order). On-chain they're a single `;`-separated
|
||||
servers; clients try them in order). On-chain they're a single comma-separated
|
||||
text record; the resolver splits/trims/drops-empties. Address encodings are
|
||||
canonical per chain (EIP-55 / bech32 / SS58 / Monero-base58). Subnames work
|
||||
identically (`bar.foobar.testing`).
|
||||
|
||||
#### v1 registration status and expiry
|
||||
|
||||
A response carries `status`, `expires` and `graceEnds` whenever the resolver
|
||||
read them, a successful resolve included, so a client that has just resolved a
|
||||
name already knows when it expires. Both timestamps are Unix seconds, and
|
||||
`null` when they could not be read.
|
||||
|
||||
| `status` | Meaning |
|
||||
|---|---|
|
||||
| `registered` | live; `expires` is when that ends |
|
||||
| `grace` | lapsed, but only the previous owner may renew it, until `graceEnds` |
|
||||
| `expired` | lapsed and past grace; anyone may register it |
|
||||
| `unregistered` | never registered, and free to take |
|
||||
| `unknown` | no `SNRC_REGISTRAR_<TLD>` configured, so status could not be read |
|
||||
|
||||
A reservation is orthogonal to the status: a name held back by the registry
|
||||
carries `reasonCode` and `reason` whether or not it is registered.
|
||||
|
||||
`grace` and `expired` are told apart by the registrar's own `available(id)`
|
||||
rule, `expires + GRACE_PERIOD < now`. `GRACE_PERIOD` is read from the contract
|
||||
rather than assumed, and `now` is the latest block's timestamp rather than the
|
||||
host clock, which the registrar compares against too, so a machine with a wrong
|
||||
clock cannot misreport a registration. That rule alone is not enough: it also
|
||||
holds for a name nobody ever registered (`0 + GRACE_PERIOD < now`), so a zero
|
||||
expiry is what separates *never registered* from *registered and since
|
||||
released*.
|
||||
|
||||
A subname reports the status of the 2LD above it, which is only as good as the
|
||||
name it sits under. A subname nobody created answers 404 `unregistered`.
|
||||
|
||||
#### v1 errors
|
||||
|
||||
Every non-2xx body carries two fields: `error` is a fixed code to branch on,
|
||||
and `message` is a sentence for a human. Match on `error`, never on `message`,
|
||||
which is free to change.
|
||||
|
||||
```jsonc
|
||||
{"name": "nope.testing", "error": "unregistered",
|
||||
"message": "this name has never been registered",
|
||||
"status": "unregistered", "expires": null, "graceEnds": null}
|
||||
```
|
||||
|
||||
The codes are `tldNotConfigured`, `notFullyQualified`, `unregistered`,
|
||||
`expired`, `noSuchRoute` and `upstreamError`. When the registration is what went
|
||||
wrong, `error` and `status` hold the same value, so one field is enough to read.
|
||||
|
||||
`upstreamError` says only which exception type the RPC call raised. The text
|
||||
goes to the resolver's log instead, because `SNRC_RPC` can carry a provider key
|
||||
and urlopen puts the URL it failed on into the message. It is also the answer
|
||||
when a registrar, controller or oracle address has no contract behind it: the
|
||||
empty reply is refused rather than read as zero, which would make every name
|
||||
look free.
|
||||
|
||||
#### v1 status codes
|
||||
### Status codes
|
||||
|
||||
| Status | Meaning |
|
||||
|---|---|
|
||||
| 200 | resolved (`status` is `registered` or `grace`, or `unknown` when no registrar is configured) |
|
||||
| 200 | resolved |
|
||||
| 400 | TLD not configured, or not a fully-qualified name |
|
||||
| 404 | `unregistered` |
|
||||
| 410 | `expired`: lapsed and past grace, so anyone may take it |
|
||||
| 404 | name has no resolver set on the registry |
|
||||
| 502 | upstream RPC error / reth not synced |
|
||||
|
||||
### Querying by labelhash
|
||||
### Configuring registries
|
||||
|
||||
A client asking whether a name is free is usually about to register it, and
|
||||
whoever runs the resolver could register it first. To avoid that, send the
|
||||
keccak hash of the label in ENS's `[<64 hex>]` form instead of the label:
|
||||
|
||||
```sh
|
||||
# instead of /resolve/acme.testing
|
||||
curl -s "http://127.0.0.1:8000/resolve/[$(printf acme | keccak-256sum | cut -d' ' -f1)].testing"
|
||||
```
|
||||
|
||||
namehash is `keccak(parent || keccak(label))`, so this reaches the same node and
|
||||
returns the same record. The registrar keys `nameExpires` and `reservedNames` on
|
||||
the labelhash too, so the status fields do not need the label either. The
|
||||
resolver learns the name only by guessing the label and hashing it.
|
||||
|
||||
Only the second-level label is a registry key, and `status` decodes a bracket
|
||||
there at any depth. The record does not: a bracket is decoded only in a
|
||||
two-label name, so `sub.[<hash>].testing` is not a supported query. Subname
|
||||
labels stay text; a bracket label left of the 2LD is an ordinary label. Routers
|
||||
from v22 send every 2LD this way, so a registrable name normally never reaches
|
||||
this service.
|
||||
|
||||
On v2, read `type`: only `available` means the name is free. On v1, read
|
||||
`status`: a name is free on `unregistered` (404) and on `expired` (410), every
|
||||
other status means somebody holds it, and a `reasonCode` means the registry will
|
||||
refuse it whatever the status says.
|
||||
|
||||
The hash must be keccak-256. `openssl dgst -sha3-256` and `sha3sum` compute
|
||||
SHA3-256, a different function that returns 64 valid-looking hex characters
|
||||
pointing at the wrong node.
|
||||
|
||||
The resolver lowercases the query before matching, so uppercase hex works too.
|
||||
Clients that refuse raw brackets in a path can percent-encode them as `%5B` and
|
||||
`%5D`.
|
||||
|
||||
Brackets cannot collide with a real name: they are invalid in a normalised ENS
|
||||
name, and a `[<64 hex>]` label is 66 bytes against the registrar's
|
||||
`maxLabelLength` of 63. A plain `0x…` label is not treated as a hash, since that
|
||||
is an ordinary, registrable name.
|
||||
|
||||
Only 2LDs can be queried this way, as only a 2LD can be raced for: subnames are
|
||||
created by the 2LD's owner. A bracket label in a subname is hashed as written,
|
||||
so it points at a node nobody can own. ENS tooling accepts the bracketed form at
|
||||
any depth; this resolver does not, on purpose.
|
||||
|
||||
This hides interest in a name and nothing else: the registration itself is
|
||||
public, and commit-reveal covers that step. A short or well-known label is easy
|
||||
to guess by hashing candidates, and the reveal publishes the labelhash, so an
|
||||
operator who logged the query can match it to the name afterwards.
|
||||
|
||||
### What a name costs
|
||||
|
||||
The controller's `prices()` names the price oracle, so no extra configuration is
|
||||
needed beyond `SNRC_CONTROLLER_<TLD>`. A `SimplexPriceOracle` exposes its curve
|
||||
through `prices()`, in US cents per year, which is the unit this API carries.
|
||||
|
||||
An ENS-shaped oracle exposes only `price1Letter()`..`price6Letter()`, in attoUSD
|
||||
per second, and charges a premium on a lapsed name that it does not expose. A
|
||||
quote from one is therefore only safe for a name that was never registered: an
|
||||
`expired` name gets no price rather than one below what the registrar charges.
|
||||
|
||||
**Set `SNRC_CONTROLLER_<TLD>` wherever `SNRC_REGISTRAR_<TLD>` is.** Without a
|
||||
controller there is no oracle, so no name can be priced.
|
||||
|
||||
**Upgrade this service before the routers that query it.** Routers from SMP v22
|
||||
call `/v2/resolve`, which an older resolver does not serve. Every name then
|
||||
answers `ERR NAME RESOLVER "HTTP 404"` until this service is upgraded, while
|
||||
`/health` still reports it as ready.
|
||||
|
||||
### Why a name is reserved
|
||||
|
||||
v2 carries the controller's reason as `reservedReason`. v1 carries the same word
|
||||
as `reasonCode`, plus `reason`, an English sentence for a human reading this API.
|
||||
Clients should branch on the word and phrase it themselves, in the user's
|
||||
language.
|
||||
|
||||
| `reasonCode` | Meaning |
|
||||
|---|---|
|
||||
| `internal` | reserved for SimpleX |
|
||||
| `trademark` | reserved to protect a trademark |
|
||||
| `community` | reserved for the community |
|
||||
| `unknown` | a reason added to the contract after this resolver; still reserved |
|
||||
|
||||
These are `SimplexController.Reason`, where 0 means not reserved. A controller
|
||||
from before the enum stores a boolean, whose `true` decodes as 1, which is why
|
||||
1 reads as `internal`, so nothing needs migrating.
|
||||
|
||||
### Configuring addresses
|
||||
|
||||
The resolver reads three contracts, each configured per TLD.
|
||||
|
||||
The **registry** answers who owns a node, and `/resolve` reads the records from
|
||||
it. The **registrar** (ERC-721) holds `nameExpires` and `GRACE_PERIOD`, which
|
||||
is where every expiry field comes from, and `labelOf`, which is how a hashed
|
||||
query is answered with a name. A name registered without recording its label
|
||||
cannot answer one, and `/v2/resolve` refuses it rather than answer with a name
|
||||
the client will reject. With no registrar for a TLD, `/resolve` still works and
|
||||
reports `"status": "unknown"`. The **controller** holds
|
||||
`reservedNames`, which is where `reasonCode` comes from. With no controller a
|
||||
held-back name reads as not reserved, and no name can be priced.
|
||||
|
||||
All three default to the mainnet `.testing` deployment. `.simplex` is unset
|
||||
until it is deployed.
|
||||
|
||||
The controller default is the **proxy**, not `SimplexControllerImpl`. Storage
|
||||
lives in the proxy, so the implementation address answers nothing. The two
|
||||
deployment files use different names for that proxy:
|
||||
`deployments.mainnet.testing.json` records it under the ENS role name
|
||||
`ETHRegistrarController`, and `verification.mainnet.testing.json` calls it
|
||||
`SimplexControllerProxy`. Both are the same address, and it is the one used
|
||||
here.
|
||||
|
||||
To override any of them, set `SNRC_REGISTRY_<TLD>`, `SNRC_REGISTRAR_<TLD>` or
|
||||
`SNRC_CONTROLLER_<TLD>` on the `resolver` service in `docker-compose.yml`, or
|
||||
as env vars when you run the script directly.
|
||||
Defaults to mainnet `.testing` (`0x03f438…`); `.simplex` is unset until
|
||||
deployed. Override per TLD via env on the `resolver` service in
|
||||
`docker-compose.yml` (`SNRC_REGISTRY_TESTING` / `SNRC_REGISTRY_SIMPLEX`), or as
|
||||
env vars for the standalone script.
|
||||
|
||||
@@ -150,12 +150,6 @@ services:
|
||||
# only if you're deploying against a different network or contract.
|
||||
# SNRC_REGISTRY_TESTING: 0x...
|
||||
# SNRC_REGISTRY_SIMPLEX: 0x...
|
||||
# Registrar and controller, same cascade. Without the registrar `status`
|
||||
# is "unknown"; without the controller a reserved name is "unregistered".
|
||||
# SNRC_REGISTRAR_TESTING: 0x...
|
||||
# SNRC_REGISTRAR_SIMPLEX: 0x...
|
||||
# SNRC_CONTROLLER_TESTING: 0x...
|
||||
# SNRC_CONTROLLER_SIMPLEX: 0x...
|
||||
ports:
|
||||
- "127.0.0.1:8000:8000"
|
||||
restart: unless-stopped
|
||||
|
||||
@@ -29,7 +29,6 @@ Usage:
|
||||
./snrc-resolve.py # serve on :8000
|
||||
|
||||
curl -s http://127.0.0.1:8000/resolve/foobar.testing | jq .
|
||||
curl -s 'http://127.0.0.1:8000/resolve/[<64-hex labelhash>].testing' | jq .
|
||||
curl -s http://127.0.0.1:8000/health
|
||||
|
||||
Environment:
|
||||
@@ -39,11 +38,6 @@ Environment:
|
||||
0x58fc46996d975c57883564648bda5206d1a0102b)
|
||||
SNRC_REGISTRY_SIMPLEX ENSRegistry for the .simplex deployment
|
||||
(default: empty — TLD not yet deployed)
|
||||
SNRC_REGISTRAR_<TLD> BaseRegistrar (ERC-721) for the TLD; expiry and status
|
||||
(default: mainnet for .testing, empty for .simplex)
|
||||
SNRC_CONTROLLER_<TLD> SimplexController (proxy) for the TLD; reservations,
|
||||
and through its `prices()` oracle what registering costs
|
||||
(default: mainnet for .testing, empty for .simplex)
|
||||
SNRC_PORT Listen port (default: 8000)
|
||||
SNRC_BIND Bind address (default: 0.0.0.0)
|
||||
|
||||
@@ -67,7 +61,6 @@ import hashlib
|
||||
import json
|
||||
import os
|
||||
import sys
|
||||
import time
|
||||
from http.server import BaseHTTPRequestHandler, ThreadingHTTPServer
|
||||
from urllib.parse import unquote, urlparse
|
||||
from urllib.request import Request, urlopen
|
||||
@@ -91,31 +84,6 @@ REGISTRIES = {
|
||||
"simplex": os.environ.get("SNRC_REGISTRY_SIMPLEX", ""), # not deployed yet
|
||||
}
|
||||
|
||||
REGISTRARS = {
|
||||
"testing": os.environ.get("SNRC_REGISTRAR_TESTING", "")
|
||||
or "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a", # mainnet .testing
|
||||
"simplex": os.environ.get("SNRC_REGISTRAR_SIMPLEX", ""), # not deployed yet
|
||||
}
|
||||
|
||||
CONTROLLERS = {
|
||||
"testing": os.environ.get("SNRC_CONTROLLER_TESTING", "")
|
||||
# Proxy address, not SimplexControllerImpl: storage is held by the proxy.
|
||||
# Recorded in deployments.json as ETHRegistrarController.
|
||||
or "0xeeb9b6bf5fb68fb726005f7ba549c2f4b32f2dad", # mainnet .testing
|
||||
"simplex": os.environ.get("SNRC_CONTROLLER_SIMPLEX", ""), # not deployed yet
|
||||
}
|
||||
|
||||
# `reservedNames` holds a SimplexController.Reason; 0 means not reserved. A
|
||||
# controller from before the enum stores a bool, whose `true` decodes as 1,
|
||||
# which is why 1 reads as "internal".
|
||||
RESERVED_REASONS = {
|
||||
1: ("internal", "reserved for SimpleX"),
|
||||
2: ("trademark", "reserved to protect a trademark"),
|
||||
3: ("community", "reserved for the community"),
|
||||
}
|
||||
# a Reason added to the contract after this resolver: still reserved, unworded
|
||||
UNKNOWN_REASON = ("unknown", "reserved")
|
||||
|
||||
# SLIP-44 coin types (https://github.com/satoshilabs/slips/blob/master/slip-0044.md)
|
||||
COIN_ETH = 60
|
||||
COIN_BTC = 0
|
||||
@@ -124,8 +92,6 @@ COIN_DOT = 354
|
||||
|
||||
ZERO_ADDR = "0x0000000000000000000000000000000000000000"
|
||||
|
||||
# The registry prices in attoUSD (1e-18 USD); the protocol carries US cents.
|
||||
|
||||
|
||||
# ---------- RPC + ABI helpers (mirrors ens-lookup.py shape) ----------
|
||||
|
||||
@@ -157,216 +123,12 @@ def namehash(name: str) -> bytes:
|
||||
return node
|
||||
|
||||
|
||||
# ENS's encoding for a label whose preimage is unknown. Brackets are outside
|
||||
# the normalised character set, so it cannot collide with a registrable name.
|
||||
ENCODED_LABELHASH_LEN = 66 # "[" + 64 hex + "]"
|
||||
|
||||
|
||||
def is_encoded_labelhash(label: str) -> bool:
|
||||
return (
|
||||
len(label) == ENCODED_LABELHASH_LEN
|
||||
and label.startswith("[")
|
||||
and label.endswith("]")
|
||||
and all(c in "0123456789abcdef" for c in label[1:-1])
|
||||
)
|
||||
|
||||
|
||||
def node_of(name: str) -> bytes:
|
||||
"""namehash, decoding a second-level labelhash so `[hash].tld` reaches the
|
||||
node its name does. Only a second-level name is ever hashed; a bracket
|
||||
anywhere else is hashed as written."""
|
||||
labels = name.split(".")
|
||||
if len(labels) != 2 or not is_encoded_labelhash(labels[0]):
|
||||
return namehash(name)
|
||||
return keccak(namehash(labels[1]) + bytes.fromhex(labels[0][1:-1]))
|
||||
|
||||
|
||||
# ---------- Registration status ----------
|
||||
|
||||
|
||||
def head_block():
|
||||
"""How far behind the node is. Unlike expiry, this is the one thing that has
|
||||
to be measured against the host clock: a node that stops still has a block."""
|
||||
try:
|
||||
block = rpc("eth_getBlockByNumber", ["latest", False])
|
||||
return {
|
||||
"blockNumber": decode_uint(block["number"]),
|
||||
"chainLagSeconds": int(time.time()) - decode_uint(block["timestamp"]),
|
||||
}
|
||||
except Exception:
|
||||
return {"blockNumber": None, "chainLagSeconds": None}
|
||||
|
||||
|
||||
def chain_now() -> int:
|
||||
"""Expiry is compared against the block timestamp, never the host clock."""
|
||||
block = rpc("eth_getBlockByNumber", ["latest", False])
|
||||
return decode_uint(block["timestamp"])
|
||||
|
||||
|
||||
def grace_period(registrar: str) -> int:
|
||||
"""A deployment can configure a different window, so it is read on chain."""
|
||||
return decode_uint(eth_call(registrar, selector("GRACE_PERIOD()")))
|
||||
|
||||
|
||||
def expiry_status(expires: int, grace: int, now: int) -> str:
|
||||
"""The registrar's `available(id)` is not enough on its own: it is also
|
||||
true for a name nobody registered, since 0 + GRACE_PERIOD < now."""
|
||||
if expires == 0:
|
||||
return "unregistered"
|
||||
if expires > now:
|
||||
return "registered"
|
||||
if expires + grace >= now:
|
||||
return "grace"
|
||||
return "expired"
|
||||
|
||||
|
||||
def reservation_reason(tld: str, token: int) -> int:
|
||||
"""The SimplexController.Reason held for the name, 0 when not reserved."""
|
||||
controller = CONTROLLERS.get(tld)
|
||||
if not controller:
|
||||
return 0
|
||||
raw = eth_call(controller, selector("reservedNames(bytes32)") + encode_uint(token))
|
||||
return decode_uint(raw)
|
||||
|
||||
|
||||
def pricing_params(tld: str):
|
||||
"""What it costs to register a name under this TLD, in US cents, or None
|
||||
when no controller or price oracle is configured."""
|
||||
controller = CONTROLLERS.get(tld)
|
||||
if not controller:
|
||||
return None
|
||||
oracle = decode_address(eth_call(controller, selector("prices()")))
|
||||
if oracle == ZERO_ADDR:
|
||||
return None
|
||||
try:
|
||||
return read_oracle_prices(controller, oracle)
|
||||
except RuntimeError:
|
||||
# An oracle that does not expose its curve cannot be quoted from. The
|
||||
# name is still registrable; the price is simply not ours to state.
|
||||
return None
|
||||
|
||||
|
||||
SECONDS_PER_YEAR = 31536000
|
||||
ATTO_PER_CENT = 10**16
|
||||
|
||||
|
||||
def read_oracle_prices(controller: str, oracle: str):
|
||||
"""SimplexPriceOracle keeps the curve in US cents per year, the unit the SMP
|
||||
protocol carries. An ENS-shaped oracle prices in attoUSD per second and
|
||||
charges a premium on lapsed names that it does not expose, so a quote from
|
||||
it is only safe for a name that was never registered."""
|
||||
try:
|
||||
base, tiers = decode_prices(eth_call(oracle, selector("prices()")))
|
||||
premium_unknown = False
|
||||
except RuntimeError:
|
||||
base, tiers = decode_letter_prices(oracle)
|
||||
premium_unknown = True
|
||||
min_len = decode_uint(eth_call(controller, selector("minCharLength()")))
|
||||
return {
|
||||
# lengths the registry refuses are left out rather than priced at zero
|
||||
"registrationPrices": {n: c for n, c in tiers.items() if n >= min_len},
|
||||
"basePrice": base,
|
||||
"minLabelLength": min_len,
|
||||
"_premiumUnknown": premium_unknown,
|
||||
}
|
||||
|
||||
|
||||
def decode_letter_prices(oracle: str):
|
||||
"""`price1Letter()`..`price6Letter()`, in attoUSD per second. Quotes round
|
||||
up, so one is never below what the registry charges. An oracle built before
|
||||
the six-letter tier stops at five, and charges its highest tier for anything
|
||||
longer, which is what basePrice means here."""
|
||||
tiers = {}
|
||||
for n in range(1, 7):
|
||||
try:
|
||||
rate = decode_uint(eth_call(oracle, selector(f"price{n}Letter()")))
|
||||
except RuntimeError:
|
||||
if n <= 5:
|
||||
raise
|
||||
break
|
||||
tiers[n] = ceil_div(rate * SECONDS_PER_YEAR, ATTO_PER_CENT)
|
||||
return tiers.pop(max(tiers)), tiers
|
||||
|
||||
|
||||
def ceil_div(a: int, b: int) -> int:
|
||||
return -(-a // b)
|
||||
|
||||
|
||||
def decode_prices(hex_data: str):
|
||||
"""`prices()` returns the base price and the lengths priced differently."""
|
||||
raw = bytes.fromhex(hex_data[2:] if hex_data.startswith("0x") else hex_data)
|
||||
# a short answer is not a curve: decoding it would quote every name as free
|
||||
if len(raw) < 96:
|
||||
raise RuntimeError("prices(): short response")
|
||||
base = int.from_bytes(raw[:32], "big")
|
||||
at = int.from_bytes(raw[32:64], "big")
|
||||
count = int.from_bytes(raw[at:at + 32], "big")
|
||||
tiers = {}
|
||||
for i in range(count):
|
||||
item = at + 32 + i * 64
|
||||
length = int.from_bytes(raw[item:item + 32], "big")
|
||||
tiers[length] = int.from_bytes(raw[item + 32:item + 64], "big")
|
||||
return base, tiers
|
||||
|
||||
|
||||
def name_status(name: str):
|
||||
labels = name.split(".")
|
||||
tld = labels[-1]
|
||||
registrar = REGISTRARS.get(tld)
|
||||
if not registrar or len(labels) < 2:
|
||||
return {
|
||||
"status": "unknown",
|
||||
# nothing was read, so there is no block to report
|
||||
"lastBlockTs": None,
|
||||
"expires": None,
|
||||
"graceEnds": None,
|
||||
"reasonCode": None,
|
||||
"reason": None,
|
||||
}
|
||||
|
||||
# nameExpires and reservedNames are keyed on uint256(keccak(label)).
|
||||
# The 2LD's label is that key at any depth. node_of decodes a bracket only
|
||||
# in a two-label name, so a bracket subname gets a status but no record.
|
||||
token = label_token(labels[-2])
|
||||
expires = decode_uint(
|
||||
eth_call(registrar, selector("nameExpires(uint256)") + encode_uint(token))
|
||||
)
|
||||
grace = grace_period(registrar) if expires else 0
|
||||
now = chain_now()
|
||||
status = expiry_status(expires, grace, now)
|
||||
|
||||
# A reservation is orthogonal to the registration: a registered name can be
|
||||
# held back too.
|
||||
code = reservation_reason(tld, token)
|
||||
reason = RESERVED_REASONS.get(code, UNKNOWN_REASON) if code else None
|
||||
|
||||
out = {
|
||||
"status": status,
|
||||
# the block this was read at
|
||||
"lastBlockTs": now,
|
||||
"expires": expires or None,
|
||||
"graceEnds": (expires + grace) if expires else None,
|
||||
"reasonCode": reason[0] if reason else None,
|
||||
"reason": reason[1] if reason else None,
|
||||
}
|
||||
if status in ("unregistered", "expired"):
|
||||
pricing = pricing_params(tld)
|
||||
# a lapsed name may carry a premium this resolver cannot read, and a
|
||||
# quote without it would be below what the registry charges
|
||||
if pricing and not (status == "expired" and pricing["_premiumUnknown"]):
|
||||
out.update({k: v for k, v in pricing.items() if not k.startswith("_")})
|
||||
return out
|
||||
|
||||
|
||||
def selector(signature: str) -> str:
|
||||
return "0x" + keccak(signature.encode())[:4].hex()
|
||||
|
||||
|
||||
def eth_call(to: str, data: str) -> str:
|
||||
result = rpc("eth_call", [{"to": to, "data": data}, "latest"])
|
||||
if result == "0x":
|
||||
raise RuntimeError(f"empty return from {to}: no contract at that address?")
|
||||
return result
|
||||
return rpc("eth_call", [{"to": to, "data": data}, "latest"])
|
||||
|
||||
|
||||
def decode_address(hex_data: str) -> str:
|
||||
@@ -381,42 +143,6 @@ def decode_bytes(hex_data: str) -> bytes:
|
||||
return raw[64:64 + length]
|
||||
|
||||
|
||||
def registered_label(registrar: str, token: int):
|
||||
"""The plaintext label the registrar recorded at registration, keyed by the
|
||||
hash of that label. None when the name was registered without
|
||||
registerWithLabel, so the registrar cannot name it."""
|
||||
raw = decode_bytes(eth_call(registrar, selector("labelOf(uint256)") + encode_uint(token)))
|
||||
return raw.decode("utf-8", errors="replace") if raw else None
|
||||
|
||||
|
||||
def canonical_name(name: str):
|
||||
"""The name to answer with: a hashed query does not carry one, so the
|
||||
registrar's record of the label fills it in. None when it recorded none."""
|
||||
labels = name.split(".")
|
||||
registrar = REGISTRARS.get(labels[-1])
|
||||
if not registrar or len(labels) != 2 or not is_encoded_labelhash(labels[0]):
|
||||
return name
|
||||
label = registered_label(registrar, label_token(labels[0]))
|
||||
return label + "." + labels[1] if label else None
|
||||
|
||||
|
||||
def label_token(label: str) -> int:
|
||||
"""The registry key for a second-level label, whether it arrived as text or
|
||||
already hashed."""
|
||||
if is_encoded_labelhash(label):
|
||||
return int(label[1:-1], 16)
|
||||
return int.from_bytes(keccak(label.encode()), "big")
|
||||
|
||||
|
||||
def decode_uint(hex_data: str) -> int:
|
||||
raw = hex_data[2:] if hex_data.startswith("0x") else hex_data
|
||||
return int(raw[-64:], 16) if raw else 0
|
||||
|
||||
|
||||
def encode_uint(value: int) -> str:
|
||||
return value.to_bytes(32, "big").hex()
|
||||
|
||||
|
||||
def encode_text_call(node: bytes, key: str) -> str:
|
||||
sel = selector("text(bytes32,string)")
|
||||
head = node.hex() + (0x40).to_bytes(32, "big").hex()
|
||||
@@ -664,117 +390,6 @@ def split_links(value: str) -> list:
|
||||
return [item.strip() for item in value.split(LINK_SEPARATOR) if item.strip()]
|
||||
|
||||
|
||||
def upstream_error(subject: dict, e: Exception) -> dict:
|
||||
"""urlopen puts the failing URL into its message and SNRC_RPC can carry a
|
||||
provider key, so the text goes to the log and only the type to the caller."""
|
||||
print(f"upstream error: {type(e).__name__}: {e}", file=sys.stderr)
|
||||
return {
|
||||
**subject,
|
||||
"error": "upstreamError",
|
||||
"message": f"upstream RPC failed ({type(e).__name__})",
|
||||
}
|
||||
|
||||
|
||||
def name_record(name: str):
|
||||
"""The NameRecord for a registered name. A name with no resolver set still
|
||||
has one, with every field unset."""
|
||||
registry = REGISTRIES[name.rsplit(".", 1)[-1]]
|
||||
node = node_of(name)
|
||||
node_hex = node.hex()
|
||||
resolver_addr = decode_address(eth_call(registry, selector("resolver(bytes32)") + node_hex))
|
||||
owner = decode_address(eth_call(registry, selector("owner(bytes32)") + node_hex))
|
||||
rec = {
|
||||
"name": canonical_name(name),
|
||||
"nickname": "",
|
||||
"website": "",
|
||||
"location": "",
|
||||
"simplexContact": [],
|
||||
"simplexChannel": [],
|
||||
"eth": None,
|
||||
"btc": None,
|
||||
"xmr": None,
|
||||
"dot": None,
|
||||
"owner": owner,
|
||||
"resolver": resolver_addr,
|
||||
}
|
||||
if resolver_addr == ZERO_ADDR:
|
||||
return rec
|
||||
texts = {}
|
||||
for k in TEXT_KEYS:
|
||||
try:
|
||||
v = text(resolver_addr, node, k)
|
||||
except RuntimeError:
|
||||
v = ""
|
||||
if v:
|
||||
texts[k] = v
|
||||
rec.update(
|
||||
{
|
||||
"nickname": texts.get("nickname") or texts.get("name") or texts.get("description") or "",
|
||||
"website": texts.get("url", ""),
|
||||
"location": texts.get("location", ""),
|
||||
"simplexContact": split_links(texts.get("simplex.contact", "")),
|
||||
"simplexChannel": split_links(texts.get("simplex.channel", "")),
|
||||
"eth": addr_multicoin(resolver_addr, node, COIN_ETH),
|
||||
"btc": addr_multicoin(resolver_addr, node, COIN_BTC),
|
||||
"xmr": addr_multicoin(resolver_addr, node, COIN_XMR),
|
||||
"dot": addr_multicoin(resolver_addr, node, COIN_DOT),
|
||||
}
|
||||
)
|
||||
return rec
|
||||
|
||||
|
||||
def name_response(reg, registration_body):
|
||||
"""The SMP protocol's NameResponse: the registration and the block read at."""
|
||||
return 200, {"lastBlockTs": reg["lastBlockTs"], "registration": registration_body}
|
||||
|
||||
|
||||
def registration(name: str):
|
||||
"""The SMP protocol's NameRegistration, which the relay decodes as is.
|
||||
Translating the contract's model to it is this resolver's job."""
|
||||
tld = name.rsplit(".", 1)[-1]
|
||||
if not REGISTRIES.get(tld):
|
||||
return 400, {"name": name, "error": "tldNotConfigured"}
|
||||
reg = name_status(name)
|
||||
status = reg["status"]
|
||||
if status in ("registered", "grace"):
|
||||
rec = name_record(name)
|
||||
# the client checks that the record names what it asked about, so a
|
||||
# hashed query the registrar cannot name is refused rather than answered
|
||||
if rec["name"] is None:
|
||||
return 502, {"name": name, "error": "labelNotRecorded"}
|
||||
# a subname inherits the 2LD's status, so only its node's owner says
|
||||
# whether anyone created it
|
||||
if len(name.split(".")) > 2 and rec["owner"] == ZERO_ADDR:
|
||||
# name_status reads pricing only when the name was already
|
||||
# unregistered, so read it here
|
||||
status = "unregistered"
|
||||
pricing = pricing_params(tld)
|
||||
if pricing:
|
||||
reg.update({k: v for k, v in pricing.items() if not k.startswith("_")})
|
||||
else:
|
||||
return name_response(reg, {
|
||||
"type": "registered",
|
||||
"expires": reg["expires"],
|
||||
"graceUntil": reg["graceEnds"],
|
||||
"reservedReason_": reg["reasonCode"],
|
||||
"nameRecord": rec,
|
||||
})
|
||||
if reg["reasonCode"]:
|
||||
return name_response(reg, {"type": "reserved", "reservedReason": reg["reasonCode"]})
|
||||
if status in ("unregistered", "expired"):
|
||||
if "basePrice" not in reg:
|
||||
return 502, {"name": name, "error": "noPriceOracle"}
|
||||
return name_response(reg, {
|
||||
"type": "available",
|
||||
"pricing": {
|
||||
"registrationPrices": reg["registrationPrices"],
|
||||
"basePrice": reg["basePrice"],
|
||||
"minLabelLength": reg["minLabelLength"],
|
||||
},
|
||||
})
|
||||
return 502, {"name": name, "error": status}
|
||||
|
||||
|
||||
def resolve(name: str):
|
||||
tld = name.rsplit(".", 1)[-1]
|
||||
registry = REGISTRIES.get(tld)
|
||||
@@ -782,60 +397,17 @@ def resolve(name: str):
|
||||
configured = [k for k, v in REGISTRIES.items() if v]
|
||||
return 400, {
|
||||
"name": name,
|
||||
"error": "tldNotConfigured",
|
||||
"message": f"TLD '{tld}' is not configured on this resolver",
|
||||
"configuredTlds": configured,
|
||||
"error": f"TLD '{tld}' is not configured on this resolver",
|
||||
"configured_tlds": configured,
|
||||
}
|
||||
|
||||
node = node_of(name)
|
||||
node = namehash(name)
|
||||
node_hex = node.hex()
|
||||
|
||||
# Before the resolver lookup, so a lapsed name is not reported as noResolver.
|
||||
reg = name_status(name)
|
||||
if reg["status"] in ("unregistered", "expired"):
|
||||
# A name in grace is not here: its record still resolves.
|
||||
body = {
|
||||
"name": name,
|
||||
**reg,
|
||||
"error": reg["status"],
|
||||
"message": (
|
||||
"this name has never been registered"
|
||||
if reg["status"] == "unregistered"
|
||||
else "this registration expired and is open to anyone"
|
||||
),
|
||||
}
|
||||
return (404 if reg["status"] == "unregistered" else 410), body
|
||||
|
||||
resolver_raw = eth_call(registry, selector("resolver(bytes32)") + node_hex)
|
||||
resolver_addr = decode_address(resolver_raw)
|
||||
if resolver_addr == ZERO_ADDR:
|
||||
# A registered name always resolves: with no resolver set the record is
|
||||
# still returned with every field unset, so "taken until <date>" stays
|
||||
# answerable. For a subname, no owner means nobody created it.
|
||||
owner = decode_address(eth_call(registry, selector("owner(bytes32)") + node_hex))
|
||||
if len(name.split(".")) > 2 and owner == ZERO_ADDR:
|
||||
return 404, {
|
||||
"name": name,
|
||||
**reg,
|
||||
"status": "unregistered",
|
||||
"error": "unregistered",
|
||||
"message": "this subname has never been created",
|
||||
}
|
||||
return 200, {
|
||||
"name": canonical_name(name) or name,
|
||||
"nickname": "",
|
||||
"website": "",
|
||||
"location": "",
|
||||
"simplexContact": [],
|
||||
"simplexChannel": [],
|
||||
"eth": None,
|
||||
"btc": None,
|
||||
"xmr": None,
|
||||
"dot": None,
|
||||
"owner": owner,
|
||||
"resolver": ZERO_ADDR,
|
||||
**reg,
|
||||
}
|
||||
return 404, {"name": name, "error": "no resolver set for this name"}
|
||||
|
||||
owner_raw = eth_call(registry, selector("owner(bytes32)") + node_hex)
|
||||
owner = decode_address(owner_raw)
|
||||
@@ -859,7 +431,7 @@ def resolve(name: str):
|
||||
# use the ENSIP-5 dot convention (e.g. "simplex.contact") — only the
|
||||
# resolver's JSON surface camelCases them.
|
||||
return 200, {
|
||||
"name": canonical_name(name) or name,
|
||||
"name": name,
|
||||
"nickname": nickname,
|
||||
"website": texts.get("url", ""),
|
||||
"location": texts.get("location", ""),
|
||||
@@ -871,7 +443,6 @@ def resolve(name: str):
|
||||
"dot": addr_multicoin(resolver_addr, node, COIN_DOT),
|
||||
"owner": owner,
|
||||
"resolver": resolver_addr,
|
||||
**reg,
|
||||
}
|
||||
|
||||
|
||||
@@ -883,51 +454,33 @@ class Handler(BaseHTTPRequestHandler):
|
||||
parts = [unquote(p) for p in path.split("/") if p]
|
||||
|
||||
if parts == ["health"]:
|
||||
self._respond(200, {"ok": True, "rpc": RPC, "registries": REGISTRIES, **head_block()})
|
||||
self._respond(
|
||||
200,
|
||||
{"ok": True, "rpc": RPC, "registries": REGISTRIES},
|
||||
)
|
||||
return
|
||||
|
||||
if len(parts) == 3 and parts[0] == "v2" and parts[1] == "resolve":
|
||||
name = parts[2].strip().lower()
|
||||
if not name or "." not in name:
|
||||
self._respond(400, {"name": name, "error": "notFullyQualified"})
|
||||
return
|
||||
try:
|
||||
status, body = registration(name)
|
||||
except Exception as e: # surface upstream errors as 502
|
||||
status, body = 502, upstream_error({"name": name}, e)
|
||||
self._respond(status, body)
|
||||
return
|
||||
|
||||
# /v1/resolve is an alias: relays before SMP v22 call /resolve
|
||||
if parts[:2] == ["v1", "resolve"] and len(parts) == 3:
|
||||
parts = ["resolve", parts[2]]
|
||||
|
||||
if len(parts) == 2 and parts[0] == "resolve":
|
||||
name = parts[1].strip().lower()
|
||||
if not name or "." not in name:
|
||||
self._respond(
|
||||
400,
|
||||
{
|
||||
"name": name,
|
||||
"error": "notFullyQualified",
|
||||
"message": "expected a fully-qualified name, e.g. alice.testing",
|
||||
"error": "expected fully-qualified name, e.g. /resolve/alice.testing",
|
||||
"got": name,
|
||||
},
|
||||
)
|
||||
return
|
||||
try:
|
||||
status, body = resolve(name)
|
||||
except Exception as e: # surface upstream errors as 502
|
||||
status, body = 502, upstream_error({"name": name}, e)
|
||||
status, body = 502, {"name": name, "error": f"{type(e).__name__}: {e}"}
|
||||
self._respond(status, body)
|
||||
return
|
||||
|
||||
self._respond(
|
||||
404,
|
||||
{
|
||||
"error": "noSuchRoute",
|
||||
"message": "not found",
|
||||
"routes": ["/health", "/v2/resolve/<query>", "/v1/resolve/<name>", "/resolve/<name>"],
|
||||
},
|
||||
{"error": "not found", "routes": ["/health", "/resolve/<name>"]},
|
||||
)
|
||||
|
||||
def _respond(self, status: int, body: dict):
|
||||
@@ -952,7 +505,7 @@ def main():
|
||||
)
|
||||
for tld, addr in REGISTRIES.items():
|
||||
sys.stderr.write(f" .{tld:<8s} = {addr or '(not configured)'}\n")
|
||||
sys.stderr.write(" GET /v2/resolve/<name> GET /v1/resolve/<name> GET /health\n")
|
||||
sys.stderr.write(" GET /resolve/<name> GET /health\n")
|
||||
try:
|
||||
server.serve_forever()
|
||||
except KeyboardInterrupt:
|
||||
|
||||
@@ -4,11 +4,8 @@
|
||||
Run with `python3 -m unittest scripts/resolver/service/test_snrc_resolve.py`.
|
||||
"""
|
||||
|
||||
import contextlib
|
||||
import importlib.util
|
||||
import io
|
||||
import os
|
||||
import time
|
||||
import unittest
|
||||
|
||||
# snrc-resolve.py has a hyphen, so import it via importlib instead of `import`.
|
||||
@@ -20,12 +17,6 @@ snrc = importlib.util.module_from_spec(_SPEC)
|
||||
_SPEC.loader.exec_module(snrc)
|
||||
|
||||
|
||||
def registration(name):
|
||||
"""registration() answers a NameResponse; most tests assert what is in it."""
|
||||
status, body = snrc.registration(name)
|
||||
return status, (body["registration"] if status == 200 else body)
|
||||
|
||||
|
||||
class SplitLinksTests(unittest.TestCase):
|
||||
"""`split_links` decodes the multi-URL convention for simplex.contact /
|
||||
simplex.channel text records. Reuses the same rule the dApp's
|
||||
@@ -91,949 +82,5 @@ class SplitLinksTests(unittest.TestCase):
|
||||
)
|
||||
|
||||
|
||||
class EncodedLabelhashTests(unittest.TestCase):
|
||||
# keccak-256("alice"), written out in full wherever a test needs it.
|
||||
# 9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501
|
||||
|
||||
REGISTRAR = "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a"
|
||||
GRACE = 90 * 86400
|
||||
|
||||
def setUp(self):
|
||||
self._saved = (snrc.REGISTRARS, snrc.CONTROLLERS, snrc.eth_call, snrc.chain_now)
|
||||
snrc.REGISTRARS = {"testing": self.REGISTRAR}
|
||||
snrc.CONTROLLERS = {"testing": ""}
|
||||
snrc.chain_now = lambda: int(time.time())
|
||||
|
||||
def tearDown(self):
|
||||
snrc.REGISTRARS, snrc.CONTROLLERS, snrc.eth_call, snrc.chain_now = self._saved
|
||||
|
||||
def test_the_encoded_form_is_recognised(self):
|
||||
self.assertTrue(
|
||||
snrc.is_encoded_labelhash(
|
||||
"[9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501]"
|
||||
)
|
||||
)
|
||||
|
||||
def test_an_ordinary_label_is_not(self):
|
||||
self.assertFalse(snrc.is_encoded_labelhash("alice"))
|
||||
self.assertFalse(snrc.is_encoded_labelhash("[alice]"))
|
||||
self.assertFalse(snrc.is_encoded_labelhash("9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501"))
|
||||
|
||||
def test_non_hex_between_the_brackets_is_not(self):
|
||||
self.assertFalse(snrc.is_encoded_labelhash("[" + "z" * 64 + "]"))
|
||||
# uppercase is rejected because the handler lowercases the whole name
|
||||
self.assertFalse(snrc.is_encoded_labelhash("[" + "A" * 64 + "]"))
|
||||
self.assertFalse(snrc.is_encoded_labelhash("[0x9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501]"))
|
||||
|
||||
def test_the_wrong_length_is_not(self):
|
||||
self.assertFalse(snrc.is_encoded_labelhash("[" + "a" * 63 + "]"))
|
||||
self.assertFalse(snrc.is_encoded_labelhash("[" + "a" * 65 + "]"))
|
||||
|
||||
def test_hash_and_label_reach_the_same_node(self):
|
||||
self.assertEqual(
|
||||
snrc.node_of("alice.testing"),
|
||||
snrc.node_of(
|
||||
"[9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501]"
|
||||
".testing"
|
||||
),
|
||||
)
|
||||
|
||||
def test_a_plain_name_is_unaffected(self):
|
||||
self.assertEqual(snrc.node_of("alice.testing"), snrc.namehash("alice.testing"))
|
||||
|
||||
def test_a_bracket_subname_label_stays_literal(self):
|
||||
"""Only the 2LD is a key, so a bracket label left of it is hashed as
|
||||
written."""
|
||||
self.assertNotEqual(
|
||||
snrc.node_of(
|
||||
"[9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501]"
|
||||
".alice.testing"
|
||||
),
|
||||
snrc.namehash("alice.alice.testing"),
|
||||
)
|
||||
|
||||
def test_a_0x_prefixed_label_is_taken_literally(self):
|
||||
name = "0x9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501.testing"
|
||||
self.assertEqual(snrc.node_of(name), snrc.namehash(name))
|
||||
self.assertNotEqual(snrc.node_of(name), snrc.node_of("alice.testing"))
|
||||
|
||||
def test_a_malformed_bracket_label_falls_back_to_a_literal_name(self):
|
||||
name = "[nothex].testing"
|
||||
self.assertEqual(snrc.node_of(name), snrc.namehash(name))
|
||||
|
||||
def test_status_by_hash_matches_status_by_name(self):
|
||||
future = int(time.time()) + 86400
|
||||
seen = []
|
||||
|
||||
def eth_call(to, data):
|
||||
seen.append(data)
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(self.GRACE)
|
||||
return "0x" + snrc.encode_uint(future)
|
||||
|
||||
snrc.eth_call = eth_call
|
||||
by_name = snrc.name_status("alice.testing")
|
||||
by_hash = snrc.name_status(
|
||||
"[9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501]"
|
||||
".testing"
|
||||
)
|
||||
self.assertEqual(by_name, by_hash)
|
||||
self.assertEqual(by_name["status"], "registered")
|
||||
# nothing in either request carried the label itself
|
||||
self.assertTrue(all("alice".encode().hex() not in d for d in seen))
|
||||
|
||||
|
||||
class NameStatusTests(unittest.TestCase):
|
||||
REGISTRAR = "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a"
|
||||
|
||||
GRACE = 90 * 86400
|
||||
|
||||
def _expiry(self, value):
|
||||
def eth_call(to, data):
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(self.GRACE)
|
||||
self.assertTrue(data.startswith(snrc.selector("nameExpires(uint256)")))
|
||||
return "0x" + snrc.encode_uint(value)
|
||||
|
||||
return eth_call
|
||||
|
||||
def _keys(self, status, expires, grace_ends, read_at=-1):
|
||||
"""Every branch answers with the same keys; only some carry values."""
|
||||
return {
|
||||
"status": status,
|
||||
"lastBlockTs": self.now if read_at == -1 else read_at,
|
||||
"expires": expires,
|
||||
"graceEnds": grace_ends,
|
||||
"reasonCode": None,
|
||||
"reason": None,
|
||||
}
|
||||
|
||||
def setUp(self):
|
||||
self._saved = (
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
snrc.rpc,
|
||||
)
|
||||
snrc.REGISTRARS = {"testing": self.REGISTRAR}
|
||||
# Expiry alone; ReservedTests covers a configured controller.
|
||||
snrc.CONTROLLERS = {"testing": ""}
|
||||
self.now = int(time.time())
|
||||
snrc.chain_now = lambda: self.now
|
||||
|
||||
def tearDown(self):
|
||||
(
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
snrc.rpc,
|
||||
) = self._saved
|
||||
|
||||
def test_now_is_the_latest_blocks_timestamp(self):
|
||||
# setUp replaced chain_now with the fixture clock; test the real one
|
||||
real_chain_now = self._saved[3]
|
||||
snrc.rpc = lambda method, params: {"timestamp": "0x65f1a2c0", "number": "0x123"}
|
||||
self.assertEqual(real_chain_now(), 0x65F1A2C0)
|
||||
|
||||
def test_status_reads_the_chain_clock_not_the_host_clock(self):
|
||||
future = int(time.time()) + 3600
|
||||
snrc.eth_call = self._expiry(future)
|
||||
self.assertEqual(snrc.name_status("alice.testing")["status"], "registered")
|
||||
snrc.chain_now = lambda: future + 3650 * 86400
|
||||
self.assertEqual(snrc.name_status("alice.testing")["status"], "expired")
|
||||
|
||||
def test_a_registrar_that_is_not_a_contract_is_an_error_not_a_free_name(self):
|
||||
"""An address with no code answers eth_call with empty data. Read as
|
||||
zero, that would make every name look free."""
|
||||
snrc.eth_call = self._saved[2] # the real one, so its guard runs
|
||||
snrc.rpc = lambda method, params: "0x"
|
||||
with self.assertRaises(RuntimeError):
|
||||
snrc.name_status("alice.testing")
|
||||
|
||||
def test_zero_expiry_means_never_registered(self):
|
||||
snrc.eth_call = self._expiry(0)
|
||||
self.assertEqual(
|
||||
snrc.name_status("alice.testing"),
|
||||
self._keys("unregistered", None, None),
|
||||
)
|
||||
|
||||
def test_recently_expired_is_in_grace_and_says_when_it_ends(self):
|
||||
past = int(time.time()) - 3600
|
||||
snrc.eth_call = self._expiry(past)
|
||||
self.assertEqual(
|
||||
snrc.name_status("alice.testing"),
|
||||
self._keys("grace", past, past + self.GRACE),
|
||||
)
|
||||
|
||||
def test_past_the_grace_window_it_is_expired_and_claimable(self):
|
||||
past = int(time.time()) - self.GRACE - 3600
|
||||
snrc.eth_call = self._expiry(past)
|
||||
self.assertEqual(snrc.name_status("alice.testing")["status"], "expired")
|
||||
|
||||
def test_the_boundary_belongs_to_grace(self):
|
||||
"""The registrar frees a name only when expires + GRACE < now."""
|
||||
now = int(time.time())
|
||||
snrc.eth_call = self._expiry(now - self.GRACE)
|
||||
self.assertEqual(snrc.name_status("alice.testing")["status"], "grace")
|
||||
|
||||
def test_future_expiry_is_registered(self):
|
||||
future = int(time.time()) + 3600
|
||||
snrc.eth_call = self._expiry(future)
|
||||
self.assertEqual(
|
||||
snrc.name_status("alice.testing"),
|
||||
self._keys("registered", future, future + self.GRACE),
|
||||
)
|
||||
|
||||
def test_never_registered_is_not_confused_with_claimable(self):
|
||||
"""`available(id)` is true for both, since 0 + GRACE < now."""
|
||||
snrc.eth_call = self._expiry(0)
|
||||
self.assertEqual(snrc.name_status("alice.testing")["status"], "unregistered")
|
||||
self.assertNotEqual(snrc.name_status("alice.testing")["status"], "expired")
|
||||
|
||||
def test_a_subname_reports_the_status_of_its_2ld(self):
|
||||
future = int(time.time()) + 3600
|
||||
seen = []
|
||||
|
||||
def eth_call(to, data):
|
||||
seen.append(data)
|
||||
return "0x" + snrc.encode_uint(future)
|
||||
|
||||
snrc.eth_call = eth_call
|
||||
self.assertEqual(snrc.name_status("x.alice.testing")["status"], "registered")
|
||||
# the token asked about is keccak("alice"), not keccak("x")
|
||||
self.assertTrue(seen[0].endswith(snrc.keccak(b"alice").hex()))
|
||||
|
||||
def test_a_hashed_2ld_is_queried_by_its_hash_at_any_depth(self):
|
||||
"""The token must come from the hash, not from hashing the brackets."""
|
||||
seen = []
|
||||
|
||||
def eth_call(to, data):
|
||||
seen.append(data)
|
||||
return "0x" + snrc.encode_uint(0)
|
||||
|
||||
snrc.eth_call = eth_call
|
||||
hashed = "[" + snrc.keccak(b"alice").hex() + "]"
|
||||
snrc.name_status("x." + hashed + ".testing")
|
||||
self.assertTrue(seen[0].endswith(snrc.keccak(b"alice").hex()))
|
||||
|
||||
def test_unconfigured_tld_is_unknown_rather_than_unregistered(self):
|
||||
snrc.REGISTRARS = {"testing": ""}
|
||||
snrc.eth_call = lambda *a: self.fail("must not reach the chain")
|
||||
self.assertEqual(
|
||||
snrc.name_status("alice.testing"),
|
||||
self._keys("unknown", None, None, read_at=None),
|
||||
)
|
||||
|
||||
def test_every_branch_returns_the_same_keys(self):
|
||||
keys = {
|
||||
"status",
|
||||
"lastBlockTs",
|
||||
"expires",
|
||||
"graceEnds",
|
||||
"reasonCode",
|
||||
"reason",
|
||||
}
|
||||
snrc.eth_call = self._expiry(0)
|
||||
self.assertEqual(set(snrc.name_status("alice.testing")), keys)
|
||||
snrc.eth_call = self._expiry(int(time.time()) + 3600)
|
||||
self.assertEqual(set(snrc.name_status("alice.testing")), keys)
|
||||
snrc.REGISTRARS = {"testing": ""}
|
||||
snrc.eth_call = lambda *a: self.fail("must not reach the chain")
|
||||
self.assertEqual(set(snrc.name_status("alice.testing")), keys)
|
||||
|
||||
|
||||
class ReservedTests(unittest.TestCase):
|
||||
REGISTRAR = "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a"
|
||||
CONTROLLER = "0x281ca41311c2aa808c917c4674639d7567b75714"
|
||||
|
||||
def setUp(self):
|
||||
self._saved = (snrc.REGISTRARS, snrc.CONTROLLERS, snrc.eth_call, snrc.chain_now)
|
||||
snrc.REGISTRARS = {"testing": self.REGISTRAR}
|
||||
snrc.CONTROLLERS = {"testing": self.CONTROLLER}
|
||||
snrc.chain_now = lambda: int(time.time())
|
||||
|
||||
def tearDown(self):
|
||||
snrc.REGISTRARS, snrc.CONTROLLERS, snrc.eth_call, snrc.chain_now = self._saved
|
||||
|
||||
def _chain(self, expires, reserved):
|
||||
def eth_call(to, data):
|
||||
if data.startswith(snrc.selector("reservedNames(bytes32)")):
|
||||
self.assertEqual(to, self.CONTROLLER)
|
||||
return "0x" + snrc.encode_uint(1 if reserved else 0)
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(90 * 86400)
|
||||
if data.startswith(snrc.selector("prices()")):
|
||||
return "0x" + snrc.encode_uint(0) # no price oracle, no auction
|
||||
return "0x" + snrc.encode_uint(expires)
|
||||
|
||||
return eth_call
|
||||
|
||||
def test_unregistered_and_reserved_reports_the_reservation(self):
|
||||
snrc.eth_call = self._chain(0, True)
|
||||
reg = snrc.name_status("acme.testing")
|
||||
self.assertEqual(reg["status"], "unregistered")
|
||||
self.assertEqual(reg["reasonCode"], "internal")
|
||||
|
||||
def test_unregistered_and_not_reserved_reads_unregistered(self):
|
||||
snrc.eth_call = self._chain(0, False)
|
||||
self.assertEqual(snrc.name_status("acme.testing")["status"], "unregistered")
|
||||
|
||||
def test_a_lapsed_reserved_name_keeps_its_reservation(self):
|
||||
past = int(time.time()) - 91 * 86400
|
||||
snrc.eth_call = self._chain(past, True)
|
||||
reg = snrc.name_status("acme.testing")
|
||||
self.assertEqual(reg["status"], "expired")
|
||||
self.assertEqual(reg["reasonCode"], "internal")
|
||||
|
||||
def test_a_live_name_is_registered_even_if_reserved(self):
|
||||
snrc.eth_call = self._chain(int(time.time()) + 86400, True)
|
||||
self.assertEqual(snrc.name_status("acme.testing")["status"], "registered")
|
||||
|
||||
def test_a_name_in_grace_belongs_to_its_owner_not_the_reserved_set(self):
|
||||
snrc.eth_call = self._chain(int(time.time()) - 3600, True)
|
||||
self.assertEqual(snrc.name_status("acme.testing")["status"], "grace")
|
||||
|
||||
def test_no_controller_configured_means_reserved_is_never_reported(self):
|
||||
snrc.CONTROLLERS = {"testing": ""}
|
||||
snrc.eth_call = self._chain(0, True) # reserved on chain, but unread
|
||||
self.assertEqual(snrc.name_status("acme.testing")["status"], "unregistered")
|
||||
|
||||
def test_reserved_is_asked_by_labelhash_so_a_hashed_query_works(self):
|
||||
# keccak-256("acme")
|
||||
hashed = "[e29dae06ef4c3e336b7538b6d4f52ca1ecec009b1df6fb501320e11b223aeeaf]"
|
||||
snrc.eth_call = self._chain(0, True)
|
||||
self.assertEqual(snrc.name_status(hashed + ".testing")["reasonCode"], "internal")
|
||||
|
||||
|
||||
class ReservedReasonTests(unittest.TestCase):
|
||||
REGISTRY = "0x58fc46996d975c57883564648bda5206d1a0102b"
|
||||
REGISTRAR = "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a"
|
||||
CONTROLLER = "0x281ca41311c2aa808c917c4674639d7567b75714"
|
||||
|
||||
def setUp(self):
|
||||
self._saved = (
|
||||
snrc.REGISTRIES,
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
)
|
||||
snrc.REGISTRIES = {"testing": self.REGISTRY}
|
||||
snrc.REGISTRARS = {"testing": self.REGISTRAR}
|
||||
snrc.CONTROLLERS = {"testing": self.CONTROLLER}
|
||||
snrc.chain_now = lambda: int(time.time())
|
||||
|
||||
def tearDown(self):
|
||||
(
|
||||
snrc.REGISTRIES,
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
) = self._saved
|
||||
|
||||
def _chain(self, expires, reserved):
|
||||
def eth_call(to, data):
|
||||
if data.startswith(snrc.selector("reservedNames(bytes32)")):
|
||||
return "0x" + snrc.encode_uint(1 if reserved else 0)
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(90 * 86400)
|
||||
if data.startswith(snrc.selector("prices()")):
|
||||
return "0x" + snrc.encode_uint(0) # no price oracle, no auction
|
||||
return "0x" + snrc.encode_uint(expires)
|
||||
|
||||
return eth_call
|
||||
|
||||
def _reserved_as(self, code):
|
||||
def eth_call(to, data):
|
||||
if data.startswith(snrc.selector("reservedNames(bytes32)")):
|
||||
return "0x" + snrc.encode_uint(code)
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(90 * 86400)
|
||||
if data.startswith(snrc.selector("prices()")):
|
||||
return "0x" + snrc.encode_uint(0)
|
||||
return "0x" + snrc.encode_uint(0)
|
||||
|
||||
return eth_call
|
||||
|
||||
def test_every_enum_value_has_a_code_and_a_sentence(self):
|
||||
for code, (name, sentence) in snrc.RESERVED_REASONS.items():
|
||||
snrc.eth_call = self._reserved_as(code)
|
||||
reg = snrc.name_status("acme.testing")
|
||||
self.assertEqual(reg["reasonCode"], name)
|
||||
self.assertEqual(reg["reason"], sentence)
|
||||
|
||||
def test_a_trademark_reservation_says_so(self):
|
||||
snrc.eth_call = self._reserved_as(2)
|
||||
_, body = snrc.resolve("acme.testing")
|
||||
self.assertEqual(body["reasonCode"], "trademark")
|
||||
|
||||
def test_a_controller_storing_a_bool_reads_as_internal(self):
|
||||
"""Before the enum `reservedNames` was a bool; its `true` decodes as 1."""
|
||||
snrc.eth_call = self._reserved_as(1)
|
||||
reg = snrc.name_status("acme.testing")
|
||||
self.assertEqual(reg["reasonCode"], "internal")
|
||||
self.assertEqual(reg["reason"], "reserved for SimpleX")
|
||||
|
||||
def test_an_enum_value_this_resolver_predates_is_not_dropped(self):
|
||||
"""A new Reason still reserves the name, and says it is unknown rather
|
||||
than claiming the chain recorded none."""
|
||||
snrc.eth_call = self._reserved_as(99)
|
||||
reg = snrc.name_status("acme.testing")
|
||||
self.assertEqual(reg["reasonCode"], "unknown")
|
||||
self.assertEqual(reg["reason"], "reserved")
|
||||
|
||||
def test_a_reserved_name_carries_the_reason(self):
|
||||
snrc.eth_call = self._chain(0, True)
|
||||
status, body = snrc.resolve("acme.testing")
|
||||
self.assertEqual(status, 404)
|
||||
self.assertEqual(body["status"], "unregistered")
|
||||
self.assertEqual(body["reason"], "reserved for SimpleX")
|
||||
|
||||
def test_the_message_does_not_claim_a_trademark(self):
|
||||
snrc.eth_call = self._chain(0, True)
|
||||
_, body = snrc.resolve("acme.testing")
|
||||
self.assertNotIn("trademark", body["message"])
|
||||
|
||||
def test_an_unregistered_name_has_no_reason(self):
|
||||
snrc.eth_call = self._chain(0, False)
|
||||
status, body = snrc.resolve("acme.testing")
|
||||
self.assertEqual(status, 404)
|
||||
self.assertEqual(body["status"], "unregistered")
|
||||
self.assertIsNone(body["reason"])
|
||||
|
||||
def test_an_expired_name_has_no_reason(self):
|
||||
snrc.eth_call = self._chain(1, False)
|
||||
status, body = snrc.resolve("acme.testing")
|
||||
self.assertEqual(status, 410)
|
||||
self.assertEqual(body["status"], "expired")
|
||||
self.assertIsNone(body["reason"])
|
||||
|
||||
def test_a_hashed_query_gets_the_reason_too(self):
|
||||
snrc.eth_call = self._chain(0, True)
|
||||
# keccak-256("acme")
|
||||
hashed = "[e29dae06ef4c3e336b7538b6d4f52ca1ecec009b1df6fb501320e11b223aeeaf]"
|
||||
_, body = snrc.resolve(hashed + ".testing")
|
||||
self.assertEqual(body["reason"], "reserved for SimpleX")
|
||||
|
||||
|
||||
class PricingTests(unittest.TestCase):
|
||||
"""The oracle keeps the curve in US cents per year, and a lapsed name costs
|
||||
the ordinary price: this registry runs no auction."""
|
||||
|
||||
REGISTRY = "0x58fc46996d975c57883564648bda5206d1a0102b"
|
||||
REGISTRAR = "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a"
|
||||
CONTROLLER = "0x281ca41311c2aa808c917c4674639d7567b75714"
|
||||
ORACLE = "0x1e0c9a2b9d1a4c8f7b3e5d6a9c2f4b8e1d7a3c50"
|
||||
|
||||
GRACE = 90 * 86400
|
||||
BASE = 200
|
||||
EXCEPTIONS = {1: 64000, 2: 16000, 3: 1600, 4: 800, 5: 500}
|
||||
MIN_LENGTH = 3
|
||||
|
||||
def setUp(self):
|
||||
self._saved = (
|
||||
snrc.REGISTRIES,
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
)
|
||||
snrc.REGISTRIES = {"testing": self.REGISTRY}
|
||||
snrc.REGISTRARS = {"testing": self.REGISTRAR}
|
||||
snrc.CONTROLLERS = {"testing": self.CONTROLLER}
|
||||
self.now = int(time.time())
|
||||
snrc.chain_now = lambda: self.now
|
||||
|
||||
def tearDown(self):
|
||||
(
|
||||
snrc.REGISTRIES,
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
) = self._saved
|
||||
|
||||
def _prices_return(self):
|
||||
words = [snrc.encode_uint(self.BASE), snrc.encode_uint(0x40),
|
||||
snrc.encode_uint(len(self.EXCEPTIONS))]
|
||||
for length, cents in self.EXCEPTIONS.items():
|
||||
words += [snrc.encode_uint(length), snrc.encode_uint(cents)]
|
||||
return "0x" + "".join(words)
|
||||
|
||||
def _chain(self, expires, oracle=None, reserved=0):
|
||||
oracle = self.ORACLE if oracle is None else oracle
|
||||
self.oracle_calls = []
|
||||
|
||||
def eth_call(to, data):
|
||||
if data.startswith(snrc.selector("nameExpires(uint256)")):
|
||||
return "0x" + snrc.encode_uint(expires)
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(self.GRACE)
|
||||
if data.startswith(snrc.selector("reservedNames(bytes32)")):
|
||||
return "0x" + snrc.encode_uint(reserved)
|
||||
if data.startswith(snrc.selector("minCharLength()")):
|
||||
self.assertEqual(to, self.CONTROLLER)
|
||||
return "0x" + snrc.encode_uint(self.MIN_LENGTH)
|
||||
if data.startswith(snrc.selector("prices()")):
|
||||
if to == self.CONTROLLER:
|
||||
return "0x" + snrc.encode_uint(int(oracle, 16))
|
||||
self.oracle_calls.append(data[:10])
|
||||
self.assertEqual(to, oracle)
|
||||
return self._prices_return()
|
||||
return self.fail("unexpected call " + data[:10])
|
||||
|
||||
return eth_call
|
||||
|
||||
def _lapsed(self, days_past_grace):
|
||||
"""An expiry whose grace ended `days_past_grace` days ago. The extra
|
||||
second clears the boundary, which counts as still in grace."""
|
||||
return self.now - self.GRACE - 1 - days_past_grace * 86400
|
||||
|
||||
def test_the_prices_are_the_oracles_cents_per_year(self):
|
||||
snrc.eth_call = self._chain(self._lapsed(0))
|
||||
reg = snrc.name_status("acme.testing")
|
||||
# 1 and 2 are below minCharLength
|
||||
self.assertEqual(reg["registrationPrices"], {3: 1600, 4: 800, 5: 500})
|
||||
self.assertEqual(reg["basePrice"], self.BASE)
|
||||
self.assertEqual(reg["minLabelLength"], self.MIN_LENGTH)
|
||||
|
||||
def test_a_lapsed_name_costs_the_ordinary_price(self):
|
||||
snrc.eth_call = self._chain(self._lapsed(0))
|
||||
reg = snrc.name_status("acme.testing")
|
||||
self.assertEqual(reg["status"], "expired")
|
||||
|
||||
def test_a_controller_with_no_oracle_leaves_the_name_merely_expired(self):
|
||||
snrc.eth_call = self._chain(self._lapsed(0), oracle=snrc.ZERO_ADDR)
|
||||
self.assertEqual(snrc.name_status("acme.testing")["status"], "expired")
|
||||
|
||||
def test_a_name_in_grace_never_reaches_the_oracle(self):
|
||||
snrc.eth_call = self._chain(self.now - 3600)
|
||||
self.assertEqual(snrc.name_status("acme.testing")["status"], "grace")
|
||||
self.assertEqual(self.oracle_calls, [])
|
||||
|
||||
def test_a_reserved_lapsed_name_keeps_its_reservation(self):
|
||||
snrc.eth_call = self._chain(self._lapsed(0), reserved=2)
|
||||
reg = snrc.name_status("acme.testing")
|
||||
self.assertEqual(reg["status"], "expired")
|
||||
self.assertEqual(reg["reasonCode"], "trademark")
|
||||
|
||||
def test_resolve_reports_the_prices(self):
|
||||
snrc.eth_call = self._chain(self._lapsed(1))
|
||||
status, body = snrc.resolve("acme.testing")
|
||||
self.assertEqual(status, 410)
|
||||
self.assertEqual(body["status"], "expired")
|
||||
self.assertEqual(body["basePrice"], self.BASE)
|
||||
|
||||
def test_a_hashed_query_is_priced_too(self):
|
||||
# keccak-256("acme")
|
||||
hashed = "[e29dae06ef4c3e336b7538b6d4f52ca1ecec009b1df6fb501320e11b223aeeaf]"
|
||||
snrc.eth_call = self._chain(self._lapsed(0))
|
||||
_, body = snrc.resolve(hashed + ".testing")
|
||||
self.assertEqual(body["status"], "expired")
|
||||
self.assertEqual(body["basePrice"], self.BASE)
|
||||
|
||||
|
||||
class EnsOracleTests(unittest.TestCase):
|
||||
""".testing runs an ENS-shaped oracle: it prices in attoUSD per second and
|
||||
charges a premium on lapsed names that it does not expose."""
|
||||
|
||||
REGISTRY = "0x58fc46996d975c57883564648bda5206d1a0102b"
|
||||
REGISTRAR = "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a"
|
||||
CONTROLLER = "0x281ca41311c2aa808c917c4674639d7567b75714"
|
||||
ORACLE = "0x1e0c9a2b9d1a4c8f7b3e5d6a9c2f4b8e1d7a3c50"
|
||||
GRACE = 90 * 86400
|
||||
MIN_LENGTH = 6
|
||||
|
||||
def setUp(self):
|
||||
self._saved = (snrc.REGISTRIES, snrc.REGISTRARS, snrc.CONTROLLERS, snrc.eth_call, snrc.chain_now)
|
||||
snrc.REGISTRIES = {"testing": self.REGISTRY}
|
||||
snrc.REGISTRARS = {"testing": self.REGISTRAR}
|
||||
snrc.CONTROLLERS = {"testing": self.CONTROLLER}
|
||||
self.now = int(time.time())
|
||||
snrc.chain_now = lambda: self.now
|
||||
|
||||
def tearDown(self):
|
||||
(snrc.REGISTRIES, snrc.REGISTRARS, snrc.CONTROLLERS, snrc.eth_call, snrc.chain_now) = self._saved
|
||||
|
||||
def _chain(self, expires, letter_cents=0):
|
||||
def eth_call(to, data):
|
||||
if data.startswith(snrc.selector("nameExpires(uint256)")):
|
||||
return "0x" + snrc.encode_uint(expires)
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(self.GRACE)
|
||||
if data.startswith(snrc.selector("reservedNames(bytes32)")):
|
||||
return "0x" + snrc.encode_uint(0)
|
||||
if data.startswith(snrc.selector("minCharLength()")):
|
||||
return "0x" + snrc.encode_uint(self.MIN_LENGTH)
|
||||
if data.startswith(snrc.selector("prices()")):
|
||||
if to == self.CONTROLLER:
|
||||
return "0x" + snrc.encode_uint(int(self.ORACLE, 16))
|
||||
raise RuntimeError("eth_call returned 0x") # no prices() on this oracle
|
||||
for n in range(1, 7):
|
||||
if data.startswith(snrc.selector(f"price{n}Letter()")):
|
||||
rate = letter_cents * snrc.ATTO_PER_CENT // snrc.SECONDS_PER_YEAR
|
||||
return "0x" + snrc.encode_uint(rate)
|
||||
return self.fail("unexpected call " + data[:10])
|
||||
|
||||
return eth_call
|
||||
|
||||
def test_a_never_registered_name_is_priced_from_the_letter_curve(self):
|
||||
snrc.eth_call = self._chain(0)
|
||||
reg = snrc.name_status("ghost.testing")
|
||||
self.assertEqual(reg["status"], "unregistered")
|
||||
self.assertEqual(reg["basePrice"], 0)
|
||||
self.assertEqual(reg["minLabelLength"], self.MIN_LENGTH)
|
||||
|
||||
def test_a_non_zero_letter_curve_converts_to_cents_per_year(self):
|
||||
snrc.eth_call = self._chain(0, letter_cents=1200)
|
||||
self.assertEqual(snrc.name_status("ghost.testing")["basePrice"], 1200)
|
||||
|
||||
def test_a_lapsed_name_is_not_priced_because_the_premium_is_unreadable(self):
|
||||
snrc.eth_call = self._chain(self.now - self.GRACE - 1)
|
||||
reg = snrc.name_status("acme.testing")
|
||||
self.assertEqual(reg["status"], "expired")
|
||||
self.assertNotIn("basePrice", reg)
|
||||
|
||||
|
||||
class ErrorCodeTests(unittest.TestCase):
|
||||
REGISTRY = "0x58fc46996d975c57883564648bda5206d1a0102b"
|
||||
REGISTRAR = "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a"
|
||||
|
||||
def setUp(self):
|
||||
self._saved = (
|
||||
snrc.REGISTRIES,
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
)
|
||||
snrc.REGISTRIES = {"testing": self.REGISTRY, "simplex": ""}
|
||||
snrc.REGISTRARS = {"testing": self.REGISTRAR}
|
||||
snrc.CONTROLLERS = {"testing": ""}
|
||||
snrc.chain_now = lambda: int(time.time())
|
||||
|
||||
def tearDown(self):
|
||||
(
|
||||
snrc.REGISTRIES,
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
) = self._saved
|
||||
|
||||
def _chain(self, expires, resolver=None):
|
||||
def eth_call(to, data):
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(90 * 86400)
|
||||
if data.startswith(snrc.selector("resolver(bytes32)")):
|
||||
return "0x" + "00" * 12 + (resolver or "00" * 20)
|
||||
return "0x" + snrc.encode_uint(expires)
|
||||
|
||||
return eth_call
|
||||
|
||||
def test_an_unconfigured_tld_names_the_ones_that_are(self):
|
||||
status, body = snrc.resolve("alice.nosuchtld")
|
||||
self.assertEqual(status, 400)
|
||||
self.assertEqual(body["error"], "tldNotConfigured")
|
||||
self.assertEqual(body["configuredTlds"], ["testing"])
|
||||
self.assertIn("nosuchtld", body["message"])
|
||||
|
||||
def test_a_registration_problem_reports_the_status_as_the_code(self):
|
||||
for expires, code in (
|
||||
(0, "unregistered"),
|
||||
(int(time.time()) - 91 * 86400, "expired"),
|
||||
):
|
||||
with self.subTest(code=code):
|
||||
snrc.eth_call = self._chain(expires)
|
||||
_, body = snrc.resolve("alice.testing")
|
||||
self.assertEqual(body["error"], code)
|
||||
self.assertEqual(body["status"], code)
|
||||
|
||||
def test_a_name_in_grace_still_resolves(self):
|
||||
snrc.eth_call = self._chain(int(time.time()) - 3600)
|
||||
status, body = snrc.resolve("alice.testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["status"], "grace")
|
||||
self.assertNotIn("error", body)
|
||||
|
||||
def test_a_registered_name_pointing_nowhere_resolves_with_empty_records(self):
|
||||
snrc.eth_call = self._chain(int(time.time()) + 86400)
|
||||
status, body = snrc.resolve("alice.testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["status"], "registered")
|
||||
self.assertEqual(body["resolver"], snrc.ZERO_ADDR)
|
||||
self.assertEqual(body["simplexContact"], [])
|
||||
|
||||
def test_every_error_body_carries_both_fields(self):
|
||||
snrc.eth_call = self._chain(0)
|
||||
for name in ("alice.nosuchtld", "alice.testing"):
|
||||
with self.subTest(name=name):
|
||||
_, body = snrc.resolve(name)
|
||||
self.assertIsInstance(body["error"], str)
|
||||
self.assertIsInstance(body["message"], str)
|
||||
self.assertNotEqual(body["error"], body["message"])
|
||||
|
||||
def test_an_upstream_failure_does_not_echo_the_exception(self):
|
||||
with contextlib.redirect_stderr(io.StringIO()) as log:
|
||||
body = snrc.upstream_error(
|
||||
{"name": "alice.testing"},
|
||||
RuntimeError("http://user:[email protected]/kEy8 refused"),
|
||||
)
|
||||
# the operator still sees the detail in the log
|
||||
self.assertIn("secret", log.getvalue())
|
||||
self.assertEqual(body["error"], "upstreamError")
|
||||
self.assertIn("RuntimeError", body["message"])
|
||||
self.assertNotIn("secret", body["message"])
|
||||
self.assertNotIn("kEy8", body["message"])
|
||||
|
||||
|
||||
class RegistrationV2Tests(unittest.TestCase):
|
||||
"""`/v2/resolve` answers with the SMP protocol's NameRegistration, which the
|
||||
relay decodes as is. The key names are the wire contract, so they are pinned
|
||||
here: renaming one without the Haskell side is a silent break."""
|
||||
|
||||
REGISTRY = "0x58fc46996d975c57883564648bda5206d1a0102b"
|
||||
REGISTRAR = "0xef47eb4384b46c89e4482a677c2cbcbd2a6fd85a"
|
||||
CONTROLLER = "0x281ca41311c2aa808c917c4674639d7567b75714"
|
||||
ORACLE = "0x1e0c9a2b9d1a4c8f7b3e5d6a9c2f4b8e1d7a3c50"
|
||||
OWNER = "0xd83bd7e0e6b8a4c1f2593a7b0c4e8d1a6f9b2c37"
|
||||
|
||||
GRACE = 90 * 86400
|
||||
BASE = 200
|
||||
EXCEPTIONS = {1: 64000, 2: 16000, 3: 1600, 4: 800, 5: 500}
|
||||
MIN_LENGTH = 3
|
||||
|
||||
def setUp(self):
|
||||
self._saved = (
|
||||
snrc.REGISTRIES,
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
)
|
||||
snrc.REGISTRIES = {"testing": self.REGISTRY}
|
||||
snrc.REGISTRARS = {"testing": self.REGISTRAR}
|
||||
snrc.CONTROLLERS = {"testing": self.CONTROLLER}
|
||||
self.now = int(time.time())
|
||||
snrc.chain_now = lambda: self.now
|
||||
|
||||
def tearDown(self):
|
||||
(
|
||||
snrc.REGISTRIES,
|
||||
snrc.REGISTRARS,
|
||||
snrc.CONTROLLERS,
|
||||
snrc.eth_call,
|
||||
snrc.chain_now,
|
||||
) = self._saved
|
||||
|
||||
def _prices_return(self):
|
||||
words = [snrc.encode_uint(self.BASE), snrc.encode_uint(0x40),
|
||||
snrc.encode_uint(len(self.EXCEPTIONS))]
|
||||
for length, cents in self.EXCEPTIONS.items():
|
||||
words += [snrc.encode_uint(length), snrc.encode_uint(cents)]
|
||||
return "0x" + "".join(words)
|
||||
|
||||
@staticmethod
|
||||
def _abi_bytes(value: bytes) -> str:
|
||||
"""head offset, length, then the payload padded to a 32-byte word."""
|
||||
pad = (-len(value)) % 32
|
||||
return ("0x" + snrc.encode_uint(0x20) + snrc.encode_uint(len(value))
|
||||
+ (value + b"\x00" * pad).hex())
|
||||
|
||||
def _chain(self, expires, reserved=0, oracle=None, label=b"acme", owner=None):
|
||||
"""The registry answers a zero resolver, so name_record returns the
|
||||
empty record a registered name still has. `label` is what the registrar
|
||||
recorded for the 2LD; b"" means it recorded none. `owner` is the owner of
|
||||
the queried node; ZERO_ADDR means that node was never created."""
|
||||
oracle = self.ORACLE if oracle is None else oracle
|
||||
owner = self.OWNER if owner is None else owner
|
||||
|
||||
def eth_call(to, data):
|
||||
if data.startswith(snrc.selector("labelOf(uint256)")):
|
||||
return self._abi_bytes(label)
|
||||
if data.startswith(snrc.selector("nameExpires(uint256)")):
|
||||
return "0x" + snrc.encode_uint(expires)
|
||||
if data.startswith(snrc.selector("GRACE_PERIOD()")):
|
||||
return "0x" + snrc.encode_uint(self.GRACE)
|
||||
if data.startswith(snrc.selector("reservedNames(bytes32)")):
|
||||
return "0x" + snrc.encode_uint(reserved)
|
||||
if data.startswith(snrc.selector("minCharLength()")):
|
||||
return "0x" + snrc.encode_uint(self.MIN_LENGTH)
|
||||
if data.startswith(snrc.selector("prices()")):
|
||||
if to == self.CONTROLLER:
|
||||
return "0x" + snrc.encode_uint(int(oracle, 16))
|
||||
return self._prices_return()
|
||||
if data.startswith(snrc.selector("resolver(bytes32)")):
|
||||
return "0x" + snrc.encode_uint(0)
|
||||
if data.startswith(snrc.selector("owner(bytes32)")):
|
||||
return "0x" + snrc.encode_uint(int(owner, 16))
|
||||
return self.fail("unexpected call " + data[:10])
|
||||
|
||||
return eth_call
|
||||
|
||||
def _lapsed(self, days_past_grace):
|
||||
return self.now - self.GRACE - 1 - days_past_grace * 86400
|
||||
|
||||
def test_a_live_name_is_registered_and_carries_its_record(self):
|
||||
expires = self.now + 3600
|
||||
snrc.eth_call = self._chain(expires)
|
||||
status, body = registration("acme.testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["type"], "registered")
|
||||
self.assertEqual(body["expires"], expires)
|
||||
self.assertEqual(body["graceUntil"], expires + self.GRACE)
|
||||
self.assertIsNone(body["reservedReason_"])
|
||||
self.assertEqual(body["nameRecord"]["name"], "acme.testing")
|
||||
|
||||
def test_a_name_in_grace_is_still_registered(self):
|
||||
expires = self.now - 3600
|
||||
snrc.eth_call = self._chain(expires)
|
||||
_, body = registration("acme.testing")
|
||||
self.assertEqual(body["type"], "registered")
|
||||
self.assertGreater(body["graceUntil"], self.now)
|
||||
|
||||
def test_a_registered_name_that_is_held_back_says_so(self):
|
||||
snrc.eth_call = self._chain(self.now + 3600, reserved=1)
|
||||
_, body = registration("acme.testing")
|
||||
self.assertEqual(body["type"], "registered")
|
||||
self.assertEqual(body["reservedReason_"], "internal")
|
||||
|
||||
def test_an_unregistered_name_is_available_with_its_pricing(self):
|
||||
snrc.eth_call = self._chain(0)
|
||||
status, body = registration("acme.testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["type"], "available")
|
||||
# lengths below minCharLength are unregistrable, so they are not priced
|
||||
self.assertEqual(body["pricing"]["registrationPrices"], {3: 1600, 4: 800, 5: 500})
|
||||
self.assertEqual(body["pricing"]["basePrice"], self.BASE)
|
||||
self.assertEqual(body["pricing"]["minLabelLength"], self.MIN_LENGTH)
|
||||
|
||||
def test_a_lapsed_name_is_available_at_the_ordinary_price(self):
|
||||
snrc.eth_call = self._chain(self._lapsed(1))
|
||||
_, body = registration("acme.testing")
|
||||
self.assertEqual(body["type"], "available")
|
||||
self.assertEqual(body["pricing"]["basePrice"], self.BASE)
|
||||
|
||||
def test_a_held_back_name_is_reserved_and_is_never_priced(self):
|
||||
snrc.eth_call = self._chain(0, reserved=2)
|
||||
status, body = registration("acme.testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["type"], "reserved")
|
||||
self.assertEqual(body["reservedReason"], "trademark")
|
||||
self.assertNotIn("pricing", body)
|
||||
|
||||
def test_a_hashed_query_answers_the_same_as_the_name(self):
|
||||
# keccak-256("acme")
|
||||
hashed = "[e29dae06ef4c3e336b7538b6d4f52ca1ecec009b1df6fb501320e11b223aeeaf]"
|
||||
snrc.eth_call = self._chain(0)
|
||||
_, by_name = registration("acme.testing")
|
||||
_, by_hash = registration(hashed + ".testing")
|
||||
self.assertEqual(by_name, by_hash)
|
||||
|
||||
def test_an_unconfigured_tld_is_refused_not_answered(self):
|
||||
snrc.REGISTRIES = {"testing": ""}
|
||||
snrc.eth_call = lambda *a: self.fail("must not reach the chain")
|
||||
status, body = registration("acme.testing")
|
||||
self.assertEqual(status, 400)
|
||||
self.assertEqual(body["error"], "tldNotConfigured")
|
||||
|
||||
def test_no_price_oracle_is_an_error_not_a_free_name(self):
|
||||
snrc.eth_call = self._chain(0, oracle=snrc.ZERO_ADDR)
|
||||
status, body = registration("acme.testing")
|
||||
self.assertEqual(status, 502)
|
||||
self.assertEqual(body["error"], "noPriceOracle")
|
||||
|
||||
def test_a_status_it_cannot_read_is_an_error_not_a_registration(self):
|
||||
snrc.REGISTRARS = {"testing": ""}
|
||||
snrc.eth_call = self._chain(0)
|
||||
status, body = registration("acme.testing")
|
||||
self.assertEqual(status, 502)
|
||||
self.assertEqual(body["error"], "unknown")
|
||||
|
||||
def test_each_answer_carries_exactly_its_own_fields(self):
|
||||
"""The relay decodes by these names; an extra or missing one is a break."""
|
||||
cases = {
|
||||
"registered": (self._chain(self.now + 3600),
|
||||
{"type", "expires", "graceUntil", "reservedReason_", "nameRecord"}),
|
||||
"available": (self._chain(0), {"type", "pricing"}),
|
||||
"reserved": (self._chain(0, reserved=1), {"type", "reservedReason"}),
|
||||
}
|
||||
for expected_type, (chain, keys) in cases.items():
|
||||
with self.subTest(type=expected_type):
|
||||
snrc.eth_call = chain
|
||||
_, body = registration("acme.testing")
|
||||
self.assertEqual(body["type"], expected_type)
|
||||
self.assertEqual(set(body), keys)
|
||||
def test_a_hashed_query_the_registrar_cannot_name_is_refused(self):
|
||||
"""The client checks the record names what it asked about, so answering
|
||||
with a record the registrar could not name would only fail there."""
|
||||
hashed = "[e29dae06ef4c3e336b7538b6d4f52ca1ecec009b1df6fb501320e11b223aeeaf]"
|
||||
snrc.eth_call = self._chain(self.now + 3600, label=b"")
|
||||
status, body = registration(hashed + ".testing")
|
||||
self.assertEqual(status, 502)
|
||||
self.assertEqual(body["error"], "labelNotRecorded")
|
||||
|
||||
def test_a_hashed_query_is_answered_with_the_name_the_registrar_recorded(self):
|
||||
hashed = "[e29dae06ef4c3e336b7538b6d4f52ca1ecec009b1df6fb501320e11b223aeeaf]"
|
||||
snrc.eth_call = self._chain(self.now + 3600)
|
||||
status, body = registration(hashed + ".testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["nameRecord"]["name"], "acme.testing")
|
||||
def test_a_subname_that_exists_is_registered_with_its_parents_dates(self):
|
||||
expires = self.now + 3600
|
||||
snrc.eth_call = self._chain(expires)
|
||||
status, body = registration("sub.acme.testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["type"], "registered")
|
||||
self.assertEqual(body["expires"], expires)
|
||||
self.assertEqual(body["nameRecord"]["name"], "sub.acme.testing")
|
||||
|
||||
def test_a_subname_nobody_created_is_not_registered(self):
|
||||
"""The registrar only tracks 2LDs, so the parent's registration says
|
||||
nothing about a child that was never created: its node has no owner."""
|
||||
snrc.eth_call = self._chain(self.now + 3600, owner=snrc.ZERO_ADDR)
|
||||
status, body = registration("sub.acme.testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["type"], "available")
|
||||
|
||||
def test_a_2ld_is_not_subject_to_the_owner_check(self):
|
||||
"""Only a subname can be absent under a registered parent."""
|
||||
snrc.eth_call = self._chain(self.now + 3600, owner=snrc.ZERO_ADDR)
|
||||
_, body = registration("acme.testing")
|
||||
self.assertEqual(body["type"], "registered")
|
||||
|
||||
def test_v1_does_not_report_an_uncreated_subname_as_registered(self):
|
||||
"""v1 has no availability, so the only honest answer is not-found. The
|
||||
2LD case is untouched: a registered name with no resolver still resolves."""
|
||||
snrc.eth_call = self._chain(self.now + 3600, owner=snrc.ZERO_ADDR)
|
||||
status, body = snrc.resolve("sub.acme.testing")
|
||||
self.assertEqual(status, 404)
|
||||
self.assertEqual(body["error"], "unregistered")
|
||||
|
||||
def test_v1_still_resolves_a_2ld_with_no_resolver_set(self):
|
||||
snrc.eth_call = self._chain(self.now + 3600, owner=snrc.ZERO_ADDR)
|
||||
status, body = snrc.resolve("acme.testing")
|
||||
self.assertEqual(status, 200)
|
||||
self.assertEqual(body["resolver"], snrc.ZERO_ADDR)
|
||||
|
||||
def test_the_answer_says_which_block_it_was_read_at(self):
|
||||
"""The resolver is only as current as its node. Without this a client
|
||||
cannot tell an answer that predates its own registration."""
|
||||
snrc.eth_call = self._chain(self.now + 3600)
|
||||
_, res = snrc.registration("acme.testing")
|
||||
self.assertEqual(res["lastBlockTs"], self.now)
|
||||
self.assertEqual(res["registration"]["type"], "registered")
|
||||
|
||||
def test_an_available_name_says_so_too(self):
|
||||
"""This is the path that reads no block otherwise, and the one where
|
||||
staleness matters most: the name may already be taken."""
|
||||
snrc.eth_call = self._chain(0)
|
||||
_, res = snrc.registration("acme.testing")
|
||||
self.assertEqual(res["lastBlockTs"], self.now)
|
||||
self.assertEqual(res["registration"]["type"], "available")
|
||||
|
||||
if __name__ == "__main__":
|
||||
unittest.main()
|
||||
|
||||
+1
-3
@@ -1,7 +1,7 @@
|
||||
cabal-version: 3.0
|
||||
|
||||
name: simplexmq
|
||||
version: 7.1.0.9
|
||||
version: 7.1.0.5
|
||||
synopsis: SimpleXMQ message broker
|
||||
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
|
||||
<./docs/Simplex-Messaging-Client.html client> and
|
||||
@@ -194,7 +194,6 @@ library
|
||||
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs
|
||||
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc
|
||||
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
|
||||
Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
|
||||
else
|
||||
exposed-modules:
|
||||
Simplex.Messaging.Agent.Store.SQLite
|
||||
@@ -249,7 +248,6 @@ library
|
||||
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260411_service_certs
|
||||
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc
|
||||
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
|
||||
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
|
||||
Simplex.Messaging.Agent.Store.SQLite.Util
|
||||
if flag(client_postgres) || flag(server_postgres)
|
||||
exposed-modules:
|
||||
|
||||
@@ -17,16 +17,11 @@ module Simplex.FileTransfer.Agent
|
||||
toFSFilePath,
|
||||
-- Receiving files
|
||||
xftpReceiveFile',
|
||||
xftpPrepareReceiveFile',
|
||||
xftpStartReceiveFile',
|
||||
xftpDeleteRcvFile',
|
||||
xftpDeleteRcvFiles',
|
||||
-- Sending files
|
||||
xftpSendFile',
|
||||
xftpSendDescription',
|
||||
xftpPrepareSendFile',
|
||||
xftpPrepareSendDescription',
|
||||
xftpStartSendFile',
|
||||
deleteSndFileInternal,
|
||||
deleteSndFilesInternal,
|
||||
deleteSndFileRemote,
|
||||
@@ -132,12 +127,7 @@ closeXFTPAgent a = do
|
||||
stopWorkers workers = atomically (swapTVar workers M.empty) >>= mapM_ (liftIO . cancelWorker)
|
||||
|
||||
xftpReceiveFile' :: AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> Bool -> AM RcvFileId
|
||||
xftpReceiveFile' c userId vfd cfArgs approvedRelays = do
|
||||
fId <- xftpPrepareReceiveFile' c userId vfd cfArgs approvedRelays
|
||||
fId <$ xftpStartReceiveFile' c fId
|
||||
|
||||
xftpPrepareReceiveFile' :: AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> Bool -> AM RcvFileId
|
||||
xftpPrepareReceiveFile' c userId (ValidFileDescription fd@FileDescription {redirect}) cfArgs approvedRelays = do
|
||||
xftpReceiveFile' c userId (ValidFileDescription fd@FileDescription {chunks, redirect}) cfArgs approvedRelays = do
|
||||
g <- asks random
|
||||
prefixPath <- lift $ getPrefixPath "rcv.xftp"
|
||||
createDirectory prefixPath
|
||||
@@ -147,7 +137,7 @@ xftpPrepareReceiveFile' c userId (ValidFileDescription fd@FileDescription {redir
|
||||
lift $ createDirectory =<< toFSFilePath relTmpPath
|
||||
lift $ createEmptyFile =<< toFSFilePath relSavePath
|
||||
let saveFile = CryptoFile relSavePath cfArgs
|
||||
case redirect of
|
||||
fId <- case redirect of
|
||||
Nothing -> withStore c $ \db -> createRcvFile db g userId fd relPrefixPath relTmpPath saveFile approvedRelays
|
||||
Just _ -> do
|
||||
-- prepare description paths
|
||||
@@ -159,11 +149,8 @@ xftpPrepareReceiveFile' c userId (ValidFileDescription fd@FileDescription {redir
|
||||
let saveFileRedirect = CryptoFile relSavePathRedirect $ Just cfArgsRedirect
|
||||
-- create download tasks
|
||||
withStore c $ \db -> createRcvFileRedirect db g userId fd relPrefixPath relTmpPathRedirect saveFileRedirect relTmpPath saveFile approvedRelays
|
||||
|
||||
xftpStartReceiveFile' :: AgentClient -> RcvFileId -> AM ()
|
||||
xftpStartReceiveFile' c rcvFileEntityId = do
|
||||
srvs <- withStore c (`startPreparedRcvFile` rcvFileEntityId)
|
||||
lift $ forM_ srvs $ void . getXFTPRcvWorker True c . Just
|
||||
forM_ chunks (downloadChunk c)
|
||||
pure fId
|
||||
|
||||
downloadChunk :: AgentClient -> FileChunk -> AM ()
|
||||
downloadChunk c FileChunk {replicas = (FileChunkReplica {server} : _)} = do
|
||||
@@ -366,11 +353,6 @@ notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, AEvt (sAEnti
|
||||
|
||||
xftpSendFile' :: AgentClient -> UserId -> CryptoFile -> Int -> Maybe Word32 -> AM SndFileId
|
||||
xftpSendFile' c userId file numRecipients storageHours = do
|
||||
fId <- xftpPrepareSendFile' c userId file numRecipients storageHours
|
||||
fId <$ xftpStartSendFile' c fId
|
||||
|
||||
xftpPrepareSendFile' :: AgentClient -> UserId -> CryptoFile -> Int -> Maybe Word32 -> AM SndFileId
|
||||
xftpPrepareSendFile' c userId file numRecipients storageHours = do
|
||||
g <- asks random
|
||||
prefixPath <- lift $ getPrefixPath "snd.xftp"
|
||||
createDirectory prefixPath
|
||||
@@ -378,15 +360,12 @@ xftpPrepareSendFile' c userId file numRecipients storageHours = do
|
||||
key <- atomically $ C.randomSbKey g
|
||||
nonce <- atomically $ C.randomCbNonce g
|
||||
-- saving absolute filePath will not allow to restore file encryption after app update, but it's a short window
|
||||
withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce Nothing storageHours
|
||||
fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce Nothing storageHours
|
||||
lift . void $ getXFTPSndWorker True c Nothing
|
||||
pure fId
|
||||
|
||||
xftpSendDescription' :: AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Int -> AM SndFileId
|
||||
xftpSendDescription' c userId vfd numRecipients = do
|
||||
fId <- xftpPrepareSendDescription' c userId vfd numRecipients
|
||||
fId <$ xftpStartSendFile' c fId
|
||||
|
||||
xftpPrepareSendDescription' :: AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Int -> AM SndFileId
|
||||
xftpPrepareSendDescription' c userId (ValidFileDescription fdDirect@FileDescription {size, digest}) numRecipients = do
|
||||
xftpSendDescription' c userId (ValidFileDescription fdDirect@FileDescription {size, digest}) numRecipients = do
|
||||
g <- asks random
|
||||
prefixPath <- lift $ getPrefixPath "snd.xftp"
|
||||
createDirectory prefixPath
|
||||
@@ -397,12 +376,9 @@ xftpPrepareSendDescription' c userId (ValidFileDescription fdDirect@FileDescript
|
||||
liftError (FILE . FILE_IO . show) $ CF.writeFile file (LB.fromStrict $ strEncode fdDirect)
|
||||
key <- atomically $ C.randomSbKey g
|
||||
nonce <- atomically $ C.randomCbNonce g
|
||||
withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce (Just RedirectFileInfo {size, digest}) Nothing
|
||||
|
||||
xftpStartSendFile' :: AgentClient -> SndFileId -> AM ()
|
||||
xftpStartSendFile' c sndFileEntityId = do
|
||||
withStore c (`startPreparedSndFile` sndFileEntityId)
|
||||
fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce (Just RedirectFileInfo {size, digest}) Nothing
|
||||
lift . void $ getXFTPSndWorker True c Nothing
|
||||
pure fId
|
||||
|
||||
resumeXFTPSndWork :: AgentClient -> Maybe XFTPServer -> AM' ()
|
||||
resumeXFTPSndWork = void .: getXFTPSndWorker False
|
||||
|
||||
@@ -441,6 +441,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
|
||||
| depth > 0 -> do
|
||||
CryptoFile tmpFile _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ \_ ->
|
||||
fmap CF.plain $ uniqueCombine encPath "redirect.yaml"
|
||||
forM_ chunks $ acknowledgeFileChunk a
|
||||
yaml <- liftIO $ B.readFile tmpFile
|
||||
whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
|
||||
innerVfd <- either (throwE . CLIError . ("Redirect: invalid file description: " <>)) pure $ strDecode yaml
|
||||
@@ -449,6 +450,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
|
||||
Nothing -> do
|
||||
liftIO $ printNoNewLine "Decrypting file..."
|
||||
CryptoFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap CF.plain . getFilePath
|
||||
forM_ chunks $ acknowledgeFileChunk a
|
||||
whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
|
||||
liftIO $ do
|
||||
printNoNewLine $ "File downloaded: " <> path
|
||||
@@ -477,6 +479,12 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
|
||||
_ -> (`uniqueCombine` name') . (</> "Downloads") =<< getHomeDirectory
|
||||
where
|
||||
name' = T.unpack name
|
||||
acknowledgeFileChunk :: XFTPClientAgent -> FileChunk -> ExceptT CLIError IO ()
|
||||
acknowledgeFileChunk a FileChunk {replicas = replica : _} = do
|
||||
let FileChunkReplica {server, replicaId, replicaKey} = replica
|
||||
c <- withRetry retryCount $ getXFTPServerClient a server
|
||||
withRetry retryCount $ ackXFTPChunk c replicaKey (unChunkReplicaId replicaId)
|
||||
acknowledgeFileChunk _ _ = throwE $ CLIError "chunk has no replicas"
|
||||
|
||||
printProgress :: String -> Int64 -> Int64 -> IO ()
|
||||
printProgress s part total = printNoNewLine $ s <> " " <> show ((part * 100) `div` total) <> "%"
|
||||
|
||||
@@ -29,7 +29,6 @@ module Simplex.FileTransfer.Description
|
||||
YAMLFileDescription (..), -- for tests
|
||||
YAMLServerReplicas (..), -- for tests
|
||||
validateFileDescription,
|
||||
sharedDescriptionHash,
|
||||
groupReplicasByServer,
|
||||
fdSeparator,
|
||||
kb,
|
||||
@@ -73,7 +72,6 @@ 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 (Encoding (..))
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, parseAll)
|
||||
import Simplex.Messaging.Protocol (XFTPServer)
|
||||
@@ -229,13 +227,6 @@ validateFileDescription fd@FileDescription {size, chunks}
|
||||
chunkNos = map (\FileChunk {chunkNo} -> chunkNo) chunks
|
||||
chunksSize = foldl' (\(s :: Int64) FileChunk {chunkSize} -> s + fromIntegral (unFileSize chunkSize)) 0
|
||||
|
||||
sharedDescriptionHash :: FileDescription p -> ByteString
|
||||
sharedDescriptionHash FileDescription {size, digest, key, nonce, chunkSize, chunks} =
|
||||
C.sha512Hash $ smpEncode (unFileSize size, unFileDigest digest, C.unSbKey key, nonce, unFileSize chunkSize) <> foldMap chunkFields chunks
|
||||
where
|
||||
chunkFields FileChunk {chunkNo, chunkSize = cSize, digest = cDigest} =
|
||||
smpEncode (fromIntegral chunkNo :: Int64, unFileSize cSize, unFileDigest cDigest)
|
||||
|
||||
encodeFileDescription :: FileDescription p -> YAMLFileDescription
|
||||
encodeFileDescription FileDescription {party, size, digest, key, nonce, chunkSize, chunks, redirect} =
|
||||
YAMLFileDescription
|
||||
|
||||
@@ -25,6 +25,7 @@ import Control.Monad.Reader
|
||||
import Control.Monad.Trans.Except
|
||||
import qualified Data.Aeson as J
|
||||
import Data.Bifunctor (first)
|
||||
import qualified Data.ByteString.Base64.URL as B64
|
||||
import Data.ByteString.Builder (Builder, byteString)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
@@ -62,7 +63,7 @@ import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementProof
|
||||
import qualified Simplex.Messaging.Crypto.Lazy as LC
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Protocol (BlockingInfo, CommandError (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, SignedTransmission, pattern NoEntity)
|
||||
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
|
||||
@@ -593,7 +594,7 @@ processXFTPRequest ent HTTP2Body {bodyPart} = \case
|
||||
\used -> let used' = used + fromIntegral size in if used' <= quota then (True, used') else (False, used)
|
||||
receive = do
|
||||
path <- asks $ filesPath . config
|
||||
let fPath = path </> serverFileName senderId
|
||||
let fPath = path </> B.unpack (B64.encode $ unEntityId senderId)
|
||||
receiveChunk (XFTPRcvChunkSpec fPath size digest) >>= \case
|
||||
Right () -> do
|
||||
stats <- asks serverStats
|
||||
@@ -645,12 +646,11 @@ processXFTPRequest ent HTTP2Body {bodyPart} = \case
|
||||
|
||||
ackFileReception :: RecipientId -> FileRec -> M s FileResponse
|
||||
ackFileReception rId fr = do
|
||||
pure $ FRErr $ CMD PROHIBITED
|
||||
-- withFileLog (`logAckFile` rId)
|
||||
-- st <- asks fileStore
|
||||
-- liftIO $ deleteRecipient st rId fr
|
||||
-- incFileStat fileDownloadAcks
|
||||
-- pure FROk
|
||||
withFileLog (`logAckFile` rId)
|
||||
st <- asks fileStore
|
||||
liftIO $ deleteRecipient st rId fr
|
||||
incFileStat fileDownloadAcks
|
||||
pure FROk
|
||||
|
||||
deleteServerFile_ :: FileStoreClass s => FileRec -> M s (Either XFTPErrorType ())
|
||||
deleteServerFile_ fr@FileRec {senderId} = do
|
||||
|
||||
@@ -17,7 +17,6 @@ module Simplex.FileTransfer.Server.StoreLog
|
||||
logDeleteFile,
|
||||
logBlockFile,
|
||||
logAckFile,
|
||||
serverFileName,
|
||||
)
|
||||
where
|
||||
|
||||
@@ -25,7 +24,6 @@ import Control.Applicative (optional, (<|>))
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad.Except
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import qualified Data.ByteString.Base64.URL as B64
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Composition ((.:), (.::.))
|
||||
@@ -37,11 +35,10 @@ import Simplex.FileTransfer.Protocol (FileInfo (..))
|
||||
import Simplex.FileTransfer.Server.Store
|
||||
import Simplex.FileTransfer.Transport (XFTPErrorType (..))
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Protocol (BlockingInfo, EntityId (..), RcvPublicAuthKey, RecipientId, SenderId)
|
||||
import Simplex.Messaging.Protocol (BlockingInfo, RcvPublicAuthKey, RecipientId, SenderId)
|
||||
import Simplex.Messaging.Server.QueueStore (ServerEntityStatus (..))
|
||||
import Simplex.Messaging.Server.StoreLog
|
||||
import Simplex.Messaging.Util (bshow)
|
||||
import System.FilePath (takeFileName)
|
||||
import System.IO
|
||||
|
||||
data FileStoreLogRecord
|
||||
@@ -102,9 +99,6 @@ logBlockFile s fId = logFileStoreRecord s . BlockFile fId
|
||||
logAckFile :: StoreLog 'WriteMode -> RecipientId -> IO ()
|
||||
logAckFile s = logFileStoreRecord s . AckFile
|
||||
|
||||
serverFileName :: SenderId -> FilePath
|
||||
serverFileName = B.unpack . B64.encode . unEntityId
|
||||
|
||||
readWriteFileStore :: FilePath -> STMFileStore -> IO (StoreLog 'WriteMode)
|
||||
readWriteFileStore = readWriteStoreLog readFileStore writeFileStore
|
||||
|
||||
@@ -121,9 +115,7 @@ readFileStore f st = mapM_ (addFileLogRecord . LB.toStrict) . LB.lines =<< LB.re
|
||||
AddFile sId file createdAt expiresAt status
|
||||
| size file > 0 -> addFile st sId file createdAt expiresAt status
|
||||
| otherwise -> pure $ Left SIZE
|
||||
PutFile qId path
|
||||
| takeFileName path == serverFileName qId -> setFilePath st qId path
|
||||
| otherwise -> pure $ Left AUTH
|
||||
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
|
||||
|
||||
@@ -93,8 +93,7 @@ data RcvFile = RcvFile
|
||||
deriving (Show)
|
||||
|
||||
data RcvFileStatus
|
||||
= RFSPrepared
|
||||
| RFSReceiving
|
||||
= RFSReceiving
|
||||
| RFSReceived
|
||||
| RFSDecrypting
|
||||
| RFSComplete
|
||||
@@ -107,7 +106,6 @@ instance ToField RcvFileStatus where toField = toField . textEncode
|
||||
|
||||
instance TextEncoding RcvFileStatus where
|
||||
textDecode = \case
|
||||
"prepared" -> Just RFSPrepared
|
||||
"receiving" -> Just RFSReceiving
|
||||
"received" -> Just RFSReceived
|
||||
"decrypting" -> Just RFSDecrypting
|
||||
@@ -115,7 +113,6 @@ instance TextEncoding RcvFileStatus where
|
||||
"error" -> Just RFSError
|
||||
_ -> Nothing
|
||||
textEncode = \case
|
||||
RFSPrepared -> "prepared"
|
||||
RFSReceiving -> "receiving"
|
||||
RFSReceived -> "received"
|
||||
RFSDecrypting -> "decrypting"
|
||||
@@ -180,8 +177,7 @@ sndFileEncPath :: FilePath -> FilePath
|
||||
sndFileEncPath prefixPath = prefixPath </> "xftp.encrypted"
|
||||
|
||||
data SndFileStatus
|
||||
= SFSPrepared
|
||||
| SFSNew -- db record created
|
||||
= SFSNew -- db record created
|
||||
| SFSEncrypting -- encryption started
|
||||
| SFSEncrypted -- encryption complete
|
||||
| SFSUploading -- all chunk replicas are created on servers
|
||||
@@ -195,7 +191,6 @@ instance ToField SndFileStatus where toField = toField . textEncode
|
||||
|
||||
instance TextEncoding SndFileStatus where
|
||||
textDecode = \case
|
||||
"prepared" -> Just SFSPrepared
|
||||
"new" -> Just SFSNew
|
||||
"encrypting" -> Just SFSEncrypting
|
||||
"encrypted" -> Just SFSEncrypted
|
||||
@@ -204,7 +199,6 @@ instance TextEncoding SndFileStatus where
|
||||
"error" -> Just SFSError
|
||||
_ -> Nothing
|
||||
textEncode = \case
|
||||
SFSPrepared -> "prepared"
|
||||
SFSNew -> "new"
|
||||
SFSEncrypting -> "encrypting"
|
||||
SFSEncrypted -> "encrypted"
|
||||
|
||||
+38
-100
@@ -106,8 +106,7 @@ module Simplex.Messaging.Agent
|
||||
deleteConnection,
|
||||
deleteConnections,
|
||||
getConnectionServers,
|
||||
getConnectionVerifyCodes,
|
||||
getConnectionsVerifyCodes,
|
||||
getConnectionRatchetAdHash,
|
||||
setProtocolServers,
|
||||
setUserEntitlement,
|
||||
checkUserServers,
|
||||
@@ -127,15 +126,10 @@ module Simplex.Messaging.Agent
|
||||
xftpStartWorkers,
|
||||
xftpStartSndWorkers,
|
||||
xftpReceiveFile,
|
||||
xftpPrepareReceiveFile,
|
||||
xftpStartReceiveFile,
|
||||
xftpDeleteRcvFile,
|
||||
xftpDeleteRcvFiles,
|
||||
xftpSendFile,
|
||||
xftpSendDescription,
|
||||
xftpPrepareSendFile,
|
||||
xftpPrepareSendDescription,
|
||||
xftpStartSendFile,
|
||||
xftpDeleteSndFileInternal,
|
||||
xftpDeleteSndFilesInternal,
|
||||
xftpDeleteSndFileRemote,
|
||||
@@ -195,7 +189,7 @@ import Data.Time.Clock
|
||||
import Data.Time.Clock.System (systemToUTCTime)
|
||||
import Data.Traversable (mapAccumL)
|
||||
import Data.Word (Word16, Word32)
|
||||
import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, deleteSndFilesInternal, deleteSndFilesRemote, startXFTPSndWorkers, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpDeleteRcvFiles', xftpPrepareReceiveFile', xftpPrepareSendDescription', xftpPrepareSendFile', xftpReceiveFile', xftpSendDescription', xftpSendFile', xftpStartReceiveFile', xftpStartSendFile')
|
||||
import Simplex.FileTransfer.Agent (closeXFTPAgent, deleteSndFileInternal, deleteSndFileRemote, deleteSndFilesInternal, deleteSndFilesRemote, startXFTPSndWorkers, startXFTPWorkers, toFSFilePath, xftpDeleteRcvFile', xftpDeleteRcvFiles', xftpReceiveFile', xftpSendDescription', xftpSendFile')
|
||||
import Simplex.FileTransfer.Description (ValidFileDescription)
|
||||
import Simplex.FileTransfer.Protocol (FileParty (..))
|
||||
import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
|
||||
@@ -234,7 +228,7 @@ import Simplex.Messaging.Protocol
|
||||
ErrorType (AUTH),
|
||||
MsgBody,
|
||||
MsgFlags (..),
|
||||
NameResponse,
|
||||
NameRecord,
|
||||
NtfServer,
|
||||
ProtoServerWithAuth (..),
|
||||
ProtocolServer (..),
|
||||
@@ -467,7 +461,7 @@ getConnShortLink c = withAgentEnv c .:. getConnShortLink' c
|
||||
-- | Resolve a SimpleX name (PFWD RSLV). The agent owns server selection: it
|
||||
-- picks a names-capable server (ServerRoles.names) from the user's nameSrvs, so
|
||||
-- chat clients just pass the parsed domain.
|
||||
resolveSimplexName :: AgentClient -> NetworkRequestMode -> UserId -> SimplexDomain -> AE NameResponse
|
||||
resolveSimplexName :: AgentClient -> NetworkRequestMode -> UserId -> SimplexDomain -> AE NameRecord
|
||||
resolveSimplexName c nm userId domain = withAgentEnv c $ resolveSimplexName' c nm userId domain
|
||||
{-# INLINE resolveSimplexName #-}
|
||||
|
||||
@@ -490,12 +484,12 @@ changeConnectionUser c oldUserId connId newUserId = withAgentEnv c $ changeConne
|
||||
-- the caller of joinConnection saves connection ID to the database.
|
||||
-- Instead of it we could send confirmation asynchronously, but then it would be harder to report
|
||||
-- "link deleted" (SMP AUTH) interactively, so this approach is simpler overall.
|
||||
prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> PQSupport -> AE (ConnId, ContactRequestBinding)
|
||||
prepareConnectionToJoin :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> PQSupport -> AE ConnId
|
||||
prepareConnectionToJoin c userId enableNtfs = withAgentEnv c .: newConnToJoin c userId "" enableNtfs Nothing
|
||||
{-# INLINE prepareConnectionToJoin #-}
|
||||
|
||||
-- | Create SMP agent connection without queue (to be joined with acceptContact passing invitation ID).
|
||||
prepareConnectionToAccept :: AgentClient -> UserId -> Bool -> InvitationId -> PQSupport -> AE (ConnId, ContactRequestBinding)
|
||||
prepareConnectionToAccept :: AgentClient -> UserId -> Bool -> InvitationId -> PQSupport -> AE ConnId
|
||||
prepareConnectionToAccept c userId enableNtfs = withAgentEnv c .: newConnToAccept c userId "" enableNtfs
|
||||
{-# INLINE prepareConnectionToAccept #-}
|
||||
|
||||
@@ -679,13 +673,9 @@ getConnectionServers c = withAgentEnv c . getConnectionServers' c
|
||||
{-# INLINE getConnectionServers #-}
|
||||
|
||||
-- | get connection ratchet associated data hash for verification (should match peer AD hash)
|
||||
getConnectionVerifyCodes :: AgentClient -> ConnId -> AE ConnVerifyCodes
|
||||
getConnectionVerifyCodes c = withAgentEnv c . getConnectionVerifyCodes' c
|
||||
{-# INLINE getConnectionVerifyCodes #-}
|
||||
|
||||
getConnectionsVerifyCodes :: AgentClient -> [ConnId] -> AE (Map ConnId ConnVerifyCodes)
|
||||
getConnectionsVerifyCodes c = withAgentEnv c . getConnectionsVerifyCodes' c
|
||||
{-# INLINE getConnectionsVerifyCodes #-}
|
||||
getConnectionRatchetAdHash :: AgentClient -> ConnId -> AE ByteString
|
||||
getConnectionRatchetAdHash c = withAgentEnv c . getConnectionRatchetAdHash' c
|
||||
{-# INLINE getConnectionRatchetAdHash #-}
|
||||
|
||||
-- | Test protocol server
|
||||
testProtocolServer :: forall p. ProtocolTypeI p => AgentClient -> NetworkRequestMode -> UserId -> ProtoServerWithAuth p -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
|
||||
@@ -774,14 +764,6 @@ xftpReceiveFile :: AgentClient -> UserId -> ValidFileDescription 'FRecipient ->
|
||||
xftpReceiveFile c = withAgentEnv c .:: xftpReceiveFile' c
|
||||
{-# INLINE xftpReceiveFile #-}
|
||||
|
||||
xftpPrepareReceiveFile :: AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> Bool -> AE RcvFileId
|
||||
xftpPrepareReceiveFile c = withAgentEnv c .:: xftpPrepareReceiveFile' c
|
||||
{-# INLINE xftpPrepareReceiveFile #-}
|
||||
|
||||
xftpStartReceiveFile :: AgentClient -> RcvFileId -> AE ()
|
||||
xftpStartReceiveFile c = withAgentEnv c . xftpStartReceiveFile' c
|
||||
{-# INLINE xftpStartReceiveFile #-}
|
||||
|
||||
-- | Delete XFTP rcv file (deletes work files from file system and db records)
|
||||
xftpDeleteRcvFile :: AgentClient -> RcvFileId -> IO ()
|
||||
xftpDeleteRcvFile c = withAgentEnv' c . xftpDeleteRcvFile' c
|
||||
@@ -802,18 +784,6 @@ xftpSendDescription :: AgentClient -> UserId -> ValidFileDescription 'FRecipient
|
||||
xftpSendDescription c = withAgentEnv c .:. xftpSendDescription' c
|
||||
{-# INLINE xftpSendDescription #-}
|
||||
|
||||
xftpPrepareSendFile :: AgentClient -> UserId -> CryptoFile -> Int -> Maybe Word32 -> AE SndFileId
|
||||
xftpPrepareSendFile c = withAgentEnv c .:: xftpPrepareSendFile' c
|
||||
{-# INLINE xftpPrepareSendFile #-}
|
||||
|
||||
xftpPrepareSendDescription :: AgentClient -> UserId -> ValidFileDescription 'FRecipient -> Int -> AE SndFileId
|
||||
xftpPrepareSendDescription c = withAgentEnv c .:. xftpPrepareSendDescription' c
|
||||
{-# INLINE xftpPrepareSendDescription #-}
|
||||
|
||||
xftpStartSendFile :: AgentClient -> SndFileId -> AE ()
|
||||
xftpStartSendFile c = withAgentEnv c . xftpStartSendFile' c
|
||||
{-# INLINE xftpStartSendFile #-}
|
||||
|
||||
-- | Delete XFTP snd file internally (deletes work files from file system and db records)
|
||||
xftpDeleteSndFileInternal :: AgentClient -> SndFileId -> IO ()
|
||||
xftpDeleteSndFileInternal c = withAgentEnv' c . deleteSndFileInternal c
|
||||
@@ -1300,7 +1270,7 @@ getConnShortLink' c nm userId = \case
|
||||
deleteLocalInvShortLink' :: AgentClient -> ConnShortLink 'CMInvitation -> AM ()
|
||||
deleteLocalInvShortLink' c (CSLInvitation _ srv linkId _) = withStore' c $ \db -> deleteInvShortLink db srv linkId
|
||||
|
||||
resolveSimplexName' :: AgentClient -> NetworkRequestMode -> UserId -> SimplexDomain -> AM NameResponse
|
||||
resolveSimplexName' :: AgentClient -> NetworkRequestMode -> UserId -> SimplexDomain -> AM NameRecord
|
||||
resolveSimplexName' c nm userId domain = do
|
||||
resolverSrv <- getNextNameServer c userId
|
||||
resolveName c nm userId resolverSrv domain
|
||||
@@ -1341,13 +1311,8 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
|
||||
SCMInvitation -> do
|
||||
g <- asks random
|
||||
let pqEnc = CR.initialPQEncryption (isJust userLinkData_) pqInitKeys
|
||||
e2eRcvParams <- withStore' c $ \db -> do
|
||||
lockConnForUpdate db connId
|
||||
getRatchetX3dhKeys db connId >>= \case
|
||||
Right keys -> pure $ CR.mkRcvE2ERatchetParams (maxVersion e2eEncryptVRange) keys
|
||||
Left _ -> do
|
||||
(pks, e2eRcvParams) <- CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
|
||||
e2eRcvParams <$ createRatchetX3dhKeys db connId pks
|
||||
(pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqEnc
|
||||
withStore' c $ \db -> createRatchetX3dhKeys db connId pks
|
||||
pure $ CRInvitationUri crData $ toVersionRangeT e2eRcvParams e2eEncryptVRange
|
||||
setLinkDataRatchetKeys :: Maybe AddressRatchetKeys -> UserConnLinkData c -> UserConnLinkData c
|
||||
setLinkDataRatchetKeys ks = \case
|
||||
@@ -1405,47 +1370,30 @@ newQueueNtfSubscription c RcvQueue {userId, connId, server, clientNtfCreds} ntfS
|
||||
ns <- asks ntfSupervisor
|
||||
liftIO $ sendNtfSubCommand ns (NSCCreate, [connId])
|
||||
|
||||
newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> Maybe UTCTime -> ConnectionRequestUri c -> PQSupport -> AM (ConnId, ContactRequestBinding)
|
||||
newConnToJoin :: forall c. AgentClient -> UserId -> ConnId -> Bool -> Maybe UTCTime -> ConnectionRequestUri c -> PQSupport -> AM ConnId
|
||||
newConnToJoin c userId connId enableNtfs serviceRequestExpiresAt cReq pqSupport = case cReq of
|
||||
CRInvitationUri {} ->
|
||||
lift (compatibleInvitationUri cReq) >>= \case
|
||||
Just (_, Compatible e2eRcvParams, aVersion) -> create aVersion $ Right e2eRcvParams
|
||||
Just (_, _, aVersion) -> create aVersion
|
||||
Nothing -> throwE $ AGENT A_VERSION
|
||||
CRContactUri {} ->
|
||||
lift (compatibleContactUri cReq) >>= \case
|
||||
Just (Compatible SMPQueueInfo {queueAddress = SMPQueueAddress {senderId}}, ratchet_, aVersion) ->
|
||||
create aVersion $ case ratchet_ of
|
||||
Just (_, Compatible e2eRcvParams) -> Right e2eRcvParams
|
||||
Nothing -> Left senderId
|
||||
Just (_, _, aVersion) -> create aVersion
|
||||
Nothing -> throwE $ AGENT A_VERSION
|
||||
where
|
||||
create :: Compatible VersionSMPA -> Either SMP.SenderId (CR.RcvE2ERatchetParams 'C.X448) -> AM (ConnId, ContactRequestBinding)
|
||||
create (Compatible connAgentVersion) addrOrParams = do
|
||||
create :: Compatible VersionSMPA -> AM ConnId
|
||||
create (Compatible connAgentVersion) = do
|
||||
g <- asks random
|
||||
maxSupported <- asks $ maxVersion . e2eEncryptVRange . config
|
||||
let cData = ConnData {userId, connId, connAgentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport, serviceRequestExpiresAt}
|
||||
withStore c $ \db -> runExceptT $ do
|
||||
connId' <- ExceptT $ createNewConn db g cData SCMInvitation
|
||||
binding <- case addrOrParams of
|
||||
Right e2eRcvParams -> CRBRatchet . ratchetVerifyCodes . fst <$> createRatchet_ db g connId' maxSupported pqSupport e2eRcvParams
|
||||
Left senderId -> do
|
||||
let pqEnc = CR.initialPQEncryption False $ CR.joinContactInitialKeys pqSupport
|
||||
(pks, CR.E2ERatchetParams _ k1 k2 kem_) <- liftIO $ CR.generateRcvE2EParams g maxSupported pqEnc
|
||||
liftIO $ CRBRequest (requestCode k1 k2 kem_ senderId) <$ createRatchetX3dhKeys db connId' pks
|
||||
pure (connId', binding)
|
||||
withStore c $ \db -> createNewConn db g cData SCMInvitation
|
||||
|
||||
requestCode :: C.PublicKeyX448 -> C.PublicKeyX448 -> Maybe (CR.RKEMParams 'CR.RKSProposed) -> SMP.SenderId -> ByteString
|
||||
requestCode k1 k2 kem_ sndId = C.sha256Hash $ smpEncode (k1, k2, kem_, sndId)
|
||||
|
||||
newConnToAccept :: AgentClient -> UserId -> ConnId -> Bool -> InvitationId -> PQSupport -> AM (ConnId, ContactRequestBinding)
|
||||
newConnToAccept :: AgentClient -> UserId -> ConnId -> Bool -> InvitationId -> PQSupport -> AM ConnId
|
||||
newConnToAccept c userId connId enableNtfs invId pqSup = do
|
||||
Invitation {connReq} <- withStore c $ \db -> getInvitation db "newConnToAccept" invId
|
||||
case connReq of
|
||||
CRInvitation cReq -> newConnToJoin c userId connId enableNtfs Nothing cReq pqSup
|
||||
CRInvitationDR dr@DRInvitation {ratchetState} -> do
|
||||
ConnData {connId = connId'} <- newConnToAcceptDR c userId connId dr enableNtfs
|
||||
pure (connId', CRBRatchet $ ratchetVerifyCodes ratchetState)
|
||||
|
||||
CRInvitationDR dr -> (\ConnData {connId = connId'} -> connId') <$> newConnToAcceptDR c userId connId dr enableNtfs
|
||||
|
||||
newConnToAcceptDR :: AgentClient -> UserId -> ConnId -> DRInvitation -> Bool -> AM ConnData
|
||||
newConnToAcceptDR c userId connId DRInvitation {agentVersion, pqSupport} enableNtfs = do
|
||||
g <- asks random
|
||||
@@ -1488,7 +1436,7 @@ startJoinInvitation c userId connId sq_ enableNtfs cReqUri pqSupport =
|
||||
(q, _) <- lift $ newSndQueue userId "" qInfo sndKey_
|
||||
withStore c $ \db -> runExceptT $ do
|
||||
liftIO $ lockConnForUpdate db connId
|
||||
(_, e2eSndParams) <- liftIO (getSndRatchet db connId v) >>= either (const $ createRatchet_ db g connId maxSupported pqSupport e2eRcvParams) pure
|
||||
e2eSndParams <- snd <$> createRatchet_ db g connId maxSupported pqSupport e2eRcvParams
|
||||
sq' <- maybe (ExceptT $ updateNewConnSnd db connId q) pure sq_
|
||||
pure ((cData, sq'), (Just e2eSndParams, lnkId_))
|
||||
Nothing -> throwE $ AGENT A_VERSION
|
||||
@@ -1781,7 +1729,7 @@ serviceRequest_ c userId cReqUri@(CRContactUri _ addrKeys_) timeout_ doSend = do
|
||||
when (isNothing addrKeys_) $ throwE $ AGENT $ A_SERVICE ASENotDRAddress
|
||||
reqTimeout <- maybe (asks $ serviceRequestTimeout . config) pure timeout_
|
||||
expiresAt <- addUTCTime reqTimeout <$> liftIO getCurrentTime
|
||||
(connId, _) <- newConnToJoin c userId "" False (Just expiresAt) cReqUri PQSupportOn
|
||||
connId <- newConnToJoin c userId "" False (Just expiresAt) cReqUri PQSupportOn
|
||||
var <- atomically newEmptyTMVar
|
||||
atomically $ TM.insert connId var (serviceRequests c)
|
||||
r <- tryAllErrors $ do
|
||||
@@ -2168,21 +2116,20 @@ data CommandCompletion = CCMoved | CCCompleted
|
||||
|
||||
runCommandProcessing :: AgentClient -> ConnId -> Maybe SMPServer -> Worker -> AM ()
|
||||
runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
|
||||
AgentConfig {messageRetryInterval = RetryInterval2 {riFast}, commandQuotaRetryInterval} <- asks config
|
||||
let ri = RetryInterval2 {riSlow = commandQuotaRetryInterval, riFast}
|
||||
ri <- asks $ messageRetryInterval . config -- different retry interval?
|
||||
forever $ do
|
||||
atomically $ endAgentOperation c AOSndNetwork
|
||||
lift $ waitForWork doWork
|
||||
liftIO $ throwWhenInactive c
|
||||
atomically $ beginAgentOperation c AOSndNetwork
|
||||
withWork c doWork (\db -> getPendingServerCommand db connId server_) $ runProcessCmd ri
|
||||
withWork c doWork (\db -> getPendingServerCommand db connId server_) $ runProcessCmd (riFast ri)
|
||||
where
|
||||
runProcessCmd ri cmd = do
|
||||
pending <- newTVarIO []
|
||||
processCmd ri cmd pending
|
||||
mapM_ (atomically . writeTBQueue subQ) . reverse =<< readTVarIO pending
|
||||
processCmd :: RetryInterval2 -> PendingCommand -> TVar [ATransmission] -> AM ()
|
||||
processCmd ri PendingCommand {cmdId, corrId, userId, command, createdAt} pendingCmds = case command of
|
||||
processCmd :: RetryInterval -> PendingCommand -> TVar [ATransmission] -> AM ()
|
||||
processCmd ri PendingCommand {cmdId, corrId, userId, command} pendingCmds = case command of
|
||||
AClientCommand cmd -> case cmd of
|
||||
NEW enableNtfs (ACM cMode) pqEnc subMode useDR -> noServer $ do
|
||||
triedHosts <- newTVarIO S.empty
|
||||
@@ -2377,18 +2324,12 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
|
||||
SomeConn _ conn@DuplexConnection {} -> a conn
|
||||
_ -> internalErr "command requires duplex connection"
|
||||
tryCommand action = tryMoveableCommand (action $> CCCompleted)
|
||||
tryMoveableCommand action = withRetryInterval2 ri $ \_ loop -> do
|
||||
tryMoveableCommand action = withRetryInterval ri $ \_ loop -> do
|
||||
liftIO $ waitWhileSuspended c
|
||||
liftIO $ waitForUserNetwork c
|
||||
tryAllErrors action >>= \case
|
||||
Left e@(SMP _ SMP.QUOTA) -> do
|
||||
AgentConfig {quotaExceededTimeout} <- asks config
|
||||
expireTs <- addUTCTime (-quotaExceededTimeout) <$> liftIO getCurrentTime
|
||||
if createdAt < expireTs
|
||||
then cmdError e
|
||||
else retrySndOp c $ loop RISlow
|
||||
Left e
|
||||
| temporaryOrHostError e -> retrySndOp c $ loop RIFast
|
||||
| temporaryOrHostError e -> retrySndOp c loop
|
||||
| otherwise -> cmdError e
|
||||
Right CCCompleted -> withStore' c (`deleteCommand` cmdId)
|
||||
Right CCMoved -> pure () -- command processing moved to another command queue
|
||||
@@ -3048,12 +2989,10 @@ getConnectionServers' c connId = do
|
||||
SomeConn _ conn <- withStore c (`getConn` connId)
|
||||
connectionStats c conn
|
||||
|
||||
getConnectionVerifyCodes' :: AgentClient -> ConnId -> AM ConnVerifyCodes
|
||||
getConnectionVerifyCodes' c connId =
|
||||
getConnectionsVerifyCodes' c [connId] >>= maybe (throwE $ CONN NOT_FOUND "") pure . M.lookup connId
|
||||
|
||||
getConnectionsVerifyCodes' :: AgentClient -> [ConnId] -> AM (Map ConnId ConnVerifyCodes)
|
||||
getConnectionsVerifyCodes' c connIds = withStore' c (`getRatchetVerifyCodes` connIds)
|
||||
getConnectionRatchetAdHash' :: AgentClient -> ConnId -> AM ByteString
|
||||
getConnectionRatchetAdHash' c connId = do
|
||||
CR.Ratchet {rcAD = Str rcAD} <- withStore c (`getRatchet` connId)
|
||||
pure $ C.sha256Hash rcAD
|
||||
|
||||
connectionStats :: AgentClient -> Connection c -> AM ConnectionStats
|
||||
connectionStats c = \case
|
||||
@@ -4101,14 +4040,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
|
||||
enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} (EREADY lastExternalSndId)
|
||||
|
||||
smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM ()
|
||||
smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData (CR.E2ERatchetParamsUri _ k1 k2 kem_)) cInfo = do
|
||||
smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData _) cInfo = do
|
||||
logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' srvMsgId
|
||||
case conn' of
|
||||
ContactConnection _ RcvQueue {sndId} -> do
|
||||
ContactConnection {} -> do
|
||||
-- show connection request even if invitaion via contact address is not compatible.
|
||||
invId <- storeInvitation (CRInvitation connReq) cInfo False
|
||||
let srvs = L.map qServer $ crSmpQueues crData
|
||||
notify $ REQ invId PQSupportOn srvs cInfo (CRBRequest $ requestCode k1 k2 kem_ sndId) False
|
||||
notify $ REQ invId PQSupportOn srvs cInfo False
|
||||
_ -> prohibited "inv: sent to message conn"
|
||||
|
||||
storeInvitation :: ContactRequest -> ConnInfo -> Bool -> AM InvitationId
|
||||
@@ -4135,7 +4074,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
|
||||
parseMessage "3" agentMsgBody >>= \case
|
||||
AgentConnInfoReply (replyQueue :| _) cInfo -> do
|
||||
invId <- storeInvitation (CRInvitationDR $ mkDR replyQueue) cInfo False
|
||||
notify $ REQ invId PQSupportOn (qServer replyQueue :| []) cInfo (CRBRatchet $ ratchetVerifyCodes ratchetState) True
|
||||
notify $ REQ invId PQSupportOn (qServer replyQueue :| []) cInfo True
|
||||
AgentServiceRequest (replyQueue :| _) sig_ payload ->
|
||||
case verifyServiceReq rc payload sig_ of
|
||||
Left err -> logError ("service request: " <> T.pack err) >> notify (ERR $ AGENT $ A_SERVICE ASEBadSignature)
|
||||
@@ -4388,9 +4327,8 @@ agentRatchetDecrypt' :: TVar ChaChaDRG -> DB.Connection -> ConnId -> CR.RatchetX
|
||||
agentRatchetDecrypt' g db connId rc encAgentMsg = do
|
||||
skipped <- liftIO $ getSkippedMsgKeys db connId
|
||||
(agentMsgBody_, rc', skippedDiff) <- withExceptT (SEAgentError . cryptoError) $ CR.rcDecrypt g rc skipped encAgentMsg
|
||||
agentMsgBody <- liftEither $ first (SEAgentError . cryptoError) agentMsgBody_
|
||||
liftIO $ updateRatchet db connId rc' skippedDiff
|
||||
pure (agentMsgBody, CR.rcRcvKEM rc')
|
||||
liftEither $ bimap (SEAgentError . cryptoError) (,CR.rcRcvKEM rc') agentMsgBody_
|
||||
|
||||
newSndQueue :: UserId -> ConnId -> Compatible SMPQueueInfo -> Maybe (C.APrivateAuthKey) -> AM' (NewSndQueue, C.PublicKeyX25519)
|
||||
newSndQueue userId connId (Compatible (SMPQueueInfo smpClientVersion SMPQueueAddress {smpServer, senderId, queueMode, dhPublicKey = rcvE2ePubDhKey})) sndKey_ = do
|
||||
|
||||
@@ -272,7 +272,7 @@ import Simplex.Messaging.Protocol
|
||||
NetworkError (..),
|
||||
MsgFlags (..),
|
||||
MsgId,
|
||||
NameResponse,
|
||||
NameRecord,
|
||||
NtfServer,
|
||||
NtfServerWithAuth,
|
||||
ProtoServer,
|
||||
@@ -2022,7 +2022,7 @@ getQueueLink c nm userId server lnkId =
|
||||
-- resolver) and falls back to a direct send when the proxy is unavailable
|
||||
-- (faster but exposes the client IP). Mode selection is delegated to
|
||||
-- `sendOrProxySMPCommand`, which honours the network config (SPMNever etc.).
|
||||
resolveName :: AgentClient -> NetworkRequestMode -> UserId -> SMPServer -> SimplexDomain -> AM NameResponse
|
||||
resolveName :: AgentClient -> NetworkRequestMode -> UserId -> SMPServer -> SimplexDomain -> AM NameRecord
|
||||
resolveName c nm userId server domain =
|
||||
snd <$> sendOrProxySMPCommand c nm userId server "" "RSLV" NoEntity resolveViaProxy resolveDirectly
|
||||
where
|
||||
|
||||
@@ -162,7 +162,6 @@ data AgentConfig = AgentConfig
|
||||
connDeleteDeliveryTimeout :: NominalDiffTime,
|
||||
helloTimeout :: NominalDiffTime,
|
||||
quotaExceededTimeout :: NominalDiffTime,
|
||||
commandQuotaRetryInterval :: RetryInterval,
|
||||
persistErrorInterval :: NominalDiffTime,
|
||||
initialCleanupDelay :: Int64,
|
||||
cleanupInterval :: Int64,
|
||||
@@ -242,7 +241,6 @@ defaultAgentConfig =
|
||||
connDeleteDeliveryTimeout = 2 * nominalDay,
|
||||
helloTimeout = 2 * nominalDay,
|
||||
quotaExceededTimeout = 7 * nominalDay,
|
||||
commandQuotaRetryInterval = RetryInterval {initialInterval = 30_000000, increaseAfter = 0, maxInterval = 3600_000000},
|
||||
persistErrorInterval = 3, -- seconds
|
||||
initialCleanupDelay = 30 * 1000000, -- 30 seconds
|
||||
cleanupInterval = 5 * 60 * 1000000, -- 5 minutes
|
||||
|
||||
@@ -166,8 +166,6 @@ module Simplex.Messaging.Agent.Protocol
|
||||
ConnId,
|
||||
ConfirmationId,
|
||||
InvitationId,
|
||||
ConnVerifyCodes (..),
|
||||
ContactRequestBinding (..),
|
||||
MsgIntegrity (..),
|
||||
MsgErrorType (..),
|
||||
QueueStatus (..),
|
||||
@@ -406,7 +404,7 @@ data AEvent (e :: AEntity) where
|
||||
LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn
|
||||
LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> ConnectionRequestUri 'CMContact -> AEvent AEConn
|
||||
CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
|
||||
REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> ContactRequestBinding -> Bool -> AEvent AEConn -- ConnInfo is from sender; Bool - rejection reason can be sent
|
||||
REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> Bool -> AEvent AEConn -- ConnInfo is from sender; Bool - rejection reason can be sent
|
||||
SREQ :: InvitationId -> Maybe C.PublicKeyEd25519 -> MsgBody -> AEvent AEConn
|
||||
SSENT :: AgentMsgId -> Maybe SMPServer -> AEvent AEConn
|
||||
RJCT :: ConnInfo -> AEvent AEConn
|
||||
@@ -1374,15 +1372,6 @@ type ConfirmationId = ByteString
|
||||
|
||||
type InvitationId = ByteString
|
||||
|
||||
data ConnVerifyCodes = ConnVerifyCodes
|
||||
{ codeAD :: ByteString,
|
||||
codePQ :: Maybe ByteString
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ContactRequestBinding = CRBRatchet ConnVerifyCodes | CRBRequest ByteString
|
||||
deriving (Eq, Show)
|
||||
|
||||
extraSMPServerHosts :: Map TransportHost TransportHost
|
||||
extraSMPServerHosts =
|
||||
M.fromList
|
||||
|
||||
@@ -10,7 +10,6 @@ module Simplex.Messaging.Agent.RetryInterval
|
||||
withRetryInterval,
|
||||
withRetryIntervalCount,
|
||||
withRetryForeground,
|
||||
withRetryInterval2,
|
||||
withRetryLock2,
|
||||
updateRetryInterval2,
|
||||
nextRetryDelay,
|
||||
@@ -87,24 +86,9 @@ withRetryForeground ri isForeground isOnline action = callAction 0 $ initialInte
|
||||
| otherwise = (elapsed + delay, nextRetryDelay elapsed' delay ri)
|
||||
callAction elapsed' delay'
|
||||
|
||||
withRetryInterval2 :: forall m. MonadIO m => RetryInterval2 -> (RI2State -> (RetryIntervalMode -> m ()) -> m ()) -> m ()
|
||||
withRetryInterval2 = withRetryWait2 $ liftIO . threadDelay'
|
||||
|
||||
-- This function allows action to toggle between slow and fast retry intervals.
|
||||
withRetryLock2 :: forall m. MonadIO m => RetryInterval2 -> TMVar () -> (RI2State -> (RetryIntervalMode -> m ()) -> m ()) -> m ()
|
||||
withRetryLock2 ri lock = withRetryWait2 wait ri
|
||||
where
|
||||
wait delay = do
|
||||
waiting <- newTVarIO True
|
||||
_ <- liftIO . forkIO $ do
|
||||
threadDelay' delay
|
||||
atomically $ whenM (readTVar waiting) $ void $ tryPutTMVar lock ()
|
||||
atomically $ do
|
||||
takeTMVar lock
|
||||
writeTVar waiting False
|
||||
|
||||
withRetryWait2 :: forall m. Monad m => (Int64 -> m ()) -> RetryInterval2 -> (RI2State -> (RetryIntervalMode -> m ()) -> m ()) -> m ()
|
||||
withRetryWait2 wait RetryInterval2 {riSlow, riFast} action =
|
||||
withRetryLock2 RetryInterval2 {riSlow, riFast} lock action =
|
||||
callAction (0, initialInterval riSlow) (0, initialInterval riFast)
|
||||
where
|
||||
callAction :: (Int64, Int64) -> (Int64, Int64) -> m ()
|
||||
@@ -118,6 +102,14 @@ withRetryWait2 wait RetryInterval2 {riSlow, riFast} action =
|
||||
let elapsed' = elapsed + delay
|
||||
delay' = nextRetryDelay elapsed' delay ri
|
||||
call (elapsed', delay')
|
||||
wait delay = do
|
||||
waiting <- newTVarIO True
|
||||
_ <- liftIO . forkIO $ do
|
||||
threadDelay' delay
|
||||
atomically $ whenM (readTVar waiting) $ void $ tryPutTMVar lock ()
|
||||
atomically $ do
|
||||
takeTMVar lock
|
||||
writeTVar waiting False
|
||||
|
||||
nextRetryDelay :: Int64 -> Int64 -> RetryInterval -> Int64
|
||||
nextRetryDelay elapsed delay RetryInterval {increaseAfter, maxInterval} =
|
||||
|
||||
@@ -489,8 +489,7 @@ data PendingCommand = PendingCommand
|
||||
corrId :: ACorrId,
|
||||
userId :: UserId,
|
||||
connId :: ConnId,
|
||||
command :: AgentCommand,
|
||||
createdAt :: UTCTime
|
||||
command :: AgentCommand
|
||||
}
|
||||
|
||||
data AgentCmdType = ACClient | ACInternal
|
||||
|
||||
@@ -165,8 +165,6 @@ module Simplex.Messaging.Agent.Store.AgentStore
|
||||
createRatchet,
|
||||
deleteRatchet,
|
||||
getRatchet,
|
||||
getRatchetVerifyCodes,
|
||||
ratchetVerifyCodes,
|
||||
getRatchetForUpdate,
|
||||
getSkippedMsgKeys,
|
||||
updateRatchet,
|
||||
@@ -215,7 +213,6 @@ module Simplex.Messaging.Agent.Store.AgentStore
|
||||
-- Rcv files
|
||||
createRcvFile,
|
||||
createRcvFileRedirect,
|
||||
startPreparedRcvFile,
|
||||
lockRcvFileForUpdate,
|
||||
getRcvFile,
|
||||
getRcvFileByEntityId,
|
||||
@@ -237,7 +234,6 @@ module Simplex.Messaging.Agent.Store.AgentStore
|
||||
getRcvFilesExpired,
|
||||
-- Snd files
|
||||
createSndFile,
|
||||
startPreparedSndFile,
|
||||
lockSndFileForUpdate,
|
||||
getSndFile,
|
||||
getSndFileByEntityId,
|
||||
@@ -295,7 +291,6 @@ import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Base64.URL as U
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Either (partitionEithers)
|
||||
import Data.Functor (($>))
|
||||
import Data.Int (Int64)
|
||||
import Data.List (foldl', sortBy)
|
||||
@@ -1479,11 +1474,9 @@ createSndRatchet db connId ratchetState (CR.AE2ERatchetParams s (CR.E2ERatchetPa
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO ratchets
|
||||
(conn_id, ratchet_state, rc_verify_code_ad, rc_verify_code_pq, x3dh_pub_key_1, x3dh_pub_key_2, pq_pub_kem) VALUES (?, ?, ?, ?, ?, ?, ?)
|
||||
(conn_id, ratchet_state, x3dh_pub_key_1, x3dh_pub_key_2, pq_pub_kem) VALUES (?, ?, ?, ?, ?)
|
||||
ON CONFLICT (conn_id) DO UPDATE SET
|
||||
ratchet_state = EXCLUDED.ratchet_state,
|
||||
rc_verify_code_ad = EXCLUDED.rc_verify_code_ad,
|
||||
rc_verify_code_pq = EXCLUDED.rc_verify_code_pq,
|
||||
x3dh_priv_key_1 = NULL,
|
||||
x3dh_priv_key_2 = NULL,
|
||||
x3dh_pub_key_1 = EXCLUDED.x3dh_pub_key_1,
|
||||
@@ -1491,13 +1484,7 @@ createSndRatchet db connId ratchetState (CR.AE2ERatchetParams s (CR.E2ERatchetPa
|
||||
pq_priv_kem = NULL,
|
||||
pq_pub_kem = EXCLUDED.pq_pub_kem
|
||||
|]
|
||||
((connId, ratchetState) :. verifyCodesRow (ratchetVerifyCodes ratchetState) :. (x3dhPubKey1, x3dhPubKey2, CR.ARKP s <$> pqPubKem))
|
||||
|
||||
ratchetVerifyCodes :: RatchetX448 -> ConnVerifyCodes
|
||||
ratchetVerifyCodes CR.Ratchet {rcAD, rcVCPQ} = ConnVerifyCodes {codeAD = C.sha256Hash $ unStr rcAD, codePQ = unStr <$> rcVCPQ}
|
||||
|
||||
verifyCodesRow :: ConnVerifyCodes -> (Binary ByteString, Maybe (Binary ByteString))
|
||||
verifyCodesRow ConnVerifyCodes {codeAD, codePQ} = (Binary codeAD, Binary <$> codePQ)
|
||||
(connId, ratchetState, x3dhPubKey1, x3dhPubKey2, CR.ARKP s <$> pqPubKem)
|
||||
|
||||
getSndRatchet :: DB.Connection -> ConnId -> CR.VersionE2E -> IO (Either StoreError (RatchetX448, CR.AE2ERatchetParams 'C.X448))
|
||||
getSndRatchet db connId v =
|
||||
@@ -1518,12 +1505,10 @@ createRatchet db connId rc =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO ratchets (conn_id, ratchet_state, rc_verify_code_ad, rc_verify_code_pq)
|
||||
VALUES (?, ?, ?, ?)
|
||||
INSERT INTO ratchets (conn_id, ratchet_state)
|
||||
VALUES (?, ?)
|
||||
ON CONFLICT (conn_id) DO UPDATE SET
|
||||
ratchet_state = EXCLUDED.ratchet_state,
|
||||
rc_verify_code_ad = EXCLUDED.rc_verify_code_ad,
|
||||
rc_verify_code_pq = EXCLUDED.rc_verify_code_pq,
|
||||
ratchet_state = ?,
|
||||
x3dh_priv_key_1 = NULL,
|
||||
x3dh_priv_key_2 = NULL,
|
||||
x3dh_pub_key_1 = NULL,
|
||||
@@ -1531,42 +1516,7 @@ createRatchet db connId rc =
|
||||
pq_priv_kem = NULL,
|
||||
pq_pub_kem = NULL
|
||||
|]
|
||||
((connId, rc) :. verifyCodesRow (ratchetVerifyCodes rc))
|
||||
|
||||
getRatchetVerifyCodes :: DB.Connection -> [ConnId] -> IO (Map ConnId ConnVerifyCodes)
|
||||
getRatchetVerifyCodes db connIds = do
|
||||
(saved, computed) <- partitionEithers . mapMaybe rowCodes <$> selectCodes
|
||||
stored <- saveCodes computed
|
||||
pure $ M.fromList $ saved <> stored
|
||||
where
|
||||
rowCodes (connId, codeAD_, codePQ_, rc_) = case codeAD_ of
|
||||
Just codeAD -> Just $ Left $ toCodes (connId, codeAD, codePQ_)
|
||||
Nothing -> Right . (connId,) . ratchetVerifyCodes <$> rc_
|
||||
toCodes (connId, Binary codeAD, codePQ_) = (connId, ConnVerifyCodes {codeAD, codePQ = fromBinary <$> codePQ_})
|
||||
codesRow (connId, cs) = verifyCodesRow cs :. Only connId
|
||||
codesQuery :: Query
|
||||
codesQuery = "SELECT conn_id, rc_verify_code_ad, rc_verify_code_pq, CASE WHEN rc_verify_code_ad IS NULL THEN ratchet_state END FROM ratchets"
|
||||
selectCodes :: IO [(ConnId, Maybe (Binary ByteString), Maybe (Binary ByteString), Maybe RatchetX448)]
|
||||
saveCodes :: [(ConnId, ConnVerifyCodes)] -> IO [(ConnId, ConnVerifyCodes)]
|
||||
#if defined(dbPostgres)
|
||||
selectCodes = DB.query db (codesQuery <> " WHERE conn_id IN ?") (Only (In connIds))
|
||||
saveCodes cs =
|
||||
map toCodes
|
||||
<$> DB.returning
|
||||
db
|
||||
[sql|
|
||||
UPDATE ratchets r
|
||||
SET rc_verify_code_ad = COALESCE(r.rc_verify_code_ad, (upd.rc_verify_code_ad :: BYTEA)),
|
||||
rc_verify_code_pq = CASE WHEN r.rc_verify_code_ad IS NULL THEN (upd.rc_verify_code_pq :: BYTEA) ELSE r.rc_verify_code_pq END
|
||||
FROM (VALUES(?, ?, ?)) AS upd(rc_verify_code_ad, rc_verify_code_pq, conn_id)
|
||||
WHERE r.conn_id = (upd.conn_id :: BYTEA)
|
||||
RETURNING r.conn_id, r.rc_verify_code_ad, r.rc_verify_code_pq
|
||||
|]
|
||||
(map codesRow cs)
|
||||
#else
|
||||
selectCodes = concat <$> mapM (DB.query db (codesQuery <> " WHERE conn_id = ?") . Only) connIds
|
||||
saveCodes cs = cs <$ unless (null cs) (DB.executeMany db "UPDATE ratchets SET rc_verify_code_ad = ?, rc_verify_code_pq = ? WHERE conn_id = ?" $ map codesRow cs)
|
||||
#endif
|
||||
(connId, rc, rc)
|
||||
|
||||
deleteRatchet :: DB.Connection -> ConnId -> IO ()
|
||||
deleteRatchet db connId =
|
||||
@@ -1718,7 +1668,7 @@ getPendingServerCommand db connId srv_ = getWorkItem "command" getCmdId getComma
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT c.corr_id, cs.user_id, c.command, c.created_at
|
||||
SELECT c.corr_id, cs.user_id, c.command
|
||||
FROM commands c
|
||||
JOIN connections cs USING (conn_id)
|
||||
WHERE c.command_id = ?
|
||||
@@ -1726,7 +1676,7 @@ getPendingServerCommand db connId srv_ = getWorkItem "command" getCmdId getComma
|
||||
(Only cmdId)
|
||||
where
|
||||
err = SEInternal $ "command " <> bshow cmdId <> " returned []"
|
||||
pendingCommand (corrId, userId, command, createdAt) = PendingCommand {cmdId, corrId, userId, connId, command, createdAt}
|
||||
pendingCommand (corrId, userId, command) = PendingCommand {cmdId, corrId, userId, connId, command}
|
||||
markCommandFailed cmdId = DB.execute db "UPDATE commands SET failed = 1 WHERE command_id = ?" (Only cmdId)
|
||||
|
||||
updateCommandServer :: DB.Connection -> AsyncCmdId -> SMPServer -> IO (Either StoreError ())
|
||||
@@ -2500,12 +2450,12 @@ getSubscriptionServers db onlyNeeded =
|
||||
|
||||
-- TODO [certs rcv] check index for getting queues with service present
|
||||
getUserServerRcvQueueSubs :: DB.Connection -> UserId -> SMPServer -> Bool -> ServiceAssoc -> Int -> Maybe SMP.RecipientId -> IO [RcvQueueSub]
|
||||
getUserServerRcvQueueSubs db userId srv@(SMPServer h p kh) onlyNeeded hasService limit cursor_ =
|
||||
map (toServerRcvQueueSub srv) <$> case cursor_ of
|
||||
getUserServerRcvQueueSubs db userId (SMPServer h p kh) onlyNeeded hasService limit cursor_ =
|
||||
map toRcvQueueSub <$> case cursor_ of
|
||||
Nothing -> DB.query db (q <> orderLimit) (userId, h, p, kh, limit)
|
||||
Just cursor -> DB.query db (q <> " AND q.rcv_id > ? " <> orderLimit) (userId, h, p, kh, cursor, limit)
|
||||
where
|
||||
q = serverRcvQueueSubQuery <> toSubscribe <> " c.deleted = 0 AND q.deleted = 0 AND c.user_id = ? AND q.host = ? AND q.port = ? AND COALESCE(q.server_key_hash, s.key_hash) = ?" <> serviceCond
|
||||
q = rcvQueueSubQuery <> toSubscribe <> " c.deleted = 0 AND q.deleted = 0 AND c.user_id = ? AND q.host = ? AND q.port = ? AND COALESCE(q.server_key_hash, s.key_hash) = ?" <> serviceCond
|
||||
orderLimit = " ORDER BY q.rcv_id LIMIT ?"
|
||||
toSubscribe
|
||||
| onlyNeeded = " WHERE q.to_subscribe = 1 AND "
|
||||
@@ -2518,7 +2468,7 @@ unassocUserServerRcvQueueSubs :: DB.Connection -> UserId -> SMPServer -> IO [Rcv
|
||||
unassocUserServerRcvQueueSubs db userId srv@(SMPServer h p kh) = do
|
||||
deleteClientService db userId srv
|
||||
#if defined(dbPostgres)
|
||||
map (toServerRcvQueueSub srv)
|
||||
map toRcvQueueSub
|
||||
<$> DB.query
|
||||
db
|
||||
(removeRcvAssocsQuery <> " " <> returningColumns)
|
||||
@@ -2526,15 +2476,15 @@ unassocUserServerRcvQueueSubs db userId srv@(SMPServer h p kh) = do
|
||||
where
|
||||
returningColumns =
|
||||
[sql|
|
||||
RETURNING c.user_id, rcv_queues.conn_id,
|
||||
RETURNING c.user_id, rcv_queues.conn_id, rcv_queues.host, rcv_queues.port, COALESCE(rcv_queues.server_key_hash, s.key_hash),
|
||||
rcv_queues.rcv_id, rcv_queues.rcv_private_key, rcv_queues.status, c.enable_ntfs, rcv_queues.client_notice_id,
|
||||
rcv_queues.rcv_queue_id, rcv_queues.rcv_primary, rcv_queues.replace_rcv_queue_id
|
||||
|]
|
||||
#else
|
||||
qs <- map (toServerRcvQueueSub srv)
|
||||
qs <- map toRcvQueueSub
|
||||
<$> DB.query
|
||||
db
|
||||
(serverRcvQueueSubQuery <> " WHERE c.user_id = ? AND q.host = ? AND q.port = ? AND COALESCE(q.server_key_hash, s.key_hash) = ? AND q.rcv_service_assoc = 1")
|
||||
(rcvQueueSubQuery <> " WHERE c.user_id = ? AND q.host = ? AND q.port = ? AND COALESCE(q.server_key_hash, s.key_hash) = ? AND q.rcv_service_assoc = 1")
|
||||
(userId, h, p, kh)
|
||||
DB.execute db removeRcvAssocsQuery (h, p, userId, kh)
|
||||
pure qs
|
||||
@@ -2885,32 +2835,17 @@ getRcvQueueSubsByConnId_ db connId =
|
||||
rcvQueueSubQuery :: Query
|
||||
rcvQueueSubQuery =
|
||||
[sql|
|
||||
SELECT q.host, q.port, COALESCE(q.server_key_hash, s.key_hash), c.user_id, q.conn_id, q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
|
||||
SELECT c.user_id, q.conn_id, q.host, q.port, COALESCE(q.server_key_hash, s.key_hash), q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
|
||||
q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id
|
||||
FROM rcv_queues q
|
||||
JOIN servers s ON q.host = s.host AND q.port = s.port
|
||||
JOIN connections c ON q.conn_id = c.conn_id
|
||||
|]
|
||||
|
||||
serverRcvQueueSubQuery :: Query
|
||||
serverRcvQueueSubQuery =
|
||||
[sql|
|
||||
SELECT c.user_id, q.conn_id, q.rcv_id, q.rcv_private_key, q.status, c.enable_ntfs, q.client_notice_id,
|
||||
q.rcv_queue_id, q.rcv_primary, q.replace_rcv_queue_id
|
||||
FROM rcv_queues q
|
||||
JOIN servers s ON q.host = s.host AND q.port = s.port
|
||||
JOIN connections c ON q.conn_id = c.conn_id
|
||||
|]
|
||||
|
||||
type RcvQueueSubRow = (UserId, ConnId, SMP.RecipientId, SMP.RcvPrivateAuthKey) :. (QueueStatus, Maybe BoolInt, Maybe NoticeId, Int64, BoolInt, Maybe Int64)
|
||||
|
||||
toRcvQueueSub :: (NonEmpty TransportHost, ServiceName, C.KeyHash) :. RcvQueueSubRow -> RcvQueueSub
|
||||
toRcvQueueSub ((host, port, keyHash) :. r) = toServerRcvQueueSub (SMPServer host port keyHash) r
|
||||
|
||||
toServerRcvQueueSub :: SMPServer -> RcvQueueSubRow -> RcvQueueSub
|
||||
toServerRcvQueueSub server ((userId, connId, rcvId, rcvPrivateKey) :. (status, enableNtfs_, clientNoticeId, dbQueueId, BI primary, dbReplaceQueueId)) =
|
||||
toRcvQueueSub :: (UserId, ConnId, NonEmpty TransportHost, ServiceName, C.KeyHash, SMP.RecipientId, SMP.RcvPrivateAuthKey) :. (QueueStatus, Maybe BoolInt, Maybe NoticeId, Int64, BoolInt, Maybe Int64) -> RcvQueueSub
|
||||
toRcvQueueSub ((userId, connId, host, port, keyHash, rcvId, rcvPrivateKey) :. (status, enableNtfs_, clientNoticeId, dbQueueId, BI primary, dbReplaceQueueId)) =
|
||||
let enableNtfs = maybe True unBI enableNtfs_
|
||||
in RcvQueueSub {userId, connId, server, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId}
|
||||
in RcvQueueSub {userId, connId, server = SMPServer host port keyHash, rcvId, rcvPrivateKey, status, enableNtfs, clientNoticeId, dbQueueId, primary, dbReplaceQueueId}
|
||||
|
||||
getRcvQueueById :: DB.Connection -> ConnId -> Int64 -> IO (Either StoreError RcvQueue)
|
||||
getRcvQueueById db connId dbRcvId =
|
||||
@@ -3180,29 +3115,6 @@ createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redire
|
||||
chunks = []
|
||||
}
|
||||
|
||||
startPreparedRcvFile :: DB.Connection -> RcvFileId -> IO (Either StoreError [XFTPServer])
|
||||
startPreparedRcvFile db rcvFileEntityId = runExceptT $ do
|
||||
rcvFileId <- ExceptT $ getRcvFileIdByEntityId_ db rcvFileEntityId
|
||||
liftIO $ do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE rcv_files SET status = ?, updated_at = ? WHERE (rcv_file_id = ? OR redirect_id = ?) AND status = ?"
|
||||
(RFSReceiving, updatedAt, rcvFileId, rcvFileId, RFSPrepared)
|
||||
map toXFTPServer
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT DISTINCT
|
||||
s.xftp_host, s.xftp_port, s.xftp_key_hash
|
||||
FROM rcv_file_chunk_replicas r
|
||||
JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
|
||||
JOIN rcv_file_chunks c ON c.rcv_file_chunk_id = r.rcv_file_chunk_id
|
||||
JOIN rcv_files f ON f.rcv_file_id = c.rcv_file_id
|
||||
WHERE (f.rcv_file_id = ? OR f.redirect_id = ?) AND r.replica_number = 1
|
||||
|]
|
||||
(rcvFileId, rcvFileId)
|
||||
|
||||
insertRcvFile :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> Maybe DBRcvFileId -> Maybe RcvFileId -> Bool -> IO (Either StoreError (RcvFileId, DBRcvFileId))
|
||||
insertRcvFile db gVar userId FileDescription {size, digest, key, nonce, chunkSize, redirect} prefixPath tmpPath (CryptoFile savePath cfArgs) redirectId_ redirectEntityId_ approvedRelays = runExceptT $ do
|
||||
let (redirectDigest_, redirectSize_) = case redirect of
|
||||
@@ -3213,7 +3125,7 @@ insertRcvFile db gVar userId FileDescription {size, digest, key, nonce, chunkSiz
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO rcv_files (rcv_file_entity_id, user_id, size, digest, key, nonce, chunk_size, prefix_path, tmp_path, save_path, save_file_key, save_file_nonce, status, redirect_id, redirect_entity_id, redirect_digest, redirect_size, approved_relays) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((Binary rcvFileEntityId, userId, size, digest, key, nonce, chunkSize, prefixPath, tmpPath) :. (savePath, fileKey <$> cfArgs, fileNonce <$> cfArgs, RFSPrepared, redirectId_, Binary <$> redirectEntityId_, redirectDigest_, redirectSize_, BI approvedRelays))
|
||||
((Binary rcvFileEntityId, userId, size, digest, key, nonce, chunkSize, prefixPath, tmpPath) :. (savePath, fileKey <$> cfArgs, fileNonce <$> cfArgs, RFSReceiving, redirectId_, Binary <$> redirectEntityId_, redirectDigest_, redirectSize_, BI approvedRelays))
|
||||
rcvFileId <- liftIO $ insertedRowId db
|
||||
pure (rcvFileEntityId, rcvFileId)
|
||||
|
||||
@@ -3518,23 +3430,13 @@ createSndFile db gVar userId (CryptoFile path cfArgs) numRecipients prefixPath k
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO snd_files (snd_file_entity_id, user_id, path, src_file_key, src_file_nonce, num_recipients, prefix_path, key, nonce, status, redirect_size, redirect_digest, storage_time) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)"
|
||||
((Binary sndFileEntityId, userId, path, fileKey <$> cfArgs, fileNonce <$> cfArgs, numRecipients) :. (prefixPath, key, nonce, SFSPrepared, redirectSize_, redirectDigest_, storageHours))
|
||||
((Binary sndFileEntityId, userId, path, fileKey <$> cfArgs, fileNonce <$> cfArgs, numRecipients) :. (prefixPath, key, nonce, SFSNew, redirectSize_, redirectDigest_, storageHours))
|
||||
where
|
||||
(redirectSize_, redirectDigest_) =
|
||||
case redirect_ of
|
||||
Nothing -> (Nothing, Nothing)
|
||||
Just RedirectFileInfo {size, digest} -> (Just size, Just digest)
|
||||
|
||||
startPreparedSndFile :: DB.Connection -> SndFileId -> IO (Either StoreError ())
|
||||
startPreparedSndFile db sndFileEntityId = runExceptT $ do
|
||||
sndFileId <- ExceptT $ getSndFileIdByEntityId_ db sndFileEntityId
|
||||
liftIO $ do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE snd_files SET status = ?, updated_at = ? WHERE snd_file_id = ? AND status = ?"
|
||||
(SFSNew, updatedAt, sndFileId, SFSPrepared)
|
||||
|
||||
getSndFileByEntityId :: DB.Connection -> SndFileId -> IO (Either StoreError SndFile)
|
||||
getSndFileByEntityId db sndFileEntityId = runExceptT $ do
|
||||
sndFileId <- ExceptT $ getSndFileIdByEntityId_ db sndFileEntityId
|
||||
|
||||
@@ -13,7 +13,6 @@ module Simplex.Messaging.Agent.Store.Postgres.DB
|
||||
execute,
|
||||
execute_,
|
||||
executeMany,
|
||||
returning,
|
||||
query,
|
||||
query_,
|
||||
blobFieldDecoder,
|
||||
@@ -61,10 +60,6 @@ executeMany :: ToRow q => PSQL.Connection -> Query -> [q] -> IO ()
|
||||
executeMany db q qs = void $ PSQL.executeMany db q qs `E.catch` addSql q
|
||||
{-# INLINE executeMany #-}
|
||||
|
||||
returning :: (ToRow q, FromRow r) => PSQL.Connection -> Query -> [q] -> IO [r]
|
||||
returning db q qs = PSQL.returning db q qs `E.catch` addSql q
|
||||
{-# INLINE returning #-}
|
||||
|
||||
query :: (ToRow q, FromRow r) => PSQL.Connection -> Query -> q -> IO [r]
|
||||
query db q qs = PSQL.query db q qs `E.catch` addSql q
|
||||
{-# INLINE query #-}
|
||||
|
||||
@@ -15,7 +15,6 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260410_receive_attem
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Text, Maybe Text)]
|
||||
@@ -30,8 +29,7 @@ schemaMigrations =
|
||||
("20260410_receive_attempts", m20260410_receive_attempts, Just down_m20260410_receive_attempts),
|
||||
("20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs),
|
||||
("20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
|
||||
("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
|
||||
("20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes)
|
||||
("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
-21
@@ -1,21 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
m20260919_ratchet_verify_codes :: Text
|
||||
m20260919_ratchet_verify_codes =
|
||||
[r|
|
||||
ALTER TABLE ratchets ADD COLUMN rc_verify_code_ad BYTEA;
|
||||
ALTER TABLE ratchets ADD COLUMN rc_verify_code_pq BYTEA;
|
||||
|]
|
||||
|
||||
down_m20260919_ratchet_verify_codes :: Text
|
||||
down_m20260919_ratchet_verify_codes =
|
||||
[r|
|
||||
ALTER TABLE ratchets DROP COLUMN rc_verify_code_pq;
|
||||
ALTER TABLE ratchets DROP COLUMN rc_verify_code_ad;
|
||||
|]
|
||||
@@ -448,9 +448,7 @@ CREATE TABLE smp_agent_test_protocol_schema.ratchets (
|
||||
x3dh_pub_key_1 bytea,
|
||||
x3dh_pub_key_2 bytea,
|
||||
pq_priv_kem bytea,
|
||||
pq_pub_kem bytea,
|
||||
rc_verify_code_ad bytea,
|
||||
rc_verify_code_pq bytea
|
||||
pq_pub_kem bytea
|
||||
);
|
||||
|
||||
|
||||
|
||||
@@ -51,7 +51,6 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260410_receive_attempt
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260411_service_certs
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -102,8 +101,7 @@ schemaMigrations =
|
||||
("m20260410_receive_attempts", m20260410_receive_attempts, Just down_m20260410_receive_attempts),
|
||||
("m20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs),
|
||||
("m20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
|
||||
("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
|
||||
("m20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes)
|
||||
("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -1,20 +0,0 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20260919_ratchet_verify_codes :: Query
|
||||
m20260919_ratchet_verify_codes =
|
||||
[sql|
|
||||
ALTER TABLE ratchets ADD COLUMN rc_verify_code_ad BLOB;
|
||||
ALTER TABLE ratchets ADD COLUMN rc_verify_code_pq BLOB;
|
||||
|]
|
||||
|
||||
down_m20260919_ratchet_verify_codes :: Query
|
||||
down_m20260919_ratchet_verify_codes =
|
||||
[sql|
|
||||
ALTER TABLE ratchets DROP COLUMN rc_verify_code_pq;
|
||||
ALTER TABLE ratchets DROP COLUMN rc_verify_code_ad;
|
||||
|]
|
||||
@@ -182,9 +182,7 @@ CREATE TABLE ratchets(
|
||||
x3dh_pub_key_1 BLOB,
|
||||
x3dh_pub_key_2 BLOB,
|
||||
pq_priv_kem BLOB,
|
||||
pq_pub_kem BLOB,
|
||||
rc_verify_code_ad BLOB,
|
||||
rc_verify_code_pq BLOB
|
||||
pq_pub_kem BLOB
|
||||
) WITHOUT ROWID, STRICT;
|
||||
CREATE TABLE skipped_messages(
|
||||
skipped_message_id INTEGER PRIMARY KEY,
|
||||
|
||||
@@ -35,8 +35,6 @@ module Simplex.Messaging.Client
|
||||
ProxiedRelay (..),
|
||||
getProtocolClient,
|
||||
closeProtocolClient,
|
||||
closeTimedOutClient,
|
||||
pClientSentCommandsCount,
|
||||
protocolClientServer,
|
||||
protocolClientServer',
|
||||
transportHost',
|
||||
@@ -152,8 +150,7 @@ import Data.Int (Int64)
|
||||
import Data.List (find, isSuffixOf)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (catMaybes, fromMaybe, isNothing)
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Clock (UTCTime (..), diffUTCTime, getCurrentTime)
|
||||
@@ -169,7 +166,7 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON
|
||||
import Simplex.Messaging.Protocol
|
||||
import Simplex.Messaging.Protocol.Types
|
||||
import Simplex.Messaging.Server.QueueStore.QueueInfo
|
||||
import Simplex.Messaging.SimplexName (SimplexDomain, fullDomainName)
|
||||
import Simplex.Messaging.SimplexName (SimplexDomain)
|
||||
import Simplex.Messaging.TMap (TMap)
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport
|
||||
@@ -515,8 +512,7 @@ defaultSMPClientConfig =
|
||||
data Request err msg = Request
|
||||
{ corrId :: CorrId,
|
||||
entityId :: EntityId,
|
||||
-- only kept to report a late response to msgQ, a forwarded command holds a whole block
|
||||
command :: Maybe (ProtoCommand msg),
|
||||
command :: ProtoCommand msg,
|
||||
pending :: TVar Bool,
|
||||
responseVar :: TMVar (Either (ProtocolClientError err) msg)
|
||||
}
|
||||
@@ -662,9 +658,10 @@ getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qS
|
||||
responseErr = atomically . putTMVar responseVar . Left . PCETransportError
|
||||
|
||||
receive :: Transport c => ProtocolClient v err msg -> THandle v c 'TClient -> IO ()
|
||||
receive ProtocolClient {client_ = PClient {rcvQ, lastReceived}} h = forever $ do
|
||||
receive ProtocolClient {client_ = PClient {rcvQ, lastReceived, timeoutErrorCount}} h = forever $ do
|
||||
tGetClient h >>= atomically . writeTBQueue rcvQ
|
||||
getCurrentTime >>= atomically . writeTVar lastReceived
|
||||
atomically $ writeTVar timeoutErrorCount 0
|
||||
|
||||
monitor :: ProtocolClient v err msg -> IO ()
|
||||
monitor c@ProtocolClient {client_ = PClient {sendPings, lastReceived, timeoutErrorCount}} = loop smpPingInterval
|
||||
@@ -711,9 +708,7 @@ getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qS
|
||||
(pure False)
|
||||
if wasPending
|
||||
then pure Nothing
|
||||
else sendMsg $ case command of
|
||||
Just cmd | entityId == entId -> STResponse cmd clientResp
|
||||
_ -> STUnexpectedError unexpected
|
||||
else sendMsg $ if entityId == entId then STResponse command clientResp else STUnexpectedError unexpected
|
||||
where
|
||||
unexpected = unexpectedResponse respOrErr
|
||||
clientResp = case respOrErr of
|
||||
@@ -755,15 +750,6 @@ closeProtocolClient :: ProtocolClient v err msg -> IO ()
|
||||
closeProtocolClient = mapM_ (deRefWeak >=> mapM_ killThread) . action
|
||||
{-# INLINE closeProtocolClient #-}
|
||||
|
||||
-- | Disconnects client when maxCnt commands in a row timed out, 0 to disable.
|
||||
closeTimedOutClient :: Int -> ProtocolClient v err msg -> IO ()
|
||||
closeTimedOutClient maxCnt c@ProtocolClient {client_ = PClient {timeoutErrorCount}} = do
|
||||
cnt <- readTVarIO timeoutErrorCount
|
||||
when (maxCnt > 0 && cnt >= maxCnt) $ closeProtocolClient c
|
||||
|
||||
pClientSentCommandsCount :: ProtocolClient v err msg -> IO Int
|
||||
pClientSentCommandsCount ProtocolClient {client_ = PClient {sentCommands}} = M.size <$> readTVarIO sentCommands
|
||||
|
||||
-- | SMP client error type.
|
||||
data ProtocolClientError err
|
||||
= -- | Correctly parsed SMP server ERR response.
|
||||
@@ -1068,11 +1054,11 @@ proxySMPMessage c nm proxiedRelay spKey sId flags msg = proxyOKSMPCommand c nm p
|
||||
-- through `proxySMPCommand` and pattern-matches the expected RNAME response.
|
||||
-- Version-gated on the destination relay (mirrors `connectSMPProxiedRelay`):
|
||||
-- the client never sends RSLV to a relay that predates names support.
|
||||
proxyResolveName :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> SimplexDomain -> ExceptT SMPClientError IO (Either ProxyClientError NameResponse)
|
||||
proxyResolveName :: SMPClient -> NetworkRequestMode -> ProxiedRelay -> SimplexDomain -> ExceptT SMPClientError IO (Either ProxyClientError NameRecord)
|
||||
proxyResolveName c nm proxiedRelay name
|
||||
| prVersion proxiedRelay >= namesSMPVersion =
|
||||
proxySMPCommand c nm proxiedRelay Nothing NoEntity (RSLV (NQDomain name)) >>= \case
|
||||
Right (RNAME reg) | resolvedNameOrNotFound name reg -> pure $ Right reg
|
||||
proxySMPCommand c nm proxiedRelay Nothing NoEntity (RSLV name) >>= \case
|
||||
Right (RNAME nr) -> pure $ Right nr
|
||||
Right r -> throwE $ unexpectedResponse r
|
||||
Left e -> pure $ Left e
|
||||
| otherwise = throwE $ PCETransportError TEVersion
|
||||
@@ -1080,21 +1066,16 @@ proxyResolveName c nm proxiedRelay name
|
||||
-- | Direct (non-PFWD) name resolution. Exposes the client IP to the resolver;
|
||||
-- callers that want anonymity should use `proxyResolveName` via the standard
|
||||
-- proxy fallback in the agent. RSLV requires no entity ID or authorization
|
||||
-- (see `noAuthCmd` in Protocol.hs). Gated on the session version, below which
|
||||
-- the server has no RSLV at all; the encoder gates the query format separately.
|
||||
directResolveName :: SMPClient -> NetworkRequestMode -> SimplexDomain -> ExceptT SMPClientError IO NameResponse
|
||||
-- (see `noAuthCmd` in Protocol.hs). Version-gated on the session here, not the
|
||||
-- encoder, so an old server never receives RSLV.
|
||||
directResolveName :: SMPClient -> NetworkRequestMode -> SimplexDomain -> ExceptT SMPClientError IO NameRecord
|
||||
directResolveName c nm name
|
||||
| thVersion (thParams c) >= namesSMPVersion =
|
||||
sendProtocolCommand c nm Nothing NoEntity (Cmd SResolver (RSLV (NQDomain name))) >>= \case
|
||||
RNAME reg | resolvedNameOrNotFound name reg -> pure reg
|
||||
sendProtocolCommand c nm Nothing NoEntity (Cmd SResolver (RSLV name)) >>= \case
|
||||
RNAME nr -> pure nr
|
||||
r -> throwE $ unexpectedResponse r
|
||||
| otherwise = throwE $ PCETransportError TEVersion
|
||||
|
||||
resolvedNameOrNotFound :: SimplexDomain -> NameResponse -> Bool
|
||||
resolvedNameOrNotFound d NameResponse {registration} = case registration of
|
||||
NRRegistered {nameRecord} -> T.toLower (nrName nameRecord) == fullDomainName d
|
||||
_ -> True
|
||||
|
||||
-- | Acknowledge message delivery (server deletes the message).
|
||||
--
|
||||
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
|
||||
@@ -1368,22 +1349,20 @@ sendProtocolCommand c nm = sendProtocolCommand_ c nm Nothing Nothing
|
||||
--
|
||||
-- Please note: if nonce is passed it is also used as a correlation ID
|
||||
sendProtocolCommand_ :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> NetworkRequestMode -> Maybe C.CbNonce -> Maybe Int -> Maybe C.APrivateAuthKey -> EntityId -> ProtoCommand msg -> ExceptT (ProtocolClientError err) IO msg
|
||||
sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ, sentCommands}, thParams = THandleParams {blockSize, serviceAuth}} nm nonce_ tOut pKey entId cmd =
|
||||
sendProtocolCommand_ c@ProtocolClient {client_ = PClient {sndQ}, thParams = THandleParams {blockSize, serviceAuth}} nm nonce_ tOut pKey entId cmd =
|
||||
ExceptT $ uncurry sendRecv =<< mkTransmission_ c nonce_ (entId, pKey, cmd)
|
||||
where
|
||||
-- two separate "atomically" needed to avoid blocking
|
||||
sendRecv :: Either TransportError SentRawTransmission -> Request err msg -> IO (Either (ProtocolClientError err) msg)
|
||||
sendRecv t_ r@Request {corrId} = case t_ of
|
||||
Left e -> notSent e
|
||||
sendRecv t_ r = case t_ of
|
||||
Left e -> pure . Left $ PCETransportError e
|
||||
Right t
|
||||
| B.length s > blockSize - 2 -> notSent TELargeMsg
|
||||
| B.length s > blockSize - 2 -> pure . Left $ PCETransportError TELargeMsg
|
||||
| otherwise -> do
|
||||
nonBlockingWriteTBQueue sndQ (Just r, s)
|
||||
response <$> getResponse c nm tOut r
|
||||
where
|
||||
s = tEncodeBatch1 serviceAuth t
|
||||
where
|
||||
notSent e = Left (PCETransportError e) <$ atomically (TM.delete corrId sentCommands)
|
||||
|
||||
nonBlockingWriteTBQueue :: TBQueue a -> a -> IO ()
|
||||
nonBlockingWriteTBQueue q x = do
|
||||
@@ -1391,7 +1370,7 @@ nonBlockingWriteTBQueue q x = do
|
||||
unless sent $ void $ forkIO $ atomically $ writeTBQueue q x
|
||||
|
||||
getResponse :: ProtocolClient v err msg -> NetworkRequestMode -> Maybe Int -> Request err msg -> IO (Response err msg)
|
||||
getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount, sentCommands, msgQ}} nm tOut Request {corrId, entityId, pending, responseVar} = do
|
||||
getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount}} nm tOut Request {entityId, pending, responseVar} = do
|
||||
r <- fromMaybe (netTimeoutInt tcpTimeout nm) tOut `timeout` atomically (takeTMVar responseVar)
|
||||
response <- atomically $ do
|
||||
writeTVar pending False
|
||||
@@ -1400,18 +1379,14 @@ getResponse ProtocolClient {client_ = PClient {tcpTimeout, timeoutErrorCount, se
|
||||
-- See `processMsg`.
|
||||
((r <|>) <$> tryTakeTMVar responseVar) >>= \case
|
||||
Just r' -> writeTVar timeoutErrorCount 0 $> r'
|
||||
Nothing -> do
|
||||
modifyTVar' timeoutErrorCount (+ 1)
|
||||
-- a late response is delivered to msgQ, without msgQ it is only logged
|
||||
when (isNothing msgQ) $ TM.delete corrId sentCommands
|
||||
pure $ Left PCEResponseTimeout
|
||||
Nothing -> modifyTVar' timeoutErrorCount (+ 1) $> Left PCEResponseTimeout
|
||||
pure Response {entityId, response}
|
||||
|
||||
mkTransmission :: Protocol v err msg => ProtocolClient v err msg -> ClientCommand msg -> IO (PCTransmission err msg)
|
||||
mkTransmission c = mkTransmission_ c Nothing
|
||||
|
||||
mkTransmission_ :: forall v err msg. Protocol v err msg => ProtocolClient v err msg -> Maybe C.CbNonce -> ClientCommand msg -> IO (PCTransmission err msg)
|
||||
mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCommands, msgQ}} nonce_ (entityId, pKey_, command) = do
|
||||
mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCommands}} nonce_ (entityId, pKey_, command) = do
|
||||
nonce@(C.CbNonce corrId) <- maybe (atomically $ C.randomCbNonce clientCorrId) pure nonce_
|
||||
let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, entityId, command)
|
||||
auth = authTransmission (thAuth thParams) (useServiceAuth command) pKey_ nonce tForAuth
|
||||
@@ -1426,7 +1401,7 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
|
||||
Request
|
||||
{ corrId,
|
||||
entityId,
|
||||
command = command <$ msgQ,
|
||||
command,
|
||||
pending,
|
||||
responseVar
|
||||
}
|
||||
|
||||
@@ -451,7 +451,6 @@ generateSndE2EParams g v = \case
|
||||
|
||||
data RatchetInitParams = RatchetInitParams
|
||||
{ assocData :: Str,
|
||||
rcVerifyCodePQ :: Str,
|
||||
ratchetKey :: RatchetKey,
|
||||
sndHK :: HeaderKey,
|
||||
rcvNextHK :: HeaderKey,
|
||||
@@ -494,14 +493,14 @@ pqX3dhRcv (rpk1, rpk2, rpKem_) (E2ERatchetParams _ sk1 sk2 sKem_) = do
|
||||
|
||||
pqX3dh :: DhAlgorithm a => (PublicKey a, PublicKey a) -> DhSecret a -> DhSecret a -> DhSecret a -> Maybe RatchetKEMAccepted -> RatchetInitParams
|
||||
pqX3dh (sk1, rk1) dh1 dh2 dh3 kemAccepted =
|
||||
RatchetInitParams {assocData, rcVerifyCodePQ = Str vcPQ, ratchetKey = RatchetKey sk, sndHK = Key hk, rcvNextHK = Key nhk, kemAccepted}
|
||||
RatchetInitParams {assocData, ratchetKey = RatchetKey sk, sndHK = Key hk, rcvNextHK = Key nhk, kemAccepted}
|
||||
where
|
||||
assocData = Str $ pubKeyBytes sk1 <> pubKeyBytes rk1
|
||||
dhs = dhBytes' dh1 <> dhBytes' dh2 <> dhBytes' dh3 <> pq
|
||||
pq = maybe "" (\RatchetKEMAccepted {rcPQRss = KEMSharedKey ss} -> BA.convert ss) kemAccepted
|
||||
salt = B.replicate 64 '\0'
|
||||
(hk, nhk, sk) = hkdf3 salt dhs "SimpleXX3DH"
|
||||
vcPQ = hkdf salt dhs "SimpleXVerifyCode" 32
|
||||
(hk, nhk, sk) =
|
||||
let salt = B.replicate 64 '\0'
|
||||
in hkdf3 salt dhs "SimpleXX3DH"
|
||||
|
||||
type RatchetX448 = Ratchet 'X448
|
||||
|
||||
@@ -510,8 +509,6 @@ data Ratchet a = Ratchet
|
||||
rcVersion :: RatchetVersions,
|
||||
-- associated data - must be the same in both parties ratchets
|
||||
rcAD :: Str,
|
||||
-- verification code covering all handshake keys, absent in the ratchets created before it was added
|
||||
rcVCPQ :: Maybe Str,
|
||||
rcDHRs :: PrivateKey a,
|
||||
rcKEM :: Maybe RatchetKEM,
|
||||
rcSupportKEM :: PQSupport, -- defines header size, can only be enabled once
|
||||
@@ -640,14 +637,13 @@ instance FromField MessageKey where fromField = blobFieldDecoder smpDecode
|
||||
-- @
|
||||
initSndRatchet ::
|
||||
forall a. (AlgorithmI a, DhAlgorithm a) => RatchetVersions -> PublicKey a -> PrivateKey a -> (RatchetInitParams, Maybe KEMKeyPair) -> Ratchet a
|
||||
initSndRatchet rcVersion rcDHRr rcDHRs (RatchetInitParams {assocData, rcVerifyCodePQ, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) = do
|
||||
initSndRatchet rcVersion rcDHRr rcDHRs (RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) = do
|
||||
-- state.RK, state.CKs, state.NHKs = KDF_RK_HE(SK, DH(state.DHRs, state.DHRr) || state.PQRss)
|
||||
let (rcRK, rcCKs, rcNHKs) = rootKdf ratchetKey rcDHRr rcDHRs (rcPQRss <$> kemAccepted)
|
||||
pqOn = isJust rcPQRs_
|
||||
in Ratchet
|
||||
{ rcVersion,
|
||||
rcAD = assocData,
|
||||
rcVCPQ = Just rcVerifyCodePQ,
|
||||
rcDHRs,
|
||||
rcKEM = (`RatchetKEM` kemAccepted) <$> rcPQRs_,
|
||||
rcSupportKEM = PQSupport pqOn,
|
||||
@@ -672,11 +668,10 @@ initSndRatchet rcVersion rcDHRr rcDHRs (RatchetInitParams {assocData, rcVerifyCo
|
||||
-- as part of the connection request and random salt was received from the sender.
|
||||
initRcvRatchet ::
|
||||
forall a. (AlgorithmI a, DhAlgorithm a) => RatchetVersions -> PrivateKey a -> (RatchetInitParams, Maybe KEMKeyPair) -> PQSupport -> Ratchet a
|
||||
initRcvRatchet rcVersion rcDHRs (RatchetInitParams {assocData, rcVerifyCodePQ, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) pqSupport =
|
||||
initRcvRatchet rcVersion rcDHRs (RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, rcPQRs_) pqSupport =
|
||||
Ratchet
|
||||
{ rcVersion,
|
||||
rcAD = assocData,
|
||||
rcVCPQ = Just rcVerifyCodePQ,
|
||||
rcDHRs,
|
||||
-- rcKEM:
|
||||
-- state.PQRs = bob_pq_kem_key_pair
|
||||
|
||||
@@ -1,6 +1,3 @@
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
@@ -8,24 +5,13 @@
|
||||
|
||||
module Simplex.Messaging.Names.Record
|
||||
( NameRecord (..),
|
||||
NameResponse (..),
|
||||
NameRegistration (..),
|
||||
NamePricing (..),
|
||||
USDCents (..),
|
||||
NameReservedReason (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import Data.Int (Int64)
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON)
|
||||
import Simplex.Messaging.SystemTime (SystemSeconds)
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix)
|
||||
|
||||
-- | Resolved name record returned by the names role. JSON keys match the
|
||||
-- resolver REST output; both FromJSON (resolver -> server) and ToJSON
|
||||
@@ -58,87 +44,3 @@ $( JQ.deriveJSON
|
||||
defaultJSON {J.omitNothingFields = False, J.fieldLabelModifier = dropPrefix "nr"}
|
||||
''NameRecord
|
||||
)
|
||||
|
||||
-- | US cents.
|
||||
newtype USDCents = USDCents Int64
|
||||
deriving (Eq, Ord, Show)
|
||||
deriving newtype (ToJSON, FromJSON)
|
||||
|
||||
-- | What the registry holds for a name, and the block it was read at.
|
||||
data NameResponse = NameResponse
|
||||
{ -- | absent only from a v20/v21 router, which sent the record alone
|
||||
lastBlockTs :: Maybe SystemSeconds,
|
||||
registration :: NameRegistration
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | What the registry holds for a name.
|
||||
data NameRegistration
|
||||
= -- | Held by someone. Always carries a record, empty where none was set.
|
||||
NRRegistered
|
||||
{ -- | absent only from a v20/v21 router, which sent the record alone
|
||||
expires :: Maybe SystemSeconds,
|
||||
-- | unix seconds, > expires: until here only the owner may renew
|
||||
graceUntil :: Maybe SystemSeconds,
|
||||
-- | held back as well, which is why it will not free up at expiry
|
||||
reservedReason_ :: Maybe NameReservedReason,
|
||||
nameRecord :: NameRecord
|
||||
}
|
||||
| -- | Held by nobody, and registrable now.
|
||||
NRAvailable {pricing :: NamePricing}
|
||||
| -- | Held back by the registry, and not for sale at its price.
|
||||
NRReserved {reservedReason :: NameReservedReason}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Enough to price the name locally, which the router cannot do behind a hash.
|
||||
data NamePricing = NamePricing
|
||||
{ -- | US cents per year, for the lengths the registry prices specially
|
||||
registrationPrices :: Map Int USDCents,
|
||||
-- | US cents per year for every other length
|
||||
basePrice :: USDCents,
|
||||
-- | characters; the registry refuses shorter labels
|
||||
minLabelLength :: Int
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Why the registry holds a name back.
|
||||
data NameReservedReason
|
||||
= -- | held for SimpleX
|
||||
NRRInternal
|
||||
| NRRTrademark
|
||||
| NRRCommunity
|
||||
| -- | added to the registry after this version, and still reserved
|
||||
NRRUnknown Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance TextEncoding NameReservedReason where
|
||||
textEncode = \case
|
||||
NRRInternal -> "internal"
|
||||
NRRTrademark -> "trademark"
|
||||
NRRCommunity -> "community"
|
||||
NRRUnknown t -> t
|
||||
textDecode = Just . reservedReasonOf
|
||||
|
||||
-- | An unknown reason is kept as text, capped: it reaches a client as a word.
|
||||
-- Capping precedes the match, so what is kept encodes back to what it decoded.
|
||||
reservedReasonOf :: Text -> NameReservedReason
|
||||
reservedReasonOf t = case T.take 32 $ T.takeWhile (\c -> c > ' ' && c < '\DEL') t of
|
||||
"internal" -> NRRInternal
|
||||
"trademark" -> NRRTrademark
|
||||
"community" -> NRRCommunity
|
||||
r -> NRRUnknown r
|
||||
|
||||
instance ToJSON NameReservedReason where
|
||||
toJSON = textToJSON
|
||||
toEncoding = textToEncoding
|
||||
|
||||
instance FromJSON NameReservedReason where
|
||||
parseJSON = textParseJSON "NameReservedReason"
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''NamePricing)
|
||||
|
||||
-- taggedObjectJSON, not sumTypeJSON: this JSON is the RNAME payload and the
|
||||
-- resolver contract, so it must not vary with the swift build flag.
|
||||
$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "NR") ''NameRegistration)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''NameResponse)
|
||||
|
||||
@@ -80,12 +80,6 @@ module Simplex.Messaging.Protocol
|
||||
ErrorType (..),
|
||||
CommandError (..),
|
||||
ProxyError (..),
|
||||
NameQuery (..),
|
||||
NameResponse (..),
|
||||
NameRegistration (..),
|
||||
NamePricing (..),
|
||||
USDCents (..),
|
||||
NameReservedReason (..),
|
||||
NameErrorType (..),
|
||||
BrokerErrorType (..),
|
||||
NetworkError (..),
|
||||
@@ -241,7 +235,6 @@ import Data.Attoparsec.ByteString.Char8 (Parser, (<?>))
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.Bifunctor (bimap, first)
|
||||
import Data.Bits (xor)
|
||||
import qualified Data.ByteArray as BA
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
@@ -272,12 +265,12 @@ import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (.
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Names.Record
|
||||
import Simplex.Messaging.Names.Record (NameRecord (..))
|
||||
import Simplex.Messaging.Parsers
|
||||
import Simplex.Messaging.Protocol.Types
|
||||
import Simplex.Messaging.Server.QueueStore.QueueInfo
|
||||
import Simplex.Messaging.ServiceScheme
|
||||
import Simplex.Messaging.SimplexName (LabelHash, SimplexDomain (..), SimplexTLD (..), fullDomainName, labelHash)
|
||||
import Simplex.Messaging.SimplexName (SimplexDomain)
|
||||
import Simplex.Messaging.Transport
|
||||
import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..))
|
||||
import Simplex.Messaging.Util (bshow, eitherToMaybe, safeDecodeUtf8, (<$?>))
|
||||
@@ -610,7 +603,7 @@ data Command (p :: Party) where
|
||||
-- - corrId: unique correlation ID between proxy and relay, also used as a nonce to encrypt forwarded transmission
|
||||
RFWD :: EncFwdTransmission -> Command ProxyService -- use CorrId as CbNonce, proxy to relay
|
||||
-- Resolve SimpleX name.
|
||||
RSLV :: NameQuery -> Command Resolver
|
||||
RSLV :: SimplexDomain -> Command Resolver
|
||||
|
||||
deriving instance Show (Command p)
|
||||
|
||||
@@ -746,8 +739,8 @@ data BrokerMsg where
|
||||
OK :: BrokerMsg
|
||||
ERR :: ErrorType -> BrokerMsg
|
||||
PONG :: BrokerMsg
|
||||
-- What the router knows about a SimpleX name.
|
||||
RNAME :: NameResponse -> BrokerMsg
|
||||
-- Resolved SimpleX name.
|
||||
RNAME :: NameRecord -> BrokerMsg
|
||||
deriving (Eq, Show)
|
||||
|
||||
data RcvMessage = RcvMessage
|
||||
@@ -1324,10 +1317,7 @@ instance ProtocolTypeI p => FromJSON (ProtocolServer p) where
|
||||
parseJSON = strParseJSON "ProtocolServer"
|
||||
|
||||
newtype BasicAuth = BasicAuth {unBasicAuth :: ByteString}
|
||||
deriving (Ord, Show)
|
||||
|
||||
instance Eq BasicAuth where
|
||||
BasicAuth s == BasicAuth s' = BA.constEq s s'
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance IsString BasicAuth where fromString = BasicAuth . B.pack
|
||||
|
||||
@@ -1599,28 +1589,11 @@ data ErrorType
|
||||
DUPLICATE_ -- not part of SMP protocol, used internally
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | What RSLV asks about: a name, or the hash of a second-level label.
|
||||
data NameQuery = NQDomain SimplexDomain | NQHash LabelHash SimplexTLD
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Encoding NameQuery where
|
||||
smpEncode = \case
|
||||
NQDomain d -> encodeUtf8 $ fullDomainName d
|
||||
NQHash h tld -> strEncode h <> strEncode tld
|
||||
smpP = NQHash <$> strP <*> strP <|> NQDomain <$> strP
|
||||
|
||||
-- | Hashed from v22, except a name with subnames or a web TLD.
|
||||
hashedQuery :: NameQuery -> NameQuery
|
||||
hashedQuery q = case q of
|
||||
NQDomain SimplexDomain {nameTLD, domain, subDomain}
|
||||
| null subDomain && nameTLD /= TLDWeb -> NQHash (labelHash domain) nameTLD
|
||||
_ -> q
|
||||
|
||||
-- | Name resolution error
|
||||
data NameErrorType
|
||||
= -- | the names role / resolver is not configured on this server
|
||||
NO_RESOLVER
|
||||
| -- | the name does not resolve; sent only to a session below v22
|
||||
| -- | the name is not registered (resolver returned not-found)
|
||||
NOT_FOUND
|
||||
| -- | backing resolver/RPC failure - contains the diagnostic detail
|
||||
RESOLVER {resolverErr :: Text}
|
||||
@@ -1849,7 +1822,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
|
||||
PRXY host auth_ -> e (PRXY_, ' ', host, auth_)
|
||||
PFWD fwdV pubKey (EncTransmission s) -> e (PFWD_, ' ', fwdV, pubKey, Tail s)
|
||||
RFWD (EncFwdTransmission s) -> e (RFWD_, ' ', Tail s)
|
||||
RSLV q -> e (RSLV_, ' ', if v >= nameAvailSMPVersion then hashedQuery q else q)
|
||||
RSLV d -> e (RSLV_, ' ', d)
|
||||
where
|
||||
e :: Encoding a => a -> ByteString
|
||||
e = smpEncode
|
||||
@@ -1956,7 +1929,7 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
|
||||
CT SNotifierService NSUBS_
|
||||
| v >= rcvServiceSMPVersion -> Cmd SNotifierService <$> (NSUBS <$> _smpP <*> smpP)
|
||||
| otherwise -> pure $ Cmd SNotifierService $ NSUBS (-1) mempty
|
||||
CT SResolver RSLV_ -> Cmd SResolver . RSLV <$> _smpP
|
||||
CT SResolver RSLV_ -> Cmd SResolver . RSLV <$> _smpP <* A.takeByteString
|
||||
|
||||
fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg
|
||||
{-# INLINE fromProtocolError #-}
|
||||
@@ -1999,11 +1972,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
|
||||
| v < clientNoticesSMPVersion -> BLOCKED info {notice = Nothing}
|
||||
_ -> err
|
||||
PONG -> e PONG_
|
||||
RNAME res
|
||||
| v >= nameAvailSMPVersion -> e (RNAME_, ' ', Tail $ LB.toStrict $ J.encode res)
|
||||
| otherwise -> case registration res of
|
||||
NRRegistered {nameRecord} -> e (RNAME_, ' ', Tail $ LB.toStrict $ J.encode nameRecord)
|
||||
_ -> e (ERR_, ' ', NAME NOT_FOUND)
|
||||
RNAME rec -> e (RNAME_, ' ', Tail $ LB.toStrict $ J.encode rec)
|
||||
where
|
||||
e :: Encoding a => a -> ByteString
|
||||
e = smpEncode
|
||||
@@ -2050,12 +2019,8 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
|
||||
OK_ -> pure OK
|
||||
ERR_ -> ERR <$> _smpP
|
||||
PONG_ -> pure PONG
|
||||
RNAME_
|
||||
| v >= nameAvailSMPVersion -> fmap RNAME . J.eitherDecodeStrict . unTail <$?> _smpP
|
||||
| otherwise -> fmap (RNAME . oldResponse) . J.eitherDecodeStrict . unTail <$?> _smpP
|
||||
RNAME_ -> fmap RNAME . J.eitherDecodeStrict . unTail <$?> _smpP
|
||||
where
|
||||
oldResponse nameRecord =
|
||||
NameResponse {lastBlockTs = Nothing, registration = NRRegistered {expires = Nothing, graceUntil = Nothing, reservedReason_ = Nothing, nameRecord}}
|
||||
serviceRespP resp
|
||||
| v >= rcvServiceSMPVersion = resp <$> _smpP <*> smpP
|
||||
| otherwise = resp <$> _smpP <*> pure mempty
|
||||
@@ -2077,7 +2042,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
|
||||
PKEY {} -> noEntityMsg
|
||||
RRES _ -> noEntityMsg
|
||||
ALLS -> noEntityMsg
|
||||
RNAME {} -> noEntityMsg
|
||||
RNAME _ -> noEntityMsg
|
||||
-- other broker responses must have queue ID
|
||||
_
|
||||
| B.null entId -> Left $ CMD NO_ENTITY
|
||||
@@ -2447,4 +2412,3 @@ $(J.deriveJSON defaultJSON ''BlockingInfo)
|
||||
|
||||
-- run deriveJSON in one TH splice to allow mutual instance
|
||||
$(concat <$> mapM @[] (J.deriveJSON (sumTypeJSON id)) [''ProxyError, ''NameErrorType, ''ErrorType])
|
||||
|
||||
|
||||
@@ -98,12 +98,13 @@ import Network.Socket (ServiceName, Socket, socketToHandle)
|
||||
import qualified Network.TLS as TLS
|
||||
import Numeric.Natural (Natural)
|
||||
import Simplex.Messaging.Agent.Lock
|
||||
import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClient (thParams), ProtocolClientConfig (..), ProtocolClientError (..), SMPClient, SMPClientError, clientHandlers, closeTimedOutClient, forwardSMPTransmission, smpProxyError, temporaryClientError)
|
||||
import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentConfig (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
|
||||
import Simplex.Messaging.Client (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, clientHandlers, forwardSMPTransmission, smpProxyError, temporaryClientError, transportHost')
|
||||
import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Protocol
|
||||
import Simplex.Messaging.SimplexName (SimplexDomain)
|
||||
import Simplex.Messaging.Server.Control
|
||||
import Simplex.Messaging.Server.Env.STM as Env
|
||||
import Simplex.Messaging.Server.Expiration
|
||||
@@ -1092,7 +1093,6 @@ controlPortAuth h user admin role auth = do
|
||||
readTVarIO role >>= \case
|
||||
CPRNone -> do
|
||||
atomically $ writeTVar role $! newRole
|
||||
when (newRole == CPRNone) $ logWarn "ControlPort: failed auth"
|
||||
hPutStrLn h $ currentRole newRole
|
||||
r -> hPutStrLn h $ currentRole r <> if r == newRole then "" else ", start new session to change."
|
||||
where
|
||||
@@ -1454,47 +1454,32 @@ client
|
||||
Nothing -> ERR $ transportErr TENoServerAuth
|
||||
_ -> ERR $ transportErr TEVersion
|
||||
PFWD fwdV pubKey encBlock -> do
|
||||
ProxyAgent {smpAgent = a, relayForwards} <- asks proxyAgent
|
||||
ProxyAgent {smpAgent = a} <- asks proxyAgent
|
||||
ServerStats {pMsgFwds, pMsgFwdsOwn} <- asks serverStats
|
||||
let inc = mkIncProxyStats pMsgFwds pMsgFwdsOwn
|
||||
liftIO (lookupSMPServerClient a sessId) >>= \case
|
||||
Just (own, smp) -> do
|
||||
inc own pRequests
|
||||
maxFwds <- asks $ proxyRelayConcurrency . config
|
||||
-- reserved on the forked thread, so that the slot is released when the forward completes
|
||||
forkProxiedCmd $
|
||||
bracket (atomically $ reserve maxFwds relayForwards) (\r -> when r $ atomically $ release relayForwards) $ \case
|
||||
-- the relay is not keeping up, the client retries TIMEOUT later
|
||||
False -> ERR (smpProxyError PCEResponseTimeout) <$ inc own pErrorsOther
|
||||
True ->
|
||||
liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `E.catches` clientHandlers) >>= \case
|
||||
Right r -> PRES r <$ inc own pSuccesses
|
||||
Left e -> ERR (smpProxyError e) <$ case e of
|
||||
PCEProtocolError {} -> inc own pSuccesses
|
||||
PCEResponseTimeout -> do
|
||||
inc own pErrorsOther
|
||||
liftIO $ closeTimedOutClient (smpPingCount $ networkConfig $ smpCfg $ agentCfg a) smp
|
||||
_ -> inc own pErrorsOther
|
||||
forkProxiedCmd $ do
|
||||
liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `E.catches` clientHandlers) >>= \case
|
||||
Right r -> PRES r <$ inc own pSuccesses
|
||||
Left e -> ERR (smpProxyError e) <$ case e of
|
||||
PCEProtocolError {} -> inc own pSuccesses
|
||||
_ -> do
|
||||
logWarn $ "Error forwarding to relay: " <> decodeLatin1 (strEncode $ transportHost' smp) <> " own=" <> tshow own <> " " <> tshow e
|
||||
inc own pErrorsOther
|
||||
Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION)
|
||||
where
|
||||
forkProxiedCmd :: M s BrokerMsg -> M s (Maybe BrokerMsg)
|
||||
forkProxiedCmd = forkCmd serverClientConcurrency corrId (EntityId sessId)
|
||||
reserve maxFwds v = stateTVar v $ \fwds -> case M.lookup sessId fwds of
|
||||
Just n | n >= maxFwds -> (False, fwds)
|
||||
n_ -> (True, M.insert sessId (maybe 1 (+ 1) n_) fwds)
|
||||
release v = modifyTVar' v $ M.update (\n -> if n > 1 then Just (n - 1) else Nothing) sessId
|
||||
-- Run a slow command on a thread
|
||||
forkCmd :: (ServerConfig s -> Int) -> CorrId -> EntityId -> M s BrokerMsg -> M s (Maybe a)
|
||||
forkCmd concurrency corrId entId cmdAction = do
|
||||
-- the forked thread releases the slot when the command completes, the caller only if the fork failed
|
||||
mask $ \restore -> do
|
||||
wait
|
||||
forkClient clnt (B.unpack $ "client $" <> encode sessionId <> " cmd") (restore cmd `finally` signal)
|
||||
`onException` signal
|
||||
bracket_ wait signal . forkClient clnt (B.unpack $ "client $" <> encode sessionId <> " cmd") $
|
||||
-- commands MUST be processed under a reasonable timeout or the client would halt
|
||||
cmdAction >>= \t -> atomically $ writeTBQueue sndQ ([(corrId, entId, t)], [])
|
||||
pure Nothing
|
||||
where
|
||||
-- commands MUST be processed under a reasonable timeout or the client would halt
|
||||
cmd = cmdAction >>= \t -> atomically $ writeTBQueue sndQ ([(corrId, entId, t)], [])
|
||||
wait = do
|
||||
limit <- asks (concurrency . config)
|
||||
atomically $ do
|
||||
@@ -1511,19 +1496,15 @@ client
|
||||
Just nenv -> pure (Just nenv)
|
||||
-- Runs on a forked thread so RSLV does not block other commands;
|
||||
-- concurrency is limited by serverResolverConcurrency in forkCmd.
|
||||
resolveNameMsg :: VersionSMP -> NamesEnv -> NameQuery -> M s BrokerMsg
|
||||
resolveNameMsg v nenv q = do
|
||||
resolveNameMsg :: NamesEnv -> SimplexDomain -> M s BrokerMsg
|
||||
resolveNameMsg nenv d = do
|
||||
st <- asks (rslvStats . serverStats)
|
||||
(selector, msg) <-
|
||||
liftIO (resolveName nenv q) <&> \case
|
||||
Right res -> (if answered (registration res) then rslvSucc else rslvNotFound, RNAME res)
|
||||
liftIO (resolveName nenv d) <&> \case
|
||||
Right rec -> (rslvSucc, RNAME rec)
|
||||
Left e@NOT_FOUND -> (rslvNotFound, ERR $ NAME e)
|
||||
Left e -> (rslvResolverErrs, ERR $ NAME e)
|
||||
incStat (selector st) $> msg
|
||||
where
|
||||
-- below v22 the encoder answers anything but a record as NAME NOT_FOUND
|
||||
answered = \case
|
||||
NRRegistered {} -> True
|
||||
_ -> v >= nameAvailSMPVersion
|
||||
transportErr :: TransportError -> ErrorType
|
||||
transportErr = PROXY . BROKER . TRANSPORT
|
||||
mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> IORef Int) -> m ()
|
||||
@@ -1540,7 +1521,7 @@ client
|
||||
Cmd SProxyService (RFWD encBlock) -> (response . (corrId, NoEntity,) =<<) <$> processForwardedCommand encBlock
|
||||
Cmd SResolver (RSLV d) -> rslvNamesEnv >>= \case
|
||||
Nothing -> pure $ response (corrId, NoEntity, ERR (NAME NO_RESOLVER))
|
||||
Just nenv -> forkCmd serverResolverConcurrency corrId NoEntity (resolveNameMsg (thVersion thParams') nenv d)
|
||||
Just nenv -> forkCmd serverResolverConcurrency corrId NoEntity (resolveNameMsg nenv d)
|
||||
Cmd SSenderLink command -> case command of
|
||||
LKEY k -> withQueue $ \q qr -> checkMode QMMessaging qr $ secureQueue_ q k $>> getQueueLink_ q qr
|
||||
LGET -> withQueue $ \q qr -> checkContact qr $ getQueueLink_ q qr
|
||||
@@ -2145,7 +2126,6 @@ client
|
||||
let proxyNonce = C.cbNonce $ bs corrId
|
||||
s' <- liftEitherWith (const CRYPTO) $ C.cbDecryptNoPad sessSecret proxyNonce s
|
||||
FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission et} <- liftEitherWith (const $ CMD SYNTAX) $ smpDecode s'
|
||||
unless (fwdVersion `isCompatible` thServerVRange thParams') $ throwE $ transportErr TEVersion
|
||||
let clientSecret = C.dh' fwdKey serverPrivKey
|
||||
clientNonce = C.cbNonce $ bs fwdCorrId
|
||||
b <- liftEitherWith (const CRYPTO) $ C.cbDecrypt clientSecret clientNonce et
|
||||
@@ -2164,26 +2144,22 @@ client
|
||||
r2 <- liftEitherWith (const BLOCK) $ EncResponse <$> C.cbEncrypt clientSecret (C.reverseNonce clientNonce) r' paddedProxiedTLength
|
||||
let fr = FwdResponse {fwdCorrId, fwdResponse = r2}
|
||||
pure $ RRES $ EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr)
|
||||
let forwarded =
|
||||
lift (rejectOrVerify clntThAuth t') >>= \case
|
||||
-- rejectOrVerify filters allowed commands, no need to repeat it here.
|
||||
Left r -> pure r
|
||||
Right t''@(_, (corrId', entId', cmd')) -> case cmd' of
|
||||
Cmd SResolver (RSLV d) ->
|
||||
lift $
|
||||
rslvNamesEnv >>= \case
|
||||
Nothing -> pure (corrId', entId', ERR (NAME NO_RESOLVER))
|
||||
Just nenv -> (corrId',entId',) <$> resolveNameMsg (thVersion clntTHParams) nenv d
|
||||
-- INTERNAL because processCommand never returns Nothing for sender commands;
|
||||
-- `fst` drops the empty message only returned for SUB.
|
||||
_ -> maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing (Right (M.empty, M.empty, M.empty)) t'')
|
||||
-- commands of all clients of a proxy share its connection, so they are processed concurrently
|
||||
concurrency = case t' of
|
||||
Right (_, _, (_, _, Cmd SResolver _)) -> serverResolverConcurrency
|
||||
_ -> serverClientConcurrency
|
||||
-- the inner response, or Nothing if forked (RSLV).
|
||||
r_ <- lift (rejectOrVerify clntThAuth t') >>= \case
|
||||
-- rejectOrVerify filters allowed commands, no need to repeat it here.
|
||||
Left r -> pure $ Just r
|
||||
Right t''@(_, (corrId', entId', cmd')) -> case cmd' of
|
||||
Cmd SResolver (RSLV d) -> lift $ rslvNamesEnv >>= \case
|
||||
Nothing -> pure $ Just (corrId', entId', ERR (NAME NO_RESOLVER))
|
||||
Just nenv -> forkCmd serverResolverConcurrency corrId NoEntity $ do
|
||||
msg <- resolveNameMsg nenv d
|
||||
either ERR id <$> runExceptT (encodeResp (corrId', entId', msg))
|
||||
-- INTERNAL because processCommand never returns Nothing for sender commands;
|
||||
-- `fst` drops the empty message only returned for SUB.
|
||||
_ -> Just . maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing (Right (M.empty, M.empty, M.empty)) t'')
|
||||
stats <- asks serverStats
|
||||
incStat $ pMsgFwdsRecv stats
|
||||
lift $ forkCmd concurrency corrId NoEntity $ either ERR id <$> runExceptT (forwarded >>= encodeResp)
|
||||
traverse encodeResp r_
|
||||
where
|
||||
rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmissionOrError ErrorType Cmd -> M s (VerifiedTransmissionOrError s)
|
||||
rejectOrVerify clntThAuth = \case
|
||||
|
||||
@@ -67,7 +67,6 @@ module Simplex.Messaging.Server.Env.STM
|
||||
defaultNtfExpiration,
|
||||
defaultInactiveClientExpiration,
|
||||
defaultProxyClientConcurrency,
|
||||
defaultProxyRelayConcurrency,
|
||||
defaultNameResolverConcurrency,
|
||||
defaultMaxJournalMsgCount,
|
||||
defaultMaxJournalStateLines,
|
||||
@@ -129,7 +128,7 @@ import Simplex.Messaging.Server.StoreLog.ReadWrite
|
||||
import Simplex.Messaging.SystemTime
|
||||
import Simplex.Messaging.TMap (TMap)
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport (ASrvTransport, SMPVersion, SessionId, THandleParams, TransportPeer (..), VersionRangeSMP)
|
||||
import Simplex.Messaging.Transport (ASrvTransport, SMPVersion, THandleParams, TransportPeer (..), VersionRangeSMP)
|
||||
import Simplex.Messaging.Transport.Server
|
||||
import Simplex.Messaging.Util (ifM, tshow, whenM, ($>>=))
|
||||
import System.Directory (doesFileExist)
|
||||
@@ -200,8 +199,6 @@ data ServerConfig s = ServerConfig
|
||||
smpAgentCfg :: SMPClientAgentConfig,
|
||||
allowSMPProxy :: Bool, -- auth is the same with `newQueueBasicAuth`
|
||||
serverClientConcurrency :: Int,
|
||||
-- | max forwarded commands awaiting a response from one destination relay
|
||||
proxyRelayConcurrency :: Int,
|
||||
-- | max concurrent name resolutions per connection, enforced in forkCmd.
|
||||
-- Much higher than serverClientConcurrency: forwarded RSLVs from many clients
|
||||
-- aggregate over a single proxy->relay connection (only servers send proxied
|
||||
@@ -255,9 +252,6 @@ defaultInactiveClientExpiration =
|
||||
defaultProxyClientConcurrency :: Int
|
||||
defaultProxyClientConcurrency = 32
|
||||
|
||||
defaultProxyRelayConcurrency :: Int
|
||||
defaultProxyRelayConcurrency = 512
|
||||
|
||||
defaultNameResolverConcurrency :: Int
|
||||
defaultNameResolverConcurrency = 1000
|
||||
|
||||
@@ -447,10 +441,8 @@ data ClientSub
|
||||
| CSDeleted QueueId (Maybe ServiceId) -- includes previously associated service IDs
|
||||
| CSService ServiceId (Int64, IdsHash) -- only send END to idividual client subs on message delivery, not of SSUB/NSSUB
|
||||
|
||||
data ProxyAgent = ProxyAgent
|
||||
{ smpAgent :: SMPClientAgent 'Sender,
|
||||
-- forwarded commands awaiting a response, per relay session
|
||||
relayForwards :: TVar (Map SessionId Int)
|
||||
newtype ProxyAgent = ProxyAgent
|
||||
{ smpAgent :: SMPClientAgent 'Sender
|
||||
}
|
||||
|
||||
type ClientId = Int
|
||||
@@ -739,8 +731,7 @@ mkJournalStoreConfig queueStoreCfg storePath msgQueueQuota maxJournalMsgCount ma
|
||||
newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
|
||||
newSMPProxyAgent smpAgentCfg random = do
|
||||
smpAgent <- newSMPClientAgent SSender smpAgentCfg Nothing random
|
||||
relayForwards <- newTVarIO mempty
|
||||
pure ProxyAgent {smpAgent, relayForwards}
|
||||
pure ProxyAgent {smpAgent}
|
||||
|
||||
readWriteQueueStore :: forall q. StoreQueueClass q => Bool -> (RecipientId -> QueueRec -> IO q) -> FilePath -> STMQueueStore q -> IO (StoreLog 'WriteMode)
|
||||
readWriteQueueStore tty mkQ = readWriteStoreLog (readQueueStore tty mkQ) (writeQueueStore @q)
|
||||
|
||||
@@ -609,7 +609,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
|
||||
},
|
||||
allowSMPProxy = True,
|
||||
serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
|
||||
proxyRelayConcurrency = readIniDefault defaultProxyRelayConcurrency "PROXY" "relay_concurrency" ini,
|
||||
serverResolverConcurrency = readIniDefault defaultNameResolverConcurrency "NAMES" "resolver_concurrency" ini,
|
||||
namesConfig = readNamesConfig ini,
|
||||
information = serverPublicInfo ini,
|
||||
|
||||
@@ -154,9 +154,6 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
|
||||
\# socks_mode = onion\n\n\
|
||||
\# Limit number of threads a client can spawn to process proxy commands in parrallel.\n"
|
||||
<> ("# client_concurrency = " <> tshow defaultProxyClientConcurrency)
|
||||
<> "\n\n\
|
||||
\# Limit number of messages forwarded to one destination server and awaiting its response.\n"
|
||||
<> ("# relay_concurrency = " <> tshow defaultProxyRelayConcurrency)
|
||||
<> "\n\n\
|
||||
\[NAMES]\n\
|
||||
\# Public-namespace resolution via the snrc-resolve.py REST resolver.\n\
|
||||
|
||||
@@ -110,9 +110,10 @@ instance MsgStoreClass PostgresMsgStore where
|
||||
expireOldMessages :: Bool -> PostgresMsgStore -> Int64 -> Int64 -> IO MessageStats
|
||||
expireOldMessages _tty ms now ttl =
|
||||
maybeFirstRow' newMessageStats toMessageStats $ withConnection st $ \db ->
|
||||
DB.query db "CALL expire_old_messages(?,?,0,0,0)" (oldMsg, batchSize)
|
||||
DB.query db "CALL expire_old_messages(?,?,?,0,0,0)" (oldQueue, oldMsg, batchSize)
|
||||
where
|
||||
st = dbStore $ queueStore_ ms
|
||||
oldQueue = 0 :: Int64 -- expire all queues
|
||||
oldMsg = now - ttl
|
||||
batchSize = 10000 :: Int
|
||||
toMessageStats (expiredMsgsCount, storedMsgsCount, storedQueues) =
|
||||
|
||||
@@ -20,9 +20,7 @@ import Control.Logger.Simple (logError)
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1)
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Protocol (NameErrorType (..), NameQuery, NameResponse)
|
||||
import Simplex.Messaging.Protocol (NameErrorType (..), NameRecord)
|
||||
import Simplex.Messaging.Server.Names.HttpResolver
|
||||
( ResolverEnv,
|
||||
ResolverError (..),
|
||||
@@ -32,6 +30,7 @@ import Simplex.Messaging.Server.Names.HttpResolver
|
||||
newResolverEnv,
|
||||
resolveHttp,
|
||||
)
|
||||
import Simplex.Messaging.SimplexName (SimplexDomain, fullDomainName)
|
||||
import System.Timeout (timeout)
|
||||
|
||||
data NamesConfig = NamesConfig
|
||||
@@ -59,9 +58,9 @@ pingEndpoint :: NamesEnv -> IO (Either ResolverError ())
|
||||
pingEndpoint NamesEnv {resolverEnv, config} =
|
||||
fromMaybe (Left ResolverTimeout) <$> timeout (resolverTimeoutMs config * 1000) (healthHttp resolverEnv)
|
||||
|
||||
resolveName :: NamesEnv -> NameQuery -> IO (Either NameErrorType NameResponse)
|
||||
resolveName env q = do
|
||||
r <- E.try (timeout (resolverTimeoutMs (config env) * 1000) (fetch env q))
|
||||
resolveName :: NamesEnv -> SimplexDomain -> IO (Either NameErrorType NameRecord)
|
||||
resolveName env d = do
|
||||
r <- E.try (timeout (resolverTimeoutMs (config env) * 1000) (fetch env d))
|
||||
case r of
|
||||
Right result -> pure (fromMaybe (Left (RESOLVER "timeout")) result)
|
||||
Left e
|
||||
@@ -70,12 +69,14 @@ resolveName env q = do
|
||||
logError $ "[NAMES] resolver fetch raised " <> T.pack (E.displayException e)
|
||||
pure (Left (RESOLVER "resolver error"))
|
||||
|
||||
fetch :: NamesEnv -> NameQuery -> IO (Either NameErrorType NameResponse)
|
||||
fetch NamesEnv {resolverEnv} q =
|
||||
first mapResolverError <$> resolveHttp resolverEnv (decodeLatin1 $ smpEncode q)
|
||||
fetch :: NamesEnv -> SimplexDomain -> IO (Either NameErrorType NameRecord)
|
||||
fetch NamesEnv {resolverEnv} d =
|
||||
first mapResolverError <$> resolveHttp resolverEnv (fullDomainName d)
|
||||
|
||||
mapResolverError :: ResolverError -> NameErrorType
|
||||
mapResolverError = \case
|
||||
HttpStatusErr 404 -> NOT_FOUND
|
||||
HttpStatusErr 400 -> NOT_FOUND
|
||||
HttpStatusErr code -> RESOLVER ("HTTP " <> T.pack (show code))
|
||||
HttpFailure _ -> RESOLVER "transport failure"
|
||||
BodyTooLarge -> RESOLVER "response too large"
|
||||
|
||||
@@ -8,12 +8,10 @@
|
||||
--
|
||||
-- The Python REST resolver (see scripts/resolver/snrc-resolve.py) exposes
|
||||
--
|
||||
-- GET /v2/resolve/<query> -> 200 with a NameRegistration JSON document, for
|
||||
-- all three registration shapes; 400 for unknown
|
||||
-- TLDs, 502 for upstream RPC failures
|
||||
-- GET /v1/resolve/<name> -> 200 with a NameRecord, what relays before SMP
|
||||
-- v22 call as /resolve
|
||||
-- GET /health -> 200 when the resolver process is ready
|
||||
-- GET /resolve/<name> -> 200 with a NameRecord JSON document
|
||||
-- 404 / 400 for unknown names / TLDs
|
||||
-- 502 for upstream RPC failures
|
||||
-- GET /health -> 200 when the resolver process is ready
|
||||
--
|
||||
-- Boundary properties:
|
||||
-- * Response body read with `brReadSome maxResponseBytes` — adversarial
|
||||
@@ -59,7 +57,7 @@ import qualified Network.HTTP.Client as HC
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import qualified Network.HTTP.Types as HT
|
||||
import Network.HTTP.Types.URI (urlEncode)
|
||||
import Simplex.Messaging.Names.Record (NameResponse)
|
||||
import Simplex.Messaging.Names.Record (NameRecord)
|
||||
|
||||
data RpcAuth = AuthBearer Text | AuthBasic Text Text
|
||||
|
||||
@@ -110,12 +108,14 @@ authHeader = \case
|
||||
let encoded = BAE.convertToBase BAE.Base64 (encodeUtf8 u <> ":" <> encodeUtf8 p) :: ByteString
|
||||
in ("Authorization", "Basic " <> encoded)
|
||||
|
||||
-- | The query is a name or a bracketed label hash, percent-encoded (every
|
||||
-- non-unreserved byte per RFC 3986) so it cannot alter the path.
|
||||
resolveHttp :: ResolverEnv -> Text -> IO (Either ResolverError NameResponse)
|
||||
resolveHttp env q =
|
||||
-- | GET <baseUrl>/resolve/<percent-encoded name>, decoding the 200 body
|
||||
-- directly into a NameRecord in one pass (no intermediate Aeson Value). The
|
||||
-- name is percent-encoded (every non-unreserved byte per RFC 3986): the
|
||||
-- resolver expects raw labels, so slashes/punctuation must not alter the path.
|
||||
resolveHttp :: ResolverEnv -> Text -> IO (Either ResolverError NameRecord)
|
||||
resolveHttp env name =
|
||||
(>>= first InvalidJson . J.eitherDecodeStrict . BL.toStrict)
|
||||
<$> httpGet env ("/v2/resolve/" <> B.unpack (urlEncode True (encodeUtf8 q)))
|
||||
<$> httpGet env ("/resolve/" <> B.unpack (urlEncode True (encodeUtf8 name)))
|
||||
|
||||
-- | GET <baseUrl>/health; success = reachable with status < 400. The body is
|
||||
-- size-capped but NOT decoded — the probe only checks reachability.
|
||||
|
||||
@@ -469,11 +469,11 @@ prometheusMetrics sm rtm ts =
|
||||
\# TYPE simplex_smp_names_reqs counter\n\
|
||||
\simplex_smp_names_reqs " <> mshow _rslvReqs <> "\n# rslvReqs\n\
|
||||
\\n\
|
||||
\# HELP simplex_smp_names_success NameRecord resolved, or availability answered.\n\
|
||||
\# HELP simplex_smp_names_success NameRecord successfully resolved and returned.\n\
|
||||
\# TYPE simplex_smp_names_success counter\n\
|
||||
\simplex_smp_names_success " <> mshow _rslvSucc <> "\n# rslvSucc\n\
|
||||
\\n\
|
||||
\# HELP simplex_smp_names_not_found Answers a client below v22 reads as NOT_FOUND.\n\
|
||||
\# HELP simplex_smp_names_not_found Name not registered (resolver returned 404 / 400).\n\
|
||||
\# TYPE simplex_smp_names_not_found counter\n\
|
||||
\simplex_smp_names_not_found " <> mshow _rslvNotFound <> "\n# rslvNotFound\n\
|
||||
\\n\
|
||||
|
||||
@@ -159,8 +159,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
-- estimate via reltuples to avoid a full heap scan on every scrape
|
||||
(SELECT GREATEST(reltuples, 0)::bigint FROM pg_class WHERE oid = 'msg_queues'::regclass) AS queue_count,
|
||||
(SELECT COUNT(1) FROM msg_queues WHERE deleted_at IS NULL) AS queue_count,
|
||||
(SELECT COUNT(1) FROM msg_queues WHERE deleted_at IS NULL AND notifier_id IS NOT NULL) AS notifier_count,
|
||||
(SELECT COUNT(1) FROM services WHERE service_role = ?) AS rcv_service_count,
|
||||
(SELECT COUNT(1) FROM services WHERE service_role = ?) AS ntf_service_count,
|
||||
|
||||
@@ -20,9 +20,7 @@ serverSchemaMigrations =
|
||||
("20250320_short_links", m20250320_short_links, Just down_m20250320_short_links),
|
||||
("20250514_service_certs", m20250514_service_certs, Just down_m20250514_service_certs),
|
||||
("20250903_store_messages", m20250903_store_messages, Just down_m20250903_store_messages),
|
||||
("20250915_queue_ids_hash", m20250915_queue_ids_hash, Just down_m20250915_queue_ids_hash),
|
||||
("20260916_prometheus_indexes", m20260916_prometheus_indexes, Just down_m20260916_prometheus_indexes),
|
||||
("20260917_msg_queues_hot", m20260917_msg_queues_hot, Just down_m20260917_msg_queues_hot)
|
||||
("20250915_queue_ids_hash", m20250915_queue_ids_hash, Just down_m20250915_queue_ids_hash)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
@@ -590,147 +588,3 @@ ALTER TABLE services
|
||||
DROP COLUMN queue_ids_hash;
|
||||
|]
|
||||
<> dropXorHashFuncs
|
||||
|
||||
m20260916_prometheus_indexes :: Text
|
||||
m20260916_prometheus_indexes =
|
||||
[r|
|
||||
CREATE INDEX idx_msg_queues_expire ON msg_queues (recipient_id) WHERE deleted_at IS NULL AND msg_queue_expire;
|
||||
CREATE INDEX idx_msg_queues_notifier_active ON msg_queues (notifier_id) WHERE deleted_at IS NULL AND notifier_id IS NOT NULL;
|
||||
|]
|
||||
|
||||
down_m20260916_prometheus_indexes :: Text
|
||||
down_m20260916_prometheus_indexes =
|
||||
[r|
|
||||
DROP INDEX idx_msg_queues_expire;
|
||||
DROP INDEX idx_msg_queues_notifier_active;
|
||||
|]
|
||||
|
||||
m20260917_msg_queues_hot :: Text
|
||||
m20260917_msg_queues_hot =
|
||||
[r|
|
||||
DROP INDEX idx_msg_queues_updated_at_recipient_id;
|
||||
|
||||
ALTER TABLE msg_queues SET (
|
||||
fillfactor = 80,
|
||||
autovacuum_vacuum_scale_factor = 0.02,
|
||||
autovacuum_analyze_scale_factor = 0.01,
|
||||
autovacuum_vacuum_cost_limit = 1000
|
||||
);
|
||||
|
||||
ALTER TABLE messages SET (
|
||||
autovacuum_vacuum_scale_factor = 0.02,
|
||||
autovacuum_analyze_scale_factor = 0.01,
|
||||
toast.autovacuum_vacuum_scale_factor = 0.02
|
||||
);
|
||||
|
||||
ALTER TABLE services SET (
|
||||
fillfactor = 70,
|
||||
autovacuum_vacuum_threshold = 1000,
|
||||
autovacuum_vacuum_scale_factor = 0
|
||||
);
|
||||
|
||||
DROP PROCEDURE expire_old_messages(bigint, bigint, integer);
|
||||
|
||||
CREATE PROCEDURE expire_old_messages(IN p_old_ts bigint, IN batch_size integer, OUT r_expired_msgs_count bigint, OUT r_stored_msgs_count bigint, OUT r_stored_queues bigint)
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
DECLARE
|
||||
rids BYTEA[];
|
||||
rid BYTEA;
|
||||
last_rid BYTEA := '\x';
|
||||
del_count BIGINT;
|
||||
total_deleted BIGINT := 0;
|
||||
BEGIN
|
||||
LOOP
|
||||
SELECT array_agg(recipient_id)
|
||||
INTO rids
|
||||
FROM (
|
||||
SELECT recipient_id
|
||||
FROM msg_queues
|
||||
WHERE deleted_at IS NULL
|
||||
AND msg_queue_expire = TRUE
|
||||
AND recipient_id > last_rid
|
||||
ORDER BY recipient_id ASC
|
||||
LIMIT batch_size
|
||||
) qs;
|
||||
|
||||
EXIT WHEN rids IS NULL OR cardinality(rids) = 0;
|
||||
|
||||
FOREACH rid IN ARRAY rids
|
||||
LOOP
|
||||
BEGIN
|
||||
del_count := delete_expired_msgs(rid, p_old_ts);
|
||||
total_deleted := total_deleted + del_count;
|
||||
EXCEPTION WHEN OTHERS THEN
|
||||
RAISE WARNING 'STORE, expire_old_messages, error expiring queue %: %', encode(rid, 'base64'), SQLERRM;
|
||||
CONTINUE;
|
||||
END;
|
||||
COMMIT;
|
||||
END LOOP;
|
||||
last_rid := rids[cardinality(rids)];
|
||||
END LOOP;
|
||||
|
||||
r_expired_msgs_count := total_deleted;
|
||||
r_stored_msgs_count := (SELECT COUNT(1) FROM messages);
|
||||
r_stored_queues := (SELECT COUNT(1) FROM msg_queues WHERE deleted_at IS NULL);
|
||||
END;
|
||||
$$;
|
||||
|]
|
||||
|
||||
down_m20260917_msg_queues_hot :: Text
|
||||
down_m20260917_msg_queues_hot =
|
||||
[r|
|
||||
DROP PROCEDURE expire_old_messages(bigint, integer);
|
||||
|
||||
CREATE PROCEDURE expire_old_messages(IN p_old_queue bigint, IN p_old_ts bigint, IN batch_size integer, OUT r_expired_msgs_count bigint, OUT r_stored_msgs_count bigint, OUT r_stored_queues bigint)
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
DECLARE
|
||||
rids BYTEA[];
|
||||
rid BYTEA;
|
||||
last_rid BYTEA := '\x';
|
||||
del_count BIGINT;
|
||||
total_deleted BIGINT := 0;
|
||||
BEGIN
|
||||
LOOP
|
||||
SELECT array_agg(recipient_id)
|
||||
INTO rids
|
||||
FROM (
|
||||
SELECT recipient_id
|
||||
FROM msg_queues
|
||||
WHERE deleted_at IS NULL
|
||||
AND updated_at > p_old_queue
|
||||
AND msg_queue_expire = TRUE
|
||||
AND recipient_id > last_rid
|
||||
ORDER BY recipient_id ASC
|
||||
LIMIT batch_size
|
||||
) qs;
|
||||
|
||||
EXIT WHEN rids IS NULL OR cardinality(rids) = 0;
|
||||
|
||||
FOREACH rid IN ARRAY rids
|
||||
LOOP
|
||||
BEGIN
|
||||
del_count := delete_expired_msgs(rid, p_old_ts);
|
||||
total_deleted := total_deleted + del_count;
|
||||
EXCEPTION WHEN OTHERS THEN
|
||||
RAISE WARNING 'STORE, expire_old_messages, error expiring queue %: %', encode(rid, 'base64'), SQLERRM;
|
||||
CONTINUE;
|
||||
END;
|
||||
COMMIT;
|
||||
END LOOP;
|
||||
last_rid := rids[cardinality(rids)];
|
||||
END LOOP;
|
||||
|
||||
r_expired_msgs_count := total_deleted;
|
||||
r_stored_msgs_count := (SELECT COUNT(1) FROM messages);
|
||||
r_stored_queues := (SELECT COUNT(1) FROM msg_queues WHERE deleted_at IS NULL);
|
||||
END;
|
||||
$$;
|
||||
|
||||
CREATE INDEX idx_msg_queues_updated_at_recipient_id ON msg_queues (deleted_at, updated_at, msg_queue_expire, recipient_id);
|
||||
|
||||
ALTER TABLE msg_queues RESET (fillfactor, autovacuum_vacuum_scale_factor, autovacuum_analyze_scale_factor, autovacuum_vacuum_cost_limit);
|
||||
ALTER TABLE messages RESET (autovacuum_vacuum_scale_factor, autovacuum_analyze_scale_factor, toast.autovacuum_vacuum_scale_factor);
|
||||
ALTER TABLE services RESET (fillfactor, autovacuum_vacuum_threshold, autovacuum_vacuum_scale_factor);
|
||||
|]
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
|
||||
|
||||
|
||||
SET statement_timeout = 0;
|
||||
SET lock_timeout = 0;
|
||||
SET idle_in_transaction_session_timeout = 0;
|
||||
@@ -57,7 +56,7 @@ $$;
|
||||
|
||||
|
||||
|
||||
CREATE PROCEDURE smp_server.expire_old_messages(IN p_old_ts bigint, IN batch_size integer, OUT r_expired_msgs_count bigint, OUT r_stored_msgs_count bigint, OUT r_stored_queues bigint)
|
||||
CREATE PROCEDURE smp_server.expire_old_messages(IN p_old_queue bigint, IN p_old_ts bigint, IN batch_size integer, OUT r_expired_msgs_count bigint, OUT r_stored_msgs_count bigint, OUT r_stored_queues bigint)
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
DECLARE
|
||||
@@ -74,6 +73,7 @@ BEGIN
|
||||
SELECT recipient_id
|
||||
FROM msg_queues
|
||||
WHERE deleted_at IS NULL
|
||||
AND updated_at > p_old_queue
|
||||
AND msg_queue_expire = TRUE
|
||||
AND recipient_id > last_rid
|
||||
ORDER BY recipient_id ASC
|
||||
@@ -397,8 +397,7 @@ CREATE TABLE smp_server.messages (
|
||||
msg_quota boolean NOT NULL,
|
||||
msg_ntf_flag boolean NOT NULL,
|
||||
msg_body bytea NOT NULL
|
||||
)
|
||||
WITH (autovacuum_vacuum_scale_factor='0.02', autovacuum_analyze_scale_factor='0.01', toast.autovacuum_vacuum_scale_factor='0.02');
|
||||
);
|
||||
|
||||
|
||||
|
||||
@@ -442,8 +441,7 @@ CREATE TABLE smp_server.msg_queues (
|
||||
msg_can_write boolean DEFAULT true NOT NULL,
|
||||
msg_queue_expire boolean DEFAULT false NOT NULL,
|
||||
msg_queue_size bigint DEFAULT 0 NOT NULL
|
||||
)
|
||||
WITH (fillfactor='80', autovacuum_vacuum_scale_factor='0.02', autovacuum_analyze_scale_factor='0.01', autovacuum_vacuum_cost_limit='1000');
|
||||
);
|
||||
|
||||
|
||||
|
||||
@@ -455,8 +453,7 @@ CREATE TABLE smp_server.services (
|
||||
created_at bigint NOT NULL,
|
||||
queue_count bigint DEFAULT 0 NOT NULL,
|
||||
queue_ids_hash bytea DEFAULT '\x00000000000000000000000000000000'::bytea NOT NULL
|
||||
)
|
||||
WITH (fillfactor='70', autovacuum_vacuum_threshold='1000', autovacuum_vacuum_scale_factor='0');
|
||||
);
|
||||
|
||||
|
||||
|
||||
@@ -497,18 +494,10 @@ CREATE INDEX idx_messages_recipient_id_msg_ts ON smp_server.messages USING btree
|
||||
|
||||
|
||||
|
||||
CREATE INDEX idx_msg_queues_expire ON smp_server.msg_queues USING btree (recipient_id) WHERE ((deleted_at IS NULL) AND msg_queue_expire);
|
||||
|
||||
|
||||
|
||||
CREATE UNIQUE INDEX idx_msg_queues_link_id ON smp_server.msg_queues USING btree (link_id);
|
||||
|
||||
|
||||
|
||||
CREATE INDEX idx_msg_queues_notifier_active ON smp_server.msg_queues USING btree (notifier_id) WHERE ((deleted_at IS NULL) AND (notifier_id IS NOT NULL));
|
||||
|
||||
|
||||
|
||||
CREATE UNIQUE INDEX idx_msg_queues_notifier_id ON smp_server.msg_queues USING btree (notifier_id);
|
||||
|
||||
|
||||
@@ -525,6 +514,10 @@ CREATE UNIQUE INDEX idx_msg_queues_sender_id ON smp_server.msg_queues USING btre
|
||||
|
||||
|
||||
|
||||
CREATE INDEX idx_msg_queues_updated_at_recipient_id ON smp_server.msg_queues USING btree (deleted_at, updated_at, msg_queue_expire, recipient_id);
|
||||
|
||||
|
||||
|
||||
CREATE INDEX idx_services_service_role ON smp_server.services USING btree (service_role);
|
||||
|
||||
|
||||
@@ -556,4 +549,3 @@ ALTER TABLE ONLY smp_server.msg_queues
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -10,21 +10,14 @@ module Simplex.Messaging.SimplexName
|
||||
SimplexTLD (..),
|
||||
SimplexNameType (..),
|
||||
fullDomainName,
|
||||
LabelHash (..),
|
||||
labelHash,
|
||||
boundedNonSpace,
|
||||
shortNameInfoStr,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative (optional, (<|>))
|
||||
import Crypto.Hash (Digest, hash)
|
||||
import Crypto.Hash.Algorithms (Keccak_256)
|
||||
import qualified Data.Aeson.TH as J
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import qualified Data.Attoparsec.Text as AT
|
||||
import qualified Data.ByteArray as BA
|
||||
import qualified Data.ByteArray.Encoding as BAE
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Char (isDigit)
|
||||
@@ -77,20 +70,6 @@ nameLabelP = do
|
||||
-- (Cyrillic а vs ASCII a hash to different on-chain records).
|
||||
isNameLetter c = c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z'
|
||||
|
||||
-- | The registry's key for a label: 32 bytes, as labelOf takes it.
|
||||
newtype LabelHash = LabelHash ByteString
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | keccak-256 of the lowercased label, as the registry keys it.
|
||||
labelHash :: Text -> LabelHash
|
||||
labelHash label = LabelHash $ BA.convert (hash (encodeUtf8 (T.toLower label)) :: Digest Keccak_256)
|
||||
|
||||
instance StrEncoding LabelHash where
|
||||
strEncode (LabelHash h) = '[' `B.cons` (BAE.convertToBase BAE.Base16 h `B.snoc` ']')
|
||||
strP = do
|
||||
h <- BAE.convertFromBase BAE.Base16 <$?> (A.char '[' *> A.takeWhile (/= ']') <* A.char ']')
|
||||
if B.length h == 32 then pure $ LabelHash h else fail "bad LabelHash"
|
||||
|
||||
-- | Cap the name at 253 bytes (DNS full-domain limit)
|
||||
boundedNonSpace :: A.Parser ByteString
|
||||
boundedNonSpace = do
|
||||
@@ -129,15 +108,12 @@ instance Encoding SimplexDomain where
|
||||
smpP = strP
|
||||
|
||||
fullDomainName :: SimplexDomain -> Text
|
||||
fullDomainName SimplexDomain {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain]) <> decodeLatin1 (strEncode nameTLD)
|
||||
|
||||
instance StrEncoding SimplexTLD where
|
||||
strEncode = \case
|
||||
TLDSimplex -> ".simplex"
|
||||
TLDTesting -> ".testing"
|
||||
TLDWeb -> ""
|
||||
strP =
|
||||
".simplex" $> TLDSimplex <|> ".testing" $> TLDTesting <|> pure TLDWeb
|
||||
fullDomainName SimplexDomain {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld')
|
||||
where
|
||||
tld' = case nameTLD of
|
||||
TLDSimplex -> ["simplex"]
|
||||
TLDTesting -> ["testing"]
|
||||
TLDWeb -> []
|
||||
|
||||
shortNameInfoStr :: SimplexNameInfo -> Text
|
||||
shortNameInfoStr = \case
|
||||
|
||||
@@ -53,7 +53,6 @@ module Simplex.Messaging.Transport
|
||||
rcvServiceSMPVersion,
|
||||
namesSMPVersion,
|
||||
serverInfoSMPVersion,
|
||||
nameAvailSMPVersion,
|
||||
simplexMQVersion,
|
||||
smpBlockSize,
|
||||
TransportConfig (..),
|
||||
@@ -176,7 +175,6 @@ smpBlockSize = 16384
|
||||
-- 19 - service subscriptions to messages (10/20/2025)
|
||||
-- 20 - public namespaces resolver, RSLV command (6/20/2026)
|
||||
-- 21 - server public information in handshake (7/5/2026)
|
||||
-- 22 - RNAME answers name availability as well as the record (7/25/2026)
|
||||
|
||||
data SMPVersion
|
||||
|
||||
@@ -213,11 +211,6 @@ namesSMPVersion = VersionSMP 20
|
||||
serverInfoSMPVersion :: VersionSMP
|
||||
serverInfoSMPVersion = VersionSMP 21
|
||||
|
||||
-- | RNAME carries availability. A server below this answers RSLV with the
|
||||
-- record alone, and ERR NAME NOT_FOUND for a name that does not resolve.
|
||||
nameAvailSMPVersion :: VersionSMP
|
||||
nameAvailSMPVersion = VersionSMP 22
|
||||
|
||||
minClientSMPRelayVersion :: VersionSMP
|
||||
minClientSMPRelayVersion = VersionSMP 14
|
||||
|
||||
@@ -225,20 +218,20 @@ minServerSMPRelayVersion :: VersionSMP
|
||||
minServerSMPRelayVersion = VersionSMP 14
|
||||
|
||||
currentClientSMPRelayVersion :: VersionSMP
|
||||
currentClientSMPRelayVersion = VersionSMP 22
|
||||
currentClientSMPRelayVersion = VersionSMP 21
|
||||
|
||||
currentServerSMPRelayVersion :: VersionSMP
|
||||
currentServerSMPRelayVersion = VersionSMP 22
|
||||
currentServerSMPRelayVersion = VersionSMP 21
|
||||
|
||||
-- Max SMP protocol version to be used in e2e encrypted connection between
|
||||
-- client and server, as defined by SMP proxy. Normally set below the current
|
||||
-- version to prevent client version fingerprinting by the destination relays
|
||||
-- when clients upgrade at different times. Pinned to the current version (22)
|
||||
-- for this release because a proxied RSLV only carries availability from
|
||||
-- nameAvailSMPVersion (22), so the one-version anti-fingerprinting buffer does
|
||||
-- not apply yet; it reappears once the current version advances past 22.
|
||||
-- when clients upgrade at different times. Pinned to the current version (20)
|
||||
-- for this release because proxied name resolution is gated on namesSMPVersion
|
||||
-- (20), so the one-version anti-fingerprinting buffer does not apply yet; it
|
||||
-- reappears once the current version advances past 20.
|
||||
proxiedSMPRelayVersion :: VersionSMP
|
||||
proxiedSMPRelayVersion = VersionSMP 22
|
||||
proxiedSMPRelayVersion = VersionSMP 20
|
||||
|
||||
-- minimal supported protocol version is 14
|
||||
supportedClientSMPRelayVRange :: VersionRangeSMP
|
||||
@@ -865,6 +858,7 @@ forceCertChain :: CertChainPubKey -> CertChainPubKey
|
||||
forceCertChain cert@(CertChainPubKey (X.CertificateChain cc) signedKey) = length (show cc) `seq` show signedKey `seq` cert
|
||||
{-# INLINE forceCertChain #-}
|
||||
|
||||
-- This function is only used with v >= 8, so currently it's a simple record update.
|
||||
-- * Note: it requires updating version-based parameters, to be consistent with smpTHandle_.
|
||||
smpTHParamsSetVersion :: VersionSMP -> THandleParams SMPVersion p -> THandleParams SMPVersion p
|
||||
smpTHParamsSetVersion v params =
|
||||
|
||||
@@ -53,7 +53,6 @@ doubleRatchetTests = do
|
||||
it "should propose KEM during agreement, but no shared secret" $ testAlgs testPqX3dhProposeInReply
|
||||
it "should agree shared secret using KEM" $ testAlgs testPqX3dhProposeAccept
|
||||
it "should reject proposed KEM in reply" $ testAlgs testPqX3dhProposeReject
|
||||
it "should agree different PQ associated data with substituted KEM key" $ testAlgs testPqX3dhSubstitutedKem
|
||||
it "should allow second proposal in reply" $ testAlgs testPqX3dhProposeAgain
|
||||
describe "hybrid KEM key agreement errors" $ do
|
||||
it "should fail if reply contains acceptance without proposal" $ testAlgs testPqX3dhAcceptWithoutProposalError
|
||||
@@ -363,7 +362,6 @@ testDecodeV2RatchetJSON :: IO ()
|
||||
testDecodeV2RatchetJSON = do
|
||||
let v2RatchetJSON = "{\"rcVersion\":[2,2],\"rcAD\":\"2GEJrq48TmQse6NR16I-hrI0tSySZQ57E_g46nDceAPRAiF6j0drq26RTE7be6X7uiB4RaGJGf4QRXzcYuVtWw==\",\"rcDHRs\":\"TUM0Q0FRQXdCUVlESzJWdUJDSUVJRkNYbUxtSHQ3SUNfeHpGTi1Qb3ZqTVQ3S2p6XzZlZlBjOG9fRFY2RWxKOQ==\",\"rcRK\":\"BOX2X7YW5qDSp2XknY_lqacSrtDqQNPvS6iJlZIs3G0=\",\"rcNs\":0,\"rcNr\":0,\"rcPN\":0,\"rcNHKs\":\"IMouSkXUvzT_mo0WM-pqEUK09-HTLk9WOTCFQglyQxU=\",\"rcNHKr\":\"g-tus1clYPV0rGlzkf5a959tUqDYQVZ1FpcPeXdKwxI=\"}"
|
||||
Right (r :: Ratchet X25519) <- pure $ J.eitherDecodeStrict' v2RatchetJSON
|
||||
rcVCPQ r `shouldBe` Nothing
|
||||
rcSupportKEM r `shouldBe` PQSupportOff
|
||||
rcEnableKEM r `shouldBe` PQEncOff
|
||||
rcSndKEM r `shouldBe` PQEncOff
|
||||
@@ -419,18 +417,6 @@ testPqX3dhProposeAccept _ = do
|
||||
Right paramsAlice <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
paramsAlice `compatibleRatchets` paramsBob
|
||||
|
||||
testPqX3dhSubstitutedKem :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
testPqX3dhSubstitutedKem _ = do
|
||||
g <- C.newRandom
|
||||
let v = currentE2EEncryptVersion
|
||||
(pksAlice@(_, _, Just _), e2eAlice) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
|
||||
(_, E2ERatchetParams _ _ _ (Just (RKParamsProposed mallorysKem))) <- liftIO $ generateRcvE2EParams @a g v PQSupportOn
|
||||
(pksBob@(_, _, Just _), AE2ERatchetParams _ e2eBob) <- liftIO $ generateSndE2EParams @a g v (Just $ AUseKEM SRKSAccepted $ AcceptKEM mallorysKem)
|
||||
Right (paramsBob, _) <- pure $ pqX3dhSnd pksBob e2eAlice
|
||||
Right (paramsAlice, _) <- runExceptT $ pqX3dhRcv pksAlice e2eBob
|
||||
assocData paramsAlice `shouldBe` assocData paramsBob
|
||||
rcVerifyCodePQ paramsAlice `shouldNotBe` rcVerifyCodePQ paramsBob
|
||||
|
||||
testPqX3dhProposeReject :: forall a. (AlgorithmI a, DhAlgorithm a) => C.SAlgorithm a -> IO ()
|
||||
testPqX3dhProposeReject _ = do
|
||||
g <- C.newRandom
|
||||
@@ -473,9 +459,9 @@ testPqX3dhProposeAgain _ = do
|
||||
|
||||
compatibleRatchets :: (RatchetInitParams, x) -> (RatchetInitParams, x) -> Expectation
|
||||
compatibleRatchets
|
||||
(RatchetInitParams {assocData, rcVerifyCodePQ, ratchetKey, sndHK, rcvNextHK, kemAccepted}, _)
|
||||
(RatchetInitParams {assocData = ad, rcVerifyCodePQ = vcPQ, ratchetKey = rk, sndHK = shk, rcvNextHK = rnhk, kemAccepted = ka}, _) = do
|
||||
assocData == ad && rcVerifyCodePQ == vcPQ && ratchetKey == rk && sndHK == shk && rcvNextHK == rnhk `shouldBe` True
|
||||
(RatchetInitParams {assocData, ratchetKey, sndHK, rcvNextHK, kemAccepted}, _)
|
||||
(RatchetInitParams {assocData = ad, ratchetKey = rk, sndHK = shk, rcvNextHK = rnhk, kemAccepted = ka}, _) = do
|
||||
assocData == ad && ratchetKey == rk && sndHK == shk && rcvNextHK == rnhk `shouldBe` True
|
||||
case (kemAccepted, ka) of
|
||||
(Just RatchetKEMAccepted {rcPQRr, rcPQRss, rcPQRct}, Just RatchetKEMAccepted {rcPQRr = pqk, rcPQRss = pqss, rcPQRct = pqct}) ->
|
||||
pqk /= rcPQRr && pqss == rcPQRss && pqct == rcPQRct `shouldBe` True
|
||||
|
||||
@@ -204,7 +204,7 @@ pattern INFO :: ConnInfo -> AEvent 'AEConn
|
||||
pattern INFO connInfo = A.INFO PQSupportOn connInfo
|
||||
|
||||
pattern REQ :: InvitationId -> NonEmpty SMPServer -> ConnInfo -> AEvent e
|
||||
pattern REQ invId srvs connInfo <- A.REQ invId PQSupportOn srvs connInfo _ _
|
||||
pattern REQ invId srvs connInfo <- A.REQ invId PQSupportOn srvs connInfo _
|
||||
|
||||
pattern CON :: AEvent 'AEConn
|
||||
pattern CON = A.CON PQEncOn
|
||||
@@ -293,7 +293,7 @@ createConnection c userId enableNtfs cMode clientData subMode = do
|
||||
|
||||
joinConnection :: AgentClient -> UserId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> AE (ConnId, SndQueueSecured)
|
||||
joinConnection c userId enableNtfs cReq connInfo subMode = do
|
||||
(connId, _) <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn
|
||||
connId <- A.prepareConnectionToJoin c userId enableNtfs cReq PQSupportOn
|
||||
sndSecure <- A.joinConnection c NRMInteractive userId connId enableNtfs cReq connInfo PQSupportOn subMode
|
||||
pure (connId, sndSecure)
|
||||
|
||||
@@ -442,9 +442,6 @@ functionalAPITests ps = do
|
||||
it "should expire multiple messages" $ testExpireManyMessages ps
|
||||
it "should expire one message if quota is exceeded" $ testExpireMessageQuota ps
|
||||
it "should expire multiple messages if quota is exceeded" $ testExpireManyMessagesQuota ps
|
||||
describe "joining a full contact address" $ do
|
||||
it "should retry joining until the address has space" $ testJoinFullContactAsync ps
|
||||
it "should fail joining after quota exceeded timeout" $ testJoinFullContactAsyncExpire ps
|
||||
it "should drop message after too many receive attempts" $ testDropMsgAfterRcvAttempts ps
|
||||
#if !defined(dbPostgres)
|
||||
-- TODO [postgres] restore from outdated db backup (we use copyFile/renameFile for sqlite)
|
||||
@@ -584,9 +581,9 @@ functionalAPITests ps = do
|
||||
it "should pass with correct password" $ testSMPServerConnectionTest ps auth (srv auth) `shouldReturn` Right (Just (Right testServerInformation))
|
||||
it "should fail without password" $ testSMPServerConnectionTest ps auth (srv Nothing) `shouldReturn` Left authErr
|
||||
it "should fail with incorrect password" $ testSMPServerConnectionTest ps auth (srv $ Just "wrong") `shouldReturn` Left authErr
|
||||
describe "getConnectionVerifyCodes" $
|
||||
it "should return the same codes for both peers" $
|
||||
withSmpServer ps testConnectionVerifyCodes
|
||||
describe "getRatchetAdHash" $
|
||||
it "should return the same data for both peers" $
|
||||
withSmpServer ps testRatchetAdHash
|
||||
describe "Delivery receipts" $ do
|
||||
it "should send and receive delivery receipt" $ withSmpServer ps testDeliveryReceipts
|
||||
it "send delivery receipts concurrently with messages" $ testDeliveryReceiptsConcurrent ps
|
||||
@@ -758,7 +755,7 @@ runAgentClientTestPQ :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (A
|
||||
runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId =
|
||||
runRight_ $ do
|
||||
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ False SMSubscribe
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
|
||||
sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
|
||||
liftIO $ sqSecured' `shouldBe` True
|
||||
("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
|
||||
@@ -987,12 +984,12 @@ runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (Agent
|
||||
runAgentClientContactTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
|
||||
runRight_ $ do
|
||||
(_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo bPQ
|
||||
sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" bPQ SMSubscribe
|
||||
liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
|
||||
("", _, A.REQ invId pqSup' _ "bob's connInfo" _ _) <- get alice
|
||||
("", _, A.REQ invId pqSup' _ "bob's connInfo" _) <- get alice
|
||||
liftIO $ pqSup' `shouldBe` PQSupportOn
|
||||
(bobId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ)
|
||||
bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ)
|
||||
sqSecured' <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
|
||||
liftIO $ sqSecured' `shouldBe` sqSecured
|
||||
("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get bob
|
||||
@@ -1056,7 +1053,7 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp
|
||||
Nothing -> expectationFailure "address must advertise DR ratchet keys"
|
||||
-- classic (non-DR) join drops the address keys from the request
|
||||
let connReqJoin = if useDR then connReq' else case connReq' of CRContactUri d _ -> CRContactUri d Nothing
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReqJoin bPQ
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True connReqJoin bPQ
|
||||
if asyncJoin
|
||||
then do
|
||||
A.joinConnectionAsync bob "join" False aliceId True connReqJoin "bob's connInfo" bPQ SMSubscribe
|
||||
@@ -1064,9 +1061,9 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp
|
||||
else do
|
||||
sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReqJoin "bob's connInfo" bPQ SMSubscribe
|
||||
liftIO $ sqSecuredJoin `shouldBe` False
|
||||
("", _, A.REQ invId reqPQ _ "bob's connInfo" _ _) <- get alice
|
||||
("", _, A.REQ invId reqPQ _ "bob's connInfo" _) <- get alice
|
||||
liftIO $ reqPQ `shouldBe` PQSupportOn
|
||||
(bobId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
if asyncAccept
|
||||
then do
|
||||
acceptContactAsync alice "accept" bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
|
||||
@@ -1096,10 +1093,10 @@ runCreateConnectionDRTest_ asyncNew addrIK bPQ ps = withSmpServer ps $ withAgent
|
||||
liftIO $ case addrKeys_ of
|
||||
Just (_, CR.E2ERatchetParamsUri _ _ _ kem_) -> isJust kem_ `shouldBe` supportPQ (CR.initialPQEncryption False addrIK)
|
||||
Nothing -> expectationFailure "createConnection must advertise DR ratchet keys"
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReq bPQ
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True connReq bPQ
|
||||
void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" bPQ SMSubscribe
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice
|
||||
(bobId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
|
||||
bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
void $ acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
|
||||
("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
|
||||
allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
|
||||
@@ -1121,10 +1118,10 @@ testContactDRMatrix ps = do
|
||||
|
||||
joinContactDR :: HasCallStack => AgentClient -> AgentClient -> ConnectionRequestUri 'CMContact -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO ()
|
||||
joinContactDR alice requester connReq addrIK pqEnc = do
|
||||
(aliceId, _) <- A.prepareConnectionToJoin requester 1 True connReq PQSupportOn
|
||||
aliceId <- A.prepareConnectionToJoin requester 1 True connReq PQSupportOn
|
||||
void $ A.joinConnection requester NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice
|
||||
(reqId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
|
||||
reqId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
void $ acceptContact alice 1 reqId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
|
||||
("", _, A.CONF confId _ _ "alice's connInfo") <- get requester
|
||||
allowConfirmGreet alice reqId requester aliceId confId addrIK pqEnc
|
||||
@@ -1152,7 +1149,7 @@ testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob ca
|
||||
joinContactDR alice carol connReq2 addrIK pqEnc
|
||||
void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK)
|
||||
void $ A.setConnShortLink alice NRMInteractive addrConnId SCMContact userLinkData Nothing True (Just addrIK)
|
||||
(aId, _) <- A.prepareConnectionToJoin bob 1 True connReq1 PQSupportOn
|
||||
aId <- A.prepareConnectionToJoin bob 1 True connReq1 PQSupportOn
|
||||
void $ A.joinConnection bob NRMInteractive 1 aId True connReq1 "bob's connInfo" PQSupportOn SMSubscribe
|
||||
get alice =##> \case ("", _, A.ERR _) -> True; _ -> False
|
||||
|
||||
@@ -1195,11 +1192,11 @@ testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \al
|
||||
liftIO $ shortLink' `shouldBe` shortLink
|
||||
(_, ContactLinkData _ updated, connReq') <- getConnShortLink bob 1 shortLink
|
||||
liftIO $ ratchetKeys updated `shouldBe` ratchetKeys published
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReq' bPQ
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True connReq' bPQ
|
||||
sqSecuredJoin <- A.joinConnection bob NRMInteractive 1 aliceId True connReq' "bob's connInfo" bPQ SMSubscribe
|
||||
liftIO $ sqSecuredJoin `shouldBe` False
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice
|
||||
(bobId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
|
||||
bobId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
_ <- acceptContact alice 1 bobId True invId "alice's connInfo" (CR.connPQEncryption addrIK) SMSubscribe
|
||||
("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
|
||||
allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
|
||||
@@ -1219,10 +1216,10 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do
|
||||
(ccLink@(CCLink _ (Just shortLink)), preparedParams) <- A.prepareConnectionLink alice 1 rootKey linkEntId True Nothing connIK True Nothing
|
||||
_ <- A.createConnectionForLink alice NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe
|
||||
(_, _, connReq') <- getConnShortLink bob 1 shortLink
|
||||
(aId, _) <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn
|
||||
aId <- A.prepareConnectionToJoin bob 1 True connReq' PQSupportOn
|
||||
_ <- A.joinConnection bob NRMInteractive 1 aId True connReq' "bob's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice
|
||||
(bId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
|
||||
bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption addrIK)
|
||||
pure (bId, invId, aId)
|
||||
("", "", DOWN _ _) <- nGet alice
|
||||
("", "", DOWN _ _) <- nGet bob
|
||||
@@ -1247,12 +1244,12 @@ runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId
|
||||
where
|
||||
msgId = subtract baseId . fst
|
||||
connectViaContact b pq qInfo = do
|
||||
(aId, _) <- A.prepareConnectionToJoin b 1 True qInfo pq
|
||||
aId <- A.prepareConnectionToJoin b 1 True qInfo pq
|
||||
sqSecuredJoin <- A.joinConnection b NRMInteractive 1 aId True qInfo "bob's connInfo" pq SMSubscribe
|
||||
liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
|
||||
("", _, A.REQ invId pqSup' _ "bob's connInfo" _ _) <- get alice
|
||||
("", _, A.REQ invId pqSup' _ "bob's connInfo" _) <- get alice
|
||||
liftIO $ pqSup' `shouldBe` PQSupportOn
|
||||
(bId, _) <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ)
|
||||
bId <- A.prepareConnectionToAccept alice 1 True invId (CR.connPQEncryption aPQ)
|
||||
sqSecuredAccept <- acceptContact alice 1 bId True invId "alice's connInfo" (CR.connPQEncryption aPQ) SMSubscribe
|
||||
liftIO $ sqSecuredAccept `shouldBe` True
|
||||
("", _, A.CONF confId pqSup'' _ "alice's connInfo") <- get b
|
||||
@@ -1293,10 +1290,10 @@ testRejectContactRequest :: HasCallStack => IO ()
|
||||
testRejectContactRequest =
|
||||
withAgentClients2 $ \alice bob -> runRight_ $ do
|
||||
(_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured `shouldBe` False -- joining via contact address connection
|
||||
("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _ _) <- get alice
|
||||
("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _) <- get alice
|
||||
Left (A.CMD PROHIBITED _) <- tryError $ rejectContact alice NRMInteractive 1 invId (Just "no rejection without double ratchet")
|
||||
rejectContact alice NRMInteractive 1 invId Nothing
|
||||
liftIO $ noMessages bob "nothing delivered to bob"
|
||||
@@ -1306,9 +1303,9 @@ testRejectContactRequestDR =
|
||||
withAgentClients2 $ \alice bob -> runRight_ $ do
|
||||
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
|
||||
(_addrConnId, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
|
||||
void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
|
||||
rejectContact alice NRMInteractive 1 invId (Just "not now")
|
||||
("", _, A.RJCT "not now") <- get bob
|
||||
pure ()
|
||||
@@ -1318,9 +1315,9 @@ testRejectContactRequestDRAsync =
|
||||
withAgentClients2 $ \alice bob -> runRight_ $ do
|
||||
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
|
||||
(_addrConnId, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
|
||||
void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _ _) <- get alice
|
||||
("", _, A.REQ invId _ _ "bob's connInfo" _) <- get alice
|
||||
rejectContactAsync alice "1" 1 invId (Just "not now")
|
||||
("", _, A.RJCT "not now") <- get bob
|
||||
pure ()
|
||||
@@ -1433,7 +1430,7 @@ testUpdateConnectionUserId =
|
||||
(connId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
|
||||
newUserId <- createUser alice False [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
|
||||
_ <- changeConnectionUser alice 1 connId newUserId
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured' <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured' `shouldBe` True
|
||||
("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
|
||||
@@ -1592,7 +1589,7 @@ testInvitationErrors ps restart = do
|
||||
b <- getAgentB
|
||||
(bId, cReq) <- withServer1 ps $ runRight $ createConnection a 1 True SCMInvitation Nothing SMSubscribe
|
||||
("", "", DOWN _ [_]) <- nGet a
|
||||
(aId, _) <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn
|
||||
aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn
|
||||
-- fails to secure the queue on testPort
|
||||
BROKER srv (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
(testPort `isSuffixOf` srv) `shouldBe` True
|
||||
@@ -1662,7 +1659,7 @@ testContactErrors ps restart = do
|
||||
b <- getAgentB
|
||||
(contactId, cReq) <- withServer1 ps $ runRight $ createConnection a 1 True SCMContact Nothing SMSubscribe
|
||||
("", "", DOWN _ [_]) <- nGet a
|
||||
(aId, _) <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn
|
||||
aId <- runRight $ A.prepareConnectionToJoin b 1 True cReq PQSupportOn
|
||||
-- fails to create queue on testPort2
|
||||
BROKER srv2 (NETWORK _) <- runLeft $ A.joinConnection b NRMInteractive 1 aId True cReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
(testPort2 `isSuffixOf` srv2) `shouldBe` True
|
||||
@@ -1684,10 +1681,10 @@ testContactErrors ps restart = do
|
||||
Right r -> error $ "unexpected result " <> show r
|
||||
Left _ -> putStrLn "retrying send" >> threadDelay 200000 >> loopSend
|
||||
loopSend
|
||||
("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _ _) <- get a
|
||||
("", _, A.REQ invId PQSupportOn _ "bob's connInfo" _) <- get a
|
||||
pure invId
|
||||
("", "", DOWN _ [_]) <- nGet a
|
||||
(bId, _) <- runRight $ A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
bId <- runRight $ A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
withServer2 ps $ do
|
||||
("", "", UP _ [_]) <- nGet b''
|
||||
let loopSecure = do
|
||||
@@ -1767,7 +1764,7 @@ testInvitationShortLink viaProxy a b =
|
||||
|
||||
testJoinConn_ :: Bool -> Bool -> AgentClient -> ConnId -> AgentClient -> ConnectionRequestUri c -> ExceptT AgentErrorType IO ()
|
||||
testJoinConn_ viaProxy sndSecure a bId b connReq = do
|
||||
(aId, _) <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
|
||||
aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
|
||||
sndSecure' <- A.joinConnection b NRMInteractive 1 aId True connReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sndSecure' `shouldBe` sndSecure
|
||||
("", _, CONF confId _ "bob's connInfo") <- get a
|
||||
@@ -1795,7 +1792,7 @@ testInvitationShortLinkAsync viaProxy a b = do
|
||||
connReq' `shouldBe` connReq
|
||||
linkUserData connData' `shouldBe` userData
|
||||
runRight $ do
|
||||
(aId, _) <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
|
||||
aId <- A.prepareConnectionToJoin b 1 True connReq PQSupportOn
|
||||
A.joinConnectionAsync b "123" False aId True connReq "bob's connInfo" PQSupportOn SMSubscribe
|
||||
get b =##> \case ("123", c, JOINED sndSecure) -> c == aId && sndSecure; _ -> False
|
||||
("", _, CONF confId _ "bob's connInfo") <- get a
|
||||
@@ -1837,7 +1834,7 @@ testContactShortLink viaProxy a b =
|
||||
(aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
|
||||
liftIO $ sndSecure `shouldBe` False
|
||||
("", _, REQ invId _ "bob's connInfo") <- get a
|
||||
(bId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
bId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
sndSecure' <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sndSecure' `shouldBe` True
|
||||
("", _, CONF confId _ "alice's connInfo") <- get b
|
||||
@@ -1890,7 +1887,7 @@ testAddContactShortLink viaProxy a b =
|
||||
(aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
|
||||
liftIO $ sndSecure `shouldBe` False
|
||||
("", _, REQ invId _ "bob's connInfo") <- get a
|
||||
(bId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
bId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
sndSecure' <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sndSecure' `shouldBe` True
|
||||
("", _, CONF confId _ "alice's connInfo") <- get b
|
||||
@@ -2049,7 +2046,7 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b
|
||||
(bId, sndSecure) <- joinConnection b 1 True connReq' "bob's connInfo" SMSubscribe
|
||||
liftIO $ sndSecure `shouldBe` False
|
||||
("", _, REQ invId _ "bob's connInfo") <- get a
|
||||
(aId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
aId <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
|
||||
sndSecure' <- acceptContact a 1 aId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sndSecure' `shouldBe` True
|
||||
("", _, CONF confId _ "alice's connInfo") <- get b
|
||||
@@ -2487,49 +2484,6 @@ testExpireManyMessagesQuota (t, msType) = withSmpServerConfigOn t cfg' testPort
|
||||
where
|
||||
cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
|
||||
|
||||
testJoinFullContactAsync :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
|
||||
testJoinFullContactAsync (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
|
||||
(contactId, qInfo) <- fillContactAddress
|
||||
withAgent 2 agentCfg {commandQuotaRetryInterval = fastRetryInterval} initAgentServers testDB2 $ \bob -> do
|
||||
aliceId <- runRight $ do
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
A.joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
pure aliceId
|
||||
threadDelay 500000
|
||||
noMessages bob "joining should be retried while the address is full"
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \alice -> runRight_ $ do
|
||||
subscribeConnection alice contactId
|
||||
("", _, A.REQ _ _ _ "carol's connInfo" _ _) <- get alice
|
||||
get bob =##> \case ("2", c, JOINED False) -> c == aliceId; _ -> False
|
||||
("", _, A.REQ _ _ _ "bob's connInfo" _ _) <- get alice
|
||||
pure ()
|
||||
where
|
||||
cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
|
||||
|
||||
testJoinFullContactAsyncExpire :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
|
||||
testJoinFullContactAsyncExpire (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
|
||||
(_, qInfo) <- fillContactAddress
|
||||
withAgent 2 agentCfg {quotaExceededTimeout = 2, commandQuotaRetryInterval = fastRetryInterval} initAgentServers testDB2 $ \bob -> do
|
||||
aliceId <- runRight $ do
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
A.joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
pure aliceId
|
||||
threadDelay 500000
|
||||
noMessages bob "joining should be retried until quota exceeded timeout"
|
||||
get bob =##> \case ("2", c, ERR (SMP _ QUOTA)) -> c == aliceId; _ -> False
|
||||
where
|
||||
cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
|
||||
|
||||
fillContactAddress :: HasCallStack => IO (ConnId, ConnectionRequestUri 'CMContact)
|
||||
fillContactAddress = do
|
||||
(contactId, qInfo) <- withAgent 1 agentCfg initAgentServers testDB $ \alice -> runRight $ do
|
||||
(contactId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
|
||||
pure (contactId, qInfo)
|
||||
withAgent 3 agentCfg initAgentServers testDB3 $ \carol -> runRight_ $ do
|
||||
(aliceId, _) <- A.prepareConnectionToJoin carol 1 True qInfo PQSupportOn
|
||||
void $ A.joinConnection carol NRMInteractive 1 aliceId True qInfo "carol's connInfo" PQSupportOn SMSubscribe
|
||||
pure (contactId, qInfo)
|
||||
|
||||
testDropMsgAfterRcvAttempts :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
|
||||
testDropMsgAfterRcvAttempts ps =
|
||||
withSmpServerStoreLogOn ps testPort $ \_ -> do
|
||||
@@ -2795,7 +2749,7 @@ makeConnectionForUsers = makeConnectionForUsers_ PQSupportOn
|
||||
makeConnectionForUsers_ :: HasCallStack => PQSupport -> AgentClient -> UserId -> AgentClient -> UserId -> ExceptT AgentErrorType IO (ConnId, ConnId)
|
||||
makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do
|
||||
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive aliceUserId True True SCMInvitation Nothing Nothing (IKLinkPQ pqSupport) False SMSubscribe
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
|
||||
aliceId <- A.prepareConnectionToJoin bob bobUserId True qInfo pqSupport
|
||||
sqSecured' <- A.joinConnection bob NRMInteractive bobUserId aliceId True qInfo "bob's connInfo" pqSupport SMSubscribe
|
||||
liftIO $ sqSecured' `shouldBe` True
|
||||
("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
|
||||
@@ -3077,7 +3031,7 @@ testAsyncCommands alice bob baseId =
|
||||
createConnectionAsync alice "1" bobId True SCMInvitation IKPQOn False SMSubscribe
|
||||
("1", bobId', INV (ACR _ qInfo)) <- get alice
|
||||
liftIO $ bobId' `shouldBe` bobId
|
||||
(aliceId, _) <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
aliceId <- prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
joinConnectionAsync bob "2" False aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
("2", aliceId', JOINED sqSecured') <- get bob
|
||||
liftIO $ do
|
||||
@@ -3147,7 +3101,7 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
|
||||
-- complete connection via contact address
|
||||
(aliceId, _) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
|
||||
("", _, REQ invId _ "bob's connInfo") <- get alice
|
||||
(bobId, _) <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
|
||||
bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
|
||||
_ <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, CONF confId _ "alice's connInfo") <- get bob
|
||||
allowConnection bob aliceId confId "bob's connInfo"
|
||||
@@ -3175,7 +3129,7 @@ testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
|
||||
liftIO $ aliceId' `shouldBe` aliceId
|
||||
-- complete connection
|
||||
("", _, REQ invId _ "bob's connInfo") <- get alice
|
||||
(bobId, _) <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
|
||||
bobId <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
|
||||
_ <- acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
("", _, CONF confId _ "alice's connInfo") <- get bob
|
||||
allowConnection bob aliceId confId "bob's connInfo"
|
||||
@@ -3205,7 +3159,7 @@ testAcceptContactAsync alice bob baseId =
|
||||
(aliceId, sqSecuredJoin) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
|
||||
liftIO $ sqSecuredJoin `shouldBe` False -- joining via contact address connection
|
||||
("", _, REQ invId _ "bob's connInfo") <- get alice
|
||||
(bobId, _) <- prepareConnectionToAccept alice 1 True invId PQSupportOn
|
||||
bobId <- prepareConnectionToAccept alice 1 True invId PQSupportOn
|
||||
acceptContactAsync alice "1" bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
|
||||
get alice =##> \case ("1", c, JOINED sqSecured') -> c == bobId && sqSecured' == True; _ -> False
|
||||
("", _, CONF confId _ "alice's connInfo") <- get bob
|
||||
@@ -3486,7 +3440,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
|
||||
createConnectionAsync a "1" bId True SCMInvitation IKPQOn False SMSubscribe
|
||||
("1", bId', INV (ACR _ qInfo)) <- get a
|
||||
liftIO $ bId' `shouldBe` bId
|
||||
(aId, _) <- prepareConnectionToJoin b 1 True qInfo PQSupportOn
|
||||
aId <- prepareConnectionToJoin b 1 True qInfo PQSupportOn
|
||||
joinConnectionAsync b "2" False aId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ threadDelay 500000
|
||||
ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
|
||||
@@ -4069,23 +4023,13 @@ testServerInformation =
|
||||
serverCountry = Nothing
|
||||
}
|
||||
|
||||
testConnectionVerifyCodes :: HasCallStack => IO ()
|
||||
testConnectionVerifyCodes =
|
||||
testRatchetAdHash :: HasCallStack => IO ()
|
||||
testRatchetAdHash =
|
||||
withAgentClients2 $ \a b -> runRight_ $ do
|
||||
(aId, bId) <- makeConnection a b
|
||||
codes1 <- getConnectionVerifyCodes a bId
|
||||
codes2 <- getConnectionVerifyCodes b aId
|
||||
liftIO $ do
|
||||
codes1 `shouldBe` codes2
|
||||
codePQ codes1 `shouldNotBe` Nothing
|
||||
liftIO $ withTransaction (store $ agentEnv a) $ \db ->
|
||||
DB.execute_ db "UPDATE ratchets SET rc_verify_code_ad = NULL, rc_verify_code_pq = NULL"
|
||||
codes1' <- getConnectionVerifyCodes a bId
|
||||
liftIO $ codes1' `shouldBe` codes1
|
||||
liftIO $ withTransaction (store $ agentEnv a) $ \db ->
|
||||
DB.execute_ db "UPDATE ratchets SET ratchet_state = NULL"
|
||||
codes1'' <- getConnectionVerifyCodes a bId
|
||||
liftIO $ codes1'' `shouldBe` codes1
|
||||
ad1 <- getConnectionRatchetAdHash a bId
|
||||
ad2 <- getConnectionRatchetAdHash b aId
|
||||
liftIO $ ad1 `shouldBe` ad2
|
||||
|
||||
testDeliveryReceipts :: HasCallStack => IO ()
|
||||
testDeliveryReceipts =
|
||||
@@ -4674,7 +4618,8 @@ testServerMultipleIdentities =
|
||||
testE2ERatchetParams12
|
||||
|
||||
testWaitForUserNetwork :: IO ()
|
||||
testWaitForUserNetwork = withAgent 1 aCfg initAgentServers testDB $ \a -> do
|
||||
testWaitForUserNetwork = do
|
||||
a <- getSMPAgentClient' 1 aCfg initAgentServers testDB
|
||||
noNetworkDelay a
|
||||
setUserNetworkInfo a $ UserNetworkInfo UNNone False
|
||||
networkDelay a 100000
|
||||
@@ -4691,7 +4636,8 @@ testWaitForUserNetwork = withAgent 1 aCfg initAgentServers testDB $ \a -> do
|
||||
aCfg = agentCfg {userNetworkInterval = 100000, userOfflineDelay = 0}
|
||||
|
||||
testDoNotResetOnlineToOffline :: IO ()
|
||||
testDoNotResetOnlineToOffline = withAgent 1 aCfg initAgentServers testDB $ \a -> do
|
||||
testDoNotResetOnlineToOffline = do
|
||||
a <- getSMPAgentClient' 1 aCfg initAgentServers testDB
|
||||
noNetworkDelay a
|
||||
setUserNetworkInfo a $ UserNetworkInfo UNWifi False
|
||||
networkDelay a 100000
|
||||
@@ -4712,7 +4658,8 @@ testDoNotResetOnlineToOffline = withAgent 1 aCfg initAgentServers testDB $ \a ->
|
||||
aCfg = agentCfg {userNetworkInterval = 100000, userOfflineDelay = 0.1}
|
||||
|
||||
testResumeMultipleThreads :: IO ()
|
||||
testResumeMultipleThreads = withAgent 1 aCfg initAgentServers testDB $ \a -> do
|
||||
testResumeMultipleThreads = do
|
||||
a <- getSMPAgentClient' 1 aCfg initAgentServers testDB
|
||||
noNetworkDelay a
|
||||
setUserNetworkInfo a $ UserNetworkInfo UNNone False
|
||||
vs <-
|
||||
|
||||
@@ -14,6 +14,7 @@ module AgentTests.ResolveNameTests (resolveNameTests) where
|
||||
|
||||
import AgentTests.FunctionalAPITests (withAgent)
|
||||
import Control.Monad.Except (runExceptT)
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.List (isInfixOf)
|
||||
import Network.HTTP.Types (Status, status200, status404, status502)
|
||||
@@ -21,7 +22,7 @@ import NamesResolverServer (memCfg, memCfg2, memProxyCfg, withNames)
|
||||
import qualified NamesResolverServer as NRS
|
||||
import SMPAgentClient
|
||||
import SMPClient
|
||||
import SMPNamesTests (availableBody, registeredBody, testNameRecord)
|
||||
import SMPNamesTests (testNameRecord)
|
||||
import Simplex.Messaging.Agent (resolveSimplexName)
|
||||
import Simplex.Messaging.Agent.Client (AgentClient)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (InitialAgentServers (..), ServerCfg, ServerRoles (..), presetServerCfg)
|
||||
@@ -70,13 +71,13 @@ withNoNameServers k = withAgent 1 agentCfg (oneSrv (proxySrvCfg testSMPServer))
|
||||
resolveNameTests :: Spec
|
||||
resolveNameTests = do
|
||||
describe "direct path (SPMNever)" $
|
||||
it "a resolver error propagates as SMP host (NAME RESOLVER)" testDirectResolverErr
|
||||
it "404 propagates as SMP host (NAME NOT_FOUND)" testDirectNotFound
|
||||
describe "proxy path (SPMAlways)" $
|
||||
it "a resolver error propagates via proxy as SMP <proxyHost> (NAME RESOLVER)" testProxyResolverErr
|
||||
it "404 from resolver propagates via proxy as SMP <proxyHost> (NAME NOT_FOUND)" testProxyNotFound
|
||||
describe "TLDTesting path" $
|
||||
it "NAME RESOLVER for TLDTesting too" testTestingTldResolverErr
|
||||
it "NAME NOT_FOUND for TLDTesting too" testTestingTldNotFound
|
||||
describe "TLDWeb path" $
|
||||
it "NAME RESOLVER for TLDWeb too" testWebTldResolverErr
|
||||
it "NAME NOT_FOUND for TLDWeb too" testWebTldNotFound
|
||||
describe "no resolver configured" $
|
||||
it "answers NAME NO_RESOLVER" testNoResolver
|
||||
describe "no names servers (names role off everywhere)" $
|
||||
@@ -85,50 +86,38 @@ resolveNameTests = do
|
||||
it "surfaces as SMP host (NAME (RESOLVER ..))" testBackendError
|
||||
describe "success path" $
|
||||
it "returns NameRecord" testDirectSuccess
|
||||
describe "name availability" $
|
||||
it "an unregistered name answers as available" testAvailSuccess
|
||||
|
||||
testAvailSuccess :: HasCallStack => IO ()
|
||||
testAvailSuccess =
|
||||
withDirectResolver (status200, availableBody) $ \c -> do
|
||||
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
|
||||
case r of
|
||||
Right SMP.NameResponse {registration = SMP.NRAvailable {}} -> pure ()
|
||||
_ -> expectationFailure $ "expected Right NRAvailable, got: " <> show r
|
||||
|
||||
-- | 404 is a resolver that predates /v2/resolve: no status from that endpoint
|
||||
-- means "not registered", since an unregistered name answers NRAvailable.
|
||||
testDirectResolverErr :: HasCallStack => IO ()
|
||||
testDirectResolverErr =
|
||||
testDirectNotFound :: HasCallStack => IO ()
|
||||
testDirectNotFound =
|
||||
withDirectResolver (status404, "{}") $ \c -> do
|
||||
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
|
||||
case r of
|
||||
Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER _))), got: " <> show r
|
||||
Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
|
||||
|
||||
testProxyResolverErr :: HasCallStack => IO ()
|
||||
testProxyResolverErr =
|
||||
testProxyNotFound :: HasCallStack => IO ()
|
||||
testProxyNotFound =
|
||||
withProxyAndResolver (status404, "{}") $ \c -> do
|
||||
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
|
||||
case r of
|
||||
Left (SMP host (SMP.NAME (SMP.RESOLVER _))) | testPort `isInfixOf` host -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (SMP <proxyHost:" <> testPort <> "> (NAME (RESOLVER _))), got: " <> show r
|
||||
Left (SMP host (SMP.NAME SMP.NOT_FOUND)) | testPort `isInfixOf` host -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (SMP <proxyHost:" <> testPort <> "> (NAME NOT_FOUND)), got: " <> show r
|
||||
|
||||
testTestingTldResolverErr :: HasCallStack => IO ()
|
||||
testTestingTldResolverErr =
|
||||
testTestingTldNotFound :: HasCallStack => IO ()
|
||||
testTestingTldNotFound =
|
||||
withDirectResolver (status404, "{}") $ \c -> do
|
||||
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDTesting "bob" [])
|
||||
case r of
|
||||
Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER _))), got: " <> show r
|
||||
Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
|
||||
|
||||
testWebTldResolverErr :: HasCallStack => IO ()
|
||||
testWebTldResolverErr =
|
||||
testWebTldNotFound :: HasCallStack => IO ()
|
||||
testWebTldNotFound =
|
||||
withDirectResolver (status404, "{}") $ \c -> do
|
||||
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDWeb "example.com" [])
|
||||
case r of
|
||||
Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER _))), got: " <> show r
|
||||
Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
|
||||
|
||||
testNoResolver :: HasCallStack => IO ()
|
||||
testNoResolver =
|
||||
@@ -156,8 +145,8 @@ testBackendError =
|
||||
|
||||
testDirectSuccess :: HasCallStack => IO ()
|
||||
testDirectSuccess =
|
||||
withDirectResolver (status200, registeredBody testNameRecord) $ \c -> do
|
||||
withDirectResolver (status200, J.encode testNameRecord) $ \c -> do
|
||||
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
|
||||
case r of
|
||||
Right SMP.NameResponse {registration = SMP.NRRegistered {nameRecord}} -> nameRecord `shouldBe` testNameRecord
|
||||
_ -> expectationFailure $ "expected Right NRRegistered, got: " <> show r
|
||||
Right nr -> nr `shouldBe` testNameRecord
|
||||
_ -> expectationFailure $ "expected Right NameRecord, got: " <> show r
|
||||
|
||||
@@ -743,11 +743,9 @@ testGetNextRcvChunkToDownload st = do
|
||||
withTransaction st $ \db -> do
|
||||
Right Nothing <- getNextRcvChunkToDownload db xftpServer1 86400
|
||||
|
||||
Right fId1 <- createRcvFile db g 1 rcvFileDescr1 "filepath" "filepath" (CryptoFile "filepath" Nothing) True
|
||||
Right _ <- startPreparedRcvFile db fId1
|
||||
Right _ <- createRcvFile db g 1 rcvFileDescr1 "filepath" "filepath" (CryptoFile "filepath" Nothing) True
|
||||
DB.execute_ db "UPDATE rcv_file_chunk_replicas SET replica_key = cast('bad' as blob) WHERE rcv_file_chunk_replica_id = 1"
|
||||
Right fId2 <- createRcvFile db g 1 rcvFileDescr1 "filepath" "filepath" (CryptoFile "filepath" Nothing) True
|
||||
Right _ <- startPreparedRcvFile db fId2
|
||||
|
||||
Left e <- getNextRcvChunkToDownload db xftpServer1 86400
|
||||
show e `shouldContain` "ConversionFailed"
|
||||
@@ -785,7 +783,6 @@ testGetNextSndFileToPrepare st = do
|
||||
-- Right _ <- createSndFile db g 1 (CryptoFile "filepath" Nothing) 1 "filepath" testFileSbKey testFileCbNonce Nothing
|
||||
-- DB.execute_ db "UPDATE snd_files SET status = 'new', num_recipients = 'bad' WHERE snd_file_id = 1"
|
||||
Right fId2 <- createSndFile db g 1 (CryptoFile "filepath" Nothing) 1 "filepath" testFileSbKey testFileCbNonce Nothing Nothing
|
||||
Right _ <- startPreparedSndFile db fId2
|
||||
DB.execute_ db "UPDATE snd_files SET status = 'new' WHERE snd_file_id = 2"
|
||||
|
||||
-- Left e <- getNextSndFileToPrepare db 86400
|
||||
|
||||
@@ -71,7 +71,9 @@ initServers =
|
||||
}
|
||||
|
||||
testChooseDifferentOperator :: IO ()
|
||||
testChooseDifferentOperator = withAgent 1 agentCfg initServers testDB $ \c -> runRight_ $ do
|
||||
testChooseDifferentOperator = do
|
||||
c <- getSMPAgentClient' 1 agentCfg initServers testDB
|
||||
runRight_ $ do
|
||||
-- chooses the only operator with storage role
|
||||
srv1 <- withAgentEnv c $ getNextServer c 1 storageSrvs []
|
||||
liftIO $ srv1 == testOp1Srv1 || srv1 == testOp1Srv2 `shouldBe` True
|
||||
|
||||
@@ -14,11 +14,8 @@ import Util
|
||||
retryIntervalTests :: Spec
|
||||
retryIntervalTests = do
|
||||
describe "Retry interval with 2 modes and lock" $ do
|
||||
testRetryIntervalSameMode withRetryNewLock2
|
||||
testRetryIntervalSwitchMode withRetryNewLock2
|
||||
describe "Retry interval with 2 modes" $ do
|
||||
testRetryIntervalSameMode withRetryInterval2
|
||||
testRetryIntervalSwitchMode withRetryInterval2
|
||||
testRetryIntervalSameMode
|
||||
testRetryIntervalSwitchMode
|
||||
describe "Foreground retry interval" $ do
|
||||
testRetryForeground
|
||||
testRetryToBackground
|
||||
@@ -44,18 +41,14 @@ testFastRI =
|
||||
maxInterval = 40000
|
||||
}
|
||||
|
||||
type WithRetry2 = RetryInterval2 -> (RI2State -> (RetryIntervalMode -> IO ()) -> IO ()) -> IO ()
|
||||
|
||||
withRetryNewLock2 :: WithRetry2
|
||||
withRetryNewLock2 ri action = newEmptyTMVarIO >>= \lock -> withRetryLock2 ri lock action
|
||||
|
||||
testRetryIntervalSameMode :: WithRetry2 -> Spec
|
||||
testRetryIntervalSameMode withRetry =
|
||||
testRetryIntervalSameMode :: Spec
|
||||
testRetryIntervalSameMode =
|
||||
it "should increase elapased time and interval when the mode stays the same" $ do
|
||||
lock <- newEmptyTMVarIO
|
||||
intervals <- newTVarIO []
|
||||
reportedIntervals <- newTVarIO []
|
||||
ts <- newTVarIO =<< getCurrentTime
|
||||
withRetry testRI $ \(RI2State slow fast) loop -> do
|
||||
withRetryLock2 testRI lock $ \(RI2State slow fast) loop -> do
|
||||
ints <- addInterval intervals ts
|
||||
atomically $ modifyTVar' reportedIntervals ((slow, fast) :)
|
||||
when (length ints < 9) $ loop RIFast
|
||||
@@ -72,13 +65,14 @@ testRetryIntervalSameMode withRetry =
|
||||
(20000, 40000)
|
||||
]
|
||||
|
||||
testRetryIntervalSwitchMode :: WithRetry2 -> Spec
|
||||
testRetryIntervalSwitchMode withRetry =
|
||||
testRetryIntervalSwitchMode :: Spec
|
||||
testRetryIntervalSwitchMode =
|
||||
it "should increase elapased time and interval when the mode switches" $ do
|
||||
lock <- newEmptyTMVarIO
|
||||
intervals <- newTVarIO []
|
||||
reportedIntervals <- newTVarIO []
|
||||
ts <- newTVarIO =<< getCurrentTime
|
||||
withRetry testRI $ \(RI2State slow fast) loop -> do
|
||||
withRetryLock2 testRI lock $ \(RI2State slow fast) loop -> do
|
||||
ints <- addInterval intervals ts
|
||||
atomically $ modifyTVar' reportedIntervals ((slow, fast) :)
|
||||
when (length ints < 11) $ loop $ if length ints <= 5 then RIFast else RISlow
|
||||
|
||||
@@ -22,7 +22,7 @@ import qualified Data.X509.Validation as XV
|
||||
import SMPClient
|
||||
import Simplex.FileTransfer.Protocol (FileInfo (..))
|
||||
import Simplex.FileTransfer.Server.Store (FileRec (..), FileRecipient (..), FileStoreClass (..), RoundedFileTime, STMFileStore (..))
|
||||
import Simplex.FileTransfer.Server.StoreLog (FileStoreLogRecord (..), readWriteFileStore, serverFileName)
|
||||
import Simplex.FileTransfer.Server.StoreLog (FileStoreLogRecord (..), readWriteFileStore)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Protocol
|
||||
@@ -37,7 +37,6 @@ import Simplex.Messaging.Server.StoreLog
|
||||
import Simplex.Messaging.SystemTime
|
||||
import Simplex.Messaging.Transport (SMPServiceRole (..))
|
||||
import Simplex.Messaging.Transport.Credentials (genCredentials)
|
||||
import System.FilePath ((</>))
|
||||
import Test.Hspec hiding (fit, it)
|
||||
import Util
|
||||
|
||||
@@ -270,18 +269,6 @@ fileStoreLogTests = do
|
||||
saved = [AddFile sId file createdAt Nothing EntityActive, BlockFile sId blockedWithNotice],
|
||||
compacted = [AddFile sId file createdAt Nothing (EntityBlocked blockedWithNotice)],
|
||||
state = M.fromList [(sId, (file, createdAt, Nothing, EntityBlocked blockedWithNotice))]
|
||||
},
|
||||
SLTC
|
||||
{ name = "put file with wrong file name",
|
||||
saved = [AddFile sId file createdAt (Just expiresAt) EntityActive, PutFile sId "/etc/passwd"],
|
||||
compacted = [AddFile sId file createdAt (Just expiresAt) EntityActive],
|
||||
state = M.fromList [(sId, (file, createdAt, Just expiresAt, EntityActive))]
|
||||
},
|
||||
SLTC
|
||||
{ name = "put file in another directory",
|
||||
saved = [AddFile sId file createdAt (Just expiresAt) EntityActive, PutFile sId ("/srv/xftp" </> serverFileName sId)],
|
||||
compacted = [AddFile sId file createdAt (Just expiresAt) EntityActive, PutFile sId ("/srv/xftp" </> serverFileName sId)],
|
||||
state = M.fromList [(sId, (file, createdAt, Just expiresAt, EntityActive))]
|
||||
}
|
||||
]
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@ import Data.Word (Word32)
|
||||
import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..))
|
||||
import Simplex.FileTransfer.Server.Store
|
||||
import Simplex.FileTransfer.Server.Store.Postgres (PostgresFileStore, importFileStore, exportFileStore)
|
||||
import Simplex.FileTransfer.Server.StoreLog (closeStoreLog, readWriteFileStore, serverFileName, writeFileStore)
|
||||
import Simplex.FileTransfer.Server.StoreLog (closeStoreLog, readWriteFileStore, writeFileStore)
|
||||
import Simplex.FileTransfer.Transport (XFTPErrorType (..))
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Protocol (BlockingInfo (..), BlockingReason (..), EntityId (..))
|
||||
@@ -17,7 +17,6 @@ import Simplex.Messaging.Server.QueueStore (ServerEntityStatus (..))
|
||||
import Simplex.Messaging.Server.StoreLog (openWriteStoreLog)
|
||||
import Simplex.Messaging.SystemTime (RoundedSystemTime (..))
|
||||
import System.Directory (doesFileExist, removeFile)
|
||||
import System.FilePath ((</>))
|
||||
import Test.Hspec hiding (fit, it)
|
||||
import UnliftIO.STM
|
||||
import Util
|
||||
@@ -266,7 +265,7 @@ testMigrationRoundTrip = do
|
||||
sId2 = EntityId "migration_file_2"
|
||||
rId1 = EntityId "migration_rcp_1_"
|
||||
addFile stmStore sId1 fileInfo1 testCreatedAt (Just testExpiresAt) EntityActive `shouldReturn` Right ()
|
||||
void $ setFilePath stmStore sId1 ("/tmp" </> serverFileName sId1)
|
||||
void $ setFilePath stmStore sId1 "/tmp/file1"
|
||||
addRecipient stmStore sId1 (FileRecipient rId1 rcpKey1) `shouldReturn` Right ()
|
||||
let testBlockInfo = BlockingInfo {reason = BRSpam, notice = Nothing}
|
||||
addFile stmStore sId2 fileInfo2 testCreatedAt Nothing (EntityBlocked testBlockInfo) `shouldReturn` Right ()
|
||||
@@ -290,7 +289,7 @@ testMigrationRoundTrip = do
|
||||
case result1 of
|
||||
Right (FileRec {fileInfo = fi, filePath, expiresAt, fileStatus}, _) -> do
|
||||
size fi `shouldBe` 128000
|
||||
readTVarIO filePath `shouldReturn` Just ("/tmp" </> serverFileName sId1)
|
||||
readTVarIO filePath `shouldReturn` Just "/tmp/file1"
|
||||
expiresAt `shouldBe` Just testExpiresAt
|
||||
readTVarIO fileStatus `shouldReturn` EntityActive
|
||||
Left e -> expectationFailure $ "getFile sId1 failed: " <> show e
|
||||
|
||||
@@ -47,12 +47,10 @@ withResolverServerDelayed delayMs handler action = do
|
||||
let (st, body) = handler (pathInfo req)
|
||||
send $ responseLBS st [(hContentType, "application/json")] body
|
||||
|
||||
-- | The resolver API is versioned on its own: v2 answers with NameRegistration
|
||||
-- JSON, which is the only shape the server asks for.
|
||||
resolveResp :: Status -> LB.ByteString -> [Text] -> (Status, LB.ByteString)
|
||||
resolveResp st body = \case
|
||||
["health"] -> (ok200, "{}")
|
||||
("v2" : "resolve" : _) -> (st, body)
|
||||
("resolve" : _) -> (st, body)
|
||||
_ -> (notFound404, "{}")
|
||||
|
||||
testNamesConfig :: Int -> NamesConfig
|
||||
|
||||
+33
-168
@@ -14,11 +14,11 @@ module RSLVTests (rslvTests) where
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad.Trans.Except (ExceptT, runExceptT)
|
||||
import Data.IORef (readIORef)
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.IORef (IORef, readIORef)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
@@ -29,18 +29,14 @@ import SMPClient
|
||||
import Simplex.Messaging.Client
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String (strDecode)
|
||||
import SMPNamesTests (availableBody, registeredBody, reservedBody, resolved, testNameRecord, testPricing)
|
||||
import SMPNamesTests (testNameRecord)
|
||||
import Simplex.Messaging.Protocol
|
||||
( BrokerMsg (..),
|
||||
Cmd (..),
|
||||
Command (..),
|
||||
CorrId (..),
|
||||
ErrorType (..),
|
||||
NameQuery (..),
|
||||
NameRegistration (..),
|
||||
NameResponse (..),
|
||||
NameErrorType (..),
|
||||
NameReservedReason (..),
|
||||
SParty (..),
|
||||
Transmission,
|
||||
TransmissionForAuth (..),
|
||||
@@ -50,7 +46,6 @@ import Simplex.Messaging.Protocol
|
||||
tPut,
|
||||
)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
|
||||
import Simplex.Messaging.SimplexName (SimplexDomain)
|
||||
import Simplex.Messaging.Transport
|
||||
import Simplex.Messaging.Version (mkVersionRange)
|
||||
@@ -65,11 +60,6 @@ withResolverServer (st, body) runTest =
|
||||
NRS.withResolverServer (NRS.resolveResp st body) $ \port _ ->
|
||||
withSmpServerConfigOn (transport @TLS) (withNames port memCfg) testPort (const runTest)
|
||||
|
||||
withResolverServerReqs :: (Status, LB.ByteString) -> (IORef [[Text]] -> IO a) -> IO a
|
||||
withResolverServerReqs (st, body) runTest =
|
||||
NRS.withResolverServer (NRS.resolveResp st body) $ \port reqs ->
|
||||
withSmpServerConfigOn (transport @TLS) (withNames port memCfg) testPort (const (runTest reqs))
|
||||
|
||||
withProxyAndResolver :: (Status, LB.ByteString) -> IO a -> IO a
|
||||
withProxyAndResolver (st, body) runTest =
|
||||
NRS.withResolverServer (NRS.resolveResp st body) $ \port _ ->
|
||||
@@ -78,7 +68,7 @@ withProxyAndResolver (st, body) runTest =
|
||||
|
||||
sendRslv :: Transport c => THandleSMP c 'TClient -> B.ByteString -> SimplexDomain -> IO (Transmission (Either ErrorType BrokerMsg))
|
||||
sendRslv h@THandle {params} corrId d = do
|
||||
let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, NoEntity, Cmd SResolver (RSLV (NQDomain d)))
|
||||
let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId corrId, NoEntity, Cmd SResolver (RSLV d))
|
||||
[Right ()] <- tPut h (Right (Nothing, tToSend) :| [])
|
||||
r :| _ <- tGetClient h
|
||||
pure r
|
||||
@@ -86,38 +76,40 @@ sendRslv h@THandle {params} corrId d = do
|
||||
rslvTests :: Spec
|
||||
rslvTests = do
|
||||
describe "RSLV direct (non-forwarded)" $ do
|
||||
it "resolver without the v2 route (404) -> NAME RESOLVER, not NOT_FOUND" testRslvBackendNotFound
|
||||
it "resolver replies 404 -> NAME NOT_FOUND (reached, not CMD PROHIBITED)" testRslvBackendNotFound
|
||||
it "resolver replies 502 -> NAME (RESOLVER ..)" testRslvBackendHttpErr
|
||||
it "no names config -> NAME NO_RESOLVER" testRslvDisabled
|
||||
it "refuses to send RSLV on a session below namesSMPVersion" testRslvVersion
|
||||
describe "RSLV forwarded (PFWD)" $ do
|
||||
it "PFWD-wrapped RSLV reaches resolver via proxy (PCEProtocolError (NAME RESOLVER))" testRslvForwarded
|
||||
it "PFWD-wrapped RSLV reaches resolver via proxy (PCEProtocolError (NAME NOT_FOUND))" testRslvForwarded
|
||||
it "PFWD-wrapped RSLV success returns RNAME (record JSON frames over the proxy)" testRslvForwardedSuccess
|
||||
describe "RSLV success path (RNAME response)" $ do
|
||||
it "returns RNAME with NameRecord" testRslvSuccess
|
||||
describe "RSLV availability (RNAME response)" $ do
|
||||
it "unregistered comes back AVAILABLE" testRslvAvailable
|
||||
it "reserved comes back with the reason" testRslvReserved
|
||||
it "PFWD-wrapped availability reaches the resolver" testRslvForwardedAvailable
|
||||
describe "RSLV below v22" $ do
|
||||
it "still resolves a name to its record" testRslvOldClientRecord
|
||||
it "still answers NAME NOT_FOUND for a name that does not resolve" testRslvOldClientNotFound
|
||||
describe "hashed lookups" $ do
|
||||
it "RSLV sends the 2LD as its hash" testRslvSendsTheHash
|
||||
it "a name with subnames is sent as text" testSubnameKeepsItsLabels
|
||||
it "a record naming a different name is rejected" testRslvWrongName
|
||||
describe "RSLV resource use" $
|
||||
it "one connection has at most resolver_concurrency lookups in flight" testRslvConnectionCap
|
||||
xit "one connection must not fan out to many concurrent resolver requests" testRslvFanOut
|
||||
|
||||
testRslvFanOut :: IO ()
|
||||
testRslvFanOut =
|
||||
NRS.withResolverServerDelayed 3000 (NRS.resolveResp status200 "{}") $ \port reqs ->
|
||||
withSmpServerConfigOn (transport @TLS) (withNames port memCfg) testPort $ const $
|
||||
testSMPClient @TLS $ \(h@THandle {params} :: THandleSMP TLS 'TClient) -> do
|
||||
let k = 64 :: Int
|
||||
globalCap = 8 :: Int
|
||||
forM_ [1 .. k] $ \i -> do
|
||||
let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId (B.pack $ "fan" <> show i), NoEntity, Cmd SResolver (RSLV (domain "alice.simplex")))
|
||||
[Right ()] <- tPut h (Right (Nothing, tToSend) :| [])
|
||||
pure ()
|
||||
threadDelay 800000
|
||||
inFlight <- length . filter ((== ["resolve"]) . take 1) <$> readIORef reqs
|
||||
inFlight `shouldSatisfy` (<= globalCap)
|
||||
|
||||
-- | /v2/resolve answers 200, 400 or 502, so a 404 is a resolver that predates
|
||||
-- the route, not a name that does not exist.
|
||||
testRslvBackendNotFound :: IO ()
|
||||
testRslvBackendNotFound =
|
||||
withResolverServer (status404, "{}") $
|
||||
testSMPClient @TLS $ \h -> do
|
||||
(corrId, _entId, resp) <- sendRslv h "rs01" (domain "ghost.simplex")
|
||||
corrId `shouldBe` CorrId "rs01"
|
||||
resp `shouldBe` Right (ERR (NAME (RESOLVER "HTTP 404")))
|
||||
resp `shouldBe` Right (ERR (NAME NOT_FOUND))
|
||||
|
||||
testRslvBackendHttpErr :: IO ()
|
||||
testRslvBackendHttpErr =
|
||||
@@ -135,7 +127,7 @@ testRslvDisabled =
|
||||
|
||||
testRslvVersion :: IO ()
|
||||
testRslvVersion =
|
||||
withResolverServer (status200, registeredBody testNameRecord) $ do
|
||||
withResolverServer (status200, J.encode testNameRecord) $ do
|
||||
g <- C.newRandom
|
||||
ts <- getCurrentTime
|
||||
let srv = SMPServer testHost testPort testKeyHash
|
||||
@@ -147,7 +139,7 @@ testRslvVersion =
|
||||
Left (PCETransportError TEVersion) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (PCETransportError TEVersion), got: " <> show r
|
||||
|
||||
forwardedResolveAlice :: IO (Either SMPClientError (Either ProxyClientError SMP.NameResponse))
|
||||
forwardedResolveAlice :: IO (Either SMPClientError (Either ProxyClientError SMP.NameRecord))
|
||||
forwardedResolveAlice = do
|
||||
g <- C.newRandom
|
||||
ts <- getCurrentTime
|
||||
@@ -163,152 +155,25 @@ testRslvForwarded :: IO ()
|
||||
testRslvForwarded =
|
||||
withProxyAndResolver (status404, "{}") $
|
||||
forwardedResolveAlice >>= \r -> case r of
|
||||
Left (PCEProtocolError (SMP.NAME (SMP.RESOLVER _))) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (PCEProtocolError (NAME (RESOLVER _))), got: " <> show r
|
||||
Left (PCEProtocolError (SMP.NAME SMP.NOT_FOUND)) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (PCEProtocolError (NAME NOT_FOUND)), got: " <> show r
|
||||
|
||||
testRslvForwardedSuccess :: IO ()
|
||||
testRslvForwardedSuccess =
|
||||
withProxyAndResolver (status200, registeredBody testNameRecord) $
|
||||
withProxyAndResolver (status200, J.encode testNameRecord) $
|
||||
forwardedResolveAlice >>= \r -> case r of
|
||||
Right (Right NameResponse {registration = NRRegistered {nameRecord}}) -> nameRecord `shouldBe` testNameRecord
|
||||
_ -> expectationFailure $ "expected Right (Right NRRegistered), got: " <> show r
|
||||
Right (Right nr) -> nr `shouldBe` testNameRecord
|
||||
_ -> expectationFailure $ "expected Right (Right NameRecord), got: " <> show r
|
||||
|
||||
testRslvSuccess :: IO ()
|
||||
testRslvSuccess =
|
||||
withResolverServer (status200, registeredBody testNameRecord) $
|
||||
withResolverServer (status200, J.encode testNameRecord) $
|
||||
testSMPClient @TLS $ \h -> do
|
||||
(corrId, _entId, resp) <- sendRslv h "rs07" (domain "alice.simplex")
|
||||
corrId `shouldBe` CorrId "rs07"
|
||||
case resp of
|
||||
Right (RNAME NameResponse {registration = NRRegistered {nameRecord}}) -> nameRecord `shouldBe` testNameRecord
|
||||
_ -> expectationFailure $ "expected Right (RNAME NRRegistered), got: " <> show resp
|
||||
|
||||
testRslvAvailable :: IO ()
|
||||
testRslvAvailable =
|
||||
withResolverServer (status200, availableBody) $
|
||||
testSMPClient @TLS $ \h -> do
|
||||
(corrId, _entId, resp) <- sendRslv h "na01" (domain "ghost.simplex")
|
||||
corrId `shouldBe` CorrId "na01"
|
||||
resp `shouldBe` Right (RNAME (resolved (NRAvailable testPricing)))
|
||||
|
||||
testRslvReserved :: IO ()
|
||||
testRslvReserved =
|
||||
withResolverServer (status200, reservedBody) $
|
||||
testSMPClient @TLS $ \h -> do
|
||||
(_, _, resp) <- sendRslv h "na03" (domain "acme.simplex")
|
||||
resp `shouldBe` Right (RNAME (resolved (NRReserved NRRTrademark)))
|
||||
|
||||
-- | A client that predates v22 must see exactly what it saw before: the record
|
||||
-- for a name that resolves, and NOT_FOUND for one that does not.
|
||||
oldClient :: IO SMPClient
|
||||
oldClient = do
|
||||
g <- C.newRandom
|
||||
ts <- getCurrentTime
|
||||
let srv = SMPServer testHost testPort testKeyHash
|
||||
-- the version just below the gate: a lower ceiling would pass even if
|
||||
-- the gate were at 20 or 21
|
||||
oldCfg = defaultSMPClientConfig {serverVRange = mkVersionRange minServerSMPRelayVersion serverInfoSMPVersion}
|
||||
pcE <- getProtocolClient g NRMInteractive (1, srv, Nothing) oldCfg [] Nothing ts (\_ -> pure ())
|
||||
either (fail . show) pure pcE
|
||||
|
||||
testRslvOldClientRecord :: IO ()
|
||||
testRslvOldClientRecord =
|
||||
withResolverServer (status200, registeredBody testNameRecord) $ do
|
||||
pc <- oldClient
|
||||
r <- runExceptT' (directResolveName pc NRMInteractive (domain "alice.simplex"))
|
||||
r `shouldBe` NameResponse Nothing (NRRegistered Nothing Nothing Nothing testNameRecord)
|
||||
|
||||
testRslvOldClientNotFound :: IO ()
|
||||
testRslvOldClientNotFound =
|
||||
withResolverServer (status200, availableBody) $ do
|
||||
pc <- oldClient
|
||||
r <- runExceptT (directResolveName pc NRMInteractive (domain "alice.simplex"))
|
||||
case r of
|
||||
Left (PCEProtocolError (SMP.NAME SMP.NOT_FOUND)) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (PCEProtocolError (NAME NOT_FOUND)), got: " <> show r
|
||||
|
||||
testRslvForwardedAvailable :: IO ()
|
||||
testRslvForwardedAvailable =
|
||||
withProxyAndResolver (status200, availableBody) $
|
||||
forwardedResolveAlice >>= \r -> case r of
|
||||
Right (Right NameResponse {registration = NRAvailable {pricing}}) -> pricing `shouldBe` testPricing
|
||||
_ -> expectationFailure $ "expected Right (Right NRAvailable), got: " <> show r
|
||||
|
||||
-- keccak-256("alice"), the registry key
|
||||
aliceHash :: Text
|
||||
aliceHash = "[9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501]"
|
||||
|
||||
-- | The paths the client asked the resolver for.
|
||||
resolvePaths :: IORef [[Text]] -> IO [[Text]]
|
||||
resolvePaths reqs = filter isResolve <$> readIORef reqs
|
||||
where
|
||||
isResolve = \case ("v2" : "resolve" : _) -> True; _ -> False
|
||||
|
||||
currentClient :: IO SMPClient
|
||||
currentClient = do
|
||||
g <- C.newRandom
|
||||
ts <- getCurrentTime
|
||||
let srv = SMPServer testHost testPort testKeyHash
|
||||
pcE <- getProtocolClient g NRMInteractive (1, srv, Nothing) defaultSMPClientConfig [] Nothing ts (\_ -> pure ())
|
||||
either (fail . show) pure pcE
|
||||
|
||||
testRslvSendsTheHash :: IO ()
|
||||
testRslvSendsTheHash =
|
||||
withResolverServerReqs (status200, registeredBody testNameRecord) $ \reqs -> do
|
||||
pc <- currentClient
|
||||
r <- runExceptT' (directResolveName pc NRMInteractive (domain "alice.simplex"))
|
||||
resolvePaths reqs `shouldReturn` [["v2", "resolve", aliceHash <> ".simplex"]]
|
||||
-- the client never sent the name, and the record still names it
|
||||
case r of
|
||||
NameResponse {registration = NRRegistered {nameRecord}} -> SMP.nrName nameRecord `shouldBe` "alice.simplex"
|
||||
_ -> expectationFailure $ "expected NRRegistered, got: " <> show r
|
||||
|
||||
testSubnameKeepsItsLabels :: IO ()
|
||||
testSubnameKeepsItsLabels =
|
||||
withResolverServerReqs (status200, availableBody) $ \reqs -> do
|
||||
pc <- currentClient
|
||||
_ <- runExceptT' (directResolveName pc NRMInteractive (domain "x.alice.simplex"))
|
||||
resolvePaths reqs `shouldReturn` [["v2", "resolve", "x.alice.simplex"]]
|
||||
|
||||
-- a hashed query does not tell the router the name, so the record's own name is
|
||||
-- checked against the one that was asked for
|
||||
testRslvWrongName :: IO ()
|
||||
testRslvWrongName =
|
||||
withResolverServer (status200, registeredBody testNameRecord {SMP.nrName = "mallory.simplex"}) $ do
|
||||
pc <- currentClient
|
||||
r <- runExceptT (directResolveName pc NRMInteractive (domain "alice.simplex"))
|
||||
case r of
|
||||
Left (PCEUnexpectedResponse _) -> pure ()
|
||||
_ -> expectationFailure $ "expected Left (PCEUnexpectedResponse ..), got: " <> show r
|
||||
|
||||
-- The resolver answers after 3s and the server gives up after 1s, so a request
|
||||
-- that reached the resolver stays in flight for the whole check.
|
||||
testRslvConnectionCap :: IO ()
|
||||
testRslvConnectionCap =
|
||||
NRS.withResolverServerDelayed 3000 (NRS.resolveResp status200 "{}") $ \port reqs ->
|
||||
withSmpServerConfigOn (transport @TLS) (updateCfg (withNames port memCfg) $ \c -> c {serverResolverConcurrency = connCap}) testPort $ const $
|
||||
testSMPClient @TLS $ \h -> do
|
||||
sendRslvs h "cap" 16
|
||||
threadDelay 800000
|
||||
length <$> resolvePaths reqs `shouldReturn` connCap
|
||||
recvResponses h 16 `shouldReturn` replicate 16 (Right (ERR (NAME (RESOLVER "timeout"))))
|
||||
where
|
||||
connCap = 4
|
||||
|
||||
-- | One RSLV per block, so no batch limit applies.
|
||||
sendRslvs :: THandleSMP TLS 'TClient -> String -> Int -> IO ()
|
||||
sendRslvs h@THandle {params} prefix n =
|
||||
forM_ [1 .. n] $ \i -> do
|
||||
let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId (B.pack $ prefix <> show i), NoEntity, Cmd SResolver (RSLV (NQDomain (domain "alice.simplex"))))
|
||||
[Right ()] <- tPut h (Right (Nothing, tToSend) :| [])
|
||||
pure ()
|
||||
|
||||
recvResponses :: THandleSMP TLS 'TClient -> Int -> IO [Either ErrorType BrokerMsg]
|
||||
recvResponses h n
|
||||
| n <= 0 = pure []
|
||||
| otherwise = do
|
||||
rs <- map (\(_, _, r) -> r) . L.toList <$> tGetClient h
|
||||
(rs <>) <$> recvResponses h (n - length rs)
|
||||
Right (RNAME nr) -> nr `shouldBe` testNameRecord
|
||||
_ -> expectationFailure $ "expected Right (RNAME ..), got: " <> show resp
|
||||
|
||||
runExceptT' :: Show e => ExceptT e IO a -> IO a
|
||||
runExceptT' a = runExceptT a >>= either (fail . show) pure
|
||||
|
||||
+3
-4
@@ -276,7 +276,6 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
|
||||
smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 1, msgQSize = Nothing}, -- seconds
|
||||
allowSMPProxy = False,
|
||||
serverClientConcurrency = 2,
|
||||
proxyRelayConcurrency = defaultProxyRelayConcurrency,
|
||||
serverResolverConcurrency = defaultNameResolverConcurrency,
|
||||
namesConfig = Nothing,
|
||||
information = Nothing,
|
||||
@@ -317,9 +316,6 @@ prevRange vr = vr {maxVersion = max (minVersion vr) (prevVersion $ maxVersion vr
|
||||
prevVersion :: Version v -> Version v
|
||||
prevVersion (Version v) = Version (v - 1)
|
||||
|
||||
nextVersion :: Version v -> Version v
|
||||
nextVersion (Version v) = Version (v + 1)
|
||||
|
||||
proxyCfg :: AServerConfig
|
||||
proxyCfg = proxyCfgMS (ASType SQSMemory SMSJournal)
|
||||
|
||||
@@ -350,6 +346,9 @@ proxyCfgShortTimeout =
|
||||
nt = NetworkTimeout {backgroundTimeout = 4_000000, interactiveTimeout = 4_000000}
|
||||
in cfg' {smpAgentCfg = aCfg {smpCfg = cCfg {networkConfig = (networkConfig cCfg) {tcpConnectTimeout = nt}}}}
|
||||
|
||||
-- Proxy whose forward (RFWD) response deadline is 1us: every forward to the relay times out
|
||||
-- while the initial relay connect (tcpConnectTimeout) is unaffected, so a session is established
|
||||
-- and then every forward on it fails with a response timeout.
|
||||
proxyCfgForwardTimeout :: AServerConfig
|
||||
proxyCfgForwardTimeout =
|
||||
updateCfg proxyCfg $ \cfg' ->
|
||||
|
||||
+16
-130
@@ -3,7 +3,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module SMPNamesTests (smpNamesTests, testNameRecord, testPricing, registeredBody, availableBody, reservedBody, responseBody, resolved) where
|
||||
module SMPNamesTests (smpNamesTests, testNameRecord) where
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
@@ -11,14 +11,13 @@ import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Either (isLeft, isRight)
|
||||
import Data.IORef (readIORef)
|
||||
import Data.List (sort)
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Network.HTTP.Types (status200, status400, status404, status500, status502)
|
||||
import NamesResolverServer (resolveResp, testNamesConfig, withResolverServer, withResolverServerDelayed)
|
||||
import Simplex.Messaging.Encoding (smpDecode, smpEncode)
|
||||
import Simplex.Messaging.Encoding.String (strDecode)
|
||||
import Simplex.Messaging.Protocol (Command (..), ErrorType (..), NameErrorType (..), NamePricing (..), NameQuery (..), NameRecord (..), NameRegistration (..), NameResponse (..), NameReservedReason (..), ProtocolEncoding (..), USDCents (..))
|
||||
import Simplex.Messaging.Protocol (ErrorType (..), NameErrorType (..), NameRecord (..))
|
||||
import Simplex.Messaging.Server.Main (validateUrl)
|
||||
import Simplex.Messaging.Server.Names
|
||||
( NamesConfig (..),
|
||||
@@ -28,9 +27,7 @@ import Simplex.Messaging.Server.Names
|
||||
resolveName,
|
||||
)
|
||||
import Simplex.Messaging.Server.Names.HttpResolver (ResolverError (..))
|
||||
import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexTLD (..), labelHash)
|
||||
import Simplex.Messaging.SystemTime (RoundedSystemTime (..))
|
||||
import Simplex.Messaging.Transport (nameAvailSMPVersion, serverInfoSMPVersion)
|
||||
import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexTLD (..))
|
||||
import Test.Hspec
|
||||
|
||||
testNameRecord :: NameRecord
|
||||
@@ -50,41 +47,12 @@ testNameRecord =
|
||||
nrResolver = "0x0202020202020202020202020202020202020202"
|
||||
}
|
||||
|
||||
-- | What the resolver serves on /v2/resolve. Spelled out rather than encoded
|
||||
-- from the Haskell value: the literal JSON is the contract with the resolver.
|
||||
registeredBody :: NameRecord -> LB.ByteString
|
||||
registeredBody nameRec =
|
||||
responseBody $ "{\"type\":\"registered\",\"expires\":1813853483,\"graceUntil\":1821629483,\"reservedReason_\":null,\"nameRecord\":" <> J.encode nameRec <> "}"
|
||||
|
||||
availableBody :: LB.ByteString
|
||||
availableBody = responseBody "{\"type\":\"available\",\"pricing\":{\"registrationPrices\":{\"3\":12793,\"4\":3198},\"basePrice\":100,\"minLabelLength\":3}}"
|
||||
|
||||
reservedBody :: LB.ByteString
|
||||
reservedBody = responseBody "{\"type\":\"reserved\",\"reservedReason\":\"trademark\"}"
|
||||
|
||||
-- | The registration, and the block the resolver read it at.
|
||||
responseBody :: LB.ByteString -> LB.ByteString
|
||||
responseBody reg = "{\"lastBlockTs\":" <> testReadAt <> ",\"registration\":" <> reg <> "}"
|
||||
|
||||
testReadAt :: LB.ByteString
|
||||
testReadAt = "1813000000"
|
||||
|
||||
resolved :: NameRegistration -> NameResponse
|
||||
resolved registration = NameResponse {lastBlockTs = Just (RoundedSystemTime 1813000000), registration}
|
||||
|
||||
-- | What `registeredBody testNameRecord` resolves to.
|
||||
registeredAlice :: NameRegistration
|
||||
registeredAlice =
|
||||
NRRegistered {expires = Just (RoundedSystemTime 1813853483), graceUntil = Just (RoundedSystemTime 1821629483), reservedReason_ = Nothing, nameRecord = testNameRecord}
|
||||
|
||||
smpNamesTests :: Spec
|
||||
smpNamesTests = do
|
||||
describe "NameRecord JSON (Protocol)" nameRecordEncodingSpec
|
||||
describe "ErrorType NAME wire encoding" errorWireSpec
|
||||
describe "RSLV wire encoding" rslvWireSpec
|
||||
describe "Name parsing (SimplexDomain)" parseNameSpec
|
||||
describe "HTTP resolver" resolverSpec
|
||||
describe "name availability" availabilitySpec
|
||||
describe "Resolver health probe" healthSpec
|
||||
describe "resolver_endpoint validation" validateUrlSpec
|
||||
|
||||
@@ -133,87 +101,8 @@ errorWireSpec =
|
||||
-- RESOLVER detail may contain spaces - must survive the round-trip
|
||||
smpDecode (smpEncode (NAME (RESOLVER "HTTP 502"))) `shouldBe` Right (NAME (RESOLVER "HTTP 502"))
|
||||
|
||||
-- the query format changed at v22, so an older session must still get the name
|
||||
rslvWireSpec :: Spec
|
||||
rslvWireSpec = do
|
||||
it "below v22 carries the name, as it did before" $
|
||||
encodeProtocol v20 (RSLV (NQDomain aliceDomain')) `shouldBe` "RSLV " <> smpEncode aliceDomain'
|
||||
-- keccak-256("alice"), the same constant the resolver's own tests use
|
||||
it "from v22 carries the 2LD as its hash" $
|
||||
encodeProtocol v22 (RSLV (NQDomain aliceDomain'))
|
||||
`shouldBe` "RSLV [9c0257114eb9399a2985f8e75dad7600c5d89fe3824ffa99ec1c3eb8bf3b0501].simplex"
|
||||
-- the hashed query has no room for subname labels, so such a name goes as text
|
||||
it "a name with subnames is not hashed" $
|
||||
encodeProtocol v22 (RSLV (NQDomain aliceDomain' {subDomain = ["x"]})) `shouldBe` "RSLV x.alice.simplex"
|
||||
it "leaves a web name alone: no registry, nothing to key on" $
|
||||
encodeProtocol v22 (RSLV (NQDomain webDomain')) `shouldBe` "RSLV example.com"
|
||||
where
|
||||
v20 = serverInfoSMPVersion
|
||||
v22 = nameAvailSMPVersion
|
||||
aliceDomain' = SimplexDomain {nameTLD = TLDSimplex, domain = "alice", subDomain = []}
|
||||
webDomain' = SimplexDomain {nameTLD = TLDWeb, domain = "example.com", subDomain = []}
|
||||
|
||||
availabilitySpec :: Spec
|
||||
availabilitySpec = do
|
||||
-- one lookup answers what the name points to, whether it can be taken, and
|
||||
-- whether it is held back
|
||||
it "a registered name answers with its record and dates" $
|
||||
answers (registeredBody testNameRecord) (resolved registeredAlice)
|
||||
it "a registered name can be held back too" $
|
||||
answers heldBackBody . resolved $
|
||||
NRRegistered {expires = Just (RoundedSystemTime 1813853483), graceUntil = Just (RoundedSystemTime 1821629483), reservedReason_ = Just NRRInternal, nameRecord = testNameRecord}
|
||||
it "an unregistered name answers with the price" $
|
||||
answers availableBody (resolved NRAvailable {pricing = testPricing})
|
||||
it "reserved carries the reason and no price" $
|
||||
answers reservedBody (resolved $ NRReserved NRRTrademark)
|
||||
-- losing the reservation would offer a name that cannot be registered
|
||||
it "a reason from a later version still reserves the name" $
|
||||
answers (responseBody "{\"type\":\"reserved\",\"reservedReason\":\"seasonal\"}") (resolved $ NRReserved (NRRUnknown "seasonal"))
|
||||
-- RNAME carries the registration as JSON, so that is the encoding to hold
|
||||
it "every registration survives the wire" $
|
||||
mapM_
|
||||
(\a -> J.eitherDecodeStrict (LB.toStrict (J.encode a)) `shouldBe` Right a)
|
||||
[ registeredAlice,
|
||||
NRRegistered {expires = Nothing, graceUntil = Nothing, reservedReason_ = Just NRRInternal, nameRecord = testNameRecord},
|
||||
NRAvailable {pricing = testPricing},
|
||||
NRReserved NRRInternal,
|
||||
NRReserved NRRTrademark,
|
||||
NRReserved NRRCommunity,
|
||||
NRReserved (NRRUnknown "seasonal")
|
||||
]
|
||||
-- one vocabulary: the same word from the resolver and in JSON
|
||||
it "a reason reads the same in JSON as from the resolver" $ do
|
||||
J.encode (NRRUnknown "seasonal") `shouldBe` "\"seasonal\""
|
||||
J.encode NRRTrademark `shouldBe` "\"trademark\""
|
||||
where
|
||||
heldBackBody =
|
||||
responseBody $ "{\"type\":\"registered\",\"expires\":1813853483,\"graceUntil\":1821629483,\"reservedReason_\":\"internal\",\"nameRecord\":" <> J.encode testNameRecord <> "}"
|
||||
answers body a =
|
||||
withResolverServer (resolveResp status200 body) $ \port _ -> do
|
||||
env <- newNamesEnv (testNamesConfig port)
|
||||
resolveName env aliceQuery `shouldReturn` Right a
|
||||
aliceQuery = NQDomain SimplexDomain {nameTLD = TLDSimplex, domain = "alice", subDomain = []}
|
||||
|
||||
-- | The .testing oracle: US cents per year by label length.
|
||||
testPricing :: NamePricing
|
||||
testPricing =
|
||||
NamePricing
|
||||
{ registrationPrices = M.fromList [(3, USDCents 12793), (4, USDCents 3198)],
|
||||
basePrice = USDCents 100,
|
||||
minLabelLength = 3
|
||||
}
|
||||
|
||||
parseNameSpec :: Spec
|
||||
parseNameSpec = do
|
||||
-- the hashed form is a query, not a name: it has its own type
|
||||
it "a name is never a hash" $
|
||||
parseN ("[" <> T.replicate 64 "b" <> "].simplex") `shouldSatisfy` isLeft
|
||||
it "a query survives the wire" $
|
||||
mapM_
|
||||
(\q -> smpDecode (smpEncode q) `shouldBe` Right q)
|
||||
[ NQDomain d,
|
||||
NQHash (labelHash "alice") TLDSimplex
|
||||
]
|
||||
it "accepts a valid simplex-TLD name" $
|
||||
case parseN "privacy.simplex" of
|
||||
Right d -> do
|
||||
@@ -249,26 +138,23 @@ parseNameSpec = do
|
||||
where
|
||||
parseN :: T.Text -> Either String SimplexDomain
|
||||
parseN = strDecode . encodeUtf8
|
||||
d = SimplexDomain {nameTLD = TLDSimplex, domain = "alice", subDomain = ["x"]}
|
||||
|
||||
resolverSpec :: Spec
|
||||
resolverSpec = do
|
||||
it "returns the registration on 200 OK" $
|
||||
withResolverServer (resolveResp status200 (registeredBody testNameRecord)) $ \port _ -> do
|
||||
it "returns NameRecord on 200 OK" $
|
||||
withResolverServer (resolveResp status200 (J.encode testNameRecord)) $ \port _ -> do
|
||||
env <- newNamesEnv (testNamesConfig port)
|
||||
resolveName env aliceDomain `shouldReturn` Right (resolved registeredAlice)
|
||||
resolveName env aliceDomain `shouldReturn` Right testNameRecord
|
||||
|
||||
-- /v2/resolve answers 200, 400 or 502 and never says "no such name": an
|
||||
-- unregistered name is NRAvailable. So no status maps to NOT_FOUND.
|
||||
it "returns RESOLVER on 404 (a resolver without the v2 route)" $
|
||||
it "returns NOT_FOUND on 404" $
|
||||
withResolverServer (resolveResp status404 "{}") $ \port _ -> do
|
||||
env <- newNamesEnv (testNamesConfig port)
|
||||
resolveName env aliceDomain `shouldReturn` Left (RESOLVER "HTTP 404")
|
||||
resolveName env aliceDomain `shouldReturn` Left NOT_FOUND
|
||||
|
||||
it "returns RESOLVER on 400 (TLD not configured)" $
|
||||
it "returns NOT_FOUND on 400 (unknown TLD)" $
|
||||
withResolverServer (resolveResp status400 "{}") $ \port _ -> do
|
||||
env <- newNamesEnv (testNamesConfig port)
|
||||
resolveName env aliceDomain `shouldReturn` Left (RESOLVER "HTTP 400")
|
||||
resolveName env aliceDomain `shouldReturn` Left NOT_FOUND
|
||||
|
||||
it "returns RESOLVER on 502 (upstream failure)" $
|
||||
withResolverServer (resolveResp status502 "{}") $ \port _ -> do
|
||||
@@ -285,31 +171,31 @@ resolverSpec = do
|
||||
env <- newNamesEnv (testNamesConfig port)
|
||||
resolveName env aliceDomain `shouldReturn` Left (RESOLVER "invalid response")
|
||||
|
||||
it "returns RESOLVER when JSON parses but isn't a NameRegistration shape" $
|
||||
it "returns RESOLVER when JSON parses but isn't a NameRecord shape" $
|
||||
withResolverServer (resolveResp status200 "{}") $ \port _ -> do
|
||||
env <- newNamesEnv (testNamesConfig port)
|
||||
resolveName env aliceDomain `shouldReturn` Left (RESOLVER "invalid response")
|
||||
|
||||
it "returns RESOLVER (timeout) when the resolver is slower than resolverTimeoutMs" $
|
||||
withResolverServerDelayed 1500 (resolveResp status200 (registeredBody testNameRecord)) $ \port _ -> do
|
||||
withResolverServerDelayed 1500 (resolveResp status200 (J.encode testNameRecord)) $ \port _ -> do
|
||||
env <- newNamesEnv (testNamesConfig port) {resolverTimeoutMs = 300}
|
||||
resolveName env aliceDomain `shouldReturn` Left (RESOLVER "timeout")
|
||||
|
||||
it "sends one HTTP request per lookup (no cache)" $
|
||||
withResolverServer (resolveResp status200 (registeredBody testNameRecord)) $ \port reqs -> do
|
||||
withResolverServer (resolveResp status200 (J.encode testNameRecord)) $ \port reqs -> do
|
||||
env <- newNamesEnv (testNamesConfig port)
|
||||
_ <- resolveName env aliceDomain
|
||||
_ <- resolveName env aliceDomain
|
||||
readIORef reqs >>= \rs -> length rs `shouldBe` 2
|
||||
|
||||
it "addresses the resolver with the full canonical domain name" $
|
||||
withResolverServer (resolveResp status200 (registeredBody testNameRecord)) $ \port reqs -> do
|
||||
withResolverServer (resolveResp status200 (J.encode testNameRecord)) $ \port reqs -> do
|
||||
env <- newNamesEnv (testNamesConfig port)
|
||||
_ <- resolveName env aliceDomain
|
||||
readIORef reqs `shouldReturn` [["v2", "resolve", "alice.simplex"]]
|
||||
readIORef reqs `shouldReturn` [["resolve", "alice.simplex"]]
|
||||
|
||||
where
|
||||
aliceDomain = NQDomain SimplexDomain {nameTLD = TLDSimplex, domain = "alice", subDomain = []}
|
||||
aliceDomain = SimplexDomain {nameTLD = TLDSimplex, domain = "alice", subDomain = []}
|
||||
|
||||
healthSpec :: Spec
|
||||
healthSpec = do
|
||||
|
||||
+4
-22
@@ -21,7 +21,6 @@ import Control.Logger.Simple
|
||||
import Control.Monad (forM, forM_, forever, replicateM_)
|
||||
import Control.Monad.Trans.Except (ExceptT, runExceptT)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
@@ -64,10 +63,8 @@ smpProxyTests = do
|
||||
testProxyRecoversWithoutDisconnect
|
||||
it "reconnects to relay after sender disconnects mid-connection" $ \_ ->
|
||||
testProxyReconnectAfterRelayRestart
|
||||
it "must drop a stuck relay session after forward timeouts" $ \_ ->
|
||||
xit "must drop a stuck relay session after forward timeouts" $ \_ ->
|
||||
testProxyForwardTimeoutStuckSession
|
||||
it "does not keep oversized forwarded command" $ \_ ->
|
||||
testForwardOversizedNotKept
|
||||
describe "agent client reconnection" $ do
|
||||
it "reconnects after a connect is cancelled mid-flight" $ \_ ->
|
||||
testAgentClientReconnectAfterCancel
|
||||
@@ -196,8 +193,6 @@ deliverMessagesViaProxy proxyServ relayServ alg unsecuredMsgs securedMsgs = do
|
||||
forM_ unsecuredMsgs $ \msg -> do
|
||||
runExceptT' (proxySMPMessage pc NRMInteractive sess Nothing sndId noMsgFlags msg) `shouldReturn` Right ()
|
||||
runExceptT' (proxySMPMessage pc NRMInteractive sess {prSessionId = "bad session"} Nothing sndId noMsgFlags msg) `shouldReturn` Left (ProxyProtocolError $ SMP.PROXY SMP.NO_SESSION)
|
||||
forM_ ([prevVersion minServerSMPRelayVersion, nextVersion currentServerSMPRelayVersion] :: [VersionSMP]) $ \v ->
|
||||
runExceptT' (proxySMPMessage pc NRMInteractive sess {prVersion = v} Nothing sndId noMsgFlags msg) `shouldReturn` Left (ProxyProtocolError $ SMP.PROXY $ SMP.PROTOCOL $ SMP.PROXY $ SMP.BROKER $ SMP.TRANSPORT TEVersion)
|
||||
-- receive 1
|
||||
(_tSess, _, [(_entId, STEvent (Right (SMP.MSG RcvMessage {msgId, msgBody = EncRcvMsgBody encBody})))]) <- atomically $ readTBQueue msgQ
|
||||
dec msgId encBody `shouldBe` Right msg
|
||||
@@ -236,7 +231,7 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
|
||||
withAgent 1 aCfg (servers aTestCfg) testDB $ \alice ->
|
||||
withAgent 2 aCfg (servers bTestCfg) testDB2 $ \bob -> runRight_ $ do
|
||||
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured `shouldBe` True
|
||||
("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
|
||||
@@ -292,7 +287,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
|
||||
-- otherwise the CONF messages would get mixed with MSG
|
||||
prePair alice bob = do
|
||||
(bobId, CCLink qInfo Nothing) <- runExceptT' $ A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
|
||||
(aliceId, _) <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
aliceId <- runExceptT' $ A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured <- runExceptT' $ A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured `shouldBe` True
|
||||
confId <-
|
||||
@@ -351,7 +346,7 @@ agentViaProxyRetryOffline = do
|
||||
withServer $ \_ -> do
|
||||
(aliceId, bobId) <- withServer2 $ \_ -> runRight $ do
|
||||
(bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
|
||||
(aliceId, _) <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
aliceId <- A.prepareConnectionToJoin bob 1 True qInfo PQSupportOn
|
||||
sqSecured <- A.joinConnection bob NRMInteractive 1 aliceId True qInfo "bob's connInfo" PQSupportOn SMSubscribe
|
||||
liftIO $ sqSecured `shouldBe` True
|
||||
("", _, A.CONF confId pqSup' _ "bob's connInfo") <- get alice
|
||||
@@ -514,19 +509,6 @@ testProxyForwardTimeoutStuckSession =
|
||||
rs <- forM ([1 .. 10] :: [Int]) $ \_ -> runExceptT' (proxySMPMessage pc NRMInteractive sess Nothing sId noMsgFlags "hi")
|
||||
rs `shouldSatisfy` elem (Left (ProxyProtocolError (SMP.PROXY SMP.NO_SESSION)))
|
||||
|
||||
testForwardOversizedNotKept :: IO ()
|
||||
testForwardOversizedNotKept =
|
||||
withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ -> do
|
||||
g <- C.newRandom
|
||||
ts <- getCurrentTime
|
||||
let proxyClientCfg = defaultSMPClientConfig {serverVRange = supportedProxyClientSMPRelayVRange, agreeSecret = True, proxyServer = True}
|
||||
c <- either (fail . show) pure =<< getProtocolClient g NRMBackground (1, testSMPServer, Nothing) proxyClientCfg [] Nothing ts (\_ -> pure ())
|
||||
(k, _) <- atomically $ C.generateKeyPair @'C.X25519 g
|
||||
let et = SMP.EncTransmission $ B.replicate smpBlockSize 'a'
|
||||
runExceptT (forwardSMPTransmission c (SMP.CorrId "123456789012345678901234") currentClientSMPRelayVersion k et)
|
||||
`shouldReturn` Left (PCETransportError TELargeMsg)
|
||||
pClientSentCommandsCount c `shouldReturn` 0
|
||||
|
||||
-- Bug B (same root cause as the proxy, in the messaging agent): getSMPServerClient inserts an
|
||||
-- empty SessionVar into smpClients, then connects inside newProtocolClient's tryAllErrors, which
|
||||
-- rethrows async exceptions. If the connecting thread is cancelled mid-connect, putTMVar is
|
||||
|
||||
+1
-53
@@ -34,7 +34,7 @@ import Simplex.FileTransfer.Server.Env (AFStoreType, XFTPServerConfig (..), defa
|
||||
import Simplex.FileTransfer.Server.Store (STMFileStore)
|
||||
import Simplex.FileTransfer.Transport (XFTPErrorType (AUTH))
|
||||
import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
|
||||
import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpPrepareReceiveFile, xftpPrepareSendFile, xftpReceiveFile, xftpSendDescription, xftpStartReceiveFile, xftpStartSendFile, xftpStartWorkers)
|
||||
import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendDescription, xftpStartWorkers)
|
||||
import qualified Simplex.Messaging.Agent as XA
|
||||
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, xftpCfg)
|
||||
@@ -84,8 +84,6 @@ xftpAgentTests =
|
||||
it "should send and receive with encrypted local files" testXFTPAgentSendReceiveEncrypted
|
||||
it "should send and receive large file with a redirect" testXFTPAgentSendReceiveRedirect
|
||||
it "should send and receive small file without a redirect" testXFTPAgentSendReceiveNoRedirect
|
||||
it "should receive prepared file only after it is started" testXFTPAgentPrepareReceive
|
||||
it "should send prepared file only after it is started" testXFTPAgentPrepareSend
|
||||
it "should extend storage time with an entitlement proof and report the granted expiry" $ \_ -> testXFTPAgentEntitlement
|
||||
describe "sending and receiving with version negotiation" $ beforeWith (const (pure ())) testXFTPAgentSendReceiveMatrix
|
||||
it "should resume receiving file after restart" $ \_ -> testXFTPAgentReceiveRestore
|
||||
@@ -280,56 +278,6 @@ testXFTPAgentSendReceiveNoRedirect = withXFTPServer $ do
|
||||
inBytes <- B.readFile filePathIn
|
||||
B.readFile out `shouldReturn` inBytes
|
||||
|
||||
testXFTPAgentPrepareReceive :: HasCallStack => AFStoreType -> IO ()
|
||||
testXFTPAgentPrepareReceive = withXFTPServer $ do
|
||||
filePath <- createRandomFile
|
||||
(_, _, rfd1, rfd2) <- withAgent 1 agentCfg initAgentServers testDB $ \sndr -> runRight $ testSend sndr filePath
|
||||
rfId2 <- withAgent 2 agentCfg initAgentServers testDB2 $ \rcp -> runRight $ do
|
||||
xftpStartWorkers rcp (Just recipientFiles)
|
||||
rfId1 <- xftpReceiveFile rcp 1 rfd1 Nothing True
|
||||
rfId2 <- xftpPrepareReceiveFile rcp 1 rfd2 Nothing True
|
||||
rfProgress rcp $ mb 18
|
||||
("", rfId1', RFDONE _) <- rfGet rcp
|
||||
liftIO $ do
|
||||
rfId1' `shouldBe` rfId1
|
||||
timeout 300000 (rfGet rcp) `shouldReturn` Nothing
|
||||
pure rfId2
|
||||
withAgent 3 agentCfg initAgentServers testDB2 $ \rcp' -> runRight_ $ do
|
||||
xftpStartWorkers rcp' (Just recipientFiles)
|
||||
liftIO $ timeout 300000 (rfGet rcp') `shouldReturn` Nothing
|
||||
xftpStartReceiveFile rcp' rfId2
|
||||
rfProgress rcp' $ mb 18
|
||||
("", rfId2', RFDONE path) <- rfGet rcp'
|
||||
liftIO $ do
|
||||
rfId2' `shouldBe` rfId2
|
||||
file <- B.readFile filePath
|
||||
B.readFile path `shouldReturn` file
|
||||
|
||||
testXFTPAgentPrepareSend :: HasCallStack => AFStoreType -> IO ()
|
||||
testXFTPAgentPrepareSend = withXFTPServer $ do
|
||||
filePath1 <- createRandomFile' "testfile1"
|
||||
filePath2 <- createRandomFile' "testfile2"
|
||||
sfId2 <- withAgent 1 agentCfg initAgentServers testDB $ \sndr -> runRight $ do
|
||||
xftpStartWorkers sndr (Just senderFiles)
|
||||
sfId1 <- xftpSendFile sndr 1 (CF.plain filePath1) 1
|
||||
sfId2 <- xftpPrepareSendFile sndr 1 (CF.plain filePath2) 1 Nothing
|
||||
sfProgress sndr $ mb 18
|
||||
("", sfId1', SFDONE _ _) <- sfGet sndr
|
||||
liftIO $ do
|
||||
sfId1' `shouldBe` sfId1
|
||||
timeout 300000 (sfGet sndr) `shouldReturn` Nothing
|
||||
pure sfId2
|
||||
rfd <- withAgent 2 agentCfg initAgentServers testDB $ \sndr' -> runRight $ do
|
||||
xftpStartWorkers sndr' (Just senderFiles)
|
||||
liftIO $ timeout 300000 (sfGet sndr') `shouldReturn` Nothing
|
||||
xftpStartSendFile sndr' sfId2
|
||||
sfProgress sndr' $ mb 18
|
||||
("", sfId2', SFDONE _ [rfd]) <- sfGet sndr'
|
||||
liftIO $ sfId2' `shouldBe` sfId2
|
||||
pure rfd
|
||||
withAgent 3 agentCfg initAgentServers testDB2 $ \rcp ->
|
||||
runRight_ . void $ testReceive rcp rfd filePath2
|
||||
|
||||
testXFTPAgentSendReceiveMatrix :: Spec
|
||||
testXFTPAgentSendReceiveMatrix = do
|
||||
describe "old server" $ do
|
||||
|
||||
@@ -63,6 +63,8 @@ xftpServerTests =
|
||||
it "should create, add recipients, upload and receive file chunk" testFileChunkDeliveryAddRecipients
|
||||
it "should delete file chunk (1 client)" testFileChunkDelete
|
||||
it "should delete file chunk (2 clients)" testFileChunkDelete2
|
||||
it "should acknowledge file chunk reception (1 client)" testFileChunkAck
|
||||
it "should acknowledge file chunk reception (2 clients)" testFileChunkAck2
|
||||
it "should not allow chunks of wrong size" testWrongChunkSize
|
||||
it "should expire chunks after set interval" testFileChunkExpiration
|
||||
it "should disconnect inactive clients" testInactiveClientExpiration
|
||||
@@ -182,6 +184,33 @@ runTestFileChunkDelete s r = do
|
||||
deleteXFTPChunk s spKey sId
|
||||
`catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
|
||||
|
||||
testFileChunkAck :: AFStoreType -> Expectation
|
||||
testFileChunkAck = xftpTest $ \c -> runRight_ $ runTestFileChunkAck c c
|
||||
|
||||
testFileChunkAck2 :: AFStoreType -> Expectation
|
||||
testFileChunkAck2 = xftpTest2 $ \s r -> runRight_ $ runTestFileChunkAck s r
|
||||
|
||||
runTestFileChunkAck :: XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
|
||||
runTestFileChunkAck s r = do
|
||||
g <- liftIO C.newRandom
|
||||
(sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
bytes <- liftIO $ createTestChunk testChunkPath
|
||||
digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath
|
||||
let file = FileInfo {sndKey, size = chSize, digest}
|
||||
chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
|
||||
(sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing
|
||||
uploadXFTPChunk s spKey sId chunkSpec
|
||||
|
||||
downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
|
||||
liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
|
||||
ackXFTPChunk r rpKey rId
|
||||
liftIO $ readChunk sId `shouldReturn` bytes
|
||||
downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
|
||||
`catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
|
||||
ackXFTPChunk r rpKey rId
|
||||
`catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
|
||||
|
||||
testWrongChunkSize :: AFStoreType -> Expectation
|
||||
testWrongChunkSize = xftpTest $ \c -> do
|
||||
g <- C.newRandom
|
||||
@@ -307,12 +336,32 @@ testFileLog _ = do
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerStoreLogOn $ \_ -> testXFTPClient $ \c -> runRight_ $ do
|
||||
rId1 <- liftIO $ readTVarIO rIdVar1
|
||||
rId2 <- liftIO $ readTVarIO rIdVar2
|
||||
-- recipient 1 can download, acknowledges - +1 to log
|
||||
download g c rpKey1 rId1 digest bytes
|
||||
ackXFTPChunk c rpKey1 rId1
|
||||
-- recipient 2 can download
|
||||
download g c rpKey2 rId2 digest bytes
|
||||
logSize testXFTPLogFile `shouldReturn` 4
|
||||
logSize testXFTPStatsBackupFile `shouldReturn` 15
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerStoreLogOn $ \_ -> pure () -- ack is compacted - -1 from log
|
||||
logSize testXFTPLogFile `shouldReturn` 3
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
withXFTPServerStoreLogOn $ \_ -> testXFTPClient $ \c -> runRight_ $ do
|
||||
sId <- liftIO $ readTVarIO sIdVar
|
||||
rId1 <- liftIO $ readTVarIO rIdVar1
|
||||
rId2 <- liftIO $ readTVarIO rIdVar2
|
||||
-- recipients can download
|
||||
-- recipient 1 can't download due to previous acknowledgement
|
||||
download g c rpKey1 rId1 digest bytes
|
||||
`catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
|
||||
-- recipient 2 can download
|
||||
download g c rpKey2 rId2 digest bytes
|
||||
-- sender can delete - +1 to log
|
||||
deleteXFTPChunk c spKey sId
|
||||
|
||||
Reference in New Issue
Block a user