xftp server: support storage time and BBS proofs of badge credential to extend it

apps/xftp-server/XFTPWeb.hs

@@ -58,7 +58,7 @@ xftpSubsts XFTPServerConfig {fileExpiration, logStatsInterval, allowNewFiles, ne
   [("smpConfig", Nothing), ("xftpConfig", Just "y")] <> substConfig <> serverInfoSubsts simplexmqSource information <> [("onionHost", strEncode <$> onionHost), ("iniFileName", Just "file-server.ini")]
   where
     substConfig =
-      [ ("fileExpiration", Just $ maybe "Never" (fromString . timedTTLText . ttl) fileExpiration),
+      [ ("fileExpiration", Just . fromString . timedTTLText . ttl $ fileExpiration),
         ("statsEnabled", Just . yesNo $ isJust logStatsInterval),
         ("newUploadsAllowed", Just . yesNo $ allowNewFiles),
         ("basicAuthEnabled", Just . yesNo $ isJust newFileBasicAuth)

plans/2026-08-22-xftp-file-storage-time.md

@@ -0,0 +1,132 @@
+# Implementation plan: XFTP variable file storage time
+
+Proposal: `../rfcs/2026-08-22-xftp-file-storage-time.md`.
+
+## simplexmq: entitlement crypto
+
+New module `Simplex.Messaging.Crypto.Entitlement`, over `Simplex.Messaging.Crypto.BBS`:
+
+Types:
+
+```
+newtype MasterKey = MasterKey ByteString
+
+data Entitlement = Entitlement
+  { entitlementName :: Text,
+    expiresAt :: UTCTime,
+    extraInfo :: Text
+  }
+
+data EntitlementCredential = EntitlementCredential
+  { issuerKeyIdx :: Int,
+    masterKey :: MasterKey,
+    issuerSignature :: BBSSignature,
+    entitlement :: Entitlement
+  }
+
+data EntitlementProof = EntitlementProof
+  { issuerKeyIdx :: Int,
+    proof :: BBSProof,
+    entitlement :: Entitlement
+  }
+```
+
+Functions and constants:
+
+- the disclosed-message encoding: the master key is message 0 and stays undisclosed; `expiresAt`, `entitlementName`, and `extraInfo` are messages 1 to 3 and are disclosed
+- the BBS header string `"SimpleX entitlement v1"`, the message count, and the disclosed indexes
+- `generateEntitlementProof :: BBSPublicKey -> EntitlementCredential -> BBSPresHeader -> IO (Either String EntitlementProof)`
+- `verifyEntitlement :: Map Int BBSPublicKey -> BBSPresHeader -> EntitlementProof -> IO (Maybe Bool)` (the caller supplies the presentation header; the server reconstructs it, the proof never includes it)
+- the issuer public keys constant `Map Int BBSPublicKey`
+
+## simplexmq: protocol, new XFTP version
+
+In `Simplex.FileTransfer.Transport`:
+
+- add the next `VersionXFTP` and set `currentXFTPVersion` to 4
+
+In `Simplex.FileTransfer.Protocol`:
+
+- add `GrantedStorageTime` and its encoding; retain the one-character sum prefix for future variants:
+
+```
+data GrantedStorageTime = GSTExpires {epochSeconds :: Int64}
+```
+
+- add the storage time (`Maybe Int64`: `Nothing` requests the server maximum, `Just` a number of hours) and `Maybe EntitlementProof` fields to `FNEW`
+- add the granted storage to `FRSndIds` as `Maybe GrantedStorageTime` (`Nothing` when decoding a response from a server below this version)
+- build the presentation header for FNEW
+
+In `Simplex.FileTransfer.Server`:
+
+- pass `sessionId` from `thParams` into `processXFTPRequest`
+
+## simplexmq: server configuration
+
+In `Simplex.FileTransfer.Server.Env` and `Simplex.FileTransfer.Server.Main`:
+
+- make `fileExpiration` non-optional (`ExpirationConfig`, no longer `Maybe`); the server always expires files, so the server maximum is always a concrete number of seconds
+- read a maximum storage time (a number of hours) for each entitlement name from the `[STORE_LOG]` INI section, from the keys `expire_files_hours_for_supporter` and `expire_files_hours_for_legend`
+- exit at startup if any name's maximum is below the default file expiration
+- read the issuer public keys from the shared constant
+
+## simplexmq: server store and expiration
+
+The `files` table gets a nullable `expires_at`. Every new file stores a concrete `expires_at`. It is NULL only for pre-feature rows, which the migration must not re-date (it has no access to the operator's configured TTL); those are expired at query time as `created_at + ttl`.
+
+Common to both stores, in `Simplex.FileTransfer.Server.Store`:
+
+- add `expiresAt :: Maybe RoundedFileTime` to `FileRec`
+- in `createFile`, verify the proof against `sessionId <> sndKey <> digest`, cap the requested hours at the entitlement's maximum, round the expiry up to the hour, store it, and return that same value as the granted storage
+- a valid proof raises the maximum to the entitlement's configured value; a proof that fails verification, carries an unknown issuer key, or whose entitlement expired more than 24 hours ago falls back to the default maximum. The entitlement is honoured for 24 hours after its `expiresAt`.
+- `expiredFiles` receives `now` and `old` (= `now - ttl`). A stored expiry is deleted when `expires_at < now` (no grace — it is already rounded up); a legacy row (no `expires_at`) is deleted when `created_at + fileTimePrecision < old` (the grace covers `created_at` being floored to the hour)
+- retain `created_at` for statistics, export, and the legacy fallback
+
+STM store:
+
+- in `expiredFiles`, expire a new file when `roundedSeconds expiresAt < now`, and a legacy file (no `expiresAt`) when `created_at + fileTimePrecision < old`
+
+PostgreSQL store, in `Simplex.FileTransfer.Server.Store.Postgres` and its migrations:
+
+- add the nullable column `expires_at BIGINT` (no backfill)
+- add one composite index `idx_files_expiry ON files (expires_at, created_at)`
+- `expiredFiles` query: `WHERE (expires_at < ?) OR (expires_at IS NULL AND created_at < ?) LIMIT ?` with `(now, old - fileTimePrecision)`. The first arm deletes stored (already rounded-up) expiries; the second drains legacy rows, with the grace folded into `old - fileTimePrecision` so the columns stay bare and sargable. Keep the `OR` at the top level so each disjunct is independently indexable (BitmapOr on the composite index): `expires_at` covers arm 1's range and arm 2's `IS NULL` group, and `created_at` orders arm 2 within that group. A `COALESCE(expires_at, created_at + ttl)` predicate is avoided (not sargable, would force a sequential scan). No `ORDER BY` — the batch loop deletes all expired rows regardless of order.
+
+Store log, in `Simplex.FileTransfer.Server.StoreLog`:
+
+- add the optional expiration to the `AddFile` record; a record without it parses to `Nothing` (the configured default), never a hardcoded value
+
+## simplexmq: agent
+
+Public API in `Simplex.Messaging.Agent`:
+
+- add `Maybe EntitlementCredential` and storage time (`Maybe Int64` hours) parameters to `xftpSendFile`
+
+Store, in both the SQLite and PostgreSQL agent stores:
+
+- add a nullable entitlement credential column (JSON text) and a nullable storage time column (integer hours; NULL means the server maximum) to `snd_files`
+- add the migration to both stores
+- in `createSndFile`, store the credential and the storage time
+
+Upload, in `Simplex.Messaging.Agent.Client` and `Simplex.FileTransfer.Client`:
+
+- in `agentXFTPNewChunk`, read the credential, the storage time, and the digest from the send record
+- inside `withClient`, where `sessionId` is available, build the presentation header `sessionId <> sndKey <> digest`, generate the proof, and send FNEW with the storage time and the proof
+- discard the returned expiration for now
+
+## simplex-chat
+
+- remove lifetime badges: make `badgeExpiry` a `UTCTime`, drop the `"lifetime"` encoding, and remove the lifetime option from the UI and the CLI
+- map `BadgeInfo` to `Entitlement` (`entitlementName = textEncode badgeType`, `expiresAt = badgeExpiry`, `extraInfo = badgeExtra`) when calling the agent
+- pass the user's credential and `FSMaxTime` to `xftpSendFile`
+- retain the `maxXFTPFileSize` size limit
+- reuse `verifyEntitlement` for peer-badge verification
+- import the issuer public keys from the shared simplexmq constant
+
+## Order
+
+1. Add the entitlement crypto module; move chat's badge verification onto it and remove lifetime badges.
+2. Add the new XFTP version, the FNEW protocol change (storage time + proof), and the response.
+3. Change the server configuration, store, expiration, and store log.
+4. Change the agent store and add proof generation on upload.
+5. Wire chat to pass the credential and the storage time.

rfcs/2026-08-22-xftp-file-storage-time.md

@@ -0,0 +1,85 @@
+# XFTP variable file storage time
+
+## Summary
+
+The server stores a storage time for each file. The sender sets it in the FNEW command. The sender may present a proof of an entitlement to raise the maximum storage time the server allows. Each proof is bound to the uploaded chunk and to the TLS session, so it cannot be reused for another chunk or another session.
+
+## Entitlement
+
+An entitlement is a name, an expiration, and an extra string. It is the disclosed content of a BBS proof: the holder's secret remains undisclosed, and the three fields are revealed. The server reads `entName` to select a maximum storage time, checks `entExpires`, and ignores `entExtra`; the interpretation of `entExtra` is out of scope here. The protocol references only the entitlement, never a badge; chat maps its own badge to an entitlement before it asks the agent to send.
+
+The proof discloses the entitlement and includes the issuer key index and the BBS proof. The holder's secret and the BBS signature remain with the sender and are never transmitted. The origin of the sender's signed entitlement, from the entitlement service, is out of scope here.
+
+```
+entitlement = entName entExpires entExtra
+entName = shortString        ; e.g. "supporter", "legend"
+entExpires = shortString     ; expiration, encoded as signed
+entExtra = shortString       ; opaque, interpretation out of scope
+
+entitlementProof = issuerKeyIndex bbsProof entitlement
+issuerKeyIndex = 2*2 OCTET   ; Word16, network byte order
+bbsProof = largeString       ; BBS proof bytes
+```
+
+The presentation header that the BBS proof is generated over is not transmitted; the server reconstructs it from the command context (see [Binding](#binding)), which is what binds the proof.
+
+## Storage time
+
+```
+fileStorageTime = %s"0" / (%s"1" storageHours)
+storageHours = 8*8 OCTET     ; Int64, network byte order
+```
+
+The storage time is an optional number of hours. Absent (`%s"0"`) requests the maximum the server allows for the presented entitlement, or the default maximum when no proof is present. A value (`%s"1"` with hours) requests a specific number of hours.
+
+## Commands, new XFTP version
+
+The new protocol version extends FNEW.
+
+```
+fnew = %s"FNEW " fileInfo rcvKeys optBasicAuth fileStorageTime optEntitlementProof
+optEntitlementProof = %s"0" / (%s"1" entitlementProof)
+```
+
+`fileInfo`, `rcvKeys`, and `optBasicAuth` are defined by the current XFTP protocol. Version 3 and earlier encode neither `fileStorageTime` nor the proof, and the server applies the default storage time.
+
+## Responses
+
+FNEW extends the SIDS response with the granted storage.
+
+```
+sndIds = %s"SIDS " senderId rcvIds optGrantedStorageTime
+optGrantedStorageTime = %s"0" / (%s"1" grantedStorageTime)
+grantedStorageTime = grantedExpires
+grantedExpires = %s"T" expiresAt
+expiresAt = 8*8 OCTET        ; Int64, seconds since epoch (absolute UTC instant), network byte order
+```
+
+`grantedExpires` returns the absolute expiration — the same value stored for the file. The sum encoding retains a one-character prefix so further variants can be added. Version 3 and earlier omit `optGrantedStorageTime` entirely; a client decoding such a response reads it as absent. `senderId` and `rcvIds` are defined by the current XFTP protocol.
+
+## Binding
+
+The presentation header binds each proof to the TLS session and to the specific chunk. The server reconstructs it and rejects a proof generated for any other session or chunk.
+
+```
+presHeader = sessionId sndKey digest
+```
+
+The chunk is identified by the sender key and the digest, which the server verifies for every command on the file. `sessionId` is the TLS session identifier; `sndKey` and `digest` are the fields of `fileInfo`.
+
+## Maximum storage time
+
+The server configures a maximum storage time for each entitlement name, and a default maximum for requests with no proof. Each maximum is a number of hours. The server exits at startup if any name's maximum is below the default, so a proof never reduces the allowed time. The server honours an entitlement for 24 hours after its expiration; past that grace it is treated as no proof.
+
+If the requested time exceeds the maximum, the server stores the file for the maximum and does not reject the request. The expiration is rounded up to the hour, stored, and returned as `grantedExpires`.
+
+## Encoding primitives
+
+```
+shortString = length *OCTET   ; 0-255 bytes
+largeString = length2 *OCTET
+length = 1*1 OCTET
+length2 = 2*2 OCTET           ; Word16, network byte order
+```
+
+`senderId`, `rcvIds`, `fileInfo`, `sndKey`, `digest`, `rcvKeys`, `optBasicAuth`, and `sessionId` are defined by the current XFTP and SMP protocols.

simplexmq.cabal

@@ -135,6 +135,7 @@ library
       Simplex.Messaging.Crypto.Lazy
       Simplex.Messaging.Crypto.Ratchet
       Simplex.Messaging.Crypto.BBS
+      Simplex.Messaging.Crypto.Entitlement
       Simplex.Messaging.Crypto.SNTRUP761
       Simplex.Messaging.Crypto.SNTRUP761.Bindings
       Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
@@ -192,6 +193,7 @@ library
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260410_receive_attempts
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
   else
       exposed-modules:
           Simplex.Messaging.Agent.Store.SQLite
@@ -245,6 +247,7 @@ library
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260410_receive_attempts
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260411_service_certs
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
           Simplex.Messaging.Agent.Store.SQLite.Util
   if flag(client_postgres) || flag(server_postgres)
       exposed-modules:

src/Simplex/FileTransfer/Agent.hs

@@ -68,6 +68,7 @@ import Simplex.Messaging.Agent.Stats
 import Simplex.Messaging.Agent.Store.AgentStore
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential)
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.File as CF
 import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -350,16 +351,16 @@ xftpDeleteRcvFiles' c rcvFileEntityIds = do
 notify :: forall m e. (MonadIO m, AEntityI e) => AgentClient -> AEntityId -> AEvent e -> m ()
 notify c entId cmd = atomically $ writeTBQueue (subQ c) ("", entId, AEvt (sAEntity @e) cmd)
 
-xftpSendFile' :: AgentClient -> UserId -> CryptoFile -> Int -> AM SndFileId
-xftpSendFile' c userId file numRecipients = do
+xftpSendFile' :: AgentClient -> UserId -> CryptoFile -> Int -> Maybe EntitlementCredential -> Maybe Int64 -> AM SndFileId
+xftpSendFile' c userId file numRecipients credential storageTime = do
   g <- asks random
   prefixPath <- lift $ getPrefixPath "snd.xftp"
   createDirectory prefixPath
   let relPrefixPath = takeFileName prefixPath
   key <- atomically $ C.randomSbKey g
   nonce <- atomically $ C.randomCbNonce g
   -- saving absolute filePath will not allow to restore file encryption after app update, but it's a short window
-  fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce Nothing
+  fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce Nothing credential storageTime
   lift . void $ getXFTPSndWorker True c Nothing
   pure fId
 
@@ -375,7 +376,7 @@ xftpSendDescription' c userId (ValidFileDescription fdDirect@FileDescription {si
   liftError (FILE . FILE_IO . show) $ CF.writeFile file (LB.fromStrict $ strEncode fdDirect)
   key <- atomically $ C.randomSbKey g
   nonce <- atomically $ C.randomCbNonce g
-  fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce $ Just RedirectFileInfo {size, digest}
+  fId <- withStore c $ \db -> createSndFile db g userId file numRecipients relPrefixPath key nonce (Just RedirectFileInfo {size, digest}) Nothing Nothing
   lift . void $ getXFTPSndWorker True c Nothing
   pure fId
 
@@ -405,7 +406,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
     prepareFile _ SndFile {prefixPath = Nothing} =
       throwE $ INTERNAL "no prefix path"
     prepareFile cfg sndFile@SndFile {sndFileId, sndFileEntityId, userId, prefixPath = Just ppath, status} = do
-      SndFile {numRecipients, chunks} <-
+      SndFile {numRecipients, chunks, entitlementCredential, storageTime} <-
         if status /= SFSEncrypted -- status is SFSNew or SFSEncrypting
           then do
             fsEncPath <- lift . toFSFilePath $ sndFileEncPath ppath
@@ -424,7 +425,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
       let (pendingChunks, preparedSrvs) = partitionEithers $ map srvOrPendingChunk chunks
       -- concurrently?
       -- separate worker to create chunks? record retries and delay on snd_file_chunks?
-      srvs <- forM pendingChunks $ createChunk numRecipients'
+      srvs <- forM pendingChunks $ createChunk numRecipients' entitlementCredential storageTime
       let allSrvs = S.fromList $ preparedSrvs <> srvs
       lift $ forM_ allSrvs $ \srv -> getXFTPSndWorker True c (Just srv)
       withStore' c $ \db -> updateSndFileStatus db sndFileId SFSUploading
@@ -454,8 +455,8 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
         srvOrPendingChunk ch@SndFileChunk {replicas} = case replicas of
           [] -> Left ch
           SndFileChunkReplica {server} : _ -> Right server
-        createChunk :: Int -> SndFileChunk -> AM (ProtocolServer 'PXFTP)
-        createChunk numRecipients' ch = do
+        createChunk :: Int -> Maybe EntitlementCredential -> Maybe Int64 -> SndFileChunk -> AM (ProtocolServer 'PXFTP)
+        createChunk numRecipients' credential storageTime ch = do
           liftIO $ assertAgentForeground c
           (replica, ProtoServerWithAuth srv _) <- tryCreate
           withStore' c $ \db -> createSndFileReplica db ch replica
@@ -482,7 +483,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
               deleted <- withStore' c $ \db -> getSndFileDeleted db sndFileId
               when deleted $ throwE $ FILE NO_FILE
               withNextSrv c userId storageSrvs triedHosts [] $ \srvAuth -> do
-                replica <- agentXFTPNewChunk c ch numRecipients' srvAuth
+                replica <- agentXFTPNewChunk c ch numRecipients' srvAuth credential storageTime
                 pure (replica, srvAuth)
 
 sndWorkerInternalError :: AgentClient -> DBSndFileId -> SndFileId -> Maybe FilePath -> AgentErrorType -> AM ()

src/Simplex/FileTransfer/Client.hs

@@ -57,6 +57,7 @@ import Network.Socket (HostName)
 import Simplex.FileTransfer.Chunks
 import Simplex.FileTransfer.Protocol
 import Simplex.FileTransfer.Transport
+import Simplex.Messaging.Crypto.Entitlement (EntitlementProof)
 import Simplex.Messaging.Client
   ( NetworkConfig (..),
     NetworkRequestMode (..),
@@ -253,10 +254,12 @@ createXFTPChunk ::
   FileInfo ->
   NonEmpty C.APublicAuthKey ->
   Maybe BasicAuth ->
+  Maybe Int64 ->
+  Maybe EntitlementProof ->
   ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId)
-createXFTPChunk c spKey file rcps auth_ =
-  sendXFTPCommand c spKey NoEntity (FNEW file rcps auth_) Nothing >>= \case
-    (FRSndIds sId rIds, body) -> noFile body (sId, rIds)
+createXFTPChunk c spKey file rcps auth_ storageTime proof =
+  sendXFTPCommand c spKey NoEntity (FNEW file rcps auth_ storageTime proof) Nothing >>= \case
+    (FRSndIds sId rIds _, body) -> noFile body (sId, rIds)
     (r, _) -> throwE $ unexpectedResponse r
 
 addXFTPRecipients :: XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> NonEmpty C.APublicAuthKey -> ExceptT XFTPClientError IO (NonEmpty RecipientId)