diff --git a/plans/2026-08-22-xftp-file-storage-time.md b/plans/2026-08-22-xftp-file-storage-time.md index 33ebd40a8..b7f4759be 100644 --- a/plans/2026-08-22-xftp-file-storage-time.md +++ b/plans/2026-08-22-xftp-file-storage-time.md @@ -66,9 +66,9 @@ In `Simplex.FileTransfer.Server`: 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` +- 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 - exit at startup if any name's maximum is below the default file expiration -- read the issuer public keys from the shared constant +- add `entitlementKeys :: Map Word16 BBSPublicKey` to the server config (default = the shared constant, set from `Main`); `storageMaxSeconds` verifies the proof against it, so the trusted keys never come from the sender ## simplexmq: server store and expiration @@ -110,6 +110,7 @@ Store, in both the SQLite and PostgreSQL agent stores: Upload, in `Simplex.Messaging.Agent.Client` and `Simplex.FileTransfer.Client`: +- add `entitlementKeys :: Map Word16 BBSPublicKey` to `AgentConfig` (default = the shared constant); `mkEntitlementProof` looks up `issuerKeyIdx` there to get the issuer public key that proof generation needs - 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 - `createXFTPChunk` returns the granted expiry (epoch seconds); `agentXFTPNewChunk` stores it on `NewSndChunkReplica` @@ -121,6 +122,10 @@ Completion: - 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) +Testing: + +- e2e test in `tests/XFTPAgent.hs`: generate a BBS keypair, sign a supporter credential (issuer key index 1), run the server with `entitlementKeys = {1: testPk}` and a supporter maximum above the default, run the sender agent with the same `entitlementKeys`, send a file with the credential requesting a number of hours below that maximum, and assert `SFDONE`'s granted expiry rounds up `now + requested` (proof of the entitlement raising the max above the default) + ## simplex-chat - remove lifetime badges: make `badgeExpiry` a `UTCTime`, drop the `"lifetime"` encoding, and remove the lifetime option from the UI and the CLI diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs index f40867160..968398571 100644 --- a/src/Simplex/FileTransfer/Server.hs +++ b/src/Simplex/FileTransfer/Server.hs @@ -56,7 +56,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 (..), entitlementIssuerKeys, verifyEntitlement) +import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementProof (..), verifyEntitlement) import qualified Simplex.Messaging.Crypto.Lazy as LC import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String @@ -509,10 +509,11 @@ processXFTPRequest sessionId HTTP2Body {bodyPart} = \case storageMaxSeconds _ Nothing = asks $ ttl . fileExpiration . config storageMaxSeconds ph (Just proof@EntitlementProof {entitlement = ent}) = do entCfg <- asks $ fileStorageEntitlements . config + keys <- asks $ entitlementKeys . config defaultMax <- asks $ ttl . fileExpiration . config now <- liftIO getCurrentTime let Entitlement {entitlementName, expiresAt} = ent - liftIO (verifyEntitlement entitlementIssuerKeys ph proof) >>= \case + liftIO (verifyEntitlement keys ph proof) >>= \case Just True | addUTCTime nominalDay expiresAt > now -> pure $ fromMaybe defaultMax (M.lookup entitlementName entCfg) _ -> pure defaultMax addFileRetry :: s -> FileInfo -> Int -> RoundedFileTime -> Maybe RoundedFileTime -> M s (Either XFTPErrorType XFTPFileId) diff --git a/src/Simplex/FileTransfer/Server/Env.hs b/src/Simplex/FileTransfer/Server/Env.hs index c42e4050a..8c55f770e 100644 --- a/src/Simplex/FileTransfer/Server/Env.hs +++ b/src/Simplex/FileTransfer/Server/Env.hs @@ -41,11 +41,12 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Text (Text) import Data.Time.Clock (getCurrentTime) -import Data.Word (Word32) +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.Messaging.Crypto.BBS (BBSPublicKey) import Simplex.Messaging.Crypto.Entitlement (EntitlementProof) import Simplex.FileTransfer.Server.Stats import Data.Either (fromRight) @@ -95,6 +96,7 @@ data XFTPServerConfig s = XFTPServerConfig fileExpiration :: ExpirationConfig, -- | maximum storage time per entitlement name, seconds fileStorageEntitlements :: Map Text Int64, + entitlementKeys :: Map Word16 BBSPublicKey, -- | timeout to receive file fileTimeout :: Int, -- | time after which inactive clients can be disconnected and check interval, seconds diff --git a/src/Simplex/FileTransfer/Server/Main.hs b/src/Simplex/FileTransfer/Server/Main.hs index b3c7b08a3..3729e80c7 100644 --- a/src/Simplex/FileTransfer/Server/Main.hs +++ b/src/Simplex/FileTransfer/Server/Main.hs @@ -35,6 +35,7 @@ import Simplex.FileTransfer.Server (runXFTPServer) import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), XFTPStoreConfig, AFStoreType (..), defFileExpirationHours, defaultFileExpiration, defaultInactiveClientExpiration, readFileStoreType, runWithStoreConfig, checkFileStoreMode, importToDatabase, exportFromDatabase) import Simplex.FileTransfer.Transport (alpnSupportedXFTPhandshakes, supportedFileServerVRange) import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.Entitlement (entitlementIssuerKeys) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer) import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..)) @@ -292,6 +293,7 @@ xftpServerCLI_ generateSite serveStaticFiles cfgPath logPath = do { ttl = 3600 * readIniDefault defFileExpirationHours "STORE_LOG" "expire_files_hours" ini }, fileStorageEntitlements = iniEntitlements ini, + entitlementKeys = entitlementIssuerKeys, fileTimeout = 5 * 60 * 1000000, -- 5 mins to send 4mb chunk inactiveClientExpiration = settingIsOn "INACTIVE_CLIENTS" "disconnect" ini @@ -443,5 +445,5 @@ iniEntitlements :: Ini -> Map T.Text Int64 iniEntitlements ini = M.fromList $ mapMaybe readEntitlement [("supporter", "expire_files_hours_for_supporter"), ("legend", "expire_files_hours_for_legend")] where - readEntitlement (name, key) = (name,) <$> (parseMax =<< eitherToMaybe (lookupValue "STORE_LOG" key ini)) - parseMax t = (3600 *) <$> (readMaybe (T.unpack (T.strip t)) :: Maybe Int64) + readEntitlement (name, key) = (name,) . parseHours key <$> eitherToMaybe (lookupValue "STORE_LOG" key ini) + parseHours key t = maybe (error $ "Error: invalid " <> T.unpack key <> " value: " <> T.unpack t) (3600 *) (readMaybe (T.unpack (T.strip t)) :: Maybe Int64) diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 1bfc79a8a..94c5e22f8 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -253,7 +253,7 @@ import Simplex.Messaging.Agent.TSessionSubs (TSessionSubs) import qualified Simplex.Messaging.Agent.TSessionSubs as SS import Simplex.Messaging.Client import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential (..), entitlementIssuerKeys, generateEntitlementProof) +import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential (..), generateEntitlementProof) import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Client @@ -2194,15 +2194,16 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize}, let fileInfo = FileInfo {sndKey, size = chunkSize, digest = chunkDigest} logServer "-->" c srv NoEntity "FNEW" tSess <- mkTransportSession c userId srv chunkDigest + keys <- asks $ entitlementKeys . config (sndId, rIds, expiresAt) <- withClient c NRMBackground tSess $ \xftp -> do - proof <- liftIO $ mkEntitlementProof (sessionId $ X.thParams xftp) sndKey + proof <- liftIO $ mkEntitlementProof keys (sessionId $ X.thParams xftp) sndKey X.createXFTPChunk xftp replicaKey fileInfo (L.map fst rKeys) auth storageTime proof logServer "<--" c srv NoEntity $ B.unwords ["SIDS", logSecret sndId] pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys, expiresAt} where - mkEntitlementProof sessId sndKey = + mkEntitlementProof keys sessId sndKey = pure credential - $>>= \cred -> pure (M.lookup (issuerKeyIdx cred) entitlementIssuerKeys) + $>>= \cred -> pure (M.lookup (issuerKeyIdx cred) keys) $>>= \pk -> generateEntitlementProof pk cred (xftpNewProofHeader sessId sndKey chunkDigest) >>= \case Right p -> pure $ Just p diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs index c8a98264f..709a44674 100644 --- a/src/Simplex/Messaging/Agent/Env/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs @@ -67,6 +67,8 @@ import Simplex.Messaging.Agent.Store.Interface (DBOpts) import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationError (..)) import Simplex.Messaging.Client import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.BBS (BBSPublicKey) +import Simplex.Messaging.Crypto.Entitlement (entitlementIssuerKeys) import Simplex.Messaging.Crypto.Ratchet (VersionRangeE2E, supportedE2EEncryptVRange) import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig) import Simplex.Messaging.Notifications.Transport (NTFVersion) @@ -148,6 +150,7 @@ data AgentConfig = AgentConfig smpCfg :: ProtocolClientConfig SMPVersion, ntfCfg :: ProtocolClientConfig NTFVersion, xftpCfg :: XFTPClientConfig, + entitlementKeys :: Map Word16 BBSPublicKey, reconnectInterval :: RetryInterval, messageRetryInterval :: RetryInterval2, userNetworkInterval :: Int, @@ -226,6 +229,7 @@ defaultAgentConfig = smpCfg = defaultSMPClientConfig, ntfCfg = defaultNTFClientConfig, xftpCfg = defaultXFTPClientConfig, + entitlementKeys = entitlementIssuerKeys, reconnectInterval = defaultReconnectInterval, messageRetryInterval = defaultMessageRetryInterval, userNetworkInterval = 1800_000000, -- 30 minutes, should be less than Int32 max value diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs index 5c3174dd5..d1019231f 100644 --- a/tests/XFTPAgent.hs +++ b/tests/XFTPAgent.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -20,23 +21,30 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as LB import Data.Int (Int64) import Data.List (find, isSuffixOf) +import qualified Data.Map.Strict as M import Data.Maybe (fromJust) +import Data.Time.Clock (addUTCTime, getCurrentTime, nominalDay) +import Data.Time.Clock.System (getSystemTime, systemSeconds) import SMPAgentClient (agentCfg, initAgentServers, testDB, testDB2, testDB3) import SMPClient (xit'') import Simplex.FileTransfer.Client (XFTPClientConfig (..)) import Simplex.FileTransfer.Description (FileChunk (..), FileDescription (..), FileDescriptionURI (..), ValidFileDescription, fileDescriptionURI, kb, mb, qrSizeLimit, pattern ValidFileDescription) -import Simplex.FileTransfer.Protocol (FileParty (..)) +import Simplex.FileTransfer.Protocol (FileParty (..), GrantedStorageTime (..)) import Simplex.FileTransfer.Server.Env (AFStoreType, XFTPServerConfig (..)) import Simplex.FileTransfer.Server.Store (STMFileStore) import Simplex.FileTransfer.Transport (XFTPErrorType (AUTH)) import Simplex.FileTransfer.Types (RcvFileId, SndFileId) import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendDescription, xftpStartWorkers) +import qualified Simplex.Messaging.Agent as XA import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..)) import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, xftpCfg) +import qualified Simplex.Messaging.Agent.Env.SQLite as AEnv import Simplex.Messaging.Agent.Protocol hiding (SFDONE) import qualified Simplex.Messaging.Agent.Protocol as A import Simplex.Messaging.Client (pattern NRMInteractive) import qualified Simplex.Messaging.Crypto as C +import Simplex.Messaging.Crypto.BBS (bbsKeyGen) +import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), MasterKey (..), signEntitlement) import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Encoding.String (StrEncoding (..)) @@ -75,6 +83,7 @@ xftpAgentTests = it "should send and receive with encrypted local files" testXFTPAgentSendReceiveEncrypted it "should send and receive large file with a redirect" testXFTPAgentSendReceiveRedirect it "should send and receive small file without a redirect" testXFTPAgentSendReceiveNoRedirect + it "should extend storage time with an entitlement proof and report the granted expiry" $ \_ -> testXFTPAgentEntitlement describe "sending and receiving with version negotiation" $ beforeWith (const (pure ())) testXFTPAgentSendReceiveMatrix it "should resume receiving file after restart" $ \_ -> testXFTPAgentReceiveRestore it "should cleanup rcv tmp path after permanent error" $ \_ -> testXFTPAgentReceiveCleanup @@ -330,6 +339,32 @@ testNoRedundancy :: HasCallStack => ValidFileDescription 'FRecipient -> IO () testNoRedundancy (ValidFileDescription FileDescription {chunks}) = all (\FileChunk {replicas} -> length replicas == 1) chunks `shouldBe` True +testXFTPAgentEntitlement :: HasCallStack => IO () +testXFTPAgentEntitlement = do + Right (issuerPk, issuerSk) <- bbsKeyGen + now <- getCurrentTime + let ent = Entitlement {entitlementName = "supporter", expiresAt = addUTCTime (30 * nominalDay) now, extraInfo = ""} + keys = M.fromList [(1, issuerPk)] + Right credential <- signEntitlement issuerSk 1 (MasterKey "0123456789abcdef0123456789abcdef") ent + let srvCfg = testXFTPServerConfig {entitlementKeys = keys, fileStorageEntitlements = M.fromList [("supporter", 168 * 3600)]} + withXFTPServerCfg srvCfg $ \_ -> do + filePath <- createRandomFile_ (kb 128 :: Integer) "testfile" + withAgent 1 (agentCfg {AEnv.entitlementKeys = keys}) initAgentServers testDB $ \sndr -> runRight_ $ do + xftpStartWorkers sndr (Just senderFiles) + nowSec <- liftIO $ systemSeconds <$> getSystemTime + _ <- XA.xftpSendFile sndr 1 (CF.plain filePath) 1 (Just credential) (Just 100) + gExpires <- waitSndDone sndr + liftIO $ case gExpires of + Just (GSTExpires t) -> do + t `shouldSatisfy` (>= nowSec + 100 * 3600) + t `shouldSatisfy` (< nowSec + 100 * 3600 + 7200) + Nothing -> expectationFailure "expected granted storage time in SFDONE" + where + waitSndDone sndr = + sfGet sndr >>= \case + ("", _, A.SFDONE _ _ g) -> pure g + _ -> waitSndDone sndr + testReceive :: HasCallStack => AgentClient -> ValidFileDescription 'FRecipient -> FilePath -> ExceptT AgentErrorType IO RcvFileId testReceive rcp rfd = testReceiveCF rcp rfd Nothing diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs index d694cf271..2b28348fb 100644 --- a/tests/XFTPClient.hs +++ b/tests/XFTPClient.hs @@ -186,6 +186,7 @@ testXFTPServerConfig = controlPortUserAuth = Nothing, fileExpiration = defaultFileExpiration, fileStorageEntitlements = mempty, + entitlementKeys = mempty, fileTimeout = 10000000, inactiveClientExpiration = Just defaultInactiveClientExpiration, xftpCredentials =