more fixes

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

@@ -12,32 +12,32 @@ Types:
 newtype MasterKey = MasterKey ByteString
 
 data Entitlement = Entitlement
-  { entitlementName :: Text,
-    expiresAt :: UTCTime,
+  { expiresAt :: UTCTime,
+    entitlementName :: Text,
     extraInfo :: Text
   }
 
 data EntitlementCredential = EntitlementCredential
-  { issuerKeyIdx :: Int,
+  { issuerKeyIdx :: Word16,
     masterKey :: MasterKey,
-    issuerSignature :: BBSSignature,
-    entitlement :: Entitlement
+    entitlement :: Entitlement,
+    issuerSignature :: BBSSignature
   }
 
 data EntitlementProof = EntitlementProof
-  { issuerKeyIdx :: Int,
-    proof :: BBSProof,
-    entitlement :: Entitlement
+  { issuerKeyIdx :: Word16,
+    entitlement :: Entitlement,
+    entProof :: BBSProof
   }
 ```
 
 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 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 protocol encoding of `Entitlement` and its field order follow the same order
 - the BBS header string `"SimpleX badges v1"` (shared with chat's badges, which sign under it), 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`
+- `generateEntitlementProof :: Map Word16 BBSPublicKey -> EntitlementCredential -> BBSPresHeader -> IO (Either String EntitlementProof)` (the issuer key is looked up by the credential's index; an absent index is `Left`)
+- `verifyEntitlement :: Map Word16 BBSPublicKey -> BBSPresHeader -> EntitlementProof -> IO EntitlementVerification`, where `data EntitlementVerification = EVValid | EVInvalid | EVUnknownIssuer` (the caller supplies the presentation header; the server reconstructs it, the proof never includes it)
+- the issuer public keys constant `Map Word16 BBSPublicKey`
 
 ## simplexmq: protocol, new XFTP version
 
@@ -55,7 +55,7 @@ In `Simplex.FileTransfer.Protocol`:
 data GrantedStorageTime = GSTExpires {epochSeconds :: Int64}
 ```
 
-- add the storage time (`Maybe Int64`: `Nothing` requests the server maximum, `Just` a number of hours) to `FNEW`
+- add the storage time (`Maybe Word32`: `Nothing` requests the server maximum, `Just` a number of hours) to `FNEW`
 - add the granted storage to `FRSndIds` as `Maybe GrantedStorageTime` (`Nothing` when decoding a response from a server below this version)
 
 ## simplexmq: server configuration
@@ -63,7 +63,7 @@ data GrantedStorageTime = GSTExpires {epochSeconds :: Int64}
 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`; an absent key is skipped (that name gets the default), a present but malformed value fails startup
+- 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`, into `fileStorageEntitlements :: Map Text EntitlementConfig`, where `newtype EntitlementConfig = EntitlementConfig {storageTime :: Int64}` holds seconds; an absent key is skipped (that name gets the default), a present but malformed value fails startup
 - exit at startup if any name's maximum is below the default file expiration
 - add `entitlementKeys :: Map Word16 BBSPublicKey` to the server config (default = the shared constant, set from `Main`); the handshake verifies the proof against it, so the trusted keys never come from the sender
 
@@ -73,8 +73,8 @@ In `Simplex.FileTransfer.Server`:
 
 - `processClientHandshake` verifies the proof from the handshake, once per session, and resolves the maximum storage time for the entitlement name
 - verify only when the answer can change: the name is configured with a maximum above the default, and the entitlement expired less than 24 hours ago. A proof that fails these checks or fails to verify is logged, and the session gets the default maximum
-- `HandshakeAccepted` holds the resolved maximum for the session, and `processXFTPRequest` takes it from there, so no proof is verified while a command is processed
-- `createFile` caps the requested storage time by the session maximum
+- a verified proof becomes `peerEntitlement :: Maybe SessionEntitlement` in `THAuthServer`, where `data SessionEntitlement = SessionEntitlement {expiresAt :: SystemSeconds, entConfig :: EntitlementConfig}`; `processXFTPRequest` takes it from there, so no proof is verified while a command is processed
+- `createFile` caps the requested storage time by the session maximum, which is the entitlement's storage time when the entitlement is still valid and above the default, and the default otherwise
 
 ## simplexmq: server store and expiration
 
@@ -83,8 +83,7 @@ The `files` table gets a nullable `expires_at`. Every new file stores a concrete
 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`.
+- in `createFile`, cap the requested hours at the session maximum, round the expiry up to the hour, store it, and return that same value as the granted storage
 - `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
 
@@ -96,7 +95,7 @@ PostgreSQL store, in `Simplex.FileTransfer.Server.Store.Postgres` and its migrat
 
 - 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.
+- `expiredFiles` query: `(SELECT ... WHERE expires_at < ? LIMIT ?) UNION ALL (SELECT ... WHERE expires_at IS NULL AND created_at < ? LIMIT ?)` with `(now, limit, old - fileTimePrecision, limit)`. 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. Each arm is one range over the composite index and stops at its own limit; a single `OR` predicate builds a bitmap of every match before the limit applies. 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. New files always store an expiry, so the second arm drains permanently once the legacy rows expire, and is then removed.
 
 Store log, in `Simplex.FileTransfer.Server.StoreLog`:
 
@@ -114,7 +113,7 @@ Per-user state in `Simplex.Messaging.Agent.Env.SQLite` and `Simplex.Messaging.Ag
 
 Public API in `Simplex.Messaging.Agent`:
 
-- add storage time (`Maybe Int64` hours) to `xftpSendFile`
+- add storage time (`Maybe Word32` hours) to `xftpSendFile`
 - add `setUserEntitlement :: AgentClient -> UserId -> Maybe EntitlementCredential -> IO ()`, in the shape of `setProtocolServers`: it replaces the entry, and closes that user's XFTP clients, so the next upload presents the new credential
 
 Store, in both the SQLite and PostgreSQL agent stores:
@@ -126,7 +125,7 @@ Store, in both the SQLite and PostgreSQL agent stores:
 Upload, in `Simplex.Messaging.Agent.Client` and `Simplex.FileTransfer.Client`:
 
 - `getXFTPClient` takes a proof for the session as a parameter, `SessionId -> IO (Maybe EntitlementProof)`, beside the callback it already takes for a closed client. The client config holds no credential and no keys
-- `getXFTPServerClient` passes a function that reads the user's credential, looks the issuer key up, and generates the proof over the session id. A missing credential or a failure to generate gives `Nothing`, with the failure logged
+- `getXFTPServerClient` passes a function that reads the user's credential and generates the proof over the session id from the configured issuer keys. A missing credential or a failure to generate gives `Nothing`, with the failure logged
 - `xftpClientHandshakeV1` calls it with the session id from the connection, and sends the result in the handshake
 - `agentXFTPNewChunk` reads the storage time from the send record and sends FNEW with it
 - `createXFTPChunk` returns the granted expiry (epoch seconds); `agentXFTPNewChunk` stores it on `NewSndChunkReplica`
@@ -134,7 +133,7 @@ Upload, in `Simplex.Messaging.Agent.Client` and `Simplex.FileTransfer.Client`:
 Completion:
 
 - `createXFTPChunk` returns the granted expiry as `Maybe GrantedStorageTime`; `SndFileChunkReplica` and `NewSndChunkReplica` carry `expiresAt :: Maybe GrantedStorageTime`
-- persist it in a nullable `replica_expires_at` column on `snd_file_chunk_replicas` (added to the entitlement migration): `createSndFileReplica` stores `epochSeconds`, `getSndFile` reads it back into `GSTExpires`
+- persist it in a nullable `replica_expires_at` column on `snd_file_chunk_replicas` (added to the entitlement migration): `createSndFileReplica` stores `epochSeconds`, `getSndFile` and `getNextSndChunkToUpload` read it back into `GSTExpires`
 - on `SFDONE`, report the file expiry: a chunk expires when its last replica expires (`max` over replicas, absent replicas ignored, `Nothing` only if none report); the file expires when its first chunk expires (`min` over chunks, `Nothing` if any chunk is unknown). `GrantedStorageTime` derives `Ord`
 - `SFDONE` gains a trailing `Maybe GrantedStorageTime` (not str-encoded); chat consumes it (wired later)
 

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

@@ -13,10 +13,10 @@ An entitlement is a name, an expiration, and an extra string. It is the disclose
 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"
+entitlement = entExpires entName entExtra
 entExpires = shortString     ; expiration as a UTCTime ISO8601 string
-entExtra = shortString       ; opaque, interpretation out of scope
+entName = shortString        ; e.g. "supporter", "legend"
+entExtra = largeString       ; opaque, interpretation out of scope
 
 entitlementProof = issuerKeyIndex bbsProof entitlement
 issuerKeyIndex = 2*2 OCTET   ; Word16, network byte order
@@ -29,7 +29,7 @@ The presentation header that the BBS proof is generated over is not transmitted;
 
 ```
 fileStorageTime = %s"0" / (%s"1" storageHours)
-storageHours = 8*8 OCTET     ; Int64, network byte order
+storageHours = 4*4 OCTET     ; Word32, 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.

src/Simplex/FileTransfer/Agent.hs

@@ -69,7 +69,6 @@ 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
@@ -580,7 +579,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
               replicas = [FileChunkReplica {server, replicaId, replicaKey}]
           pure FileChunk {chunkNo, digest = chDigest, chunkSize, replicas}
         sndFileExpiresAt :: [SndFileChunk] -> Maybe GrantedStorageTime
-        sndFileExpiresAt = fmap minimum . mapM chunkExpiresAt
+        sndFileExpiresAt chunks' = fmap minimum $ L.nonEmpty =<< mapM chunkExpiresAt chunks'
           where
             chunkExpiresAt SndFileChunk {replicas} = maximum <$> L.nonEmpty (mapMaybe (\SndFileChunkReplica {expiresAt} -> expiresAt) replicas)
         createRcvFileDescriptions :: FileDescription 'FRecipient -> [SndFileChunk] -> [FileDescription 'FRecipient]

src/Simplex/FileTransfer/Server.hs

@@ -30,8 +30,8 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
-import qualified Data.Map.Strict as M
 import qualified Data.List.NonEmpty as L
+import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
@@ -57,7 +57,7 @@ import Simplex.FileTransfer.Server.StoreLog
 import Simplex.FileTransfer.Transport
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BBS (BBSPresHeader (..))
-import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementProof (..), verifyEntitlement)
+import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementProof (..), EntitlementVerification (..), verifyEntitlement)
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -241,7 +241,7 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
               Just cfg | entitlementValid now expiresAt -> do
                 keys <- asks $ entitlementKeys . config
                 liftIO (verifyEntitlement keys (BBSPresHeader sessionId) proof) >>= \case
-                  Just True -> pure $ Just SessionEntitlement {expiresAt, entConfig = cfg}
+                  EVValid -> pure $ Just SessionEntitlement {expiresAt, entConfig = cfg}
                   r -> Nothing <$ logError ("entitlement not verified: " <> tshow r)
               _ -> pure Nothing
         sendError :: XFTPErrorType -> M s (Maybe (THandleParams XFTPVersion 'TServer))

src/Simplex/FileTransfer/Server/Env.hs

@@ -46,7 +46,6 @@ import Data.X509.Validation (Fingerprint (..))
 import Network.Socket
 import qualified Network.TLS as T
 import Simplex.FileTransfer.Protocol (FileCmd, FileInfo (..), XFTPFileId)
-import Simplex.Messaging.Crypto.BBS (BBSPublicKey)
 import Simplex.FileTransfer.Server.Stats
 import Data.Either (fromRight)
 import Data.Ini (Ini, lookupValue)
@@ -66,6 +65,7 @@ import System.Directory (doesFileExist)
 import Simplex.FileTransfer.Server.StoreLog
 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.Expiration
 import Simplex.Messaging.Transport (EntitlementConfig (..))

src/Simplex/Messaging/Agent/Client.hs

@@ -255,7 +255,7 @@ import qualified Simplex.Messaging.Agent.TSessionSubs as SS
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BBS (BBSPresHeader (..), BBSPublicKey)
-import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential (..), EntitlementProof, generateEntitlementProof)
+import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential, EntitlementProof, generateEntitlementProof)
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Client
@@ -901,10 +901,8 @@ getXFTPServerClient c@AgentClient {active, xftpClients, userEntitlements, worker
 
     mkEntitlementProof :: Map Word16 BBSPublicKey -> SessionId -> IO (Maybe EntitlementProof)
     mkEntitlementProof keys sessId =
-      TM.lookupIO userId userEntitlements
-        $>>= \cred -> pure (M.lookup (issuerKeyIdx cred) keys)
-        $>>= \pk -> generateEntitlementProof pk cred (BBSPresHeader sessId)
-        >>= \case
+      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)
 

src/Simplex/Messaging/Agent/Store/AgentStore.hs

@@ -3660,7 +3660,7 @@ getNextSndChunkToUpload db server@ProtocolServer {host, port, keyHash} ttl = do
               SELECT
                 f.snd_file_id, f.snd_file_entity_id, f.user_id, f.num_recipients, f.prefix_path,
                 c.snd_file_chunk_id, c.chunk_no, c.chunk_offset, c.chunk_size, c.digest,
-                r.snd_file_chunk_replica_id, r.replica_id, r.replica_key, r.replica_status, r.delay, r.retries
+                r.snd_file_chunk_replica_id, r.replica_id, r.replica_key, r.replica_status, r.delay, r.retries, r.replica_expires_at
               FROM snd_file_chunk_replicas r
               JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
               JOIN snd_file_chunks c ON c.snd_file_chunk_id = r.snd_file_chunk_id
@@ -3674,8 +3674,8 @@ getNextSndChunkToUpload db server@ProtocolServer {host, port, keyHash} ttl = do
           pure (replica :: SndFileChunkReplica) {rcvIdsKeys}
         pure (chunk {replicas = replicas'} :: SndFileChunk)
       where
-        toChunk :: ((DBSndFileId, SndFileId, UserId, Int, FilePath) :. (Int64, Int, Int64, Word32, FileDigest) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, SndFileReplicaStatus, Maybe Int64, Int)) -> SndFileChunk
-        toChunk ((sndFileId, sndFileEntityId, userId, numRecipients, filePrefixPath) :. (sndChunkId, chunkNo, chunkOffset, chunkSize, digest) :. (sndChunkReplicaId, replicaId, replicaKey, replicaStatus, delay, retries)) =
+        toChunk :: ((DBSndFileId, SndFileId, UserId, Int, FilePath) :. (Int64, Int, Int64, Word32, FileDigest) :. (Int64, ChunkReplicaId, C.APrivateAuthKey, SndFileReplicaStatus, Maybe Int64, Int, Maybe Int64)) -> SndFileChunk
+        toChunk ((sndFileId, sndFileEntityId, userId, numRecipients, filePrefixPath) :. (sndChunkId, chunkNo, chunkOffset, chunkSize, digest) :. (sndChunkReplicaId, replicaId, replicaKey, replicaStatus, delay, retries, expiresAtSec)) =
           let chunkSpec = XFTPChunkSpec {filePath = sndFileEncPath filePrefixPath, chunkOffset, chunkSize}
            in SndFileChunk
                 { sndFileId,
@@ -3687,7 +3687,7 @@ getNextSndChunkToUpload db server@ProtocolServer {host, port, keyHash} ttl = do
                   chunkSpec,
                   digest,
                   filePrefixPath,
-                  replicas = [SndFileChunkReplica {sndChunkReplicaId, server, replicaId, replicaKey, replicaStatus, delay, retries, expiresAt = Nothing, rcvIdsKeys = []}]
+                  replicas = [SndFileChunkReplica {sndChunkReplicaId, server, replicaId, replicaKey, replicaStatus, delay, retries, expiresAt = GSTExpires <$> expiresAtSec, rcvIdsKeys = []}]
                 }
 
 updateSndChunkReplicaDelay :: DB.Connection -> Int64 -> Int64 -> IO ()

src/Simplex/Messaging/Crypto/Entitlement.hs

@@ -10,6 +10,7 @@ module Simplex.Messaging.Crypto.Entitlement
   ( Entitlement (..),
     EntitlementCredential (..),
     EntitlementProof (..),
+    EntitlementVerification (..),
     MasterKey (..),
     randomMasterKey,
     entitlementBBSHeader,
@@ -22,7 +23,6 @@ module Simplex.Messaging.Crypto.Entitlement
 where
 
 import Control.Concurrent.STM
-import Control.Monad (forM)
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson.TH as JQ
@@ -48,8 +48,8 @@ newtype MasterKey = MasterKey ByteString
   deriving (ToJSON, FromJSON) via (StrJSON "MasterKey" MasterKey)
 
 data Entitlement = Entitlement
-  { entitlementName :: Text,
-    expiresAt :: UTCTime,
+  { expiresAt :: UTCTime,
+    entitlementName :: Text,
     extraInfo :: Text
   }
   deriving (Eq, Show)
@@ -69,14 +69,17 @@ data EntitlementProof = EntitlementProof
   }
   deriving (Eq, Show)
 
+data EntitlementVerification = EVValid | EVInvalid | EVUnknownIssuer
+  deriving (Eq, Show)
+
 instance Encoding Entitlement where
-  smpEncode Entitlement {entitlementName, expiresAt, extraInfo} =
-    smpEncode (entitlementName, strEncode expiresAt, Large $ encodeUtf8 extraInfo)
+  smpEncode Entitlement {expiresAt, entitlementName, extraInfo} =
+    smpEncode (strEncode expiresAt, entitlementName, Large $ encodeUtf8 extraInfo)
   smpP = do
-    (entitlementName, expBs, Large extraBs) <- smpP
+    (expBs, entitlementName, Large extraBs) <- smpP
     expiresAt <- either fail pure $ strDecode (expBs :: ByteString)
     extraInfo <- either (fail . show) pure $ decodeUtf8' extraBs
-    pure Entitlement {entitlementName, expiresAt, extraInfo}
+    pure Entitlement {expiresAt, entitlementName, extraInfo}
 
 instance Encoding EntitlementProof where
   smpEncode EntitlementProof {issuerKeyIdx, entProof, entitlement} =
@@ -98,7 +101,7 @@ entitlementMessages :: MasterKey -> Entitlement -> [ByteString]
 entitlementMessages (MasterKey mk) ent = mk : disclosedMessages ent
 
 disclosedMessages :: Entitlement -> [ByteString]
-disclosedMessages Entitlement {entitlementName, expiresAt, extraInfo} =
+disclosedMessages Entitlement {expiresAt, entitlementName, extraInfo} =
   [strEncode expiresAt, encodeUtf8 entitlementName, encodeUtf8 extraInfo]
 
 randomMasterKey :: TVar ChaChaDRG -> STM MasterKey
@@ -112,14 +115,19 @@ verifyCredential :: BBSPublicKey -> EntitlementCredential -> IO Bool
 verifyCredential pk EntitlementCredential {masterKey, issuerSignature, entitlement} =
   bbsVerify pk issuerSignature entitlementBBSHeader (entitlementMessages masterKey entitlement)
 
-generateEntitlementProof :: BBSPublicKey -> EntitlementCredential -> BBSPresHeader -> IO (Either String EntitlementProof)
-generateEntitlementProof pk EntitlementCredential {issuerKeyIdx, masterKey, issuerSignature, entitlement} ph =
-  EntitlementProof issuerKeyIdx entitlement <$$> bbsProofGen pk issuerSignature entitlementBBSHeader ph entitlementDisclosedIndexes (entitlementMessages masterKey entitlement)
+generateEntitlementProof :: Map Word16 BBSPublicKey -> EntitlementCredential -> BBSPresHeader -> IO (Either String EntitlementProof)
+generateEntitlementProof keys EntitlementCredential {issuerKeyIdx, masterKey, issuerSignature, entitlement} ph =
+  case M.lookup issuerKeyIdx keys of
+    Nothing -> pure $ Left $ "no issuer key " <> show issuerKeyIdx
+    Just pk -> EntitlementProof issuerKeyIdx entitlement <$$> bbsProofGen pk issuerSignature entitlementBBSHeader ph entitlementDisclosedIndexes (entitlementMessages masterKey entitlement)
 
-verifyEntitlement :: Map Word16 BBSPublicKey -> BBSPresHeader -> EntitlementProof -> IO (Maybe Bool)
+verifyEntitlement :: Map Word16 BBSPublicKey -> BBSPresHeader -> EntitlementProof -> IO EntitlementVerification
 verifyEntitlement keys ph EntitlementProof {issuerKeyIdx, entProof, entitlement} =
-  forM (M.lookup issuerKeyIdx keys) $ \pk ->
-    bbsProofVerify pk entProof entitlementBBSHeader ph entitlementDisclosedIndexes entitlementMessageCount (disclosedMessages entitlement)
+  case M.lookup issuerKeyIdx keys of
+    Nothing -> pure EVUnknownIssuer
+    Just pk ->
+      (\valid -> if valid then EVValid else EVInvalid)
+        <$> bbsProofVerify pk entProof entitlementBBSHeader ph entitlementDisclosedIndexes entitlementMessageCount (disclosedMessages entitlement)
 
 entitlementIssuerKeys :: Map Word16 BBSPublicKey
 entitlementIssuerKeys =

tests/CoreTests/CryptoTests.hs

@@ -460,11 +460,11 @@ testEntitlementRoundtrip = do
       ph = BBSPresHeader "session-id + snd-key + digest"
   Right cred <- signEntitlement sk 1 mk ent
   verifyCredential pk cred `shouldReturn` True
-  Right proof <- generateEntitlementProof pk cred ph
-  verifyEntitlement keys ph proof `shouldReturn` Just True
-  -- a different presentation header does not verify (session/chunk binding)
-  verifyEntitlement keys (BBSPresHeader "other") proof `shouldReturn` Just False
-  -- an unknown issuer key index yields Nothing
-  verifyEntitlement (M.singleton 2 pk) ph proof `shouldReturn` Nothing
+  Right proof <- generateEntitlementProof keys cred ph
+  verifyEntitlement keys ph proof `shouldReturn` EVValid
+  -- a different presentation header does not verify (session binding)
+  verifyEntitlement keys (BBSPresHeader "other") proof `shouldReturn` EVInvalid
+  -- an unknown issuer key index is distinguished from an invalid proof
+  verifyEntitlement (M.singleton 2 pk) ph proof `shouldReturn` EVUnknownIssuer
   -- the protocol encoding of the proof roundtrips
   smpDecode (smpEncode proof) `shouldBe` Right proof

tests/XFTPAgent.hs

@@ -50,8 +50,8 @@ import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Protocol (BasicAuth, NetworkError (..), ProtoServerWithAuth (..), ProtocolServer (..), XFTPServerWithAuth)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
-import Simplex.Messaging.Transport (EntitlementConfig (..))
 import Simplex.Messaging.Server.Information (ServerPublicInfo)
+import Simplex.Messaging.Transport (EntitlementConfig (..))
 import Simplex.Messaging.Util (tshow)
 import System.Directory (doesDirectoryExist, doesFileExist, getFileSize, listDirectory, removeFile)
 import System.FilePath ((</>))

tests/XFTPClient.hs

@@ -19,7 +19,10 @@ import Simplex.FileTransfer.Server (runXFTPServerBlocking)
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), XFTPStoreConfig (..), AFStoreType (..), defaultFileExpiration, defaultInactiveClientExpiration)
 import Simplex.FileTransfer.Server.Store (FileStoreClass, SFSType (..), STMFileStore)
 import Simplex.FileTransfer.Transport (alpnSupportedXFTPhandshakes, supportedFileServerVRange)
+import Simplex.FileTransfer.Types (SndFileId)
 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.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server
@@ -33,6 +36,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 #endif
 
+xftpSendFile :: A.AgentClient -> UserId -> CryptoFile -> Int -> A.AE SndFileId
 xftpSendFile c userId file n = A.xftpSendFile c userId file n Nothing
 
 data AXFTPServerConfig = forall s. FileStoreClass s => AXFTPSrvCfg (XFTPServerConfig s)