stats, tests

implement
add plan for client address statistics
2026-10-12 02:22:45 +00:00 · 2026-09-27 17:20:26 +00:00 · 2026-09-27 17:01:06 +00:00 · 2026-09-27 12:34:43 +00:00 · 2026-09-25 17:14:38 +00:00 · 2026-09-24 20:59:29 +00:00
42 changed files with 2077 additions and 174 deletions
@@ -0,0 +1,309 @@
+# Implementation plan: client address statistics
+
+Scope:
+
+- SMP server
+- XFTP server
+- NTF server
+
+## Rules
+
+- Counters per address are kept in memory only.
+- Counters are neither saved nor restored.
+- Prometheus receives aggregates across addresses only.
+- Addresses are not logged.
+- Addresses are shown only by a control port command.
+
+## Address key
+
+```
+data AddrKey
+  = AKIPv4 Word32
+  | AKIPv6 Word64
+```
+
+Key of a socket address:
+
+- IPv4 address: `AKIPv4`.
+- IPv6 address in `::ffff:0:0/96`: `AKIPv4` of its last 32 bits.
+- Other IPv6 address: `AKIPv6` of its first 64 bits.
+- Other address types: not counted.
+
+Text of a key:
+
+- `AKIPv4`: `a.b.c.d`.
+- `AKIPv6`: `xxxx:xxxx:xxxx:xxxx::/64`.
+
+## Counters
+
+Each server has a fixed set of counters:
+
+```
+class (Ord c, Enum c, Bounded c) => AddrCounter c where
+  counterName :: c -> Text
+  counterBounds :: c -> [Int]
+  connectionsCounter :: c
+```
+
+`counterName` is the Prometheus label value and the control port argument.
+
+Counters of every server:
+
+- `connections`: connections passed to the protocol handler, after TLS setup.
+- One counter per command tag, named by the tag: an attempt is counted, failed ones included.
+- `errors`: parse failures and authorization failures.
+
+Command tag types:
+
+- SMP: `CommandTag` in `Simplex.Messaging.Protocol`.
+- XFTP: `FileCommandTag` in `Simplex.FileTransfer.Protocol`.
+- NTF: `NtfCommandTag` in `Simplex.Messaging.Notifications.Protocol`.
+
+A function from a command to its counter is added for each server.
+
+SMP proxy counters, by result of `PRXY`:
+
+- `PRXY_own`: own server.
+- `PRXY_connected`: other server with an existing connection.
+- `PRXY_new`: other server with a new connection.
+- `PRXY_onion`: server with onion hosts only.
+- `PRXY_failed`: error.
+
+SMP proxy counters, by result of `PFWD`:
+
+- `PFWD_own`: own server.
+- `PFWD_other`: other server.
+- `PFWD_onion`: server with onion hosts only.
+- `PFWD_failed`: error other than a protocol error, or no session.
+
+Class precedence: `failed`, then `own`, then `onion`.
+
+XFTP counters:
+
+- `upload_kb`: kilobytes of chunks stored by successful `FPUT`.
+- `download_kb`: kilobytes of chunks sent for `FGET`.
+- `recipients`: recipient keys added by successful `FNEW` and `FADD`.
+
+## Periods
+
+- A period is a fixed interval of `period` seconds. The first period starts at server start.
+- Counts of the current period are accumulated as events occur.
+- Counts of the previous period are the counts of the last closed period.
+- Histograms use the counts of closed periods.
+- The control port command shows the previous and the current counts, sorted by their sum.
+
+## Module `Simplex.Messaging.Server.AddressStats`
+
+```
+data AddrStats c = AddrStats
+  { connectionsCount :: TVar Int,
+    current :: Map c (IORef Int),
+    previous :: Map c (IORef Int)
+  }
+
+type AddrStatsMap c = TMap AddrKey (AddrStats c)
+
+data AddrHistogram = AddrHistogram
+  { bucketCounts :: [Int],
+    countSum :: Int,
+    addressCount :: Int,
+    periodMax :: Int
+  }
+
+newtype AddressStatsConfig = AddressStatsConfig
+  { period :: Int64
+  }
+```
+
+- `current` and `previous` contain one cell per counter, created when the address is inserted.
+- `bucketCounts` are cumulative counts per bound, from server start.
+
+Bounds:
+
+- `countBounds`: 1 to 9, then R10 values times powers of 10, rounded half up to integers, up to 1,000,000: 60 bounds.
+- `kilobyteBounds`: the same, up to 100,000,000: 80 bounds.
+- R10 values: 1, 1.25, 1.6, 2, 2.5, 3.15, 4, 5, 6.3, 8.
+
+Functions:
+
+- `addrKey :: SockAddr -> Maybe AddrKey`
+- `addrKeyText :: AddrKey -> Text`
+- `counterByName :: AddrCounter c => Text -> Maybe c`
+- `withAddrStats :: AddrCounter c => Maybe (AddrStatsMap c) -> Socket -> (Maybe (AddrStats c) -> IO a) -> IO a`:
+  1. The peer address is read with `getPeerName`. On an exception, the connection is not counted.
+  2. In one transaction, the entry is looked up or inserted, and `connectionsCount` is incremented.
+  3. `connectionsCounter` is incremented.
+  4. The action is run. `connectionsCount` is decremented in `finally`.
+- `incAddrCounter :: AddrCounter c => AddrStats c -> c -> IO ()`
+- `addAddrCounter :: AddrCounter c => AddrStats c -> c -> Int -> IO ()`
+- `rolloverAddrStats :: AddrCounter c => AddrStatsMap c -> IORef (Map c AddrHistogram) -> IO ()`, in one pass over the entries, per counter:
+  1. The `current` cell is set to 0. Its value is the closing count.
+  2. A non-zero closing count is added to the histogram: to each bucket with a bound at or above it, to `countSum`, and to `addressCount`.
+  3. `periodMax` is the largest closing count.
+  4. The `previous` cell is set to the closing count.
+  
+  After the pass, an entry is deleted when `connectionsCount` is 0 and every closing count is 0. `connectionsCount` is read in the deleting transaction.
+- `addressStatsThread :: AddrCounter c => AddressStatsConfig -> AddrStatsMap c -> IORef (Map c AddrHistogram) -> IO ()`: `rolloverAddrStats` every `period` seconds.
+- `topAddresses :: AddrCounter c => AddrStatsMap c -> c -> Int -> IO [(AddrKey, Int, Int)]`: the key, previous count and current count of the counter, for up to the given number of entries, sorted by the sum of both counts, largest first. Entries with both counts 0 are excluded.
+- `addrHistogramMetrics :: AddrCounter c => Text -> Map c AddrHistogram -> Text`: Prometheus text for a metric name prefix.
+
+## Prometheus
+
+Written with the other metrics of each server, when both `addressStats` and `prometheus_interval` are set:
+
+```
+# TYPE <prefix>_client_address_period_count histogram
+<prefix>_client_address_period_count_bucket{counter="<name>",le="<bound>"} <addresses>
+<prefix>_client_address_period_count_bucket{counter="<name>",le="+Inf"} <addresses>
+<prefix>_client_address_period_count_sum{counter="<name>"} <sum>
+<prefix>_client_address_period_count_count{counter="<name>"} <addresses>
+# TYPE <prefix>_client_address_period_max gauge
+<prefix>_client_address_period_max{counter="<name>"} <max>
+```
+
+Prefixes:
+
+- `simplex_smp`
+- `simplex_xftp`
+- `simplex_ntf`
+
+In scrape jobs, `convert_classic_histograms_to_nhcb: true` is set.
+
+## Configuration
+
+The same INI section in `smp-server.ini`, `file-server.ini` and `ntf-server.ini`:
+
+```
+[ADDRESS_STATS]
+enable = off
+period = 300
+```
+
+- `enable = off` or an absent section: statistics are off.
+- `period`: seconds.
+
+`iniAddressStats :: Ini -> Maybe AddressStatsConfig` is added to `Simplex.Messaging.Server.CLI`.
+
+Added to `ServerConfig`, `XFTPServerConfig` and `NtfServerConfig`:
+
+```
+addressStats :: Maybe AddressStatsConfig
+```
+
+The section is written by the `init` command of each server with `enable = off`.
+
+With `addressStats` set:
+
+- an `AddrStatsMap` and a histogram reference are added to the server env
+- `addressStatsThread` is added to the server threads
+
+## Control port
+
+Command of the SMP, XFTP and NTF control ports:
+
+```
+addresses <counter> [<n>]
+```
+
+- User role.
+- `<counter>`: a counter name.
+- `<n>`: number of addresses, 10 when absent.
+
+Output of `topAddresses`:
+
+```
+address,previous,current
+<key>,<count>,<count>
+```
+
+Errors:
+
+- Unknown counter name: `error: unknown counter`.
+- Statistics off: `error: address statistics are off`.
+
+Changes:
+
+- `CPAddresses Text (Maybe Int)` is added to `ControlProtocol` in `Simplex.Messaging.Server.Control`, `Simplex.FileTransfer.Server.Control` and `Simplex.Messaging.Notifications.Server.Control`.
+- `addresses` is added to the `help` output of each control port.
+
+## SMP server
+
+In `Simplex.Messaging.Server`:
+
+- `runServer`: in the branch without HTTP, `runTransportServerState_` is called with `TLSServerCredential {credential = smpCreds, sniCredential = Nothing}`. In both branches, the socket is passed to `runClient`.
+- `runClient` is run in `withAddrStats`. The `AddrStats` is passed to `runClientTransport`.
+- `clientAddrStats :: Maybe (AddrStats SMPAddrCounter)` is added to `Client`, as a parameter of `newClient`.
+- `receive`:
+  - The counter of each parsed transmission is incremented.
+  - `errors` is incremented for each parse error and each failed verification.
+- `processProxiedCmd`: the proxy counter is incremented when the result of `PRXY` or `PFWD` is known.
+
+## NTF server
+
+In `Simplex.Messaging.Notifications.Server`:
+
+- `runServer`: `runTransportServerState_` is called with a new `SocketState` and `TLSServerCredential {credential = srvCreds, sniCredential = Nothing}`. The socket is passed to `runClient`.
+- `runClient` is run in `withAddrStats`. The `AddrStats` is passed to `runNtfClientTransport`.
+- `ntfClientAddrStats :: Maybe (AddrStats NtfAddrCounter)` is added to `NtfServerClient`, as a parameter of `newNtfServerClient`.
+- `receive`: counting as in the SMP server.
+
+## XFTP server
+
+In `Simplex.Messaging.Transport.HTTP2.Server`:
+
+- A parameter `Socket -> SessionId -> IO () -> IO ()` is added to `runHTTP2Server`. The handler of each connection is run inside it, after TLS setup.
+- In `getHTTP2Server`, the wrapper only runs the handler.
+
+In `Simplex.FileTransfer.Server`:
+
+- `TMap SessionId (AddrStats XFTPAddrCounter)` is created in `runServer`.
+- In the connection wrapper, the handler is run in `withAddrStats`. The `AddrStats` is inserted in the map before the handler, and deleted in `finally`.
+- `addrStats :: Maybe (AddrStats XFTPAddrCounter)` is added to `XFTPTransportRequest`. It is looked up by session ID for each request.
+- `processRequest`:
+  - The counter of each decoded command is incremented.
+  - `errors` is incremented for each decoding error and each failed verification.
+- `upload_kb` is increased by the chunk size, rounded up to kilobytes, after a successful `FPUT`.
+- `download_kb` is increased by the chunk size, rounded up to kilobytes, when an `FGET` response with the file is sent.
+- `recipients` is increased by the number of recipient keys after a successful `FNEW` or `FADD`.
+
+## Tests
+
+`CoreTests.AddressStatsTests`:
+
+- `addrKey`:
+  - IPv4 address
+  - IPv4-mapped IPv6 address
+  - two IPv6 addresses in one /64: one key
+  - two IPv6 addresses in different /64: two keys
+- bounds:
+  - `countBounds` values
+  - `kilobyteBounds` values
+- `counterByName` of each counter name
+- `rolloverAddrStats`:
+  - histogram buckets, sum, address count, and max
+  - zero counts not added to histograms
+  - previous counts set to closing counts
+  - entry with an open connection kept
+  - entry with closing counts kept
+  - entry without connections and closing counts deleted
+- `topAddresses`:
+  - order by the sum of previous and current counts
+  - number of entries limited
+  - entries with both counts 0 excluded
+- `addrHistogramMetrics` output
+- command to counter function of each server
+
+Server tests, with `addressStats` set and `period` 1:
+
+- SMP basic queue tests
+- SMP proxy tests
+- XFTP basic file tests
+- NTF basic token tests
+
+Control port test, SMP server with `addressStats` and a control port set:
+
+- after messages are sent, `addresses SEND` lists the test client address
+- `addresses` without authentication returns `AUTH`
+- `addresses` with an unknown counter returns `error: unknown counter`
+
+`CLITests`: `enable = off` is checked in `[ADDRESS_STATS]` of each generated INI.
@@ -1,11 +1,12 @@
-Version 3, 2025-01-24
+Version 4, 2026-09-11

 # Overview of push notifications for SimpleX Messaging Routers

-This document describes Notification Router protocol version 3. Version history:
+This document describes Notification Router protocol version 4. Version history:
 - v1: initial version
 - v2: authenticated commands, command batching
 - v3: detailed invalid token reason
+- v4: entitlement proof in client handshake

 ## Table of contents

@@ -94,7 +95,7 @@ This diagram shows the process of subscription to notifications, notification de

 To manage notification subscriptions to SMP routers, SimpleX Notification Router provides an RPC protocol with a similar design to SimpleX Messaging Protocol router.

-This protocol sends requests and responses in a fixed size blocks of 512 bytes over TLS, uses the same [syntax of protocol transmissions](./simplex-messaging.md#smp-transmission-and-transport-block-structure) as SMP protocol, and has the same transport [handshake syntax](./simplex-messaging.md#transport-handshake) (except the router certificate is not included in the handshake).
+This protocol sends requests and responses in a fixed size blocks of 512 bytes over TLS, uses the same [syntax of protocol transmissions](./simplex-messaging.md#smp-transmission-and-transport-block-structure) as SMP protocol, and has the same transport [handshake syntax](./simplex-messaging.md#transport-handshake) (except the router certificate is not included in the handshake). The client handshake carries the protocol version, the router key hash and, from v4, the optional `entitlementProof` with the same syntax and session binding as in SMP.

 The client and router use ALPN extension with `ntf/1` protocol name to agree handshake version.

@@ -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 23. Versions 1-5 are discontinued. The version history:

 - v1: binary protocol encoding
 - v2: message flags (used to control notifications)
@@ -109,6 +109,7 @@ This document describes SMP protocol version 22. Versions 1-5 are discontinued.
 - 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
+- v23: entitlement proof in client handshake

 ## Introduction

@@ -1713,7 +1714,7 @@ cert = originalLength x509encoded
 signedRouterKey = originalLength x509encoded ; X25519 key signed by router certificate

 paddedClientHello = <padded(clientHello, 16384)>
-clientHello = smpVersion keyHash [clientKey] proxyRouter optClientService ignoredPart
+clientHello = smpVersion keyHash [clientKey] proxyRouter optClientService optEntitlementProof ignoredPart
 ; chosen SMP protocol version - it must be the maximum supported version
 ; within the range offered by the router
 keyHash = shortString ; router identity - CA certificate fingerprint
@@ -1725,7 +1726,21 @@ serviceRole = %s"M" / %s"N" / %s"P" ; Messaging / Notifier / Proxy
 serviceCertKey = certChain signedServiceKey
 signedServiceKey = originalLength x509encoded ; Ed25519 key signed by service certificate

+optEntitlementProof = %s"0" / (%s"1" entitlementProof)
+; proof of the user entitlement, encoded from v23, bound to sessionIdentifier
+entitlementProof = issuerKeyIndex bbsProof entitlement
+issuerKeyIndex = 2*2OCTET ; Word16 index of the issuer public key
+bbsProof = largeString
+entitlement = entExpires entName entExtra
+entExpires = shortString ; expiration as an ISO8601 UTC timestamp
+entName = shortString ; e.g. "supporter", "legend"
+entExtra = largeString ; opaque to the router
+
 smpVersion = 2*2OCTET ; Word16 version number
+shortString = length *OCTET
+largeString = length2 *OCTET
+length = 1*1OCTET
+length2 = 2*2OCTET ; Word16, network byte order
 originalLength = 2*2OCTET
 count = 1*1OCTET
 ignoredPart = *OCTET
@@ -1747,6 +1762,8 @@ serviceId = shortString
 handshakeError = transportError
 ```

+`entitlementProof` (v23+) presents the entitlement of the user - its name, expiration and an opaque extra string - as the disclosed content of a BBS proof over the presentation header `sessionIdentifier`, so a proof presented on another session does not verify. The holder secret and the issuer signature remain with the client. Clients send it only to their own routers, identified by the key hash pinned in TLS.
+
 `ignoredPart` in handshake allows to add additional parameters in handshake without changing protocol version - the client and routers must ignore any extra bytes within the original block length.

 For TLS transport client should assert that `sessionIdentifier` is equal to `tls-unique` channel binding defined in [RFC 5929][14] (TLS Finished message struct); we pass it in `routerHello` block to allow communication over some other transport protocol (possibly, with another channel binding).
@@ -0,0 +1,422 @@
+# Proof of work for resource creation
+
+## Summary
+
+A client presents a proof of work when it asks a server to create a resource: an SMP queue, an XFTP file chunk, a notification token. The required effort is the price of the resource: its cost in units multiplied by the price per unit.
+
+The server sets one price per unit for each tier: sessions without an entitlement, and sessions of each entitlement name. The prices are independent, so a flood in one tier raises the price of that tier alone.
+
+The proof is bound to the transport session, so it is valid on one connection to one server, and single use within it.
+
+## Interaction
+
+The exchange adds no round trip. The server handshake states the prices and the server time, the session id is the challenge input that both sides already hold, and the client attaches a proof to the command that creates the resource.
+
+Nothing is sent back for the price alone: it rides the messages that already exist.
+
+## Freshness
+
+A proof states the minute it was made for, and expires after a few minutes.
+
+Without an expiry a client mints proofs for as long as a session lasts and spends the stock in one burst. The stock is minted at the idle price, so a rising price reaches the burst after it lands, and an hour of one machine arrives in seconds. The expiry bounds the stock to the work of one window.
+
+```
+powEpoch = 4*4 OCTET    ; Word32, minutes of server time
+```
+
+The server sends its current epoch in the handshake, and the client counts minutes from it with a monotonic clock, so the clock of the device takes no part. A proof verifies while `serverEpoch - powEpoch` is within the advertised window, and one epoch ahead of the server is admitted for rounding.
+
+The window is the burst a client may prepare: a stock of `window * mint rate`. At 5 minutes and a price of 16, one desktop core holds about 2800 queue proofs.
+
+A price increase cuts the stock a second way. A proof states the effort it was made for, so every proof below the new price is rejected, and the stock of an attacker survives an increase only at the effort it paid for in advance. The two bounds compose: the stock is worth the smaller of one window of minting and the time until the next increase.
+
+## What Tor does
+
+Tor proposal 327 and the [hspow specification](https://spec.torproject.org/hspow-spec/) define a client puzzle for onion service introduction.
+
+- Function: Equi-X (Equihash(60,3) over HashX) with a Blake2b target check. Solution 16 bytes, solver memory 1.8 MiB, verification 50-120 microseconds.
+- Effort: a 32-bit number `E`. The solution passes when `R * E <= UINT32_MAX`, where `R` is the first 32 bits of `blake2b_32(challenge || S)`. `E` is the expected number of candidate solutions tested, so cost is linear in `E`.
+- Challenge: `P || ID || C || N || htonl(E)` - personalisation, service identity, a 32-byte seed from the service descriptor, a 16-byte nonce, effort.
+- Freshness: the service publishes a seed in its descriptor and rotates it every 105-120 minutes, keeps the previous seed, and holds a replay cache of used `(seed, nonce)` pairs.
+- Selection: verified requests enter a priority queue ordered by effort. Overfull queues discard the lower-effort half.
+- Adaptation: every 300 seconds the service updates `suggested-effort` by additive increase and multiplicative decrease. Increase to `max(previous + 1, TOTAL_EFFORT / REND_HANDLED)` when the queue was congested or when a trimmed request exceeded the current effort; multiply by `2/3` when the queue stays short. The value is published in the descriptor.
+- Client retry: on timeout, refetch the descriptor, then double the effort below 1000, multiply by 1.5 above it, within [8, 10000].
+
+Tor solves a reachability problem: many clients compete for one bottleneck, so they bid and the service serves the highest bids.
+
+## What we change
+
+Our problem is the price of a stored resource, so the auction is replaced by a price list.
+
+1. Threshold, not bidding. The server states the required effort; the client sends exactly that. The priority queue and its trimming are dropped. A faster device gains no priority, so the effort value describes the request rather than the device.
+2. Session binding, not seeds. The challenge includes the hash of the transport session id, which both sides already hold. This removes seed generation, seed rotation, seed publication, and the two-seed overlap.
+3. Single use by a counter, not by a replay cache. Each proof carries a session counter, and the server keeps the highest counter it accepted plus a 64-bit window of the counters below it. Per-session state is 16 bytes, against 16 bytes per accepted proof for a set of nonces. Tor needs the set because one seed spans many connections; a proof here is valid on one connection only.
+4. An expiry of minutes, against the seed window of two hours in Tor. A stock of proofs is worth one window of minting, so a price increase reaches a burst that was prepared under the old price.
+5. Prices set by the operator. Effort is the resource cost in units multiplied by the price per unit, and the operator sets the price. The estimator of Tor is deferred.
+6. One price per tier. The server knows the tier of every session, so a flood shows in its tier, and raising that price leaves the other tiers unchanged. An attacker without a badge leaves the price of badge holders where it was; an attacker with a supporter badge leaves the price of legend holders where it was.
+7. An entitlement lowers the price, and neither raises it nor removes it. A credential presents on any number of sessions without linking them, so a free tier would sell an attacker unlimited creation for the price of one badge; and a badge that could cost more than no badge would break the promise it was sold with, the promise the XFTP server keeps for storage time.
+8. A budget for clients of earlier versions, where Tor serves them at the lowest priority. They cannot pay, so they share a number of creations per minute.
+
+Kept from Tor: the Equi-X function, the linear effort scale, the verification formula, and the exact byte definitions of the target check.
+
+## Cost units
+
+Each protocol defines the unit of its own price list. The server advertises the price per unit; the client computes the effort of its request.
+
+```
+SMP:  1 unit per new queue
+      1 unit per queue link data record (in NEW, or in LSET on a queue without one)
+XFTP: 1 unit per 64 KB stored for 24 hours
+      chunkUnits = ceil(size / 65536 * storageHours / 24)
+      storageHours = min(requested hours, maximum hours of the tier); absent or 0 = the maximum
+NTF:  1 unit per token registration
+```
+
+`effort = price * units`, capped at 2^32 - 1.
+
+64 KB is the smallest chunk. The server takes chunks of 64 KB, 256 KB, 1 MB and 4 MB, and the test configuration adds 128 KB; each is a whole number of units.
+
+## Handshake parameters
+
+Each protocol adds one optional field to the server handshake, encoded from the version that introduces proof of work.
+
+```
+powParams = %s"0" / (%s"1" powScheme defaultPrice entPrices serverEpoch epochWindow)
+powScheme = 1*1 OCTET        ; 1 = Equi-X and Blake2b
+defaultPrice = tierPrice     ; without an entitlement; price 0 = proof not required
+entPrices = count *entPrice
+entPrice = entName tierPrice
+entName = shortString        ; entitlement name, as in the entitlement proof
+serverEpoch = 4*4 OCTET      ; Word32, current minute of server time
+epochWindow = 1*1 OCTET      ; minutes a proof stays valid
+
+SMP, NTF:  tierPrice = price
+XFTP:      tierPrice = price storageHours
+price = 4*4 OCTET            ; Word32, effort per unit
+storageHours = 4*4 OCTET     ; Word32, maximum storage time of the tier
+```
+
+The server handshake precedes the client handshake that carries the entitlement proof, so every price is sent. The client applies the price of its entitlement name, and the default price when it presented no entitlement or when its name is absent from the list.
+
+The XFTP client learns the maximum storage time of its tier from the same entry, so it computes the units of a chunk that asks for the maximum. The grant in `SIDS` stays as it is.
+
+## Algorithm
+
+Equi-X, by tevador, is Equihash(60,3) with two changes: the hash is HashX, and the indices are summed modulo 2^60 rather than xored.
+
+HashX takes a seed - here the challenge - and generates a short program of integer instructions over eight 64-bit registers, which maps a 64-bit input to a 64-bit output. The program differs for every seed, so hardware built for one program serves no other. That is where the resistance to an ASIC comes from, and what narrows the distance to a GPU.
+
+HashX runs the program in one of two modes. Compiled, it writes machine code for x86-64 or arm64 into executable memory, and hashes in under 100 nanoseconds. Interpreted, it hashes in 1-2 microseconds. Our clients take the interpreter on every platform: iOS refuses executable memory to App Store apps, GrapheneOS stops an Android app that loads code at run time, and desktop clients follow the phones. An attacker enables the compiler with one flag, `EQUIX_CTX_COMPILE`, or runs the benchmark of tevador as it is.
+
+Solving finds eight 16-bit indices `i0..i7` with `HX(i0) + ... + HX(i7) = 0 (mod 2^60)`, under the tree conditions of Wagner's algorithm - 15 trailing zero bits on each pair, 30 on each quadruple, 60 on the sum - and an ordering condition that makes the solution canonical. The solver holds tables over 2^16 items, which is the 1.8 MiB. A solution is `8 * uint16`, so 16 bytes, and one call returns about two of them.
+
+Verification recomputes the eight HashX values and checks the three sums. It takes 50-120 microseconds and a few kilobytes.
+
+The protocol layer above it is the target check: a solution counts when `blake2b_32(challenge || solution) * effort <= 2^32 - 1`. Finding a solution is the constant cost; landing one in a slice of `1/effort` is the price. Expected solver calls are `effort / 2`, and expected tested solutions are `effort`.
+
+## Code
+
+```
+C, the reference:  https://github.com/tevador/equix   LGPL-3.0, hashx as its submodule
+                   https://github.com/tevador/hashx   LGPL-3.0
+Rust, the port:    arti crates equix 0.7.1, hashx 0.9.1, LGPL-3.0-only
+Tor, in use:       src/ext/equix (vendored), src/feature/hs/hs_pow.c and hs_pow.h
+```
+
+The library is a git submodule at `cbits/equix`, from a fork under simplex-chat, as `cbits/libbbs` is today; hashx comes in as its nested submodule. The fork starts from tevador's repository, after a comparison with the copy in Tor for fixes. The C sources are listed in `c-sources`, and the Haskell side is a foreign import of the four calls below.
+
+```c
+equix_ctx* equix_alloc(equix_ctx_flags flags);  /* EQUIX_CTX_SOLVE | EQUIX_CTX_COMPILE, or EQUIX_CTX_VERIFY */
+int equix_solve(equix_ctx* ctx, const void* challenge, size_t size, equix_solution out[8]);
+equix_result equix_verify(equix_ctx* ctx, const void* challenge, size_t size, const equix_solution* sol);
+void equix_free(equix_ctx* ctx);
+```
+
+A context holds the program generated for the current challenge, so each thread allocates its own: one per solver thread on the client, a small pool on the server. Clients allocate without `EQUIX_CTX_COMPILE`.
+
+`hs_pow.c` is the closest model for our code: `build_equix_challenge` and `validate_equix_challenge` are the two functions we reimplement with our own challenge, `hs_pow_solve` is the search loop, `hs_pow_verify` is the order of checks, and `hs_pow_queue_work` runs solving on the worker pool at low priority.
+
+The licence is LGPL-3.0 for both implementations. Our library is AGPL-3.0, so linking asks nothing new of us, while a closed-source consumer of the library acquires the obligations of the LGPL for that part.
+
+## Proof
+
+```
+proofOfWork = powEffort powEpoch powNonce powSolution
+powEffort = 4*4 OCTET      ; Word32, the effort this proof was made for
+powEpoch = 4*4 OCTET       ; Word32, the minute of server time this proof was made for
+powNonce = powCounter powSearch
+powCounter = 4*4 OCTET     ; Word32, the counter of this proof in the session
+powSearch = 12*12 OCTET    ; the value the solver varies
+powSolution = 16*16 OCTET  ; Equi-X solution
+```
+
+40 bytes.
+
+```
+challenge = personalisation sessionHash htonl(powEffort) htonl(powEpoch) powNonce
+personalisation = 16*16 OCTET  ; "SimpleX PoW v1 " and one of %s"S" / %s"X" / %s"N"
+sessionHash = 32*32 OCTET      ; sha256 of the transport session id
+```
+
+The client picks the next counter and a random search value, calls `equix_solve(challenge)`, computes `R = ntohl(blake2b_32(challenge || S))`, and accepts the solution when `R * E <= 2^32 - 1`, computed in 64 bits. Otherwise it increments the search value as a little-endian integer and repeats.
+
+```
+S = packed solution         ; 8 indices, each a little-endian uint16, 16 bytes
+blake2b_32 = BLAKE2b initialised with a 4-byte output length
+R = the 4 bytes of blake2b_32, read big-endian
+```
+
+BLAKE2b with a 4-byte output length differs from the first 4 bytes of BLAKE2b-512, because the length is a parameter of the initial state. Both definitions follow `validate_equix_challenge` and `pack_equix_solution` in `hs_pow.c`.
+
+Counters are assigned in order and spent in order. A client that solves on several cores gives each core its own counter.
+
+A proof verifies only under the protocol letter and the session hash it was made for, so it fails on another protocol, another server, and another connection.
+
+## Commands
+
+The proof is an optional field of the commands that create resources.
+
+```
+smpNew = %s"NEW " rcvAuthKey rcvDhKey optBasicAuth subMode optQueueReqData optNtfCreds optProofOfWork
+smpLSet = %s"LSET " linkId queueLinkData optProofOfWork
+fnew = %s"FNEW " fileInfo rcvKeys optBasicAuth fileStorageTime optProofOfWork
+tnew = %s"TNEW " newNtfTkn optProofOfWork
+optProofOfWork = %s"0" / (%s"1" proofOfWork)
+```
+
+`LSET` is priced when the queue holds no link data; on a queue that holds some, it replaces the data and carries no proof. `NKEY`, `FADD` and `SNEW` are not priced. The first message to an unknown queue is out of scope.
+
+A batch of transmissions carries one proof per command. Creation commands are sent to the servers of the user over a direct session, so the proxy carries none of them.
+
+## Verification
+
+The server checks, in this order:
+
+1. `powEffort >= price of the tier of the session * units of the request` - integer comparison.
+2. `powEpoch` within the epoch window of the server, and at most one epoch ahead.
+3. `powCounter` is above the window of the session, or inside it and unused.
+4. `R * powEffort <= 2^32 - 1` - one Blake2b of 88 bytes.
+5. `equix_verify(challenge, S) == EQUIX_OK` - 50-120 microseconds.
+6. The counter is marked, and the resource is created.
+
+The counter is marked on every verified proof, including one whose command then fails, so a proof pays for one attempt.
+
+The window holds the last 64 counters, which admits proofs that arrive out of order, from commands sent concurrently on one session. A counter below the window is rejected, and the client that skipped ahead loses the proofs it left behind.
+
+Steps 1 to 3 cost less than a microsecond. Step 4 costs an attacker about `effort` Blake2b calls to pass with a random solution, so the Equi-X call in step 5 is what a forged proof buys. The server closes a session after 3 consecutive proofs that fail step 4 or step 5. An honest client checks its proof before sending it, so it never fails these steps; a stale proof or one below the price fails steps 1 to 3, which can happen to an honest client after a change of price or epoch, and closes nothing.
+
+## Entitlement
+
+SMP and NTF servers verify the entitlement proof in the handshake, as the XFTP server does. A name the server prices is verified once per session; a name it does not price is ignored without verification, and the session pays the default price. A proof that fails to verify leaves the session at the default price too.
+
+The tier of the session is fixed at the handshake, so every command in it is priced without further work.
+
+An entitlement lowers the price, and neither raises it nor removes it:
+
+```
+min(1, price) <= price_for_<name> <= price
+```
+
+The server exits at startup when a configured price breaks this rule, and logs each name that breaks it, as the XFTP server does when an entitlement storage time is below the default. An entitlement price equal to the default is allowed, as an equal storage time is on XFTP.
+
+The control port sets the three prices in one command, and refuses a triple that breaks the rule. The triple is checked as a whole, so the order in which prices change plays no part.
+
+This gives the badge a function on SMP and NTF, where it grants nothing today: the holder pays less CPU time, and a flood outside its tier leaves its price where it was.
+
+## Services
+
+A service session creates resources without a proof when the SMP server records its service as created before a configured date. `serviceCreatedAt` of the service record holds that date, so the services that presented certificates before the release are exempt, and the rule needs no migration.
+
+```
+[PROOF_OF_WORK]
+exempt_services_created_before = 2026-10-15
+```
+
+A service registered after that date pays the default price. Exempt sessions are a tier of their own in the statistics.
+
+The date is a transition. The follow-up work gives services a certificate signed by an operator, an online certificate under an offline one as SMP servers have, issued on a certificate request from each partner; a server recognises the operators in its configuration and exempts their services. It is out of scope here.
+
+## Clients of earlier versions
+
+A session below the version that introduces proof of work cannot present a proof. Its creation commands draw on one budget, shared by all such sessions: a number of creations per minute, set on the control port, unlimited at first.
+
+While an attacker uses a client of the proof-of-work version, the budget goes to clients of earlier versions and none of them notices it. When an attacker uses an earlier client, the damage is the budget. A budget of zero refuses them all; the generic lever against earlier versions stays the version range, set without a release.
+
+A command over the budget receives a new error, `BUSY`:
+
+```
+SMP:  ERR BUSY
+XFTP: FRErr BUSY
+NTF:  NRErr BUSY
+```
+
+The serializer sends `BUSY` to a session of the proof-of-work version as it is, and maps it for a session of an earlier version, as it maps `BLOCKED` for sessions below `clientNoticesSMPVersion` today:
+
+```
+SMP:  BUSY -> STORE busy
+NTF:  BUSY -> STORE busy
+XFTP: BUSY -> TIMEOUT
+```
+
+SMP and NTF share `ErrorType`, which has no `TIMEOUT`. Among the errors an SMP or NTF server sends, agents from simplexmq 7.0.0 retry only `STORE`; that release introduced SMP version 19 and ships in the apps from 7.0.0. An asynchronous `NEW` or `JOIN` of these agents retries with a growing interval and takes the next server of the user on each attempt, so a refused client moves to a server that has budget left. The XFTP agent retries `FNEW` on `TIMEOUT` from simplexmq 5.8.0. `TNEW` returns the error to the app that called `registerNtfToken`, and the agent holds no retry loop for it. An interactive command shows the error once, and the deployed apps show `STORE busy` in their generic error alert.
+
+Agents below SMP version 19 retry no error that a server sends. They end an asynchronous command on `STORE`, and the app of these versions shows the error without retrying the command, so a refused connection to a group member is lost.
+
+The other errors mislead or stop the client: `QUOTA` is shown as a connection that reached its limit of undelivered messages, `AUTH` as a connection error of authorisation, and in the deployed agents both end an asynchronous command. A budget of zero keeps the retries of clients from version 19 running at the longest interval, and a raised budget lets them through without an update.
+
+A client of the proof-of-work version shows `BUSY` to the user: an interactive command shows it at once, and a background command shows it when its retries expire on the client.
+
+## Learning the price
+
+The price reaches the client three ways, and each of them is a message the protocol already sends.
+
+1. The server handshake, at the start of the session. It states the price of every tier, because the entitlement proof arrives in the client handshake that follows.
+2. The response to a priced command. It states the price of the tier of the session, so a client that paid the old price learns the new one while its command succeeds.
+3. The error below, when the proof was absent, stale, or below the price. A client whose entitlement failed to verify learns here that it pays the default price.
+
+```
+powPrice = price serverEpoch  ; 8 bytes, appended to the response of a priced command
+```
+
+An increase costs one rejected command and the proof spent on it. A decrease costs nothing: the client over-pays until its next response, which states the lower price. A client that has been idle for longer than the epoch window solves at the last price it read, and pays one retry when the price moved meanwhile.
+
+The prices are public, as the suggested effort is in Tor, and the list of priced entitlement names is public with them.
+
+## Errors and retry
+
+A new error carries the price and the time of the server.
+
+```
+SMP:  ERR POW price epoch
+XFTP: FRErr (POW price epoch)
+NTF:  NRErr (POW price epoch)
+```
+
+The client resets its price and epoch from the error, solves at the stated price, and retries. Two retries are allowed for one command, which covers a price that moves again while the client solves; past that it reports that the server is busy, as it does when the effort exceeds its own maximum.
+
+A proof made for a higher effort than required is accepted, so a proof that outlives a decrease stays usable while its epoch holds.
+
+## Setting prices
+
+The operator sets the prices: the configuration holds the values the server starts with, and the control port reads and changes them while it runs.
+
+```
+[PROOF_OF_WORK]
+price = 16                  ; effort per unit without an entitlement, 0 = proof not required
+price_for_supporter = 4     ; effort per unit with the supporter entitlement, at least 1 and at most price
+price_for_legend = 2        ; effort per unit with the legend entitlement, at least 1 and at most price
+epoch_window_minutes = 5
+exempt_services_created_before = 2026-10-15
+```
+
+The keys follow `expire_files_hours_for_<name>` of the XFTP server, and on the XFTP server both keys name the same entitlements.
+
+Control port commands, on SMP, XFTP and NTF servers:
+
+```
+pow                    ; user role: prices, budget of earlier versions, epoch window, counts of the current period per tier
+pow p0 p1 p2           ; admin role: set the prices - p0 without an entitlement, p1 supporter, p2 legend
+pow old <n>            ; admin role: set the budget of earlier versions, creations per minute
+pow old unlimited      ; admin role: remove the budget
+```
+
+A change reaches new sessions through the handshake, and sessions in progress through their next response or error.
+
+Prices and the budget set on the control port are saved with the server state and restored at start, so a change made during an attack survives a restart that the attack outlasts. While they differ from the configuration, the server logs a warning at stop and at start, and `pow` shows both values.
+
+The XFTP and NTF control ports gain the admin role check that the SMP control port already has; both check the user role today.
+
+The estimator of Tor is deferred. If prices set by hand prove too slow, it runs per tier on the creations of that tier, between bounds set on the control port.
+
+## Statistics
+
+The server counts per tier, so a flood shows in its tier, and the use of each entitlement is accounted for. Sessions without an entitlement are counted under `default`, exempt services under `service`, and sessions of earlier versions under `old`.
+
+```
+sessions            ; sessions of the tier
+entFailed           ; entitlement proofs that failed to verify
+proofsAccepted
+effortAccepted      ; sum of the effort of accepted proofs
+proofsAbsent
+proofsBelowPrice
+proofsStale         ; epoch outside the window
+proofsReused        ; counter below the window or already marked
+proofsInvalid       ; Blake2b target or Equi-X check failed
+sessionsClosed      ; sessions closed after invalid proofs
+overBudget          ; creations of earlier versions refused by the budget
+created             ; queues, chunks or tokens created
+```
+
+The counts appear in `pow` for the current period, in the stats log, and in the Prometheus metrics. They name a tier, never a session.
+
+## Costs
+
+The rates below are estimates to be replaced by measurement on devices.
+
+A solver call hashes 2^16 indices. Compiled, a desktop core makes about 150 candidate solutions per second, measured by tevador. Interpreted at 1-2 microseconds per hash, a call spends about 100 milliseconds hashing, so the same core makes about 15-25, and a phone core, about three times slower, about 5-8.
+
+```
+effort   desktop, compiled   phone, interpreted
+     4              0.03 s                0.6 s
+    16              0.1 s                 2.5 s
+    64              0.4 s                10 s
+   256              1.7 s                40 s
+```
+
+A queue at a price of 4 costs a phone about 0.6 seconds, and a queue at 16 about 2.5 seconds. A 4 MB chunk stored for 48 hours is 128 units; at an XFTP price of 1 it costs a phone about 20 seconds, while the upload of the same chunk takes seconds to minutes. The prices of the configuration examples assume compiled solving, and fall with this table.
+
+The client maximum is one effort value: the largest that an iPhone 8 solves in 45-60 seconds and a current iPhone in 30 seconds. A benchmark on both devices sets it; by the table above it is about 200. A client reports a request priced above it as busy, so it bounds the prices an operator can set: the price of a queue, and the units of an XFTP chunk multiplied by the price per unit.
+
+Verification at 100 microseconds allows about 10000 proofs per second per core, which exceeds the rate at which queues are created and written to the store.
+
+## Attacker cost
+
+An attacker solves on desktops with the compiler, at 150 candidate solutions per second per core:
+
+```
+price    1 core      64 cores    1000 machines
+    4    37/s        2400/s      37000/s
+   16    9/s         600/s       9000/s
+  256    0.6/s       38/s        600/s
+```
+
+A desktop core of the attacker solves 20-30 times faster than a phone core of a user: three times from the hardware, and the rest from the compiler. The gap sets how high a price can rise before users feel it.
+
+The idle price is a speed bump. The defence is the increase in the tier the flood uses, and the statistics show which tier that is.
+
+An attacker without a badge floods the default tier. Its price rises, and badge holders keep their prices.
+
+An attacker who bought a badge presents it on every machine: at a price of 2, one badge on 1000 machines creates 75000 queues per second until the price of that tier is raised. The raise is paid by the holders of that badge while the flood lasts, and by no one else.
+
+The price of a badge tier rises at most to the default price. A flood in a badge tier that the default price does not hold back needs the default raised too, so users without a badge pay that raise as well; the other badge tiers keep their prices.
+
+## Client implementation
+
+The agent solves on demand, in one solver ordered by `NetworkRequestMode`: `NRMInteractive` work first, then `NRMBackground`. A solver call takes about 100 milliseconds on a phone, so background work yields between calls when interactive work arrives.
+
+Creation outside the actions of the user - connections to the members of a group - is background work, and background solving has a budget of CPU time per hour. Past it, background creations wait, and the asynchronous commands that carry them retry them later. A group of many members cannot turn the device into a miner.
+
+The solver keeps no stock. A proof is discarded when its epoch passes or its session ends.
+
+## Deployment
+
+Proof of work comes in the same version as the entitlement proof in the handshake: SMP version 23 and NTF version 4. XFTP carries the entitlement proof from version 4, which is released, so proof of work comes in XFTP version 5. Servers start with every price at zero, which asks for nothing, and operators raise them. The existing controls - `allowNewQueues`, `allowNewFiles`, the basic auth of the server - stay as they are.
+
+## Limits
+
+- Proof of work prices bulk creation; it stops no one who is willing to pay. Tor states the same conclusion: the defence covers a single machine and a small botnet, and a large botnet needs another mechanism.
+- Prices change by hand, so a flood runs at the old price until an operator raises it. The expiry bounds the stock prepared before the flood; the flood that follows is priced at the new value from the next response.
+- Phones solve with the interpreter and attackers with the compiler, which gives an attacker 20-30 times a phone per core. Equi-X narrows the gap between a CPU and a GPU, which published measurements leave open; a hash-based puzzle would give one GPU a factor of about a thousand over a phone.
+- Proofs are bound to a session, so a reconnection discards the unspent ones.
+- The cost falls on the device of the user: battery and heat, most visible when a group of many members is created at once.
+- Proof of work replaces no rate limit, and the servers limit neither creations nor commands per session today. A cap on creations per session is out of scope.
+
+## Open questions
+
+1. HashX against a fixed hash. Our clients interpret and an attacker compiles, which the estimates put at about 8 times on one core. A fixed hash - Equihash(60,3) over SipHash - removes that factor, and gives a GPU the same program for every challenge, so it runs thousands of instances in step, as the Equihash miners do; that factor is unmeasured. The measurements that decide it: interpreted solving on a mid-range Android phone and an iPhone, compiled against interpreted on one desktop core, and an estimate of a GPU solver for the fixed hash.
+2. The budget of background solving, in CPU seconds per hour.
+3. Sessions below SMP version 19: whether the budget of earlier versions applies to them, where a refusal ends their asynchronous creations, or they stay outside it and the version range is the lever against them.
+
+## Follow-up
+
+Certificates for services signed by an operator, with the requests of partners, as described under Services.
@@ -271,6 +271,7 @@ library
          Simplex.FileTransfer.Server.Store
          Simplex.FileTransfer.Server.StoreLog
          Simplex.Messaging.Server
+          Simplex.Messaging.Server.AddressStats
          Simplex.Messaging.Server.CLI
          Simplex.Messaging.Server.Control
          Simplex.Messaging.Server.Env.STM
@@ -542,6 +543,7 @@ test-suite simplexmq-test
      AgentTests.ServerChoice
      AgentTests.ShortLinkTests
      CLITests
+      CoreTests.AddressStatsTests
      CoreTests.BatchingTests
      CoreTests.CryptoFileTests
      CoreTests.CryptoTests
@@ -65,6 +65,7 @@ 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.Server (controlPortAuth, dummyVerifyCmd, verifyCmdAuthorization)
+import Simplex.Messaging.Server.AddressStats (AddrStats, ServerAddrStats (..), addAddrCounter, addressStatsThread, incAddrCounter, printTopAddresses, withAddrStats)
 import Simplex.Messaging.Server.Control (CPClientRole (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.QueueStore (ServerEntityStatus (..))
@@ -101,7 +102,8 @@ data XFTPTransportRequest = XFTPTransportRequest
    request :: H.Request,
    sendResponse :: H.Response -> IO (),
    sniUsed :: SNICredentialUsed,
-    addCORS :: Bool
+    addCORS :: Bool,
+    clientAddrStats :: Maybe (AddrStats XFTPAddrCounter)
  }

 corsHeaders :: Bool -> [N.Header]
@@ -141,6 +143,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
        : expireFiles fileExpiration
        : serverStatsThread_ cfg
          <> prometheusMetricsThread_ cfg
+          <> addressStatsThread_ cfg
          <> controlPortThread_ cfg
    )
    `finally` stopServer
@@ -154,20 +157,27 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
        Left e -> putStrLn ("Server has no valid key: " <> show e) >> exitFailure
      env <- ask
      sessions <- liftIO TM.emptyIO
+      sessionAddrStats <- liftIO TM.emptyIO
+      stats_ <- asks addrStats
      let cleanup sessionId = atomically $ TM.delete sessionId sessions
+          withConnection sock sessionId handler =
+            withAddrStats (addrStatsMap <$> stats_) sock $ \case
+              Just s -> (atomically (TM.insert sessionId s sessionAddrStats) >> handler) `finally` atomically (TM.delete sessionId sessionAddrStats)
+              Nothing -> handler
          srvParams = if isJust httpCreds_ then defaultSupportedParamsHTTPS else defaultSupportedParams
      webCanonicalRoot_ <- liftIO $ mapM canonicalizePath (webStaticPath cfg)
-      liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize srvParams srvCreds httpCreds_ transportConfig inactiveClientExpiration cleanup $ \sniUsed sessionId sessionALPN r sendResponse -> do
+      liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize srvParams srvCreds httpCreds_ transportConfig inactiveClientExpiration cleanup withConnection $ \sniUsed sessionId sessionALPN r sendResponse -> do
        let addCORS' = sniUsed && addCORSHeaders transportConfig
        case H.requestMethod r of
          Just "OPTIONS" | addCORS' -> sendResponse $ H.responseNoBody N.ok200 corsPreflightHeaders
          Just "GET" | sniUsed -> forM_ webCanonicalRoot_ $ \root -> serveStaticPageH2 root r sendResponse
          _ -> do
            reqBody <- getHTTP2Body r xftpBlockSize
+            clientAddrStats <- TM.lookupIO sessionId sessionAddrStats
            let v = VersionXFTP 1
                thServerVRange = versionToRange v
                thParams0 = THandleParams {sessionId, blockSize = xftpBlockSize, thVersion = v, thServerVRange, thAuth = Nothing, implySessId = False, encryptBlock = Nothing, serviceAuth = False, serverInfo = Nothing}
-                req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse, sniUsed, addCORS = addCORS'}
+                req0 = XFTPTransportRequest {thParams = thParams0, request = r, reqBody, sendResponse, sniUsed, addCORS = addCORS', clientAddrStats}
            flip runReaderT env $ case sessionALPN of
              Nothing -> processRequest req0
              Just alpn
@@ -330,24 +340,30 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
      [savePrometheusMetrics interval prometheusMetricsFile]
    prometheusMetricsThread_ _ = []

+    addressStatsThread_ :: XFTPServerConfig s -> [M s ()]
+    addressStatsThread_ XFTPServerConfig {addressStats = Just statsCfg} = [asks addrStats >>= mapM_ (liftIO . addressStatsThread statsCfg)]
+    addressStatsThread_ _ = []
+
    savePrometheusMetrics :: Int -> FilePath -> M s ()
    savePrometheusMetrics saveInterval metricsFile = do
      labelMyThread "savePrometheusMetrics"
      liftIO $ putStrLn $ "Prometheus metrics saved every " <> show saveInterval <> " seconds to " <> metricsFile
      ss <- asks serverStats
+      stats_ <- asks addrStats
      rtsOpts <- liftIO $ maybe ("set " <> rtsOptionsEnv) T.pack <$> lookupEnv (T.unpack rtsOptionsEnv)
      let interval = 1000000 * saveInterval
      liftIO $ forever $ do
        threadDelay interval
        ts <- getCurrentTime
-        sm <- getFileServerMetrics ss rtsOpts
+        sm <- getFileServerMetrics ss stats_ rtsOpts
        T.writeFile metricsFile $ xftpPrometheusMetrics sm ts

-    getFileServerMetrics :: FileServerStats -> T.Text -> IO FileServerMetrics
-    getFileServerMetrics ss rtsOptions = do
+    getFileServerMetrics :: FileServerStats -> Maybe (ServerAddrStats XFTPAddrCounter) -> T.Text -> IO FileServerMetrics
+    getFileServerMetrics ss stats_ rtsOptions = do
      d <- getFileServerStatsData ss
      let fd = periodStatDataCounts $ _filesDownloaded d
-      pure FileServerMetrics {statsData = d, filesDownloadedPeriods = fd, rtsOptions}
+      addressHistograms <- mapM (readIORef . addrHistograms) stats_
+      pure FileServerMetrics {statsData = d, filesDownloadedPeriods = fd, rtsOptions, addressHistograms}

    controlPortThread_ :: XFTPServerConfig s -> [M s ()]
    controlPortThread_ XFTPServerConfig {controlPort = Just port} = [runCPServer port]
@@ -402,7 +418,10 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
                  (fr, _) <- ExceptT $ liftIO $ getFile fs SFRecipient fileId
                  ExceptT $ blockServerFile fr info
                liftIO . hPutStrLn h $ either (\e -> "error: " <> show e) (\() -> "ok") r
-              CPHelp -> hPutStrLn h "commands: stats-rts, delete, help, quit"
+              CPAddresses name n_ -> withUserRole $ do
+                stats_ <- unliftIO u $ asks addrStats
+                printTopAddresses h (addrStatsMap <$> stats_) name n_
+              CPHelp -> hPutStrLn h "commands: stats-rts, delete, addresses, help, quit"
              CPQuit -> pure ()
              CPSkip -> pure ()
              where
@@ -421,21 +440,23 @@ data ServerFile = ServerFile
  }

 processRequest :: FileStoreClass s => XFTPTransportRequest -> M s ()
-processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse, addCORS}
-  | B.length bodyHead /= xftpBlockSize = sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
+processRequest XFTPTransportRequest {thParams, reqBody = body@HTTP2Body {bodyHead}, sendResponse, addCORS, clientAddrStats}
+  | B.length bodyHead /= xftpBlockSize = incAddrStats XACErrors >> sendXFTPResponse ("", NoEntity, FRErr BLOCK) Nothing
  | otherwise =
      case xftpDecodeTServer thParams bodyHead of
-        Right (Right t@(_, _, (corrId, fId, _))) -> do
+        Right (Right t@(_, _, (corrId, fId, cmd))) -> do
+          incAddrStats $ xftpCmdCounter cmd
          let THandleParams {thAuth} = thParams
              ent = peerEntitlement =<< thAuth
          verifyXFTPTransmission thAuth t >>= \case
-            VRVerified req -> uncurry send =<< processXFTPRequest ent body req
-            VRFailed e -> send (FRErr e) Nothing
+            VRVerified req -> uncurry send =<< processXFTPRequest clientAddrStats ent body req
+            VRFailed e -> incAddrStats XACErrors >> send (FRErr e) Nothing
          where
            send resp = sendXFTPResponse (corrId, fId, resp)
-        Right (Left (corrId, fId, e)) -> sendXFTPResponse (corrId, fId, FRErr e) Nothing
-        Left e -> sendXFTPResponse ("", NoEntity, FRErr e) Nothing
+        Right (Left (corrId, fId, e)) -> incAddrStats XACErrors >> sendXFTPResponse (corrId, fId, FRErr e) Nothing
+        Left e -> incAddrStats XACErrors >> sendXFTPResponse ("", NoEntity, FRErr e) Nothing
  where
+    incAddrStats c = liftIO $ forM_ clientAddrStats (`incAddrCounter` c)
    sendXFTPResponse t' serverFile_ = do
      let t_ = xftpEncodeTransmission thParams t'
 #ifdef slow_servers
@@ -490,8 +511,8 @@ verifyXFTPTransmission thAuth (tAuth, authorized, (corrId, fId, cmd)) =
    -- TODO verify with DH authorization
    req `verifyWith` k = if verifyCmdAuthorization thAuth tAuth authorized corrId k then VRVerified req else VRFailed AUTH

-processXFTPRequest :: forall s. FileStoreClass s => Maybe SessionEntitlement -> HTTP2Body -> XFTPRequest -> M s (FileResponse, Maybe ServerFile)
-processXFTPRequest ent HTTP2Body {bodyPart} = \case
+processXFTPRequest :: forall s. FileStoreClass s => Maybe (AddrStats XFTPAddrCounter) -> Maybe SessionEntitlement -> HTTP2Body -> XFTPRequest -> M s (FileResponse, Maybe ServerFile)
+processXFTPRequest addrStats_ ent HTTP2Body {bodyPart} = \case
  XFTPReqNew file rks auth storageHours -> noFile =<< ifM allowNew (createFile file rks storageHours) (pure $ FRErr AUTH)
    where
      allowNew = do
@@ -509,6 +530,10 @@ processXFTPRequest ent HTTP2Body {bodyPart} = \case
  XFTPReqPing -> noFile FRPong
  where
    noFile resp = pure (resp, Nothing)
+    addAddrStats :: XFTPAddrCounter -> Int -> M s ()
+    addAddrStats c n = liftIO $ forM_ addrStats_ $ \s -> addAddrCounter s c n
+    kilobytes :: Word32 -> Int
+    kilobytes bytes = (fromIntegral bytes + 1023) `div` 1024
    createFile :: FileInfo -> NonEmpty RcvPublicAuthKey -> Maybe Word32 -> M s FileResponse
    createFile file rks storageHours = do
      st <- asks fileStore
@@ -532,6 +557,7 @@ processXFTPRequest ent HTTP2Body {bodyPart} = \case
        stats <- asks serverStats
        lift $ incFileStat filesCreated
        liftIO $ atomicModifyIORef'_ (fileRecipients stats) (+ length rks)
+        lift $ addAddrStats XACRecipients $ length rks
        let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
        pure $ FRSndIds sId rIds (Just (GSTExpires (roundedSeconds fileExpiresAt)))
      pure $ either FRErr id r
@@ -567,6 +593,7 @@ processXFTPRequest ent HTTP2Body {bodyPart} = \case
        lift $ withFileLog $ \sl -> logAddRecipients sl sId rcps
        stats <- asks serverStats
        liftIO $ atomicModifyIORef'_ (fileRecipients stats) (+ length rks)
+        lift $ addAddrStats XACRecipients $ length rks
        let rIds = L.map (\(FileRecipient rId _) -> rId) rcps
        pure $ FRRcvIds rIds
      pure $ either FRErr id r
@@ -605,6 +632,7 @@ processXFTPRequest ent HTTP2Body {bodyPart} = \case
                    incFileStat filesUploaded
                    incFileStat filesCount
                    liftIO $ atomicModifyIORef'_ (filesSize stats) (+ fromIntegral size)
+                    addAddrStats XACUploadKb $ kilobytes size
                    pure FROk
                  Left _e -> do
                    us <- asks usedStorage
@@ -634,6 +662,7 @@ processXFTPRequest ent HTTP2Body {bodyPart} = \case
                  stats <- asks serverStats
                  incFileStat fileDownloads
                  liftIO $ updatePeriodStats (filesDownloaded stats) senderId
+                  addAddrStats XACDownloadKb $ kilobytes size
                  pure (FRFile sDhKey cbNonce, Just ServerFile {filePath = path, fileSize = size, sbState})
                _ -> pure (FRErr INTERNAL, Nothing)
        _ -> pure (FRErr NO_FILE, Nothing)
@@ -7,15 +7,18 @@ module Simplex.FileTransfer.Server.Control
 where

 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Text (Text)
 import Simplex.FileTransfer.Protocol (XFTPFileId)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo)
+import Simplex.Messaging.Server.AddressStats (addressesArgs, addressesArgsP)

 data ControlProtocol
  = CPAuth BasicAuth
  | CPStatsRTS
  | CPDelete XFTPFileId
  | CPBlock XFTPFileId BlockingInfo
+  | CPAddresses Text (Maybe Int)
  | CPHelp
  | CPQuit
  | CPSkip
@@ -26,6 +29,7 @@ instance StrEncoding ControlProtocol where
    CPStatsRTS -> "stats-rts"
    CPDelete fId -> strEncode (Str "delete", fId)
    CPBlock fId info -> strEncode (Str "block", fId, info)
+    CPAddresses name n_ -> "addresses " <> addressesArgs name n_
    CPHelp -> "help"
    CPQuit -> "quit"
    CPSkip -> ""
@@ -35,6 +39,7 @@ instance StrEncoding ControlProtocol where
      "stats-rts" -> pure CPStatsRTS
      "delete" -> CPDelete <$> _strP
      "block" -> CPBlock <$> _strP <*> _strP
+      "addresses" -> uncurry CPAddresses <$> addressesArgsP
      "help" -> pure CPHelp
      "quit" -> pure CPQuit
      "" -> pure CPSkip
@@ -16,6 +16,8 @@ module Simplex.FileTransfer.Server.Env
    XFTPStoreConfig (..),
    XFTPEnv (..),
    XFTPRequest (..),
+    XFTPAddrCounter (..),
+    xftpCmdCounter,
    XFTPStoreType,
    FileStore (..),
    AFStoreType (..),
@@ -45,7 +47,7 @@ import Data.Word (Word16, Word32)
 import Data.X509.Validation (Fingerprint (..))
 import Network.Socket
 import qualified Network.TLS as T
-import Simplex.FileTransfer.Protocol (FileCmd, FileInfo (..), XFTPFileId)
+import Simplex.FileTransfer.Protocol (FileCmd (..), FileCommand (..), FileInfo (..), XFTPFileId)
 import Simplex.FileTransfer.Server.Stats
 import Data.Either (fromRight)
 import Data.Ini (Ini, lookupValue)
@@ -67,6 +69,7 @@ import Simplex.FileTransfer.Transport (VersionRangeXFTP)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
 import Simplex.Messaging.Protocol (BasicAuth, RcvPublicAuthKey)
+import Simplex.Messaging.Server.AddressStats (AddrCounter (..), AddressStatsConfig, ServerAddrStats, countBounds, kilobyteBounds, newServerAddrStats)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information (ServerPublicInfo)
 import Simplex.Messaging.Transport (EntitlementConfig (..))
@@ -115,6 +118,7 @@ data XFTPServerConfig s = XFTPServerConfig
    serverStatsBackupFile :: Maybe FilePath,
    prometheusInterval :: Maybe Int,
    prometheusMetricsFile :: FilePath,
+    addressStats :: Maybe AddressStatsConfig,
    transportConfig :: TransportServerConfig,
    responseDelay :: Int,
    webStaticPath :: Maybe FilePath
@@ -136,9 +140,55 @@ data XFTPEnv s = XFTPEnv
    serverIdentity :: C.KeyHash,
    tlsServerCreds :: T.Credential,
    httpServerCreds :: Maybe T.Credential,
-    serverStats :: FileServerStats
+    serverStats :: FileServerStats,
+    addrStats :: Maybe (ServerAddrStats XFTPAddrCounter)
  }

+data XFTPAddrCounter
+  = XACConnections
+  | XACErrors
+  | XACFNew
+  | XACFAdd
+  | XACFPut
+  | XACFDel
+  | XACFGet
+  | XACFAck
+  | XACPing
+  | XACUploadKb
+  | XACDownloadKb
+  | XACRecipients
+  deriving (Eq, Ord, Enum, Bounded, Show)
+
+instance AddrCounter XFTPAddrCounter where
+  counterName = \case
+    XACConnections -> "connections"
+    XACErrors -> "errors"
+    XACFNew -> "FNEW"
+    XACFAdd -> "FADD"
+    XACFPut -> "FPUT"
+    XACFDel -> "FDEL"
+    XACFGet -> "FGET"
+    XACFAck -> "FACK"
+    XACPing -> "PING"
+    XACUploadKb -> "upload_kb"
+    XACDownloadKb -> "download_kb"
+    XACRecipients -> "recipients"
+  counterBounds = \case
+    XACUploadKb -> kilobyteBounds
+    XACDownloadKb -> kilobyteBounds
+    _ -> countBounds
+  connectionsCounter = XACConnections
+
+xftpCmdCounter :: FileCmd -> XFTPAddrCounter
+xftpCmdCounter (FileCmd _ cmd) = case cmd of
+  FNEW {} -> XACFNew
+  FADD _ -> XACFAdd
+  FPUT -> XACFPut
+  FDEL -> XACFDel
+  FGET _ -> XACFGet
+  FACK -> XACFAck
+  PING -> XACPing
+
 fileStore :: XFTPEnv s -> s
 fileStore = fromFileStore . store
 {-# INLINE fileStore #-}
@@ -182,7 +232,7 @@ defaultFileExpiration =
    }

 newXFTPServerEnv :: FileStoreClass s => XFTPServerConfig s -> IO (XFTPEnv s)
-newXFTPServerEnv config@XFTPServerConfig {serverStoreCfg, fileSizeQuota, fileExpiration, fileStorageEntitlements, xftpCredentials, httpCredentials} = do
+newXFTPServerEnv config@XFTPServerConfig {serverStoreCfg, fileSizeQuota, fileExpiration, fileStorageEntitlements, xftpCredentials, httpCredentials, addressStats} = do
  let defaultMax = ttl fileExpiration
      belowDefault = M.filter ((< defaultMax) . storageTime) fileStorageEntitlements
  unless (M.null belowDefault) $ do
@@ -210,7 +260,8 @@ newXFTPServerEnv config@XFTPServerConfig {serverStoreCfg, fileSizeQuota, fileExp
  httpServerCreds <- mapM loadServerCredential httpCredentials
  Fingerprint fp <- loadFingerprint xftpCredentials
  serverStats <- newFileServerStats =<< getCurrentTime
-  pure XFTPEnv {config, store, usedStorage, storeLog, random, tlsServerCreds, httpServerCreds, serverIdentity = C.KeyHash fp, serverStats}
+  addrStats <- mapM (const newServerAddrStats) addressStats
+  pure XFTPEnv {config, store, usedStorage, storeLog, random, tlsServerCreds, httpServerCreds, serverIdentity = C.KeyHash fp, serverStats, addrStats}

 data XFTPRequest
  = XFTPReqNew FileInfo (NonEmpty RcvPublicAuthKey) (Maybe BasicAuth) (Maybe Word32)
@@ -204,6 +204,8 @@ xftpServerCLI_ generateSite serveStaticFiles cfgPath logPath = do
               \disconnect = off\n"
            <> ("# ttl = " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
            <> ("# check_interval = " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
+            <> "\n"
+            <> addressStatsIniContent
            <> "\n\
               \[WEB]\n\
               \# Set path to generate static mini-site for server information\n"
@@ -325,6 +327,7 @@ xftpServerCLI_ generateSite serveStaticFiles cfgPath logPath = do
              serverStatsBackupFile = logStats $> combine logPath "file-server-stats.log",
              prometheusInterval = eitherToMaybe (lookupValue "STORE_LOG" "prometheus_interval" ini) >>= readMaybe . T.unpack,
              prometheusMetricsFile = combine logPath "xftp-server-metrics.txt",
+              addressStats = iniAddressStats ini,
              transportConfig =
                let cfg =
                      mkTransportServerConfig
@@ -11,12 +11,15 @@ module Simplex.FileTransfer.Server.Prometheus
  ) where

 import Data.Int (Int64)
+import Data.Map.Strict (Map)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffUTCTime)
 import Data.Time.Clock.System (systemEpochDay)
 import Data.Time.Format.ISO8601 (iso8601Show)
+import Simplex.FileTransfer.Server.Env (XFTPAddrCounter)
 import Simplex.FileTransfer.Server.Stats
+import Simplex.Messaging.Server.AddressStats (AddrHistogram, addrHistogramMetrics)
 import Simplex.Messaging.Server.Stats (PeriodStatCounts (..))
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Util (tshow)
@@ -24,7 +27,8 @@ import Simplex.Messaging.Util (tshow)
 data FileServerMetrics = FileServerMetrics
  { statsData :: FileServerStatsData,
    filesDownloadedPeriods :: PeriodStatCounts,
-    rtsOptions :: Text
+    rtsOptions :: Text,
+    addressHistograms :: Maybe (Map XFTPAddrCounter AddrHistogram)
  }

 rtsOptionsEnv :: Text
@@ -33,9 +37,9 @@ rtsOptionsEnv = "XFTP_RTS_OPTIONS"
 {-# FOURMOLU_DISABLE\n#-}
 xftpPrometheusMetrics :: FileServerMetrics -> UTCTime -> Text
 xftpPrometheusMetrics sm ts =
-  time <> files <> info
+  time <> files <> clientAddresses <> info
  where
-    FileServerMetrics {statsData, filesDownloadedPeriods, rtsOptions} = sm
+    FileServerMetrics {statsData, filesDownloadedPeriods, rtsOptions, addressHistograms} = sm
    FileServerStatsData
      { _fromTime,
        _filesCreated,
@@ -122,6 +126,7 @@ xftpPrometheusMetrics sm ts =
      \simplex_xftp_files_count_monthly " <> mstr (monthCount filesDownloadedPeriods) <> "\n\
      \# filesDownloaded.monthCount\n\
      \\n"
+    clientAddresses = maybe "" (addrHistogramMetrics "simplex_xftp" tsEpoch) addressHistograms
    info =
      "# Info\n\
      \# ----\n\
@@ -108,8 +108,8 @@ supportedFileServerVRange :: VersionRangeXFTP
 supportedFileServerVRange = mkVersionRange initialXFTPVersion currentXFTPVersion

 -- XFTP protocol does not use this handshake method
-xftpClientHandshakeStub :: c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
-xftpClientHandshakeStub _c _ks _keyHash _xftpVRange _proxyServer _serviceKeys = throwE TEVersion
+xftpClientHandshakeStub :: c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeXFTP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> ExceptT TransportError IO (THandle XFTPVersion c 'TClient)
+xftpClientHandshakeStub _c _ks _keyHash _xftpVRange _proxyServer _serviceKeys _mkEntitlementProof = throwE TEVersion

 alpnSupportedXFTPhandshakes :: [ALPN]
 alpnSupportedXFTPhandshakes = [xftpALPNv1]
@@ -3112,8 +3112,8 @@ setProtocolServers c userId srvs = do
  checkUserServers "setProtocolServers" srvs
  atomically $ TM.insert userId (mkUserServers srvs) (userServers c)

-- | Change the entitlement credential presented to XFTP servers for the user.
-- The credential is presented in the handshake, so the user's XFTP clients are closed to present the new one.
+-- | Change the entitlement credential presented to the servers of the user.
+-- The credential is presented in the handshake, so the user's clients are closed to present the new one.
 setUserEntitlement :: AgentClient -> UserId -> Maybe EntitlementCredential -> IO ()
 setUserEntitlement c userId cred_ = do
  changed <- atomically $ do
@@ -3121,7 +3121,7 @@ setUserEntitlement c userId cred_ = do
    if prev_ == cred_
      then pure False
      else True <$ maybe (TM.delete userId) (TM.insert userId) cred_ (userEntitlements c)
-  when changed $ closeUserXFTPClients c userId
+  when changed $ closeUserClients c userId

 checkUserServers :: Text -> NonEmpty (ServerCfg p) -> IO ()
 checkUserServers name srvs =
@@ -41,7 +41,7 @@ module Simplex.Messaging.Agent.Client
    reconnectServerClients,
    reconnectSMPServer,
    closeXFTPServerClient,
-    closeUserXFTPClients,
+    closeUserClients,
    runSMPServerTest,
    runXFTPServerTest,
    runNTFServerTest,
@@ -760,9 +760,10 @@ smpConnectClient c@AgentClient {smpClients, msgQ, proxySessTs, presetDomains} nm
    connectClient :: SMPClientVar -> AM SMPConnectedClient
    connectClient v' = do
      cfg <- lift $ getClientConfig c smpCfg
+      keys <- asks $ entitlementKeys . config
      g <- asks random
      service <- getServiceCredentials c userId srv
-      let cfg' = cfg {serviceCredentials = fst <$> service}
+      let cfg' = cfg {serviceCredentials = fst <$> service, mkEntitlementProof = userEntitlementProof c keys userId $ knownUserServer (smpServers c) userId srv}
      env <- ask
      smp <- liftError (protocolClientError SMP $ B.unpack $ strEncode srv) $ do
        ts <- readTVarIO proxySessTs
@@ -863,7 +864,7 @@ notifySub c = notifySub' c ""
 {-# INLINE notifySub #-}

 getNtfServerClient :: AgentClient -> NetworkRequestMode -> NtfTransportSession -> AM NtfClient
-getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, presetDomains} nm tSess@(_, srv, _) = do
+getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, presetDomains} nm tSess@(userId, srv, _) = do
  unlessM (readTVarIO active) $ throwE INACTIVE
  ts <- liftIO getCurrentTime
  withGetSessVar workerSeq tSess ntfClients ts (newProtocolClient c tSess ntfClients connectClient) (waitForProtocolClient c nm tSess ntfClients)
@@ -871,10 +872,12 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, pr
    connectClient :: NtfClientVar -> AM NtfClient
    connectClient v = do
      cfg <- lift $ getClientConfig c ntfCfg
+      keys <- asks $ entitlementKeys . config
      g <- asks random
      ts <- readTVarIO proxySessTs
+      let cfg' = cfg {mkEntitlementProof = userEntitlementProof c keys userId $ knownNtfServer c srv}
      liftError' (protocolClientError NTF $ B.unpack $ strEncode srv) $
-        getProtocolClient g nm tSess cfg presetDomains Nothing ts $
+        getProtocolClient g nm tSess cfg' presetDomains Nothing ts $
          clientDisconnected v

    clientDisconnected :: NtfClientVar -> NtfClient -> IO ()
@@ -884,7 +887,7 @@ getNtfServerClient c@AgentClient {active, ntfClients, workerSeq, proxySessTs, pr
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv

 getXFTPServerClient :: AgentClient -> XFTPTransportSession -> AM XFTPClient
-getXFTPServerClient c@AgentClient {active, xftpClients, userEntitlements, workerSeq, proxySessTs, presetDomains} tSess@(userId, srv, _) = do
+getXFTPServerClient c@AgentClient {active, xftpClients, workerSeq, proxySessTs, presetDomains} tSess@(userId, srv, _) = do
  unlessM (readTVarIO active) $ throwE INACTIVE
  ts <- liftIO getCurrentTime
  withGetSessVar workerSeq tSess xftpClients ts (newProtocolClient c tSess xftpClients connectClient) (waitForProtocolClient c NRMBackground tSess xftpClients)
@@ -896,30 +899,38 @@ getXFTPServerClient c@AgentClient {active, xftpClients, userEntitlements, worker
      xftpNetworkConfig <- getNetworkConfig c
      ts <- readTVarIO proxySessTs
      liftError' (protocolClientError XFTP $ B.unpack $ strEncode srv) $
-        X.getXFTPClient tSess cfg {xftpNetworkConfig} presetDomains ts (mkEntitlementProof keys) $
+        X.getXFTPClient tSess cfg {xftpNetworkConfig} presetDomains ts (userEntitlementProof c keys userId $ knownUserServer (xftpServers c) userId srv) $
          clientDisconnected v

-    mkEntitlementProof :: Map Word16 BBSPublicKey -> SessionId -> IO (Maybe EntitlementProof)
-    mkEntitlementProof keys sessId =
-      ifM knownServer proof (pure Nothing)
-      where
-        -- the entitlement is presented only to the servers of this user, matched by key hash that TLS pins,
-        -- so a file description of the sender cannot direct it to another server
-        knownServer = maybe False (any (sameKeyHash . snd) . storageSrvs) <$> TM.lookupIO userId (xftpServers c)
-        sameKeyHash (ProtoServerWithAuth srv' _) = srvKeyHash srv' == srvKeyHash srv
-        srvKeyHash (ProtocolServer _ _ _ kh) = kh
-        proof =
-          TM.lookupIO userId userEntitlements $>>= \cred ->
-            generateEntitlementProof keys cred (BBSPresHeader sessId) >>= \case
-              Right p -> pure $ Just p
-              Left e -> Nothing <$ logError ("entitlement proof error: " <> tshow e)
-
    clientDisconnected :: XFTPClientVar -> XFTPClient -> IO ()
    clientDisconnected v client = do
      atomically $ removeSessVar v tSess xftpClients
      atomically $ writeTBQueue (subQ c) ("", "", AEvt SAENone $ hostEvent DISCONNECT client)
      logInfo . decodeUtf8 $ "Agent disconnected from " <> showServer srv

+userEntitlementProof :: AgentClient -> Map Word16 BBSPublicKey -> UserId -> IO Bool -> SessionId -> IO (Maybe EntitlementProof)
+userEntitlementProof AgentClient {userEntitlements} keys userId knownServer sessId =
+  ifM knownServer proof (pure Nothing)
+  where
+    proof =
+      TM.lookupIO userId userEntitlements $>>= \cred ->
+        generateEntitlementProof keys cred (BBSPresHeader sessId) >>= \case
+          Right p -> pure $ Just p
+          Left e -> Nothing <$ logError ("entitlement proof error: " <> tshow e)
+
+-- the entitlement is presented only to the servers of this user, matched by key hash that TLS pins,
+-- so a server address received from another party cannot direct it to another server
+knownUserServer :: TMap UserId (UserServers p) -> UserId -> ProtocolServer p -> IO Bool
+knownUserServer servers userId srv = maybe False (any sameSrvKeyHash . storageSrvs) <$> TM.lookupIO userId servers
+  where
+    sameSrvKeyHash (_, ProtoServerWithAuth srv' _) = sameKeyHash srv srv'
+
+knownNtfServer :: AgentClient -> NtfServer -> IO Bool
+knownNtfServer c srv = any (sameKeyHash srv) <$> readTVarIO (ntfServers c)
+
+sameKeyHash :: ProtocolServer p -> ProtocolServer p -> Bool
+sameKeyHash ProtocolServer {keyHash} ProtocolServer {keyHash = kh} = keyHash == kh
+
 waitForProtocolClient ::
  (ProtocolTypeI (ProtoType msg), ProtocolServerClient v err msg) =>
  AgentClient ->
@@ -1059,9 +1070,15 @@ reconnectSMPServer c userId srv = do
      | userId == userId' && srv == srv' = (v :)
      | otherwise = id

-closeUserXFTPClients :: AgentClient -> UserId -> IO ()
-closeUserXFTPClients c userId = do
-  vs <- atomically $ stateTVar (xftpClients c) $ \cs ->
+closeUserClients :: AgentClient -> UserId -> IO ()
+closeUserClients c userId = do
+  closeUserSessions c userId smpClients
+  closeUserSessions c userId ntfClients
+  closeUserSessions c userId xftpClients
+
+closeUserSessions :: ProtocolServerClient v err msg => AgentClient -> UserId -> (AgentClient -> TMap (TransportSession msg) (ClientVar msg)) -> IO ()
+closeUserSessions c userId clientsSel = do
+  vs <- atomically $ stateTVar (clientsSel c) $ \cs ->
    let (userCs, cs') = M.partitionWithKey (\(userId', _, _) _ -> userId == userId') cs
     in (M.elems userCs, cs')
  mapM_ (forkIO . closeClient_ c) vs
@@ -160,6 +160,7 @@ import Network.Socket (HostName, ServiceName)
 import Network.Socks5 (SocksCredentials (..))
 import Numeric.Natural
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
@@ -482,7 +483,9 @@ data ProtocolClientConfig v = ProtocolClientConfig
    -- | Whether connecting client is a proxy server. See comment in ClientHandshake
    proxyServer :: Bool,
    -- | send SNI to server, False for SMP
-    useSNI :: Bool
+    useSNI :: Bool,
+    -- | proof of the user entitlement to send in the handshake, bound to the session
+    mkEntitlementProof :: SessionId -> IO (Maybe EntitlementProof)
  }

 -- | Default protocol client configuration.
@@ -497,7 +500,8 @@ defaultClientConfig clientALPN useSNI serverVRange =
      serverVRange,
      agreeSecret = False,
      proxyServer = False,
-      useSNI
+      useSNI,
+      mkEntitlementProof = \_ -> pure Nothing
    }
 {-# INLINE defaultClientConfig #-}

@@ -568,7 +572,7 @@ type SMPTransportSession = TransportSession BrokerMsg
 -- A single queue can be used for multiple 'SMPClient' instances,
 -- as 'SMPServerTransmission' includes server information.
 getProtocolClient :: forall v err msg. Protocol v err msg => TVar ChaChaDRG -> NetworkRequestMode -> TransportSession msg -> ProtocolClientConfig v -> [HostName] -> Maybe (TBQueue (ServerTransmissionBatch v err msg)) -> UTCTime -> (ProtocolClient v err msg -> IO ()) -> IO (Either (ProtocolClientError err) (ProtocolClient v err msg))
-getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serviceCredentials, serverVRange, agreeSecret, proxyServer, useSNI} presetDomains msgQ proxySessTs disconnected = do
+getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qSize, networkConfig, clientALPN, serviceCredentials, serverVRange, agreeSecret, proxyServer, useSNI, mkEntitlementProof} presetDomains msgQ proxySessTs disconnected = do
  case chooseTransportHost networkConfig (host srv) of
    Right useHost ->
      (getCurrentTime >>= mkProtocolClient useHost >>= runClient useTransport useHost)
@@ -635,7 +639,7 @@ getProtocolClient g nm transportSession@(_, srv, _) cfg@ProtocolClientConfig {qS
    client _ c cVar h = do
      ks <- if agreeSecret then Just <$> atomically (C.generateKeyPair g) else pure Nothing
      serviceKeys_ <- mapM (\creds -> (creds,) <$> atomically (C.generateKeyPair g)) serviceCredentials
-      runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange proxyServer serviceKeys_) >>= \case
+      runExceptT (protocolClientHandshake @v @err @msg h ks (keyHash srv) serverVRange proxyServer serviceKeys_ mkEntitlementProof) >>= \case
        Left e -> atomically . putTMVar cVar . Left $ PCETransportError e
        Right th@THandle {params} -> do
          sessionTs <- getCurrentTime
@@ -72,6 +72,7 @@ import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol (EntityId (..), ErrorType (..), NotifierId, Party (..), ProtocolServer (host), SMPServer, ServiceSub (..), SignedTransmission, Transmission, pattern NoEntity, pattern SMPServer, encodeTransmission, tGetServer, tPut)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server
+import Simplex.Messaging.Server.AddressStats (AddrStats, ServerAddrStats (..), addressStatsThread, incAddrCounter, printTopAddresses, withAddrStats)
 import Simplex.Messaging.Server.Control (CPClientRole (..))
 import Simplex.Messaging.Server.Env.STM (StartOptions (..))
 import Simplex.Messaging.Server.Stats (PeriodStats (..), PeriodStatCounts (..), periodStatCounts, periodStatDataCounts, updatePeriodStats)
@@ -80,7 +81,7 @@ import Simplex.Messaging.SystemTime
 import Simplex.Messaging.TMap (TMap)
 import Simplex.Messaging.Transport (ASrvTransport, ATransport (..), THandle (..), THandleAuth (..), THandleParams (..), TProxy, Transport (..), TransportPeer (..), defaultSupportedParams)
 import Simplex.Messaging.Transport.Buffer (trimCR)
-import Simplex.Messaging.Transport.Server (AddHTTP, runTransportServer, runLocalTCPServer)
+import Simplex.Messaging.Transport.Server (AddHTTP, TLSServerCredential (..), newSocketState, runLocalTCPServer, runTransportServerState_)
 import Simplex.Messaging.Util
 import System.Environment (lookupEnv)
 import System.Exit (exitFailure, exitSuccess)
@@ -122,6 +123,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
        : map runServer transports
          <> serverStatsThread_ cfg
          <> prometheusMetricsThread_ cfg
+          <> addressStatsThread_ cfg
          <> controlPortThread_ cfg
    )
    `finally` stopServer
@@ -131,16 +133,20 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
      srvCreds <- asks tlsServerCreds
      serverSignKey <- either fail pure $ C.x509ToPrivate' $ snd srvCreds
      env <- ask
-      liftIO $ runTransportServer started tcpPort defaultSupportedParams srvCreds tCfg $ \h -> runClient serverSignKey t h `runReaderT` env
+      ss <- liftIO newSocketState
+      liftIO $ runTransportServerState_ ss started tcpPort defaultSupportedParams TLSServerCredential {credential = srvCreds, sniCredential = Nothing} tCfg $ \sock (_, h) ->
+        runClient serverSignKey t sock h `runReaderT` env

-    runClient :: Transport c => C.APrivateSignKey -> TProxy c 'TServer -> c 'TServer -> M ()
-    runClient signKey _ h = do
-      kh <- asks serverIdentity
-      ks <- atomically . C.generateKeyPair =<< asks random
-      NtfServerConfig {ntfServerVRange} <- asks config
-      liftIO (runExceptT $ ntfServerHandshake signKey h ks kh ntfServerVRange) >>= \case
-        Right th -> runNtfClientTransport th
-        Left _ -> pure ()
+    runClient :: Transport c => C.APrivateSignKey -> TProxy c 'TServer -> Socket -> c 'TServer -> M ()
+    runClient signKey _ sock h = do
+      stats_ <- asks addrStats
+      withAddrStats (addrStatsMap <$> stats_) sock $ \addrStats_ -> do
+        kh <- asks serverIdentity
+        ks <- atomically . C.generateKeyPair =<< asks random
+        NtfServerConfig {ntfServerVRange} <- asks config
+        liftIO (runExceptT $ ntfServerHandshake signKey h ks kh ntfServerVRange) >>= \case
+          Right th -> runNtfClientTransport addrStats_ th
+          Left _ -> pure ()

    stopServer :: M ()
    stopServer = do
@@ -231,6 +237,10 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
      [savePrometheusMetrics interval prometheusMetricsFile]
    prometheusMetricsThread_ _ = []

+    addressStatsThread_ :: NtfServerConfig -> [M ()]
+    addressStatsThread_ NtfServerConfig {addressStats = Just statsCfg} = [asks addrStats >>= mapM_ (liftIO . addressStatsThread statsCfg)]
+    addressStatsThread_ _ = []
+
    savePrometheusMetrics :: Int -> FilePath -> M ()
    savePrometheusMetrics saveInterval metricsFile = do
      labelMyThread "savePrometheusMetrics"
@@ -256,7 +266,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
      pure NtfServerMetrics {statsData = d, activeTokensCounts = psTkns, activeSubsCounts = psSubs, tokenCount, approxSubCount, lastNtfCount, rtsOptions}

    getNtfRealTimeMetrics :: NtfEnv -> IO NtfRealTimeMetrics
-    getNtfRealTimeMetrics NtfEnv {subscriber, pushServer} = do
+    getNtfRealTimeMetrics NtfEnv {subscriber, pushServer, addrStats} = do
 #if MIN_VERSION_base(4,18,0)
      threadsCount <- length <$> listThreads
 #else
@@ -274,6 +284,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
      ntfPendingQueueSubs <- getSMPSubMetrics a pendingQueueSubs
      smpSessionCount <- M.size <$> readTVarIO smpSessions
      apnsPushQLength <- pushWorkersQLength pushWorkers
+      addressHistograms <- mapM (readIORef . addrHistograms) addrStats
      pure
        NtfRealTimeMetrics
          { threadsCount,
@@ -285,7 +296,8 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
            ntfPendingServiceSubs,
            ntfPendingQueueSubs,
            smpSessionCount,
-            apnsPushQLength
+            apnsPushQLength,
+            addressHistograms
          }
      where
        getSMPServiceSubMetrics :: forall sub. SMPClientAgent 'NotifierService -> (SMPClientAgent 'NotifierService -> TMap SMPServer (TVar (Maybe sub))) -> (sub -> Int64) -> IO NtfSMPSubMetrics
@@ -441,7 +453,10 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
                      T.hPutStrLn h $ name <> " own servers count: " <> tshow (length ownServers)
                      when (r == CPRAdmin) $ T.hPutStrLn h $ name <> " own servers: " <> T.intercalate "," ownServers
                      T.hPutStrLn h $ name <> " other servers count: " <> tshow otherServers
-              CPHelp -> hPutStrLn h "commands: stats, stats-rts, server-info, help, quit"
+              CPAddresses name n_ -> withUserRole $ do
+                stats_ <- unliftIO u $ asks addrStats
+                printTopAddresses h (addrStatsMap <$> stats_) name n_
+              CPHelp -> hPutStrLn h "commands: stats, stats-rts, server-info, addresses, help, quit"
              CPQuit -> pure ()
              CPSkip -> pure ()
              where
@@ -756,11 +771,11 @@ periodicNtfsThread s = do
    cnt <- withPeriodicNtfTokens st now $ \tkn -> unlift $ pushNotification s Nothing False tkn PNCheckMessages
    logNote $ "Scheduled periodic notifications: " <> tshow cnt

-runNtfClientTransport :: Transport c => THandleNTF c 'TServer -> M ()
-runNtfClientTransport th@THandle {params} = do
+runNtfClientTransport :: Transport c => Maybe (AddrStats NtfAddrCounter) -> THandleNTF c 'TServer -> M ()
+runNtfClientTransport addrStats_ th@THandle {params} = do
  qSize <- asks $ clientQSize . config
  ts <- liftIO getSystemTime
-  c <- liftIO $ newNtfServerClient qSize params ts
+  c <- liftIO $ newNtfServerClient qSize params ts addrStats_
  s <- asks subscriber
  ps <- asks pushServer
  expCfg <- asks $ inactiveClientExpiration . config
@@ -775,7 +790,7 @@ clientDisconnected :: NtfServerClient -> IO ()
 clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connected False

 receive :: Transport c => NtfPostgresStore -> THandleNTF c 'TServer -> NtfServerClient -> IO ()
-receive st th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
+receive st th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, sndQ, rcvActiveAt, ntfClientAddrStats} = forever $ do
  ts <- L.toList <$> tGetServer th
  atomically . (writeTVar rcvActiveAt $!) =<< getSystemTime
  (errs, cmds) <- partitionEithers <$> mapM cmdAction ts
@@ -784,17 +799,21 @@ receive st th@THandle {params = THandleParams {thAuth}} NtfServerClient {rcvQ, s
  where
    cmdAction = \case
      Left (corrId, entId, e) -> do
+        incAddrStats NACErrors
        logError $ "invalid client request: " <> tshow e
        pure $ Left (corrId, entId, NRErr e)
-      Right t@(_, _, (corrId, entId, _)) ->
+      Right t@(_, _, (corrId, entId, cmd)) -> do
+        incAddrStats $ ntfCmdCounter cmd
        verified =<< verifyNtfTransmission st thAuth t
        where
          verified = \case
            VRVerified req -> pure $ Right req
            VRFailed e -> do
+              incAddrStats NACErrors
              logError "unauthorized client request"
              pure $ Left (corrId, entId, NRErr e)
    write q = mapM_ (atomically . writeTBQueue q) . L.nonEmpty
+    incAddrStats c = forM_ ntfClientAddrStats (`incAddrCounter` c)

 send :: Transport c => THandleNTF c 'TServer -> NtfServerClient -> IO ()
 send h@THandle {params} NtfServerClient {sndQ, sndActiveAt} = forever $ do
@@ -7,14 +7,17 @@ module Simplex.Messaging.Notifications.Server.Control
 where

 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Text (Text)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth)
+import Simplex.Messaging.Server.AddressStats (addressesArgs, addressesArgsP)

 data ControlProtocol
  = CPAuth BasicAuth
  | CPStats
  | CPStatsRTS
  | CPServerInfo
+  | CPAddresses Text (Maybe Int)
  | CPHelp
  | CPQuit
  | CPSkip
@@ -25,6 +28,7 @@ instance StrEncoding ControlProtocol where
    CPStats -> "stats"
    CPStatsRTS -> "stats-rts"
    CPServerInfo -> "server-info"
+    CPAddresses name n_ -> "addresses " <> addressesArgs name n_
    CPHelp -> "help"
    CPQuit -> "quit"
    CPSkip -> ""
@@ -34,6 +38,7 @@ instance StrEncoding ControlProtocol where
      "stats" -> pure CPStats
      "stats-rts" -> pure CPStatsRTS
      "server-info" -> pure CPServerInfo
+      "addresses" -> uncurry CPAddresses <$> addressesArgsP
      "help" -> pure CPHelp
      "quit" -> pure CPQuit
      "" -> pure CPSkip
@@ -19,6 +19,8 @@ module Simplex.Messaging.Notifications.Server.Env
    PushWorkerVar,
    NtfRequest (..),
    NtfServerClient (..),
+    NtfAddrCounter (..),
+    ntfCmdCounter,
    defaultInactiveClientExpiration,
    newNtfServerEnv,
    newNtfSubscriber,
@@ -55,6 +57,7 @@ import Simplex.Messaging.Notifications.Server.Store.Postgres
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Transport (NTFVersion, VersionRangeNTF)
 import Simplex.Messaging.Protocol (BasicAuth, CorrId, Party (..), SMPServer, SParty (..), ServiceId, Transmission)
+import Simplex.Messaging.Server.AddressStats (AddrCounter (..), AddrStats, AddressStatsConfig, ServerAddrStats, newServerAddrStats)
 import Simplex.Messaging.Server.Env.STM (StartOptions (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
@@ -97,6 +100,7 @@ data NtfServerConfig = NtfServerConfig
    -- | interval and file to save prometheus metrics
    prometheusInterval :: Maybe Int,
    prometheusMetricsFile :: FilePath,
+    addressStats :: Maybe AddressStatsConfig,
    ntfServerVRange :: VersionRangeNTF,
    transportConfig :: TransportServerConfig,
    startOptions :: StartOptions
@@ -117,11 +121,56 @@ data NtfEnv = NtfEnv
    random :: TVar ChaChaDRG,
    tlsServerCreds :: TLS.Credential,
    serverIdentity :: C.KeyHash,
-    serverStats :: NtfServerStats
+    serverStats :: NtfServerStats,
+    addrStats :: Maybe (ServerAddrStats NtfAddrCounter)
  }

+data NtfAddrCounter
+  = NACConnections
+  | NACErrors
+  | NACTNew
+  | NACTVfy
+  | NACTChk
+  | NACTRpl
+  | NACTDel
+  | NACTCrn
+  | NACSNew
+  | NACSChk
+  | NACSDel
+  | NACPing
+  deriving (Eq, Ord, Enum, Bounded, Show)
+
+instance AddrCounter NtfAddrCounter where
+  counterName = \case
+    NACConnections -> "connections"
+    NACErrors -> "errors"
+    NACTNew -> "TNEW"
+    NACTVfy -> "TVFY"
+    NACTChk -> "TCHK"
+    NACTRpl -> "TRPL"
+    NACTDel -> "TDEL"
+    NACTCrn -> "TCRN"
+    NACSNew -> "SNEW"
+    NACSChk -> "SCHK"
+    NACSDel -> "SDEL"
+    NACPing -> "PING"
+  connectionsCounter = NACConnections
+
+ntfCmdCounter :: NtfCmd -> NtfAddrCounter
+ntfCmdCounter (NtfCmd _ cmd) = case cmd of
+  TNEW _ -> NACTNew
+  TVFY _ -> NACTVfy
+  TCHK -> NACTChk
+  TRPL _ -> NACTRpl
+  TDEL -> NACTDel
+  TCRN _ -> NACTCrn
+  SNEW _ -> NACSNew
+  SCHK -> NACSChk
+  SDEL -> NACSDel
+  PING -> NACPing
+
 newNtfServerEnv :: NtfServerConfig -> IO NtfEnv
-newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbStoreConfig, ntfCredentials, useServiceCreds} = do
+newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbStoreConfig, ntfCredentials, useServiceCreds, addressStats} = do
  random <- C.newRandom
  store <- newNtfDbStore dbStoreConfig
  tlsServerCreds <- loadServerCredential ntfCredentials
@@ -130,7 +179,8 @@ newNtfServerEnv config@NtfServerConfig {pushQSize, smpAgentCfg, apnsConfig, dbSt
  subscriber <- newNtfSubscriber smpAgentCfg dbService random
  pushServer <- newNtfPushServer pushQSize apnsConfig
  serverStats <- newNtfServerStats =<< getCurrentTime
-  pure NtfEnv {config, subscriber, pushServer, store, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats}
+  addrStats <- mapM (const newServerAddrStats) addressStats
+  pure NtfEnv {config, subscriber, pushServer, store, random, tlsServerCreds, serverIdentity = C.KeyHash fp, serverStats, addrStats}
  where
    mkDbService g st = DBService {getCredentials, updateServiceId}
      where
@@ -242,14 +292,15 @@ data NtfServerClient = NtfServerClient
    ntfThParams :: THandleParams NTFVersion 'TServer,
    connected :: TVar Bool,
    rcvActiveAt :: TVar SystemTime,
-    sndActiveAt :: TVar SystemTime
+    sndActiveAt :: TVar SystemTime,
+    ntfClientAddrStats :: Maybe (AddrStats NtfAddrCounter)
  }

-newNtfServerClient :: Natural -> THandleParams NTFVersion 'TServer -> SystemTime -> IO NtfServerClient
-newNtfServerClient qSize ntfThParams ts = do
+newNtfServerClient :: Natural -> THandleParams NTFVersion 'TServer -> SystemTime -> Maybe (AddrStats NtfAddrCounter) -> IO NtfServerClient
+newNtfServerClient qSize ntfThParams ts ntfClientAddrStats = do
  rcvQ <- newTBQueueIO qSize
  sndQ <- newTBQueueIO qSize
  connected <- newTVarIO True
  rcvActiveAt <- newTVarIO ts
  sndActiveAt <- newTVarIO ts
-  return NtfServerClient {rcvQ, sndQ, ntfThParams, connected, rcvActiveAt, sndActiveAt}
+  return NtfServerClient {rcvQ, sndQ, ntfThParams, connected, rcvActiveAt, sndActiveAt, ntfClientAddrStats}
@@ -141,6 +141,8 @@ ntfServerCLI cfgPath logPath =
               \disconnect = off\n"
            <> ("# ttl = " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
            <> ("# check_interval = " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
+            <> "\n"
+            <> addressStatsIniContent
    enableStoreLog' = settingIsOn "STORE_LOG" "enable"
    runServer startOptions ini = do
      setLogLevel $ logLevel startOptions
@@ -216,6 +218,7 @@ ntfServerCLI cfgPath logPath =
              serverStatsBackupFile = logStats $> combine logPath "ntf-server-stats.log",
              prometheusInterval = eitherToMaybe $ read . T.unpack <$> lookupValue "STORE_LOG" "prometheus_interval" ini,
              prometheusMetricsFile = combine logPath "ntf-server-metrics.txt",
+              addressStats = iniAddressStats ini,
              ntfServerVRange = supportedServerNTFVRange,
              transportConfig =
                mkTransportServerConfig
@@ -21,7 +21,9 @@ import Data.Time.Clock (UTCTime (..), diffUTCTime)
 import Data.Time.Clock.System (systemEpochDay)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Numeric.Natural (Natural)
+import Simplex.Messaging.Notifications.Server.Env (NtfAddrCounter)
 import Simplex.Messaging.Notifications.Server.Stats
+import Simplex.Messaging.Server.AddressStats (AddrHistogram, addrHistogramMetrics)
 import Simplex.Messaging.Server.Stats (PeriodStatCounts (..))
 import Simplex.Messaging.Transport (simplexMQVersion)
 import Simplex.Messaging.Util (tshow)
@@ -49,7 +51,8 @@ data NtfRealTimeMetrics = NtfRealTimeMetrics
    ntfPendingServiceSubs :: NtfSMPSubMetrics,
    ntfPendingQueueSubs :: NtfSMPSubMetrics,
    smpSessionCount :: Int,
-    apnsPushQLength :: Natural
+    apnsPushQLength :: Natural,
+    addressHistograms :: Maybe (M.Map NtfAddrCounter AddrHistogram)
  }

 data NtfSMPWorkerMetrics = NtfSMPWorkerMetrics {ownServers :: [Text], otherServers :: Int}
@@ -59,7 +62,7 @@ data NtfSMPSubMetrics = NtfSMPSubMetrics {ownSrvSubs :: M.Map Text Int, otherSer
 {-# FOURMOLU_DISABLE\n#-}
 ntfPrometheusMetrics :: NtfServerMetrics -> NtfRealTimeMetrics -> UTCTime -> Text
 ntfPrometheusMetrics sm rtm ts =
-  time <> tokens <> subscriptions <> notifications <> info
+  time <> tokens <> subscriptions <> notifications <> clientAddresses <> info
  where
    NtfServerMetrics {statsData, activeTokensCounts = psTkns, activeSubsCounts = psSubs, tokenCount, approxSubCount, lastNtfCount, rtsOptions} = sm
    NtfRealTimeMetrics
@@ -72,7 +75,8 @@ ntfPrometheusMetrics sm rtm ts =
        ntfPendingServiceSubs,
        ntfPendingQueueSubs,
        smpSessionCount,
-        apnsPushQLength
+        apnsPushQLength,
+        addressHistograms
      } = rtm
    NtfServerStatsData
      { _fromTime,
@@ -221,6 +225,7 @@ ntfPrometheusMetrics sm rtm ts =
      <> showNtfsByServer _ntfReceivedAuthOwn "simplex_ntf_notifications_received_auth_own" "Received notifications without token or subscription (AUTH error)" "ntfReceivedAuthOwn"
      <> showNtfsByServer _ntfDeliveredOwn "simplex_ntf_notifications_delivered_own" "Delivered notifications" "ntfDeliveredOwn"
      <> showNtfsByServer _ntfFailedOwn "simplex_ntf_notifications_failed_own" "Failed notifications" "ntfFailedOwn"
+    clientAddresses = maybe "" (addrHistogramMetrics "simplex_ntf" tsEpoch) addressHistograms
    info =
      "# Info\n\
      \# ----\n\
@@ -14,16 +14,19 @@ module Simplex.Messaging.Notifications.Transport
    THandleNTF,
    supportedClientNTFVRange,
    supportedServerNTFVRange,
+    entitlementNTFVersion,
    alpnSupportedNTFHandshakes,
    ntfServerHandshake,
    ntfClientHandshake,
  ) where

 import Control.Monad.Except
+import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except
 import Data.Word (Word16)
 import qualified Data.X509 as X
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Util (liftEitherWith)
@@ -50,11 +53,14 @@ initialNTFVersion = VersionNTF 3
 _invalidReasonNTFVersion :: VersionNTF
 _invalidReasonNTFVersion = VersionNTF 3

+entitlementNTFVersion :: VersionNTF
+entitlementNTFVersion = VersionNTF 4
+
 currentClientNTFVersion :: VersionNTF
-currentClientNTFVersion = VersionNTF 3
+currentClientNTFVersion = VersionNTF 4

 currentServerNTFVersion :: VersionNTF
-currentServerNTFVersion = VersionNTF 3
+currentServerNTFVersion = VersionNTF 4

 supportedClientNTFVRange :: VersionRangeNTF
 supportedClientNTFVRange = mkVersionRange initialNTFVersion currentClientNTFVersion
@@ -78,7 +84,9 @@ data NtfClientHandshake = NtfClientHandshake
  { -- | agreed SMP notifications server protocol version
    ntfVersion :: VersionNTF,
    -- | server identity - CA certificate fingerprint
-    keyHash :: C.KeyHash
+    keyHash :: C.KeyHash,
+    -- | proof of the user entitlement bound to the session
+    entitlementProof :: Maybe EntitlementProof
  }

 instance Encoding NtfServerHandshake where
@@ -91,11 +99,15 @@ instance Encoding NtfServerHandshake where
    pure NtfServerHandshake {ntfVersionRange, sessionId, authPubKey}

 instance Encoding NtfClientHandshake where
-  smpEncode NtfClientHandshake {ntfVersion, keyHash} =
-    smpEncode (ntfVersion, keyHash)
+  smpEncode NtfClientHandshake {ntfVersion = v, keyHash, entitlementProof} =
+    smpEncode (v, keyHash) <> ifHasEntitlement v (smpEncode entitlementProof) ""
  smpP = do
-    (ntfVersion, keyHash) <- smpP
-    pure NtfClientHandshake {ntfVersion, keyHash}
+    (v, keyHash) <- smpP
+    entitlementProof <- ifHasEntitlement v smpP (pure Nothing)
+    pure NtfClientHandshake {ntfVersion = v, keyHash, entitlementProof}
+
+ifHasEntitlement :: VersionNTF -> a -> a -> a
+ifHasEntitlement v a b = if v >= entitlementNTFVersion then a else b

 -- | Notifcations server transport handshake.
 ntfServerHandshake :: forall c. Transport c => C.APrivateSignKey -> c 'TServer -> C.KeyPairX25519 -> C.KeyHash -> VersionRangeNTF -> ExceptT TransportError IO (THandleNTF c 'TServer)
@@ -113,8 +125,8 @@ ntfServerHandshake serverSignKey c (k, pk) kh ntfVersionRange = do
            Nothing -> throwE TEVersion

 -- | Notifcations server client transport handshake.
-ntfClientHandshake :: forall c. Transport c => c 'TClient -> C.KeyHash -> VersionRangeNTF -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandleNTF c 'TClient)
-ntfClientHandshake c keyHash ntfVRange _proxyServer _serviceKeys = do
+ntfClientHandshake :: forall c. Transport c => c 'TClient -> C.KeyHash -> VersionRangeNTF -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> ExceptT TransportError IO (THandleNTF c 'TClient)
+ntfClientHandshake c keyHash ntfVRange _proxyServer _serviceKeys mkEntitlementProof = do
  let th@THandle {params = THandleParams {sessionId}} = ntfTHandle c
  NtfServerHandshake {sessionId = sessId, ntfVersionRange, authPubKey} <- getHandshake th
  if sessionId /= sessId
@@ -126,7 +138,8 @@ ntfClientHandshake c keyHash ntfVRange _proxyServer _serviceKeys = do
          pubKey <- C.verifyX509 serverKey authPubKey
          (,CertChainPubKey (getPeerCertChain c) authPubKey) <$> C.x509ToPublic' pubKey
        let v = maxVersion vr
-        sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash}
+        ep <- if v >= entitlementNTFVersion then liftIO (mkEntitlementProof sessionId) else pure Nothing
+        sendHandshake th $ NtfClientHandshake {ntfVersion = v, keyHash, entitlementProof = ep}
        pure $ ntfThHandleClient th v vr ck
      Nothing -> throwE TEVersion

@@ -269,6 +269,7 @@ import Network.Socket (ServiceName)
 import qualified Network.TLS as TLS
 import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Names.Record
@@ -1777,7 +1778,7 @@ transmissionP THandleParams {sessionId, implySessId, serviceAuth} = do
 class (ProtocolTypeI (ProtoType msg), ProtocolEncoding v err msg, ProtocolEncoding v err (ProtoCommand msg), Show err, Show msg) => Protocol v err msg | msg -> v, msg -> err where
  type ProtoCommand msg = cmd | cmd -> msg
  type ProtoType msg = (sch :: ProtocolType) | sch -> msg
-  protocolClientHandshake :: Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandle v c 'TClient)
+  protocolClientHandshake :: Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRange v -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> ExceptT TransportError IO (THandle v c 'TClient)
  useServiceAuth :: ProtoCommand msg -> Bool
  protocolPing :: ProtoCommand msg
  protocolError :: msg -> Maybe err
@@ -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 (ProtocolClient (thParams), ProtocolClientError (..), SMPClient, SMPClientError, clientHandlers, forwardSMPTransmission, smpProxyError, temporaryClientError)
+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.Server.AddressStats (AddrStats, ServerAddrStats (..), addAddrCounter, addressStatsThread, incAddrCounter, printTopAddresses, withAddrStats)
 import Simplex.Messaging.Server.Control
 import Simplex.Messaging.Server.Env.STM as Env
 import Simplex.Messaging.Server.Expiration
@@ -124,6 +125,7 @@ import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Buffer (trimCR)
+import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Util
 import Simplex.Messaging.Version
@@ -199,6 +201,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
            <> expireMessagesThread_ cfg
            <> serverStatsThread_ cfg
            <> prometheusMetricsThread_ cfg
+            <> addressStatsThread_ cfg
            <> controlPortThread_ cfg
    )
    `finally` stopServer s
@@ -216,11 +219,12 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
          runTransportServerState_ ss started tcpPort defaultSupportedParamsHTTPS combinedCreds tCfg $ \s (sniUsed, h) ->
            case cast h of
              Just (TLS {tlsContext} :: TLS 'TServer) | sniUsed -> labelMyThread "https client" >> attachHTTP s tlsContext
-              _ -> runClient srvCert srvSignKey t h `runReaderT` env
+              _ -> runClient srvCert srvSignKey t s h `runReaderT` env
          where
            combinedCreds = TLSServerCredential {credential = smpCreds, sniCredential = Just httpCreds}
        _ ->
-          runTransportServerState ss started tcpPort defaultSupportedParams smpCreds tCfg $ \h -> runClient srvCert srvSignKey t h `runReaderT` env
+          runTransportServerState_ ss started tcpPort defaultSupportedParams TLSServerCredential {credential = smpCreds, sniCredential = Nothing} tCfg $ \s (_, h) ->
+            runClient srvCert srvSignKey t s h `runReaderT` env

    sigIntHandlerThread :: M s ()
    sigIntHandlerThread = do
@@ -515,6 +519,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
      [logServerStats logStatsStartTime interval serverStatsLogFile]
    serverStatsThread_ _ = []

+    addressStatsThread_ :: ServerConfig s -> [M s ()]
+    addressStatsThread_ ServerConfig {addressStats = Just statsCfg} = [asks addrStats >>= mapM_ (liftIO . addressStatsThread statsCfg)]
+    addressStatsThread_ _ = []
+
    logServerStats :: Int64 -> Int64 -> FilePath -> M s ()
    logServerStats startAt logInterval statsFilePath = do
      labelMyThread "logServerStats"
@@ -699,7 +707,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
      pure ServerMetrics {statsData = d, activeQueueCounts = ps, activeNtfCounts = psNtf, entityCounts, rtsOptions}

    getRealTimeMetrics :: Env s -> IO RealTimeMetrics
-    getRealTimeMetrics Env {sockets, msgStore_ = ms, server = srv@Server {subscribers, ntfSubscribers}} = do
+    getRealTimeMetrics Env {sockets, msgStore_ = ms, server = srv@Server {subscribers, ntfSubscribers}, addrStats} = do
      socketStats <- mapM (traverse getSocketStats) =<< readTVarIO sockets
 #if MIN_VERSION_base(4,18,0)
      threadsCount <- length <$> listThreads
@@ -711,7 +719,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
      smpSubs <- getSubscribersMetrics subscribers
      ntfSubs <- getSubscribersMetrics ntfSubscribers
      loadedCounts <- loadedQueueCounts $ fromMsgStore ms
-      pure RealTimeMetrics {socketStats, threadsCount, clientsCount, deliveredSubs, deliveredTimes, smpSubs, ntfSubs, loadedCounts}
+      addressHistograms <- mapM (readIORef . addrHistograms) addrStats
+      pure RealTimeMetrics {socketStats, threadsCount, clientsCount, deliveredSubs, deliveredTimes, smpSubs, ntfSubs, loadedCounts, addressHistograms}
      where
        getSubscribersMetrics ServerSubscribers {queueSubscribers, serviceSubscribers, totalServiceSubs, subClients} = do
          subsCount <- M.size <$> getSubscribedClients queueSubscribers
@@ -732,19 +741,21 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
                Nothing -> acc
                Just (_, ts) -> (cnt + 1, updateTimeBuckets ts ts' times)

-    runClient :: Transport c => X.CertificateChain -> C.APrivateSignKey -> TProxy c 'TServer -> c 'TServer -> M s ()
-    runClient srvCert srvSignKey tp h = do
-      ms <- asks msgStore
-      g <- asks random
-      idSize <- asks $ queueIdBytes . config
-      kh <- asks serverIdentity
-      ks <- atomically . C.generateKeyPair =<< asks random
-      ServerConfig {smpServerVRange, smpHandshakeTimeout, information} <- asks config
-      let serverInfo = LB.toStrict . J.encode <$> information
-      labelMyThread $ "smp handshake for " <> transportName tp
-      liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake srvCert srvSignKey h ks kh smpServerVRange serverInfo $ getClientService ms g idSize) >>= \case
-        Just (Right th) -> runClientTransport th
-        _ -> pure ()
+    runClient :: Transport c => X.CertificateChain -> C.APrivateSignKey -> TProxy c 'TServer -> Socket -> c 'TServer -> M s ()
+    runClient srvCert srvSignKey tp sock h = do
+      stats_ <- asks addrStats
+      withAddrStats (addrStatsMap <$> stats_) sock $ \addrStats_ -> do
+        ms <- asks msgStore
+        g <- asks random
+        idSize <- asks $ queueIdBytes . config
+        kh <- asks serverIdentity
+        ks <- atomically . C.generateKeyPair =<< asks random
+        ServerConfig {smpServerVRange, smpHandshakeTimeout, information} <- asks config
+        let serverInfo = LB.toStrict . J.encode <$> information
+        labelMyThread $ "smp handshake for " <> transportName tp
+        liftIO (timeout smpHandshakeTimeout . runExceptT $ smpServerHandshake srvCert srvSignKey h ks kh smpServerVRange serverInfo $ getClientService ms g idSize) >>= \case
+          Just (Right th) -> runClientTransport addrStats_ th
+          _ -> pure ()

    getClientService :: s -> TVar ChaChaDRG -> Int -> SMPServiceRole -> X.CertificateChain -> XV.Fingerprint -> ExceptT TransportError IO ServiceId
    getClientService ms g idSize role cert fp = do
@@ -1040,7 +1051,10 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
                hPutStrLn h "saving server state..."
                unliftIO u $ saveServer False
                hPutStrLn h "server state saved!"
-              CPHelp -> hPutStrLn h "commands: stats, stats-rts, clients, sockets, socket-threads, threads, server-info, delete, save, help, quit"
+              CPAddresses name n_ -> withUserRole $ do
+                stats_ <- unliftIO u $ asks addrStats
+                printTopAddresses h (addrStatsMap <$> stats_) name n_
+              CPHelp -> hPutStrLn h "commands: stats, stats-rts, clients, sockets, socket-threads, threads, server-info, delete, addresses, save, help, quit"
              CPQuit -> pure ()
              CPSkip -> pure ()
              where
@@ -1061,13 +1075,13 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
                    logError "Unauthorized control port command"
                    hPutStrLn h "AUTH"

-runClientTransport :: forall c s. (Transport c, MsgStoreClass s) => THandleSMP c 'TServer -> M s ()
-runClientTransport h@THandle {params = thParams@THandleParams {sessionId}} = do
+runClientTransport :: forall c s. (Transport c, MsgStoreClass s) => Maybe (AddrStats SMPAddrCounter) -> THandleSMP c 'TServer -> M s ()
+runClientTransport addrStats_ h@THandle {params = thParams@THandleParams {sessionId}} = do
  q <- asks $ tbqSize . config
  ts <- liftIO getSystemTime
  nextClientId <- asks clientSeq
  clientId <- atomically $ stateTVar nextClientId $ \next -> (next, next + 1)
-  c <- liftIO $ newClient clientId q thParams ts
+  c <- liftIO $ newClient clientId q thParams ts addrStats_
  runClientThreads c `finally` clientDisconnected c
  where
    runClientThreads :: Client s -> M s ()
@@ -1144,7 +1158,7 @@ cancelSub s = case subThread s of
 type VerifiedTransmissionOrError s = Either (Transmission BrokerMsg) (VerifiedTransmission s)

 receive :: forall c s. (Transport c, MsgStoreClass s) => THandleSMP c 'TServer -> s -> Client s -> M s ()
-receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, sndQ, rcvActiveAt} = do
+receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, sndQ, rcvActiveAt, clientAddrStats} = do
  labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
  sa <- asks serverActive
  stats <- asks serverStats
@@ -1154,6 +1168,9 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ,
    atomically . (writeTVar rcvActiveAt $!) =<< getSystemTime
    let (es, ts') = partitionEithers $ L.toList ts
        errs = map (second ERR) es
+    forM_ clientAddrStats $ \s -> do
+      unless (null es) $ addAddrCounter s SACErrors $ length es
+      forM_ ts' $ \(_, _, (_, _, cmd)) -> incAddrCounter s $ smpCmdCounter cmd
    errs' <- case ts' of
      (_, _, (_, _, Cmd p cmd)) : rest -> do
        let service = peerClientService =<< thAuth
@@ -1181,7 +1198,9 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ,
    verified :: ServerStats -> SignedTransmission Cmd -> VerificationResult s -> IO (VerifiedTransmissionOrError s)
    verified stats (_, _, t@(corrId, entId, Cmd _ command)) = \case
      VRVerified q -> pure $ Right (q, t)
-      VRFailed e -> Left (corrId, entId, ERR e) <$ when (e == AUTH) incAuthStat
+      VRFailed e -> do
+        forM_ clientAddrStats (`incAddrCounter` SACErrors)
+        Left (corrId, entId, ERR e) <$ when (e == AUTH) incAuthStat
        where
          incAuthStat = case command of
            SEND {} -> incStat $ msgSentAuth stats
@@ -1376,7 +1395,7 @@ client :: forall s. MsgStoreClass s => Server s -> s -> Client s -> M s ()
 client
  Server {subscribers, ntfSubscribers}
  ms
-  clnt@Client {clientId, rcvQ, sndQ, msgQ, clientTHParams = thParams'@THandleParams {sessionId}, procThreads} = do
+  clnt@Client {clientId, rcvQ, sndQ, msgQ, clientTHParams = thParams'@THandleParams {sessionId}, procThreads, clientAddrStats} = do
    labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
    let clntServiceId = (\THClientService {serviceId} -> serviceId) <$> (peerClientService =<< thAuth thParams')
        process batchSubs t acc@(rs, msgs) =
@@ -1421,25 +1440,30 @@ client
          getRelay = do
            ProxyAgent {smpAgent = a} <- asks proxyAgent
            liftIO (getConnectedSMPServerClient a srv) >>= \case
-              Just r -> Just <$> proxyServerResponse a r
+              Just r -> Just <$> proxyServerResponse a SACPrxyConnected r
              Nothing ->
                forkProxiedCmd $
                  liftIO (runExceptT (getSMPServerClient'' a srv) `E.catches` clientHandlers)
-                    >>= proxyServerResponse a
-          proxyServerResponse :: SMPClientAgent 'Sender -> Either SMPClientError (OwnServer, SMPClient) -> M s BrokerMsg
-          proxyServerResponse a smp_ = do
+                    >>= proxyServerResponse a SACPrxyNew
+          proxyServerResponse :: SMPClientAgent 'Sender -> SMPAddrCounter -> Either SMPClientError (OwnServer, SMPClient) -> M s BrokerMsg
+          proxyServerResponse a otherCounter smp_ = do
            ServerStats {pRelays, pRelaysOwn} <- asks serverStats
            let inc = mkIncProxyStats pRelays pRelaysOwn
            case smp_ of
              Right (own, smp) -> do
                inc own pRequests
                case proxyResp smp of
-                  r@PKEY {} -> r <$ inc own pSuccesses
-                  r -> r <$ inc own pErrorsCompat
+                  r@PKEY {} -> do
+                    incAddrStats $ proxyDestCounter own smp SACPrxyOwn SACPrxyOnion otherCounter
+                    r <$ inc own pSuccesses
+                  r -> do
+                    incAddrStats SACPrxyFailed
+                    r <$ inc own pErrorsCompat
              Left e -> do
                let own = isOwnServer a srv
                inc own pRequests
                inc own $ if temporaryClientError e then pErrorsConnect else pErrorsOther
+                incAddrStats SACPrxyFailed
                logWarn $ "Error connecting: " <> decodeLatin1 (strEncode $ host srv) <> " " <> tshow e
                pure . ERR $ smpProxyError e
            where
@@ -1459,16 +1483,24 @@ client
        liftIO (lookupSMPServerClient a sessId) >>= \case
          Just (own, smp) -> do
            inc own pRequests
+            let delivered = incAddrStats (proxyDestCounter own smp SACPfwdOwn SACPfwdOnion SACPfwdOther) >> inc own pSuccesses
            forkProxiedCmd $ do
              liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `E.catches` clientHandlers)  >>= \case
-                Right r -> PRES r <$ inc own pSuccesses
+                Right r -> PRES r <$ delivered
                Left e -> ERR (smpProxyError e) <$ case e of
-                  PCEProtocolError {} -> inc own pSuccesses
-                  _ -> inc own pErrorsOther
-          Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION)
+                  PCEProtocolError {} -> delivered
+                  _ -> incAddrStats SACPfwdFailed >> inc own pErrorsOther
+          Nothing -> incAddrStats SACPfwdFailed >> 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)
+        proxyDestCounter :: OwnServer -> SMPClient -> SMPAddrCounter -> SMPAddrCounter -> SMPAddrCounter -> SMPAddrCounter
+        proxyDestCounter own smp ownCounter onionCounter otherCounter
+          | own = ownCounter
+          | THOnionHost _ <- transportHost' smp = onionCounter
+          | otherwise = otherCounter
+    incAddrStats :: SMPAddrCounter -> M s ()
+    incAddrStats c = liftIO $ forM_ clientAddrStats (`incAddrCounter` c)
    -- 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
@@ -0,0 +1,250 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+
+module Simplex.Messaging.Server.AddressStats
+  ( AddrKey (..),
+    AddrCounter (..),
+    AddrStats (..),
+    AddrStatsMap,
+    AddrHistogram (..),
+    ServerAddrStats (..),
+    AddressStatsConfig (..),
+    defaultAddressStatsPeriod,
+    countBounds,
+    kilobyteBounds,
+    addrKey,
+    addrKeyText,
+    counterByName,
+    newServerAddrStats,
+    withAddrStats,
+    openAddrStats,
+    closeAddrStats,
+    incAddrCounter,
+    addAddrCounter,
+    rolloverAddrStats,
+    addressStatsThread,
+    topAddresses,
+    printTopAddresses,
+    addressesArgsP,
+    addressesArgs,
+    addrHistogramMetrics,
+  )
+where
+
+import Control.Applicative (optional)
+import Control.Monad
+import Control.Monad.IO.Unlift
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import Data.ByteString.Char8 (ByteString)
+import Data.IORef
+import Data.Int (Int64)
+import qualified Data.IntMap.Strict as IM
+import Data.List (find, foldl', sortOn)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Maybe (fromMaybe)
+import Data.Ord (Down (..))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import qualified Data.Text.IO as T
+import Data.Word (Word32, Word64)
+import Network.Socket (SockAddr (..), Socket, getPeerName, hostAddress6ToTuple, hostAddressToTuple)
+import Numeric (showHex)
+import Simplex.Messaging.TMap (TMap)
+import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Util (atomicModifyIORef'_, bshow, labelMyThread, safeDecodeUtf8, threadDelay', tshow, whenM, (<$$>))
+import System.IO (Handle, hPutStrLn)
+import UnliftIO.Exception (finally, tryAny)
+import UnliftIO.STM
+
+data AddrKey
+  = AKIPv4 Word32
+  | AKIPv6 Word64
+  deriving (Eq, Ord, Show)
+
+class (Ord c, Enum c, Bounded c) => AddrCounter c where
+  counterName :: c -> Text
+  counterBounds :: c -> [Int]
+  counterBounds _ = countBounds
+  connectionsCounter :: c
+
+data AddrStats c = AddrStats
+  { connectionsCount :: TVar Int,
+    current :: Map c (IORef Int),
+    previous :: Map c (IORef Int)
+  }
+
+type AddrStatsMap c = TMap AddrKey (AddrStats c)
+
+data AddrHistogram = AddrHistogram
+  { bucketCounts :: [Int],
+    countSum :: Int,
+    addressCount :: Int,
+    periodMax :: Int
+  }
+  deriving (Eq, Show)
+
+data ServerAddrStats c = ServerAddrStats
+  { addrStatsMap :: AddrStatsMap c,
+    addrHistograms :: IORef (Map c AddrHistogram)
+  }
+
+newtype AddressStatsConfig = AddressStatsConfig
+  { period :: Int64
+  }
+  deriving (Show)
+
+defaultAddressStatsPeriod :: Int64
+defaultAddressStatsPeriod = 300
+
+countBounds :: [Int]
+countBounds = r10Bounds 5
+
+kilobyteBounds :: [Int]
+kilobyteBounds = r10Bounds 7
+
+r10Bounds :: Int -> [Int]
+r10Bounds decades =
+  [1 .. 9]
+    <> [(r * 10 ^ d + 50) `div` 100 | d <- [1 .. decades], r <- [100, 125, 160, 200, 250, 315, 400, 500, 630, 800]]
+    <> [10 ^ (decades + 1)]
+
+addrKey :: SockAddr -> Maybe AddrKey
+addrKey = \case
+  SockAddrInet _ a ->
+    let (b1, b2, b3, b4) = hostAddressToTuple a
+     in Just $ AKIPv4 $ foldl' (\acc b -> acc `shiftL` 8 .|. fromIntegral b) 0 [b1, b2, b3, b4]
+  SockAddrInet6 _ _ a _ -> Just $ case hostAddress6ToTuple a of
+    (0, 0, 0, 0, 0, 0xffff, w1, w2) -> AKIPv4 $ fromIntegral w1 `shiftL` 16 .|. fromIntegral w2
+    (w1, w2, w3, w4, _, _, _, _) -> AKIPv6 $ foldl' (\acc w -> acc `shiftL` 16 .|. fromIntegral w) 0 [w1, w2, w3, w4]
+  _ -> Nothing
+
+addrKeyText :: AddrKey -> Text
+addrKeyText = \case
+  AKIPv4 a -> T.intercalate "." $ map (\s -> tshow $ (a `shiftR` s) .&. 0xff) [24, 16, 8, 0]
+  AKIPv6 p -> T.intercalate ":" (map (\s -> T.pack $ showHex ((p `shiftR` s) .&. 0xffff) "") [48, 32, 16, 0]) <> "::/64"
+
+counterByName :: AddrCounter c => Text -> Maybe c
+counterByName name = find ((name ==) . counterName) [minBound .. maxBound]
+
+newServerAddrStats :: AddrCounter c => IO (ServerAddrStats c)
+newServerAddrStats = ServerAddrStats <$> TM.emptyIO <*> newIORef (M.fromList $ map (\c -> (c, emptyHistogram c)) [minBound .. maxBound])
+  where
+    emptyHistogram c = AddrHistogram {bucketCounts = map (const 0) (counterBounds c), countSum = 0, addressCount = 0, periodMax = 0}
+
+newAddrStats :: AddrCounter c => IO (AddrStats c)
+newAddrStats = AddrStats <$> newTVarIO 0 <*> newCells <*> newCells
+  where
+    newCells = M.fromList <$> mapM (\c -> (c,) <$> newIORef 0) [minBound .. maxBound]
+
+withAddrStats :: (AddrCounter c, MonadUnliftIO m) => Maybe (AddrStatsMap c) -> Socket -> (Maybe (AddrStats c) -> m a) -> m a
+withAddrStats m_ sock action = case m_ of
+  Just m ->
+    liftIO (addrKey <$$> tryAny (getPeerName sock)) >>= \case
+      Right (Just k) -> do
+        s <- liftIO $ openAddrStats m k
+        action (Just s) `finally` liftIO (closeAddrStats s)
+      _ -> action Nothing
+  Nothing -> action Nothing
+
+openAddrStats :: AddrCounter c => AddrStatsMap c -> AddrKey -> IO (AddrStats c)
+openAddrStats m k = do
+  new <- maybe newAddrStats pure =<< TM.lookupIO k m
+  s <- atomically $ TM.lookup k m >>= maybe (new <$ TM.insert k new m) pure >>= \entry -> entry <$ modifyTVar' (connectionsCount entry) (+ 1)
+  s <$ incAddrCounter s connectionsCounter
+
+closeAddrStats :: AddrStats c -> IO ()
+closeAddrStats AddrStats {connectionsCount} = atomically $ modifyTVar' connectionsCount (subtract 1)
+
+incAddrCounter :: AddrCounter c => AddrStats c -> c -> IO ()
+incAddrCounter s c = addAddrCounter s c 1
+
+addAddrCounter :: AddrCounter c => AddrStats c -> c -> Int -> IO ()
+addAddrCounter AddrStats {current} c n = forM_ (M.lookup c current) $ \cell -> atomicModifyIORef'_ cell (+ n)
+
+rolloverAddrStats :: AddrCounter c => ServerAddrStats c -> IO ()
+rolloverAddrStats ServerAddrStats {addrStatsMap, addrHistograms} = do
+  entries <- M.toList <$> readTVarIO addrStatsMap
+  closingCounts <- forM entries $ \(k, s) -> do
+    counts <- closePeriod s
+    when (all (== 0) counts) $ atomically $ deleteIdle k s
+    pure counts
+  let periodCounts = M.unionsWith (<>) $ map (M.map (: []) . M.filter (> 0)) closingCounts
+  atomicModifyIORef'_ addrHistograms $ M.mapWithKey $ \c -> addPeriodCounts (counterBounds c) (M.findWithDefault [] c periodCounts)
+  where
+    closePeriod AddrStats {current, previous} = M.traverseWithKey closeCell current
+      where
+        closeCell c cell = do
+          n <- atomicModifyIORef' cell (0,)
+          forM_ (M.lookup c previous) (`writeIORef` n)
+          pure n
+    deleteIdle k AddrStats {connectionsCount} =
+      whenM ((0 ==) <$> readTVar connectionsCount) $ TM.delete k addrStatsMap
+
+addPeriodCounts :: [Int] -> [Int] -> AddrHistogram -> AddrHistogram
+addPeriodCounts bounds ns AddrHistogram {bucketCounts, countSum, addressCount} =
+  AddrHistogram
+    { bucketCounts = zipWith (+) bucketCounts $ scanl1 (+) $ map (\i -> IM.findWithDefault 0 i boundCounts) [0 .. length bounds - 1],
+      countSum = countSum + sum ns,
+      addressCount = addressCount + length ns,
+      periodMax = maximum (0 : ns)
+    }
+  where
+    boundCounts = IM.fromListWith (+) $ map (\n -> (length $ takeWhile (< n) bounds, 1)) ns
+
+addressStatsThread :: AddrCounter c => AddressStatsConfig -> ServerAddrStats c -> IO ()
+addressStatsThread AddressStatsConfig {period} stats = do
+  labelMyThread "addressStatsThread"
+  forever $ threadDelay' (period * 1000000) >> rolloverAddrStats stats
+
+topAddresses :: AddrCounter c => AddrStatsMap c -> c -> Int -> IO [(AddrKey, Int, Int)]
+topAddresses m c n = do
+  entries <- M.toList <$> readTVarIO m
+  counts <- forM entries $ \(k, AddrStats {previous, current}) -> (k,,) <$> cellValue previous <*> cellValue current
+  pure $ take n $ sortOn (\(_, p, cur) -> Down (p + cur)) $ filter (\(_, p, cur) -> p + cur > 0) counts
+  where
+    cellValue = maybe (pure 0) readIORef . M.lookup c
+
+printTopAddresses :: AddrCounter c => Handle -> Maybe (AddrStatsMap c) -> Text -> Maybe Int -> IO ()
+printTopAddresses h m_ name n_ = case m_ of
+  Just m -> case counterByName name of
+    Just c -> do
+      rows <- topAddresses m c (fromMaybe 10 n_)
+      hPutStrLn h "address,previous,current"
+      forM_ rows $ \(k, p, cur) -> T.hPutStrLn h $ addrKeyText k <> "," <> tshow p <> "," <> tshow cur
+    Nothing -> hPutStrLn h "error: unknown counter"
+  Nothing -> hPutStrLn h "error: address statistics are off"
+
+addressesArgsP :: A.Parser (Text, Maybe Int)
+addressesArgsP = (,) <$> (A.space *> (safeDecodeUtf8 <$> A.takeTill (== ' '))) <*> optional (A.space *> A.decimal)
+
+addressesArgs :: Text -> Maybe Int -> ByteString
+addressesArgs name n_ = encodeUtf8 name <> maybe "" ((" " <>) . bshow) n_
+
+addrHistogramMetrics :: AddrCounter c => Text -> Text -> Map c AddrHistogram -> Text
+addrHistogramMetrics prefix tsEpoch histograms =
+  "# Client addresses\n\
+  \# ----------------\n\
+  \\n"
+    <> "# HELP " <> countMetric <> " Counts of client addresses per period\n"
+    <> "# TYPE " <> countMetric <> " histogram\n"
+    <> T.concat (map countLines hs)
+    <> "\n# HELP " <> maxMetric <> " Maximum count of a client address in the last period\n"
+    <> "# TYPE " <> maxMetric <> " gauge\n"
+    <> T.concat (map (\(c, AddrHistogram {periodMax}) -> sample maxMetric c [] periodMax) hs)
+    <> "\n"
+  where
+    hs = M.toList histograms
+    countMetric = prefix <> "_client_address_period_count"
+    maxMetric = prefix <> "_client_address_period_max"
+    countLines (c, AddrHistogram {bucketCounts, countSum, addressCount}) =
+      T.concat (zipWith (\b cnt -> sample (countMetric <> "_bucket") c [("le", tshow b)] cnt) (counterBounds c) bucketCounts)
+        <> sample (countMetric <> "_bucket") c [("le", "+Inf")] addressCount
+        <> sample (countMetric <> "_sum") c [] countSum
+        <> sample (countMetric <> "_count") c [] addressCount
+    sample metric c labels v =
+      metric <> "{" <> T.intercalate "," (map (\(l, lv) -> l <> "=\"" <> lv <> "\"") (("counter", counterName c) : labels)) <> "} " <> tshow v <> " " <> tsEpoch <> "\n"
@@ -44,6 +44,8 @@ module Simplex.Messaging.Server.CLI
    checkSavedFingerprint,
    iniTransports,
    iniDBOptions,
+    iniAddressStats,
+    addressStatsIniContent,
    printServerConfig,
    printServerTransports,
    printSMPServerConfig,
@@ -73,13 +75,14 @@ import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI)
+import Simplex.Messaging.Server.AddressStats (AddressStatsConfig (..), defaultAddressStatsPeriod)
 import Simplex.Messaging.Server.Env.STM (ServerStoreCfg (..), StartOptions (..), dbStoreCfg, storeLogFile')
 import Simplex.Messaging.Server.Main.GitCommit
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
 import Simplex.Messaging.Transport (ASrvTransport, ATransport (..), TLS, Transport (..), simplexMQVersion)
 import Simplex.Messaging.Transport.Server (AddHTTP, loadFileFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
-import Simplex.Messaging.Util (eitherToMaybe, whenM)
+import Simplex.Messaging.Util (eitherToMaybe, tshow, whenM)
 import System.Directory (doesDirectoryExist, listDirectory, removeDirectoryRecursive, removePathForcibly)
 import System.Environment (lookupEnv)
 import System.Exit (exitFailure)
@@ -435,6 +438,19 @@ iniDBOptions ini _default@DBOpts {connstr, schema, poolSize} =
      createSchema = False
    }

+iniAddressStats :: Ini -> Maybe AddressStatsConfig
+iniAddressStats ini =
+  AddressStatsConfig {period = readIniDefault defaultAddressStatsPeriod "ADDRESS_STATS" "period" ini}
+    <$ settingIsOn "ADDRESS_STATS" "enable" ini
+
+addressStatsIniContent :: Text
+addressStatsIniContent =
+  "[ADDRESS_STATS]\n\
+  \# Command counts per client address, shown by the control port command `addresses`\n\
+  \# and aggregated in Prometheus metrics.\n\
+  \enable = off\n"
+    <> ("period = " <> tshow defaultAddressStatsPeriod <> "\n")
+
 printServerConfig :: String -> [(ServiceName, ASrvTransport, AddHTTP)] -> Maybe FilePath -> IO ()
 printServerConfig protocol transports logFile = do
  putStrLn $ case logFile of
@@ -7,8 +7,10 @@ module Simplex.Messaging.Server.Control
  ) where

 import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Text (Text)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo, SenderId)
+import Simplex.Messaging.Server.AddressStats (addressesArgs, addressesArgsP)

 data CPClientRole = CPRNone | CPRUser | CPRAdmin
  deriving (Eq, Show)
@@ -28,6 +30,7 @@ data ControlProtocol
  | CPStatus SenderId
  | CPBlock SenderId BlockingInfo
  | CPUnblock SenderId
+  | CPAddresses Text (Maybe Int)
  | CPSave
  | CPHelp
  | CPQuit
@@ -49,6 +52,7 @@ instance StrEncoding ControlProtocol where
    CPStatus sId -> "status " <> strEncode sId
    CPBlock sId info -> "block " <> strEncode sId <> " " <> strEncode info
    CPUnblock sId -> "unblock " <> strEncode sId
+    CPAddresses name n_ -> "addresses " <> addressesArgs name n_
    CPSave -> "save"
    CPHelp -> "help"
    CPQuit -> "quit"
@@ -69,6 +73,7 @@ instance StrEncoding ControlProtocol where
      "status" -> CPStatus <$> _strP
      "block" -> CPBlock <$> _strP <*> _strP
      "unblock" -> CPUnblock <$> _strP
+      "addresses" -> uncurry CPAddresses <$> addressesArgsP
      "save" -> pure CPSave
      "help" -> pure CPHelp
      "quit" -> pure CPQuit
@@ -31,6 +31,8 @@ module Simplex.Messaging.Server.Env.STM
    SubscribedClients,
    ProxyAgent (..),
    Client (..),
+    SMPAddrCounter (..),
+    smpCmdCounter,
    ClientId,
    ClientSub (..),
    Sub (..),
@@ -111,6 +113,7 @@ import Simplex.Messaging.Client.Agent (SMPClientAgent, SMPClientAgentConfig, new
 import Simplex.Messaging.Crypto (KeyHash (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.AddressStats (AddrCounter (..), AddrStats, AddressStatsConfig, ServerAddrStats, newServerAddrStats)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.MsgStore.Journal
@@ -183,6 +186,7 @@ data ServerConfig s = ServerConfig
    -- | interval and file to save prometheus metrics
    prometheusInterval :: Maybe Int,
    prometheusMetricsFile :: FilePath,
+    addressStats :: Maybe AddressStatsConfig,
    -- | notification delivery interval
    ntfDeliveryInterval :: Int,
    -- | interval between sending pending END events to unsubscribed clients, seconds
@@ -285,7 +289,8 @@ data Env s = Env
    sockets :: TVar [(ServiceName, SocketState)],
    clientSeq :: TVar ClientId,
    proxyAgent :: ProxyAgent, -- senders served on this proxy
-    namesEnv :: Maybe NamesEnv -- public-namespace resolver, present when [NAMES] enable: on
+    namesEnv :: Maybe NamesEnv, -- public-namespace resolver, present when [NAMES] enable: on
+    addrStats :: Maybe (ServerAddrStats SMPAddrCounter)
  }

 msgStore :: Env s -> s
@@ -465,9 +470,117 @@ data Client s = Client
    connected :: TVar Bool,
    createdAt :: SystemTime,
    rcvActiveAt :: TVar SystemTime,
-    sndActiveAt :: TVar SystemTime
+    sndActiveAt :: TVar SystemTime,
+    clientAddrStats :: Maybe (AddrStats SMPAddrCounter)
  }

+data SMPAddrCounter
+  = SACConnections
+  | SACErrors
+  | SACNew
+  | SACSub
+  | SACSubs
+  | SACKey
+  | SACRKey
+  | SACLSet
+  | SACLDel
+  | SACNKey
+  | SACNDel
+  | SACGet
+  | SACAck
+  | SACOff
+  | SACDel
+  | SACQue
+  | SACSKey
+  | SACSend
+  | SACPing
+  | SACLKey
+  | SACLGet
+  | SACNSub
+  | SACNSubs
+  | SACPrxy
+  | SACPfwd
+  | SACRfwd
+  | SACRslv
+  | SACPrxyOwn
+  | SACPrxyConnected
+  | SACPrxyNew
+  | SACPrxyOnion
+  | SACPrxyFailed
+  | SACPfwdOwn
+  | SACPfwdOther
+  | SACPfwdOnion
+  | SACPfwdFailed
+  deriving (Eq, Ord, Enum, Bounded, Show)
+
+instance AddrCounter SMPAddrCounter where
+  counterName = \case
+    SACConnections -> "connections"
+    SACErrors -> "errors"
+    SACNew -> "NEW"
+    SACSub -> "SUB"
+    SACSubs -> "SUBS"
+    SACKey -> "KEY"
+    SACRKey -> "RKEY"
+    SACLSet -> "LSET"
+    SACLDel -> "LDEL"
+    SACNKey -> "NKEY"
+    SACNDel -> "NDEL"
+    SACGet -> "GET"
+    SACAck -> "ACK"
+    SACOff -> "OFF"
+    SACDel -> "DEL"
+    SACQue -> "QUE"
+    SACSKey -> "SKEY"
+    SACSend -> "SEND"
+    SACPing -> "PING"
+    SACLKey -> "LKEY"
+    SACLGet -> "LGET"
+    SACNSub -> "NSUB"
+    SACNSubs -> "NSUBS"
+    SACPrxy -> "PRXY"
+    SACPfwd -> "PFWD"
+    SACRfwd -> "RFWD"
+    SACRslv -> "RSLV"
+    SACPrxyOwn -> "PRXY_own"
+    SACPrxyConnected -> "PRXY_connected"
+    SACPrxyNew -> "PRXY_new"
+    SACPrxyOnion -> "PRXY_onion"
+    SACPrxyFailed -> "PRXY_failed"
+    SACPfwdOwn -> "PFWD_own"
+    SACPfwdOther -> "PFWD_other"
+    SACPfwdOnion -> "PFWD_onion"
+    SACPfwdFailed -> "PFWD_failed"
+  connectionsCounter = SACConnections
+
+smpCmdCounter :: Cmd -> SMPAddrCounter
+smpCmdCounter (Cmd _ cmd) = case cmd of
+  NEW _ -> SACNew
+  SUB -> SACSub
+  SUBS {} -> SACSubs
+  KEY _ -> SACKey
+  RKEY _ -> SACRKey
+  LSET {} -> SACLSet
+  LDEL -> SACLDel
+  NKEY {} -> SACNKey
+  NDEL -> SACNDel
+  GET -> SACGet
+  ACK _ -> SACAck
+  OFF -> SACOff
+  DEL -> SACDel
+  QUE -> SACQue
+  SKEY _ -> SACSKey
+  SEND {} -> SACSend
+  PING -> SACPing
+  LKEY _ -> SACLKey
+  LGET -> SACLGet
+  NSUB -> SACNSub
+  NSUBS {} -> SACNSubs
+  PRXY {} -> SACPrxy
+  PFWD {} -> SACPfwd
+  RFWD _ -> SACRfwd
+  RSLV _ -> SACRslv
+
 type VerifiedTransmission s = (Maybe (StoreQueue s, QueueRec), Transmission Cmd)

 type ResponseAndMessage = (Transmission BrokerMsg, Maybe (Transmission BrokerMsg))
@@ -520,8 +633,8 @@ newServerSubscribers = do
  pendingEvents <- newTVarIO IM.empty
  pure ServerSubscribers {subQ, queueSubscribers, serviceSubscribers, totalServiceSubs, subClients, pendingEvents}

-newClient :: ClientId -> Natural -> THandleParams SMPVersion 'TServer -> SystemTime -> IO (Client s)
-newClient clientId qSize clientTHParams createdAt = do
+newClient :: ClientId -> Natural -> THandleParams SMPVersion 'TServer -> SystemTime -> Maybe (AddrStats SMPAddrCounter) -> IO (Client s)
+newClient clientId qSize clientTHParams createdAt clientAddrStats = do
  subscriptions <- TM.emptyIO
  ntfSubscriptions <- TM.emptyIO
  serviceSubscribed <- newTVarIO False
@@ -556,7 +669,8 @@ newClient clientId qSize clientTHParams createdAt = do
        connected,
        createdAt,
        rcvActiveAt,
-        sndActiveAt
+        sndActiveAt,
+        clientAddrStats
      }

 newSubscription :: SubscriptionThread -> STM Sub
@@ -571,7 +685,7 @@ newProhibitedSub = do
  return Sub {subThread = ProhibitSub, delivered}

 newEnv :: ServerConfig s -> IO (Env s)
-newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig} = do
+newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig, addressStats} = do
  serverActive <- newTVarIO True
  server <- newServer
  msgStore_ <- case serverStoreCfg of
@@ -626,6 +740,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
      Right _ -> logInfo "[NAMES] endpoint probe ok"
      Left e -> logWarn $ "[NAMES] endpoint probe failed (server will still start, RSLV will return ERR (NAME ...) until reachable): " <> tshow e
    pure env
+  addrStats <- mapM (const newServerAddrStats) addressStats
  pure
    Env
      { serverActive,
@@ -642,7 +757,8 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
        sockets,
        clientSeq,
        proxyAgent,
-        namesEnv
+        namesEnv,
+        addrStats
      }
  where
    loadStoreLog :: StoreQueueClass q => (RecipientId -> QueueRec -> IO q) -> FilePath -> STMQueueStore q -> IO ()
@@ -578,6 +578,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
              serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
              prometheusInterval = eitherToMaybe (lookupValue "STORE_LOG" "prometheus_interval" ini) >>= readMaybe . T.unpack,
              prometheusMetricsFile = combine logPath "smp-server-metrics.txt",
+              addressStats = iniAddressStats ini,
              pendingENDInterval = 15000000, -- 15 seconds
              ntfDeliveryInterval = 1500000, -- 1.5 second
              smpServerVRange = supportedServerSMPRelayVRange,
@@ -25,7 +25,7 @@ import Network.Socket (HostName)
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (BasicAuth)
-import Simplex.Messaging.Server.CLI (SignAlgorithm, onOff)
+import Simplex.Messaging.Server.CLI (SignAlgorithm, addressStatsIniContent, onOff)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
 import Simplex.Messaging.Server.Information (Entity (..), ServerPublicInfo (..))
@@ -176,7 +176,9 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
        \disconnect = on\n"
    <> ("ttl = " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
    <> ("check_interval = " <> tshow (checkInterval defaultInactiveClientExpiration))
-    <> "\n\n\
+    <> "\n\n"
+    <> addressStatsIniContent
+    <> "\n\
        \[WEB]\n\
        \# Set path to generate static mini-site for server information and qr codes/links\n"
    <> ("static_path = " <> T.pack (fromMaybe defaultStaticPath webStaticPath) <> "\n\n")
@@ -14,12 +14,15 @@ module Simplex.Messaging.Server.Prometheus
 import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import Data.List (mapAccumL)
+import Data.Map.Strict (Map)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffUTCTime)
 import Data.Time.Clock.System (systemEpochDay)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import Network.Socket (ServiceName)
+import Simplex.Messaging.Server.AddressStats (AddrHistogram, addrHistogramMetrics)
+import Simplex.Messaging.Server.Env.STM (SMPAddrCounter)
 import Simplex.Messaging.Server.MsgStore.Types (LoadedQueueCounts (..))
 import Simplex.Messaging.Server.QueueStore.Types (EntityCounts (..))
 import Simplex.Messaging.Server.Stats
@@ -46,7 +49,8 @@ data RealTimeMetrics = RealTimeMetrics
    deliveredTimes :: TimeBuckets,
    smpSubs :: RTSubscriberMetrics,
    ntfSubs :: RTSubscriberMetrics,
-    loadedCounts :: LoadedQueueCounts
+    loadedCounts :: LoadedQueueCounts,
+    addressHistograms :: Maybe (Map SMPAddrCounter AddrHistogram)
  }

 data RTSubscriberMetrics = RTSubscriberMetrics
@@ -59,7 +63,7 @@ data RTSubscriberMetrics = RTSubscriberMetrics
 {-# FOURMOLU_DISABLE\n#-}
 prometheusMetrics :: ServerMetrics -> RealTimeMetrics -> UTCTime -> Text
 prometheusMetrics sm rtm ts =
-  time <> queues <> subscriptions <> messages <> ntfMessages <> ntfs <> relays <> services <> names <> info
+  time <> queues <> subscriptions <> messages <> ntfMessages <> ntfs <> relays <> services <> names <> clientAddresses <> info
  where
    ServerMetrics {statsData, activeQueueCounts = ps, activeNtfCounts = psNtf, entityCounts, rtsOptions} = sm
    RealTimeMetrics
@@ -70,7 +74,8 @@ prometheusMetrics sm rtm ts =
        deliveredTimes,
        smpSubs,
        ntfSubs,
-        loadedCounts
+        loadedCounts,
+        addressHistograms
      } = rtm
    ServerStatsData
      { _fromTime,
@@ -485,6 +490,7 @@ prometheusMetrics sm rtm ts =
          \# TYPE simplex_smp_names_disabled counter\n\
          \simplex_smp_names_disabled " <> mshow _rslvDisabled <> "\n# rslvDisabled\n\
          \\n"
+    clientAddresses = maybe "" (addrHistogramMetrics "simplex_smp" $ tsEpoch ts) addressHistograms
    info =
      "# Info\n\
      \# ----\n\
@@ -54,6 +54,7 @@ module Simplex.Messaging.Transport
    namesSMPVersion,
    serverInfoSMPVersion,
    nameAvailSMPVersion,
+    entitlementSMPVersion,
    simplexMQVersion,
    smpBlockSize,
    TransportConfig (..),
@@ -136,6 +137,7 @@ import qualified Network.TLS as T
 import qualified Network.TLS.Extra as TE
 import qualified Paths_simplexmq as SMQ
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, parseRead1, sumTypeJSON)
@@ -177,6 +179,7 @@ smpBlockSize = 16384
 -- 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)
+-- 23 - entitlement proof in client handshake (9/11/2026)

 data SMPVersion

@@ -218,6 +221,9 @@ serverInfoSMPVersion = VersionSMP 21
 nameAvailSMPVersion :: VersionSMP
 nameAvailSMPVersion = VersionSMP 22

+entitlementSMPVersion :: VersionSMP
+entitlementSMPVersion = VersionSMP 23
+
 minClientSMPRelayVersion :: VersionSMP
 minClientSMPRelayVersion = VersionSMP 14

@@ -225,18 +231,17 @@ minServerSMPRelayVersion :: VersionSMP
 minServerSMPRelayVersion = VersionSMP 14

 currentClientSMPRelayVersion :: VersionSMP
-currentClientSMPRelayVersion = VersionSMP 22
+currentClientSMPRelayVersion = VersionSMP 23

 currentServerSMPRelayVersion :: VersionSMP
-currentServerSMPRelayVersion = VersionSMP 22
+currentServerSMPRelayVersion = VersionSMP 23

 -- 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. Set to 22, one below the current
+-- version (23): a proxied RSLV carries availability from nameAvailSMPVersion (22),
+-- and the entitlement proof of version 23 is never sent via proxy.
 proxiedSMPRelayVersion :: VersionSMP
 proxiedSMPRelayVersion = VersionSMP 22

@@ -573,7 +578,9 @@ data SMPClientHandshake = SMPClientHandshake
    -- - notification servers,
    -- - high traffic chat bots,
    -- - high traffic business support clients.
-    clientService :: Maybe SMPClientHandshakeService
+    clientService :: Maybe SMPClientHandshakeService,
+    -- | proof of the user entitlement bound to the session
+    entitlementProof :: Maybe EntitlementProof
  }

 data SMPClientHandshakeService = SMPClientHandshakeService
@@ -591,17 +598,19 @@ data ServiceCredentials = ServiceCredentials
 data SMPServiceRole = SRMessaging | SRNotifier | SRProxy deriving (Eq, Show)

 instance Encoding SMPClientHandshake where
-  smpEncode SMPClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer, clientService} =
+  smpEncode SMPClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer, clientService, entitlementProof} =
    smpEncode (v, keyHash)
      <> maybe "" smpEncode authPubKey
      <> smpEncode proxyServer
      <> ifHasService v (smpEncode clientService) ""
+      <> ifHasEntitlement v (smpEncode entitlementProof) ""
  smpP = do
    (v, keyHash) <- smpP
    authPubKey <- optional smpP
    proxyServer <- smpP
    clientService <- ifHasService v smpP (pure Nothing)
-    pure SMPClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer, clientService}
+    entitlementProof <- ifHasEntitlement v smpP (pure Nothing)
+    pure SMPClientHandshake {smpVersion = v, keyHash, authPubKey, proxyServer, clientService, entitlementProof}

 instance Encoding SMPClientHandshakeService where
  smpEncode SMPClientHandshakeService {serviceRole, serviceCertKey} =
@@ -625,6 +634,9 @@ instance Encoding SMPServiceRole where
 ifHasService :: VersionSMP -> a -> a -> a
 ifHasService v a b = if v >= serviceCertsSMPVersion then a else b

+ifHasEntitlement :: VersionSMP -> a -> a -> a
+ifHasEntitlement v a b = if v >= entitlementSMPVersion then a else b
+
 ifHasServerInfo :: VersionSMP -> a -> a -> a
 ifHasServerInfo v a b = if v >= serverInfoSMPVersion then a else b

@@ -780,8 +792,8 @@ smpServerHandshake srvCert srvSignKey c (k, pk) kh smpVersionRange serverInfoByt
 -- | Client SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-smpClientHandshake :: forall c. Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> ExceptT TransportError IO (THandleSMP c 'TClient)
-smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange proxyServer serviceKeys_ = do
+smpClientHandshake :: forall c. Transport c => c 'TClient -> Maybe C.KeyPairX25519 -> C.KeyHash -> VersionRangeSMP -> Bool -> Maybe (ServiceCredentials, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> ExceptT TransportError IO (THandleSMP c 'TClient)
+smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange proxyServer serviceKeys_ mkEntitlementProof = do
  SMPServerHandshake {sessionId = sessId, smpVersionRange, authPubKey = certKey@(CertChainPubKey chain exact), serverInfoBytes} <- getHandshake th
  when (sessionId /= sessId) $ throwE TEBadSession
  case smpVersionRange `compatibleVRange` smpVRange of
@@ -798,8 +810,8 @@ smpClientHandshake c ks_ keyHash@(C.KeyHash kh) smpVRange proxyServer serviceKey
            Just sks | v >= serviceVersion (fst sks) && certificateSent c -> Just sks
            _ -> Nothing
          clientService = mkClientService <$> serviceKeys
-          hs = SMPClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_, proxyServer, clientService}
-      sendHandshake th hs
+      ep <- if v >= entitlementSMPVersion then liftIO (mkEntitlementProof sessionId) else pure Nothing
+      sendHandshake th SMPClientHandshake {smpVersion = v, keyHash, authPubKey = fst <$> ks_, proxyServer, clientService, entitlementProof = ep}
      service <- mapM getClientService serviceKeys
      liftIO $ smpTHandleClient th v vr (snd <$> ks_) ck proxyServer service serverInfoBytes
    Nothing -> throwE TEVersion
@@ -54,7 +54,7 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, se
  started <- newEmptyTMVarIO
  reqQ <- newTBQueueIO qSize
  action <- async $
-    runHTTP2Server started http2Port bufferSize serverSupported srvCreds Nothing transportConfig Nothing (const $ pure ()) $ \_sniUsed sessionId sessionALPN r sendResponse -> do
+    runHTTP2Server started http2Port bufferSize serverSupported srvCreds Nothing transportConfig Nothing (const $ pure ()) (\_ _ handler -> handler) $ \_sniUsed sessionId sessionALPN r sendResponse -> do
      reqBody <- getHTTP2Body r bodyHeadSize
      atomically $ writeTBQueue reqQ HTTP2Request {sessionId, sessionALPN, request = r, reqBody, sendResponse}
  void . atomically $ takeTMVar started
@@ -63,13 +63,13 @@ getHTTP2Server HTTP2ServerConfig {qSize, http2Port, bufferSize, bodyHeadSize, se
 closeHTTP2Server :: HTTP2Server -> IO ()
 closeHTTP2Server = uninterruptibleCancel . action

-runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.Supported -> T.Credential -> Maybe T.Credential -> TransportServerConfig -> Maybe ExpirationConfig -> (SessionId -> IO ()) -> (SNICredentialUsed -> HTTP2ServerFunc) -> IO ()
-runHTTP2Server started port bufferSize srvSupported srvCreds httpCreds_ transportConfig expCfg_ clientFinished = runHTTP2ServerWith_ expCfg_ clientFinished bufferSize setup
+runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.Supported -> T.Credential -> Maybe T.Credential -> TransportServerConfig -> Maybe ExpirationConfig -> (SessionId -> IO ()) -> (Socket -> SessionId -> IO () -> IO ()) -> (SNICredentialUsed -> HTTP2ServerFunc) -> IO ()
+runHTTP2Server started port bufferSize srvSupported srvCreds httpCreds_ transportConfig expCfg_ clientFinished withConnection = runHTTP2ServerWith_ expCfg_ clientFinished bufferSize setup
  where
    setup handler = do
      ss <- newSocketState
      let combinedCreds = TLSServerCredential {credential = srvCreds, sniCredential = httpCreds_}
-      runTransportServerState_ ss started port srvSupported combinedCreds transportConfig $ \_ -> handler
+      runTransportServerState_ ss started port srvSupported combinedCreds transportConfig $ \sock h@(_, tls) -> withConnection sock (tlsUniq tls) (handler h)

 -- HTTP2 server can be run on both client and server TLS connections.
 runHTTP2ServerWith :: BufferSize -> ((TLS p -> IO ()) -> a) -> HTTP2ServerFunc -> a
@@ -332,6 +332,8 @@ functionalAPITests ps = do
      withSmpServer ps testServerMultipleIdentities
    it "should connect with two peers" $
      withSmpServer ps testAgentClient3
+    it "should connect with entitlement credential" $
+      withSmpServer ps testAgentEntitlement
    it "should establish connection without PQ encryption and enable it" $
      withSmpServer ps testEnablePQEncryption
  describe "Duplex connection - delivery stress test" $ do
@@ -979,6 +981,15 @@ testAgentClient3 =
    get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False
    ackMessage c aIdForC 3 Nothing

+testAgentEntitlement :: HasCallStack => IO ()
+testAgentEntitlement = do
+  (keys, credential) <- mkTestEntitlement
+  let aCfg = agentCfg {entitlementKeys = keys}
+      servers = initAgentServers {entitlements = M.fromList [(1, credential)]}
+  withAgentClientsCfgServers2 aCfg aCfg servers $ \a b -> runRight_ $ do
+    (aId, bId) <- makeConnection a b
+    exchangeGreetings a bId b aId
+
 runAgentClientContactTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId =
  runAgentClientContactTestPQ sqSecured viaProxy (alice, IKLinkPQ pqSupport) (bob, pqSupport) baseId
@@ -108,6 +108,8 @@ smpServerTest storeLog basicAuth = do
  lookupValue "TRANSPORT" "websockets" ini `shouldBe` Right "off"
  lookupValue "AUTH" "new_queues" ini `shouldBe` Right "on"
  lookupValue "INACTIVE_CLIENTS" "disconnect" ini `shouldBe` Right "on"
+  lookupValue "ADDRESS_STATS" "enable" ini `shouldBe` Right "off"
+  lookupValue "ADDRESS_STATS" "period" ini `shouldBe` Right "300"
  doesFileExist (cfgPath <> "/ca.key") `shouldReturn` True
  -- start
  r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ()))
@@ -193,7 +195,7 @@ smpServerTestStatic = do
        X.Certificate {X.certPubKey = X.PubKeyEd25519 _k} : _ca -> print _ca -- pure ()
        leaf : _ -> error $ "Unexpected leaf cert: " <> show leaf
        [] -> error "Empty chain"
-      runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange False Nothing
+      runRight_ . void $ smpClientHandshake tls Nothing caSMP supportedClientSMPRelayVRange False Nothing (\_ -> pure Nothing)
    logDebug "Combined SMP works"
  where
    getCerts :: TLS 'TClient -> [X.Certificate]
@@ -234,6 +236,8 @@ ntfServerTest storeLog = do
  lookupValue "STORE_LOG" "log_stats" ini `shouldBe` Right "off"
  lookupValue "TRANSPORT" "port" ini `shouldBe` Right "443"
  lookupValue "TRANSPORT" "websockets" ini `shouldBe` Right "off"
+  lookupValue "ADDRESS_STATS" "enable" ini `shouldBe` Right "off"
+  lookupValue "ADDRESS_STATS" "period" ini `shouldBe` Right "300"
  doesFileExist (ntfCfgPath <> "/ca.key") `shouldReturn` True
  r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` ntfServerCLI ntfCfgPath ntfLogPath) `catchAll_` pure (Just ()))
  r `shouldContain` ["SMP notifications server v" <> simplexmqVersionCommit]
@@ -252,6 +256,8 @@ xftpServerTest storeLog = do
  lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
  lookupValue "STORE_LOG" "log_stats" ini `shouldBe` Right "off"
  lookupValue "TRANSPORT" "port" ini `shouldBe` Right "443"
+  lookupValue "ADDRESS_STATS" "enable" ini `shouldBe` Right "off"
+  lookupValue "ADDRESS_STATS" "period" ini `shouldBe` Right "300"
  doesFileExist (fileCfgPath <> "/ca.key") `shouldReturn` True
  r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` xftpServerCLI fileCfgPath fileLogPath) `catchAll_` pure (Just ()))
  r `shouldContain` ["SimpleX XFTP server v" <> simplexmqVersionCommit]
@@ -0,0 +1,326 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module CoreTests.AddressStatsTests where
+
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.IORef (readIORef)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.Map.Strict as M
+import qualified Data.Set as S
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeLatin1)
+import Network.Socket (SockAddr (..), tupleToHostAddress, tupleToHostAddress6)
+import qualified Simplex.FileTransfer.Protocol as XFTP
+import Simplex.FileTransfer.Server.Env (XFTPAddrCounter (..), xftpCmdCounter)
+import Simplex.FileTransfer.Transport (supportedFileServerVRange)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.AddressStats
+import Simplex.Messaging.Server.Env.STM (SMPAddrCounter (..), smpCmdCounter)
+import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexTLD (..))
+import Simplex.Messaging.Transport (supportedClientSMPRelayVRange, supportedServerSMPRelayVRange)
+import Simplex.Messaging.Version (VersionRange (..))
+import Test.Hspec hiding (fit, it)
+import UnliftIO.STM
+import Util
+#if defined(dbServerPostgres)
+import qualified Simplex.Messaging.Notifications.Protocol as NTF
+import Simplex.Messaging.Notifications.Server.Env (NtfAddrCounter (..), ntfCmdCounter)
+import Simplex.Messaging.Notifications.Transport (supportedServerNTFVRange)
+#endif
+
+data TestCounter = TCConnections | TCSend | TCGet
+  deriving (Eq, Ord, Enum, Bounded, Show)
+
+instance AddrCounter TestCounter where
+  counterName = \case
+    TCConnections -> "connections"
+    TCSend -> "SEND"
+    TCGet -> "GET"
+  counterBounds _ = [1, 2, 5, 10]
+  connectionsCounter = TCConnections
+
+addr1, addr2, addr3, addr4 :: AddrKey
+addr1 = AKIPv4 1
+addr2 = AKIPv4 2
+addr3 = AKIPv4 3
+addr4 = AKIPv4 4
+
+addressStatsTests :: Spec
+addressStatsTests = do
+  describe "addrKey" addrKeyTests
+  describe "bounds" boundsTests
+  describe "counterByName" counterByNameTests
+  describe "openAddrStats" openAddrStatsTests
+  describe "rolloverAddrStats" rolloverTests
+  describe "topAddresses" topAddressesTests
+  describe "addrHistogramMetrics" metricsTests
+  describe "command counters" commandCounterTests
+
+addrKeyTests :: Spec
+addrKeyTests = do
+  it "should use IPv4 address" $
+    addrKeyText <$> addrKey (ipv4 (192, 168, 1, 2)) `shouldBe` Just "192.168.1.2"
+  it "should use IPv4 address of IPv4-mapped IPv6 address" $
+    addrKey (ipv6 (0, 0, 0, 0, 0, 0xffff, 0xc0a8, 0x0102)) `shouldBe` addrKey (ipv4 (192, 168, 1, 2))
+  it "should use one key for IPv6 addresses in one /64" $ do
+    addrKey (ipv6 (0x2001, 0xdb8, 1, 2, 3, 4, 5, 6)) `shouldBe` addrKey (ipv6 (0x2001, 0xdb8, 1, 2, 7, 8, 9, 10))
+    addrKeyText <$> addrKey (ipv6 (0x2001, 0xdb8, 1, 2, 3, 4, 5, 6)) `shouldBe` Just "2001:db8:1:2::/64"
+  it "should use different keys for IPv6 addresses in different /64" $
+    addrKey (ipv6 (0x2001, 0xdb8, 1, 2, 3, 4, 5, 6)) `shouldNotBe` addrKey (ipv6 (0x2001, 0xdb8, 1, 3, 3, 4, 5, 6))
+  it "should not use other address types" $
+    addrKey (SockAddrUnix "tests/tmp/socket") `shouldBe` Nothing
+  where
+    ipv4 a = SockAddrInet 443 $ tupleToHostAddress a
+    ipv6 a = SockAddrInet6 443 0 (tupleToHostAddress6 a) 0
+
+boundsTests :: Spec
+boundsTests = do
+  it "should use R10 values up to 1000000 for counts" $
+    countBounds
+      `shouldBe` [ 1, 2, 3, 4, 5, 6, 7, 8, 9,
+                   10, 13, 16, 20, 25, 32, 40, 50, 63, 80,
+                   100, 125, 160, 200, 250, 315, 400, 500, 630, 800,
+                   1000, 1250, 1600, 2000, 2500, 3150, 4000, 5000, 6300, 8000,
+                   10000, 12500, 16000, 20000, 25000, 31500, 40000, 50000, 63000, 80000,
+                   100000, 125000, 160000, 200000, 250000, 315000, 400000, 500000, 630000, 800000,
+                   1000000
+                 ]
+  it "should use R10 values up to 100000000 for kilobytes" $ do
+    take 60 kilobyteBounds `shouldBe` countBounds
+    drop 59 kilobyteBounds
+      `shouldBe` [ 1000000, 1250000, 1600000, 2000000, 2500000, 3150000, 4000000, 5000000, 6300000, 8000000,
+                   10000000, 12500000, 16000000, 20000000, 25000000, 31500000, 40000000, 50000000, 63000000, 80000000,
+                   100000000
+                 ]
+
+counterByNameTests :: Spec
+counterByNameTests = do
+  it "should find SMP counters" $ testCounterNames [minBound .. maxBound :: SMPAddrCounter]
+  it "should find XFTP counters" $ testCounterNames [minBound .. maxBound :: XFTPAddrCounter]
+#if defined(dbServerPostgres)
+  it "should find NTF counters" $ testCounterNames [minBound .. maxBound :: NtfAddrCounter]
+#endif
+  it "should not find unknown counter" $
+    counterByName "unknown" `shouldBe` (Nothing :: Maybe SMPAddrCounter)
+  where
+    testCounterNames :: (AddrCounter c, Show c) => [c] -> Expectation
+    testCounterNames cs = map (counterByName . counterName) cs `shouldBe` map Just cs
+
+openAddrStatsTests :: Spec
+openAddrStatsTests =
+  it "should count connections of one address in one entry" $ do
+    ServerAddrStats {addrStatsMap = m} <- newServerAddrStats
+    s <- openAddrStats m addr1
+    s' <- openAddrStats m addr1
+    readTVarIO (connectionsCount s) `shouldReturn` 2
+    counts s TCConnections `shouldReturn` (0, 2)
+    closeAddrStats s'
+    readTVarIO (connectionsCount s) `shouldReturn` 1
+
+rolloverTests :: Spec
+rolloverTests = do
+  it "should add non-zero closing counts to histograms" $ do
+    stats@ServerAddrStats {addrStatsMap = m, addrHistograms} <- newServerAddrStats
+    s1 <- openAddrStats m addr1
+    s2 <- openAddrStats m addr2
+    addAddrCounter s1 TCSend 3
+    addAddrCounter s2 TCSend 7
+    rolloverAddrStats stats
+    readIORef addrHistograms
+      `shouldReturn` M.fromList
+        [ (TCConnections, AddrHistogram [2, 2, 2, 2] 2 2 1),
+          (TCSend, AddrHistogram [0, 0, 1, 2] 10 2 7),
+          (TCGet, AddrHistogram [0, 0, 0, 0] 0 0 0)
+        ]
+    addAddrCounter s1 TCSend 20
+    rolloverAddrStats stats
+    readIORef addrHistograms
+      `shouldReturn` M.fromList
+        [ (TCConnections, AddrHistogram [2, 2, 2, 2] 2 2 0),
+          (TCSend, AddrHistogram [0, 0, 1, 2] 30 3 20),
+          (TCGet, AddrHistogram [0, 0, 0, 0] 0 0 0)
+        ]
+  it "should set previous counts to closing counts" $ do
+    stats@ServerAddrStats {addrStatsMap = m} <- newServerAddrStats
+    s <- openAddrStats m addr1
+    addAddrCounter s TCSend 3
+    counts s TCSend `shouldReturn` (0, 3)
+    rolloverAddrStats stats
+    counts s TCSend `shouldReturn` (3, 0)
+    addAddrCounter s TCSend 5
+    rolloverAddrStats stats
+    counts s TCSend `shouldReturn` (5, 0)
+    rolloverAddrStats stats
+    counts s TCSend `shouldReturn` (0, 0)
+  it "should keep entries with open connections or closing counts, and delete other entries" $ do
+    stats@ServerAddrStats {addrStatsMap = m} <- newServerAddrStats
+    _ <- openAddrStats m addr1
+    s2 <- openAddrStats m addr2
+    s3 <- openAddrStats m addr3
+    closeAddrStats s3
+    rolloverAddrStats stats
+    M.keys <$> readTVarIO m `shouldReturn` [addr1, addr2, addr3]
+    addAddrCounter s2 TCSend 1
+    closeAddrStats s2
+    rolloverAddrStats stats
+    M.keys <$> readTVarIO m `shouldReturn` [addr1, addr2]
+    rolloverAddrStats stats
+    M.keys <$> readTVarIO m `shouldReturn` [addr1]
+
+topAddressesTests :: Spec
+topAddressesTests =
+  it "should return addresses with non-zero counts, sorted by the sum of previous and current counts" $ do
+    stats@ServerAddrStats {addrStatsMap = m} <- newServerAddrStats
+    [s1, s2, s3, _] <- mapM (openAddrStats m) [addr1, addr2, addr3, addr4]
+    addAddrCounter s1 TCSend 3
+    addAddrCounter s2 TCSend 7
+    rolloverAddrStats stats
+    addAddrCounter s1 TCSend 5
+    addAddrCounter s3 TCSend 10
+    topAddresses m TCSend 10 `shouldReturn` [(addr3, 0, 10), (addr1, 3, 5), (addr2, 7, 0)]
+    topAddresses m TCSend 2 `shouldReturn` [(addr3, 0, 10), (addr1, 3, 5)]
+
+metricsTests :: Spec
+metricsTests =
+  it "should encode histograms and maximums as Prometheus metrics" $
+    addrHistogramMetrics "simplex_test" "1767225600000" histograms
+      `shouldBe` T.unlines
+        [ "# Client addresses",
+          "# ----------------",
+          "",
+          "# HELP simplex_test_client_address_period_count Counts of client addresses per period",
+          "# TYPE simplex_test_client_address_period_count histogram",
+          "simplex_test_client_address_period_count_bucket{counter=\"SEND\",le=\"1\"} 0 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"SEND\",le=\"2\"} 0 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"SEND\",le=\"5\"} 1 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"SEND\",le=\"10\"} 2 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"SEND\",le=\"+Inf\"} 2 1767225600000",
+          "simplex_test_client_address_period_count_sum{counter=\"SEND\"} 10 1767225600000",
+          "simplex_test_client_address_period_count_count{counter=\"SEND\"} 2 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"GET\",le=\"1\"} 0 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"GET\",le=\"2\"} 0 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"GET\",le=\"5\"} 0 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"GET\",le=\"10\"} 0 1767225600000",
+          "simplex_test_client_address_period_count_bucket{counter=\"GET\",le=\"+Inf\"} 1 1767225600000",
+          "simplex_test_client_address_period_count_sum{counter=\"GET\"} 12 1767225600000",
+          "simplex_test_client_address_period_count_count{counter=\"GET\"} 1 1767225600000",
+          "",
+          "# HELP simplex_test_client_address_period_max Maximum count of a client address in the last period",
+          "# TYPE simplex_test_client_address_period_max gauge",
+          "simplex_test_client_address_period_max{counter=\"SEND\"} 7 1767225600000",
+          "simplex_test_client_address_period_max{counter=\"GET\"} 12 1767225600000",
+          ""
+        ]
+  where
+    histograms =
+      M.fromList
+        [ (TCSend, AddrHistogram [0, 0, 1, 2] 10 2 7),
+          (TCGet, AddrHistogram [0, 0, 0, 0] 12 1 12)
+        ]
+
+commandCounterTests :: Spec
+commandCounterTests = do
+  it "should count each SMP command in the counter named by its tag" $ do
+    cmds <- smpCommands
+    map (counterName . smpCmdCounter) cmds `shouldBe` map (commandTag . encodeProtocol (maxVersion supportedServerSMPRelayVRange)) cmds
+    S.fromList (map smpCmdCounter cmds) `shouldBe` S.fromList [SACNew .. SACRslv]
+  it "should count each XFTP command in the counter named by its tag" $ do
+    cmds <- xftpCommands
+    map (counterName . xftpCmdCounter) cmds `shouldBe` map (commandTag . encodeProtocol (maxVersion supportedFileServerVRange)) cmds
+    S.fromList (map xftpCmdCounter cmds) `shouldBe` S.fromList [XACFNew .. XACPing]
+#if defined(dbServerPostgres)
+  it "should count each NTF command in the counter named by its tag" $ do
+    cmds <- ntfCommands
+    map (counterName . ntfCmdCounter) cmds `shouldBe` map (commandTag . encodeProtocol (maxVersion supportedServerNTFVRange)) cmds
+    S.fromList (map ntfCmdCounter cmds) `shouldBe` S.fromList [NACTNew .. NACPing]
+#endif
+  where
+    commandTag :: ByteString -> Text
+    commandTag = decodeLatin1 . B.takeWhile (/= ' ')
+
+counts :: AddrStats TestCounter -> TestCounter -> IO (Int, Int)
+counts AddrStats {previous, current} c = (,) <$> readIORef (previous M.! c) <*> readIORef (current M.! c)
+
+testKeys :: IO (C.APublicAuthKey, C.APrivateAuthKey, C.PublicKeyX25519)
+testKeys = do
+  g <- C.newRandom
+  (authKey, authPrivKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+  (dhKey, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+  pure (authKey, authPrivKey, dhKey)
+
+testSMPServer :: SMPServer
+testSMPServer = SMPServer "localhost" "5001" (C.KeyHash "hash")
+
+smpCommands :: IO [Cmd]
+smpCommands = do
+  (authKey, _, dhKey) <- testKeys
+  let newQueue = NewQueueReq {rcvAuthKey = authKey, rcvDhKey = dhKey, auth_ = Nothing, subMode = SMSubscribe, queueReqData = Nothing, ntfCreds = Nothing}
+      linkData = (EncDataBytes "fixed", EncDataBytes "user")
+      name = NQDomain SimplexDomain {nameTLD = TLDSimplex, domain = "alice", subDomain = []}
+  pure
+    [ Cmd SCreator $ NEW newQueue,
+      Cmd SRecipient SUB,
+      Cmd SRecipientService $ SUBS 1 mempty,
+      Cmd SRecipient $ KEY authKey,
+      Cmd SRecipient $ RKEY (authKey :| []),
+      Cmd SRecipient $ LSET (EntityId "link") linkData,
+      Cmd SRecipient LDEL,
+      Cmd SRecipient $ NKEY authKey dhKey,
+      Cmd SRecipient NDEL,
+      Cmd SRecipient GET,
+      Cmd SRecipient $ ACK "message",
+      Cmd SRecipient OFF,
+      Cmd SRecipient DEL,
+      Cmd SRecipient QUE,
+      Cmd SSender $ SKEY authKey,
+      Cmd SSender $ SEND noMsgFlags "hello",
+      Cmd SIdleClient PING,
+      Cmd SSenderLink $ LKEY authKey,
+      Cmd SSenderLink LGET,
+      Cmd SNotifier NSUB,
+      Cmd SNotifierService $ NSUBS 1 mempty,
+      Cmd SProxiedClient $ PRXY testSMPServer Nothing,
+      Cmd SProxiedClient $ PFWD (maxVersion supportedClientSMPRelayVRange) dhKey (EncTransmission "transmission"),
+      Cmd SProxyService $ RFWD (EncFwdTransmission "transmission"),
+      Cmd SResolver $ RSLV name
+    ]
+
+xftpCommands :: IO [XFTP.FileCmd]
+xftpCommands = do
+  (authKey, _, dhKey) <- testKeys
+  pure
+    [ XFTP.FileCmd XFTP.SFSender $ XFTP.FNEW (XFTP.FileInfo authKey 65536 "digest") (authKey :| []) Nothing Nothing,
+      XFTP.FileCmd XFTP.SFSender $ XFTP.FADD (authKey :| []),
+      XFTP.FileCmd XFTP.SFSender XFTP.FPUT,
+      XFTP.FileCmd XFTP.SFSender XFTP.FDEL,
+      XFTP.FileCmd XFTP.SFRecipient $ XFTP.FGET dhKey,
+      XFTP.FileCmd XFTP.SFRecipient XFTP.FACK,
+      XFTP.FileCmd XFTP.SFRecipient XFTP.PING
+    ]
+
+#if defined(dbServerPostgres)
+ntfCommands :: IO [NTF.NtfCmd]
+ntfCommands = do
+  (authKey, authPrivKey, dhKey) <- testKeys
+  let token = NTF.DeviceToken NTF.PPApnsTest "token"
+      queue = NTF.SMPQueueNtf testSMPServer (EntityId "notifier")
+  pure
+    [ NTF.NtfCmd NTF.SToken $ NTF.TNEW $ NTF.NewNtfTkn token authKey dhKey,
+      NTF.NtfCmd NTF.SToken $ NTF.TVFY $ NTF.NtfRegCode "code",
+      NTF.NtfCmd NTF.SToken NTF.TCHK,
+      NTF.NtfCmd NTF.SToken $ NTF.TRPL token,
+      NTF.NtfCmd NTF.SToken NTF.TDEL,
+      NTF.NtfCmd NTF.SToken $ NTF.TCRN 20,
+      NTF.NtfCmd NTF.SSubscription $ NTF.SNEW $ NTF.NewNtfSub (EntityId "token") queue authPrivKey,
+      NTF.NtfCmd NTF.SSubscription NTF.SCHK,
+      NTF.NtfCmd NTF.SSubscription NTF.SDEL,
+      NTF.NtfCmd NTF.SSubscription NTF.PING
+    ]
+#endif
@@ -40,6 +40,7 @@ import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost, defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
@@ -48,6 +49,7 @@ import Simplex.Messaging.Notifications.Server.Push.APNS
 import Simplex.Messaging.Notifications.Server.Push.APNS.Internal
 import Simplex.Messaging.Notifications.Transport
 import Simplex.Messaging.Protocol
+import Simplex.Messaging.Server.AddressStats (AddressStatsConfig (..))
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport
@@ -117,10 +119,13 @@ ntfTestDBCfg2 :: PostgresStoreCfg
 ntfTestDBCfg2 = ntfTestDBCfg {dbOpts = ntfTestStoreDBOpts2, dbStoreLogPath = Just ntfTestStoreLogFile2}

 testNtfClient :: Transport c => (THandleNTF c 'TClient -> IO a) -> IO a
-testNtfClient client = do
+testNtfClient = testNtfClientProof (\_ -> pure Nothing)
+
+testNtfClientProof :: Transport c => (SessionId -> IO (Maybe EntitlementProof)) -> (THandleNTF c 'TClient -> IO a) -> IO a
+testNtfClientProof mkEntitlementProof client = do
  Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost
  runTransportClient defaultTransportClientConfig Nothing host ntfTestPort (Just testKeyHash) $ \h ->
-    runExceptT (ntfClientHandshake h testKeyHash supportedClientNTFVRange False Nothing) >>= \case
+    runExceptT (ntfClientHandshake h testKeyHash supportedClientNTFVRange False Nothing mkEntitlementProof) >>= \case
      Right th -> client th
      Left e -> error $ show e

@@ -155,6 +160,7 @@ ntfServerCfg =
      serverStatsBackupFile = Nothing,
      prometheusInterval = Nothing,
      prometheusMetricsFile = ntfTestPrometheusMetricsFile,
+      addressStats = Just AddressStatsConfig {period = 1},
      ntfServerVRange = supportedServerNTFVRange,
      transportConfig = mkTransportServerConfig True (Just alpnSupportedNTFHandshakes) False,
      startOptions = defaultStartOptions
@@ -39,9 +39,10 @@ import qualified Simplex.Messaging.Agent.Protocol as AP
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Notifications.Protocol
+import qualified Simplex.Messaging.Notifications.Protocol as NP
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
 import Simplex.Messaging.Notifications.Server.Push.APNS
-import Simplex.Messaging.Notifications.Transport (THandleNTF)
+import Simplex.Messaging.Notifications.Transport (THandleNTF, entitlementNTFVersion)
 import Simplex.Messaging.Parsers (parse, parseAll)
 import Simplex.Messaging.Protocol hiding (notification)
 import Simplex.Messaging.Server.Env.STM (AStoreType)
@@ -55,6 +56,8 @@ ntfServerTests ps@(t, _) = do
  describe "Notifications server protocol syntax" $ ntfSyntaxTests t
  describe "Push provider policy" $ do
    it "rejects APNS test provider unless enabled" $ testApnsTestProviderRejected t
+  describe "Entitlement proof" $ do
+    it "responds in the session with entitlement proof" $ testNtfEntitlementProof t
  describe "Notification subscriptions (NKEY)" $ testNotificationSubscription ps createNtfQueueNKEY
  describe "Notification subscriptions (NEW with ntf creds)" $ testNotificationSubscription ps createNtfQueueNEW
  describe "Retried notification subscription" $ testRetriedNtfSubscription ps
@@ -88,6 +91,16 @@ testApnsTestProviderRejected (ATransport (t :: TProxy c 'TServer)) = do
        signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
      pure ()

+testNtfEntitlementProof :: ASrvTransport -> Expectation
+testNtfEntitlementProof (ATransport (t :: TProxy c 'TServer)) = do
+  mkProof <- mkTestEntitlementProof
+  withNtfServer (ATransport t) $
+    testNtfClientProof mkProof $ \(nh :: THandleNTF c 'TClient) -> do
+      let THandle {params = THandleParams {thVersion}} = nh
+      thVersion `shouldSatisfy` (>= entitlementNTFVersion)
+      RespNtf "1" NoEntity NRPong <- sendRecvNtf nh (Nothing, "1", NoEntity, NP.PING)
+      pure ()
+
 pattern RespNtf :: CorrId -> QueueId -> NtfResponse -> Transmission (Either ErrorType NtfResponse)
 pattern RespNtf corrId queueId command <- (corrId, queueId, Right command)

@@ -18,7 +18,12 @@ module SMPClient where
 import Control.Monad
 import Control.Monad.Except (runExceptT)
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Data.List.NonEmpty (NonEmpty)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Time.Clock (addUTCTime, getCurrentTime, nominalDay)
+import Data.Word (Word16)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import Network.Socket
@@ -28,19 +33,24 @@ import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Client (NetworkConfig (..), NetworkTimeout (..), ProtocolClientConfig (..), chooseTransportHost, defaultNetworkConfig)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.BBS (BBSPresHeader (..), BBSPublicKey, bbsKeyGen)
+import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementCredential, EntitlementProof, MasterKey (..), generateEntitlementProof, signEntitlement)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (runSMPServerBlocking)
+import Simplex.Messaging.Server.AddressStats (AddressStatsConfig (..))
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SMSType (..), SQSType (..))
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
 import Simplex.Messaging.Transport
+import Simplex.Messaging.Transport.Buffer (trimCR)
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.Server
 import Simplex.Messaging.Transport.Shared (ChainCertificates (..), chainIdCaCerts)
 import Simplex.Messaging.Util (ifM)
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
+import System.IO (Handle, IOMode (..), hClose, hFlush)
 import System.Info (os)
 import Test.Hspec hiding (fit, it)
 import UnliftIO.Concurrent
@@ -84,6 +94,12 @@ ntfTestPort = "6001"
 ntfTestPort2 :: ServiceName
 ntfTestPort2 = "6002"

+testControlPort :: ServiceName
+testControlPort = "5226"
+
+testControlPortUserAuth :: BasicAuth
+testControlPortUserAuth = "user_password"
+
 testKeyHash :: C.KeyHash
 testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="

@@ -163,8 +179,16 @@ testSMPServiceClient serviceCreds client = do
  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
  testSMPClient_ useHost testPort supportedClientSMPRelayVRange (Just serviceCreds) client

+testSMPClientProof :: Transport c => (SessionId -> IO (Maybe EntitlementProof)) -> (THandleSMP c 'TClient -> IO a) -> IO a
+testSMPClientProof mkEntitlementProof client = do
+  Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
+  testSMPClientProof_ useHost testPort supportedClientSMPRelayVRange Nothing mkEntitlementProof client
+
 testSMPClient_ :: Transport c => TransportHost -> ServiceName -> VersionRangeSMP -> Maybe (TLS.Credential, C.KeyPairEd25519) -> (THandleSMP c 'TClient -> IO a) -> IO a
-testSMPClient_ host port vr serviceCreds_ client = do
+testSMPClient_ host port vr serviceCreds_ = testSMPClientProof_ host port vr serviceCreds_ (\_ -> pure Nothing)
+
+testSMPClientProof_ :: Transport c => TransportHost -> ServiceName -> VersionRangeSMP -> Maybe (TLS.Credential, C.KeyPairEd25519) -> (SessionId -> IO (Maybe EntitlementProof)) -> (THandleSMP c 'TClient -> IO a) -> IO a
+testSMPClientProof_ host port vr serviceCreds_ mkEntitlementProof client = do
  serviceAndKeys_ <- forM serviceCreds_ $ \(serviceCreds@(cc, pk), keys) -> do
    Right serviceSignKey <- pure $ C.x509ToPrivate' pk
    let idCert' = case chainIdCaCerts cc of
@@ -175,12 +199,25 @@ testSMPClient_ host port vr serviceCreds_ client = do
    pure (ServiceCredentials {serviceRole = SRMessaging, serviceCreds, serviceCertHash, serviceSignKey}, keys)
  let tcConfig = defaultTransportClientConfig {clientALPN, clientCredentials = fst <$> serviceCreds_} :: TransportClientConfig
  runTransportClient tcConfig Nothing host port (Just testKeyHash) $ \h ->
-    runExceptT (smpClientHandshake h Nothing testKeyHash vr False serviceAndKeys_) >>= \case
+    runExceptT (smpClientHandshake h Nothing testKeyHash vr False serviceAndKeys_ mkEntitlementProof) >>= \case
      Right th -> client th
      Left e -> error $ show e
  where
    clientALPN = Just alpnSupportedSMPHandshakes

+mkTestEntitlement :: IO (Map Word16 BBSPublicKey, EntitlementCredential)
+mkTestEntitlement = do
+  Right (issuerKey, issuerSecret) <- bbsKeyGen
+  expiresAt <- addUTCTime (30 * nominalDay) <$> getCurrentTime
+  let entitlement = Entitlement {entitlementName = "supporter", expiresAt, extraInfo = ""}
+  Right credential <- signEntitlement issuerSecret 1 (MasterKey "0123456789abcdef0123456789abcdef") entitlement
+  pure (M.singleton 1 issuerKey, credential)
+
+mkTestEntitlementProof :: IO (SessionId -> IO (Maybe EntitlementProof))
+mkTestEntitlementProof = do
+  (keys, credential) <- mkTestEntitlement
+  pure $ \sessId -> either error Just <$> generateEntitlementProof keys credential (BBSPresHeader sessId)
+
 runSMPClient :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO a) -> IO a
 runSMPClient _ test' = testSMPClient test'

@@ -199,7 +236,7 @@ testNtfServiceClient _ keys client = do
            clientALPN = Just alpnSupportedSMPHandshakes
          }
  runTransportClient tcConfig Nothing "localhost" testPort (Just testKeyHash) $ \h ->
-    runExceptT (smpClientHandshake h Nothing testKeyHash supportedClientSMPRelayVRange False $ Just (service, keys)) >>= \case
+    runExceptT (smpClientHandshake h Nothing testKeyHash supportedClientSMPRelayVRange False (Just (service, keys)) (\_ -> pure Nothing)) >>= \case
      Right th -> client th
      Left e -> error $ show e

@@ -261,6 +298,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
      serverStatsBackupFile = Nothing,
      prometheusInterval = Nothing,
      prometheusMetricsFile = testPrometheusMetricsFile,
+      addressStats = Just AddressStatsConfig {period = 1},
      pendingENDInterval = 500000,
      ntfDeliveryInterval = 200000,
      smpCredentials =
@@ -396,6 +434,22 @@ withStallingServerOn port action =
    (pure ())
    (const action)

+withControlPort :: (Handle -> IO a) -> IO a
+withControlPort action = do
+  addr : _ <- getAddrInfo (Just defaultHints {addrSocketType = Stream}) (Just "127.0.0.1") (Just testControlPort)
+  E.bracket (connectHandle addr) hClose $ \h -> replicateM_ 2 (B.hGetLine h) >> action h
+  where
+    connectHandle addr = do
+      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+      connect sock $ addrAddress addr
+      socketToHandle sock ReadWriteMode
+
+controlPortCommand :: Handle -> ByteString -> Int -> IO [ByteString]
+controlPortCommand h cmd n = do
+  B.hPutStrLn h cmd
+  hFlush h
+  replicateM n $ trimCR <$> B.hGetLine h
+
 withSmpServerOn :: HasCallStack => (ASrvTransport, AStoreType) -> ServiceName -> IO a -> IO a
 withSmpServerOn ps port' = withSmpServerThreadOn ps port' . const

@@ -33,11 +33,13 @@ import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ)
 import qualified Simplex.Messaging.Agent.Protocol as A
 import Simplex.Messaging.Client
+import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, QueueReqData (..), RcvMessage (..), SubscriptionMode (..), maxMessageLength, noMsgFlags)
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Server.AddressStats (AddressStatsConfig (..), defaultAddressStatsPeriod)
 import Simplex.Messaging.Server.Env.STM (AStoreType (..), ServerConfig (..))
 import Simplex.Messaging.Server.MsgStore.Types (SQSType (..))
 import Simplex.Messaging.Transport
@@ -149,7 +151,29 @@ smpProxyTests = do
      xdescribe "stress test 10k" $ do
        let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [srv1]) (map bshow [1 :: Int .. nMsgs])
        it "25 agents, 300 pairs, 17 messages" . oneServer . withNumCapabilities 4 $ deliver 25 17
+  describe "client address statistics" $ do
+    it "should count proxy commands to other servers" $
+      proxyAddressStats [] [("PRXY", "2"), ("PRXY_new", "1"), ("PRXY_connected", "1"), ("PFWD", "3"), ("PFWD_other", "2"), ("PFWD_failed", "1")]
+    it "should count proxy commands to own servers" $
+      proxyAddressStats ["127.0.0.1"] [("PRXY", "2"), ("PRXY_own", "2"), ("PFWD", "3"), ("PFWD_own", "2"), ("PFWD_failed", "1")]
  where
+    proxyAddressStats :: [ByteString] -> [(ByteString, ByteString)] -> AStoreType -> IO ()
+    proxyAddressStats ownDomains counts msType =
+      twoServers_ proxyCfg' (cfgMS msType) testProxyCounts msType
+      where
+        proxyCfg' = updateCfg (proxyCfgMS msType) $ \cfg_ ->
+          cfg_
+            { addressStats = Just AddressStatsConfig {period = defaultAddressStatsPeriod},
+              controlPort = Just testControlPort,
+              controlPortUserAuth = Just testControlPortUserAuth,
+              smpAgentCfg = (smpAgentCfg cfg_) {ownServerDomains = ownDomains}
+            }
+        testProxyCounts = do
+          deliverMessageViaProxy (SMPServer testHost2 testPort testKeyHash) (SMPServer testHost2 testPort2 testKeyHash) C.SEd448 "hello 1" "hello 2"
+          withControlPort $ \h -> do
+            controlPortCommand h ("auth " <> SMP.unBasicAuth testControlPortUserAuth) 1 `shouldReturn` ["Current role is CPRUser"]
+            forM_ counts $ \(counter, n) ->
+              controlPortCommand h ("addresses " <> counter) 2 `shouldReturn` ["address,previous,current", "127.0.0.1,0," <> n]
    oneServer test msType = withSmpServerConfigOn (transport @TLS) (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) testPort $ const test
    twoServers test msType = twoServers_ (proxyCfgMS msType) (proxyCfgMS msType) test msType
    twoServersFirstProxy test msType = twoServers_ (proxyCfgMS msType) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
@@ -47,6 +47,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll, parseString)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (exportMessages)
+import Simplex.Messaging.Server.AddressStats (AddressStatsConfig (..), defaultAddressStatsPeriod)
 import Simplex.Messaging.Server.Env.STM (AStoreType (..), MsgStore (..), ServerConfig (..), ServerStoreCfg (..), readWriteQueueStore)
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..), QStoreCfg (..), stmQueueStore)
@@ -81,6 +82,7 @@ serverTests = do
    describe "NEW, OFF and DEL commands, SEND messages" testCreateDelete
    describe "Stress test" stressTest
    describe "allowNewQueues setting" testAllowNewQueues
+    describe "entitlement proof in handshake" testEntitlementProofHandshake
  describe "SMP messages" $ do
    describe "duplex communication over 2 SMP connections" testDuplex
    describe "switch subscription to another TCP connection" testSwitchSub
@@ -96,6 +98,7 @@ serverTests = do
  describe "Restore messages" testRestoreMessages
  describe "Restore messages (old / v2)" testRestoreExpireMessages
  describe "Save prometheus metrics" testPrometheusMetrics
+  describe "Client address statistics" testAddressStatsControlPort
  describe "Timing of AUTH error" testTiming
  describe "Message notifications" $ do
    testMessageNotifications
@@ -464,6 +467,19 @@ testAllowNewQueues =
        Resp "abcd" NoEntity (ERR AUTH) <- signSendRecv h rKey ("abcd", NoEntity, New rPub dhPub)
        pure ()

+testEntitlementProofHandshake :: SpecWith (ASrvTransport, AStoreType)
+testEntitlementProofHandshake =
+  it "should create queue in the session with entitlement proof" $ \(ATransport (t :: TProxy c 'TServer), msType) -> do
+    mkProof <- mkTestEntitlementProof
+    withSmpServerConfigOn (ATransport t) (cfgMS msType) testPort $ \_ ->
+      testSMPClientProof @c mkProof $ \h@THandle {params = THandleParams {thVersion}} -> do
+        thVersion `shouldSatisfy` (>= entitlementSMPVersion)
+        g <- C.newRandom
+        (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+        (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+        Resp "abcd" NoEntity (Ids _ _ _) <- signSendRecv h rKey ("abcd", NoEntity, New rPub dhPub)
+        pure ()
+
 testDuplex :: SpecWith (ASrvTransport, AStoreType)
 testDuplex =
  it "should create 2 simplex connections and exchange messages" $ \(ATransport t, msType) ->
@@ -1254,6 +1270,27 @@ testPrometheusMetrics =
    let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {prometheusInterval = Just 1}
    withSmpServerConfigOn at cfg' testPort $ \_ -> threadDelay 1000000
    doesFileExist testPrometheusMetricsFile `shouldReturn` True
+    metrics <- B.readFile testPrometheusMetricsFile
+    metrics `shouldSatisfy` ("# TYPE simplex_smp_client_address_period_count histogram" `B.isInfixOf`)
+
+testAddressStatsControlPort :: SpecWith (ASrvTransport, AStoreType)
+testAddressStatsControlPort =
+  it "should list client addresses by counter via control port" $ \(at@(ATransport (_ :: TProxy c 'TServer)), msType) -> do
+    let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {addressStats = Just AddressStatsConfig {period = defaultAddressStatsPeriod}, controlPort = Just testControlPort, controlPortUserAuth = Just testControlPortUserAuth}
+        ipv4Client = testSMPClient_ @c "127.0.0.1" testPort supportedClientSMPRelayVRange Nothing
+    withSmpServerConfigOn at cfg' testPort $ \_ ->
+      ipv4Client $ \r -> ipv4Client $ \s -> do
+        g <- C.newRandom
+        (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd448 g
+        (sId, _, _, _) <- createAndSecureQueue r sPub
+        Resp "bcda" _ OK <- signSendRecv s sKey ("bcda", sId, _SEND "hello")
+        Resp "cdab" _ OK <- signSendRecv s sKey ("cdab", sId, _SEND "hello again")
+        withControlPort $ \h -> do
+          controlPortCommand h "addresses SEND" 1 `shouldReturn` ["AUTH"]
+          controlPortCommand h ("auth " <> unBasicAuth testControlPortUserAuth) 1 `shouldReturn` ["Current role is CPRUser"]
+          controlPortCommand h "addresses unknown" 1 `shouldReturn` ["error: unknown counter"]
+          controlPortCommand h "addresses SEND" 2 `shouldReturn` ["address,previous,current", "127.0.0.1,0,2"]
+          controlPortCommand h "addresses connections" 2 `shouldReturn` ["address,previous,current", "127.0.0.1,0,2"]

 createAndSecureQueue :: Transport c => THandleSMP c 'TClient -> SndPublicAuthKey -> IO (SenderId, RecipientId, RcvPrivateAuthKey, RcvDhSecret)
 createAndSecureQueue h sPub = do
@@ -7,6 +7,7 @@ import CLITests
 import Control.Concurrent (threadDelay)
 import qualified Control.Exception as E
 import Control.Logger.Simple
+import CoreTests.AddressStatsTests
 import CoreTests.BatchingTests
 import CoreTests.CryptoFileTests
 import CoreTests.CryptoTests
@@ -83,6 +84,7 @@ main = do
      . after_ (eventuallyRemove "tests/tmp" 3)
      $ do
        describe "Core tests" $ do
+          describe "Address statistics tests" addressStatsTests
          describe "Batching tests" batchingTests
          describe "Encoding tests" encodingTests
          describe "Version range" versionRangeTests
@@ -24,6 +24,7 @@ import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Protocol (UserId)
 import Simplex.Messaging.Crypto.File (CryptoFile)
 import Simplex.Messaging.Protocol (XFTPServer)
+import Simplex.Messaging.Server.AddressStats (AddressStatsConfig (..))
 import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server
 import Test.Hspec hiding (fit, it)
@@ -208,6 +209,7 @@ testXFTPServerConfig =
      serverStatsBackupFile = Nothing,
      prometheusInterval = Nothing,
      prometheusMetricsFile = xftpTestPrometheusMetricsFile,
+      addressStats = Just AddressStatsConfig {period = 1},
      transportConfig = mkTransportServerConfig True (Just alpnSupportedXFTPhandshakes) False,
      responseDelay = 0,
      webStaticPath = Nothing
@@ -28,6 +28,7 @@ import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
 import Network.HPACK.Token (tokenKey)
 import qualified Network.HTTP2.Client as H2
+import SMPClient (controlPortCommand, testControlPort, testControlPortUserAuth, withControlPort)
 import ServerTests (logSize)
 import Simplex.FileTransfer.Client hiding (createXFTPChunk)
 import qualified Simplex.FileTransfer.Client as A
@@ -39,7 +40,8 @@ import Simplex.Messaging.Client (ProtocolClientError (..))
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding (smpDecode, smpEncode)
-import Simplex.Messaging.Protocol (BasicAuth, EntityId (..), RecipientId, SenderId, pattern NoEntity)
+import Simplex.Messaging.Protocol (BasicAuth (..), EntityId (..), RecipientId, SenderId, pattern NoEntity)
+import Simplex.Messaging.Server.AddressStats (AddressStatsConfig (..), defaultAddressStatsPeriod)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
 import Simplex.Messaging.Transport (CertChainPubKey (..), TLS (..), TransportPeer (..), defaultSupportedParams, defaultSupportedParamsHTTPS)
 import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), defaultTransportClientConfig, runTLSTransportClient)
@@ -68,6 +70,7 @@ xftpServerTests =
      it "should disconnect inactive clients" testInactiveClientExpiration
      it "should not allow uploading chunks after specified storage quota" testFileStorageQuota
      it "should store file records to log and restore them after server restart" testFileLog
+      it "should count commands, transfers and recipients by client address" testFileAddressStats
      describe "XFTP basic auth" $ do
        --                                               allow FNEW | server auth | clnt auth | success
        it "prohibited without basic auth" $ testFileBasicAuth True (Just "pwd") Nothing False
@@ -334,6 +337,23 @@ testFileLog _ = do
      downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
      liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes

+testFileAddressStats :: AFStoreType -> Expectation
+testFileAddressStats fsType =
+  withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsType) $ \c -> c {addressStats, controlPort = Just testControlPort, controlPortUserAuth = Just testControlPortUserAuth}) $ \_ -> do
+    ts <- getCurrentTime
+    runRight_ $ do
+      c <- ExceptT $ getXFTPClient (1, "xftp://[email protected]:8000", Nothing) testXFTPClientConfig [] ts (\_ -> pure Nothing) (\_ -> pure ())
+      runTestFileChunkDelivery c c
+    withControlPort $ \h -> do
+      controlPortCommand h ("auth " <> unBasicAuth testControlPortUserAuth) 1 `shouldReturn` ["Current role is CPRUser"]
+      controlPortCommand h "addresses errors" 1 `shouldReturn` ["address,previous,current"]
+      forM_ counts $ \(counter, n) ->
+        controlPortCommand h ("addresses " <> counter) 2 `shouldReturn` ["address,previous,current", "127.0.0.1,0," <> n]
+  where
+    addressStats = Just AddressStatsConfig {period = defaultAddressStatsPeriod}
+    counts :: [(ByteString, ByteString)]
+    counts = [("connections", "1"), ("FNEW", "2"), ("FPUT", "2"), ("FGET", "2"), ("recipients", "2"), ("upload_kb", "128"), ("download_kb", "256")]
+
 testFileBasicAuth :: Bool -> Maybe BasicAuth -> Maybe BasicAuth -> Bool -> AFStoreType -> IO ()
 testFileBasicAuth allowNewFiles newFileBasicAuth clntAuth success fsType =
  withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsType) $ \c -> c {allowNewFiles, newFileBasicAuth}) $
Author	SHA1	Message	Date
Evgeny @ SimpleX Chat	16dda77679	stats, tests	2026-09-27 17:20:26 +00:00
Evgeny @ SimpleX Chat	f93ed11d1a	implement	2026-09-27 17:01:06 +00:00
Evgeny @ SimpleX Chat	629d5d8204	add plan for client address statistics	2026-09-27 12:34:43 +00:00
Evgeny @ SimpleX Chat	1d8e5c7019	Merge branch 'master' into ep/pow	2026-09-25 17:14:38 +00:00
Evgeny @ SimpleX Chat	14a7e21721	update rfc	2026-09-24 20:59:29 +00:00
Evgeny @ SimpleX Chat	720c73fad8	Merge branch 'master' into ep/pow	2026-09-24 16:51:40 +00:00
Evgeny @ SimpleX Chat	c34cbaf319	present entitlements in handshake	2026-09-24 16:40:56 +00:00
Evgeny @ SimpleX Chat	cfb955bb4c	rfc: resource management with pow	2026-09-16 16:41:37 +00:00