dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-08-28 23:08:27 +00:00
Code Issues Packages Projects Releases Wiki Activity

add file expiration time to agent event

Browse Source
This commit is contained in:
Evgeny @ SimpleX Chat
2026-08-28 07:24:13 +00:00
parent af4bed8836
commit 1ce2df9aa0
16 changed files with 56 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files
plans/2026-08-22-xftp-file-storage-time.md
+8 -1
View File
@@ -112,7 +112,14 @@ 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
- `createXFTPChunk` returns the granted expiry (epoch seconds); `agentXFTPNewChunk` stores it on `NewSndChunkReplica`
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`
- 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)
## simplex-chat
rfcs/2026-08-22-xftp-file-storage-time.md
+1 -1
View File
@@ -13,7 +13,7 @@ The proof discloses the entitlement and includes the issuer key index and the BB
```
entitlement = entName entExpires entExtra
entName = shortString ; e.g. "supporter", "legend"
entExpires = shortString ; expiration, encoded as signed
entExpires = shortString ; expiration as a UTCTime ISO8601 string
entExtra = shortString ; opaque, interpretation out of scope
entitlementProof = issuerKeyIndex bbsProof entitlement
src/Simplex/FileTransfer/Agent.hs
+6 -2
View File
@@ -54,7 +54,7 @@ import Simplex.FileTransfer.Chunks (toKB)
import Simplex.FileTransfer.Client (XFTPChunkSpec (..), getChunkDigest, prepareChunkSizes, prepareChunkSpecs, singleChunkSize)
import Simplex.FileTransfer.Crypto
import Simplex.FileTransfer.Description
import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
import Simplex.FileTransfer.Protocol (FileParty (..), GrantedStorageTime, SFileParty (..))
import Simplex.FileTransfer.Transport (XFTPRcvChunkSpec (..))
import qualified Simplex.FileTransfer.Transport as XFTP
import Simplex.FileTransfer.Types
@@ -544,7 +544,7 @@ runXFTPSndWorker c srv Worker {doWork} = do
notify c sndFileEntityId $ SFPROG uploaded total
when complete $ do
(sndDescr, rcvDescrs) <- sndFileToDescrs sf
notify c sndFileEntityId $ SFDONE sndDescr rcvDescrs
notify c sndFileEntityId $ SFDONE sndDescr rcvDescrs (sndFileExpiresAt chunks)
lift . forM_ prefixPath $ removePath <=< toFSFilePath
withStore' c $ \db -> updateSndFileComplete db sndFileId
where
@@ -578,6 +578,10 @@ runXFTPSndWorker c srv Worker {doWork} = do
let chunkSize = FileSize $ sndChunkSize ch
replicas = [FileChunkReplica {server, replicaId, replicaKey}]
pure FileChunk {chunkNo, digest = chDigest, chunkSize, replicas}
sndFileExpiresAt :: [SndFileChunk] -> Maybe GrantedStorageTime
sndFileExpiresAt = fmap minimum . mapM chunkExpiresAt
where
chunkExpiresAt SndFileChunk {replicas} = maximum <$> L.nonEmpty (mapMaybe (\SndFileChunkReplica {expiresAt} -> expiresAt) replicas)
createRcvFileDescriptions :: FileDescription 'FRecipient -> [SndFileChunk] -> [FileDescription 'FRecipient]
createRcvFileDescriptions fd sndChunks = map (\chunks -> (fd :: (FileDescription 'FRecipient)) {chunks}) rcvChunks
where
src/Simplex/FileTransfer/Client.hs
+2 -2
View File
@@ -256,10 +256,10 @@ createXFTPChunk ::
Maybe BasicAuth ->
Maybe Int64 ->
Maybe EntitlementProof ->
ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId)
ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId, Maybe GrantedStorageTime)
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)
(FRSndIds sId rIds gs, body) -> noFile body (sId, rIds, gs)
(r, _) -> throwE $ unexpectedResponse r
addXFTPRecipients :: XFTPClient -> C.APrivateAuthKey -> XFTPFileId -> NonEmpty C.APublicAuthKey -> ExceptT XFTPClientError IO (NonEmpty RecipientId)
src/Simplex/FileTransfer/Client/Main.hs
+1 -1
View File
@@ -328,7 +328,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
digest <- liftIO $ getChunkDigest chunkSpec
let ch = FileInfo {sndKey, size = chunkSize, digest}
c <- withRetry retryCount $ getXFTPServerClient a xftpServer
(sndId, rIds) <- withRetry retryCount $ createXFTPChunk c spKey ch (L.map fst rKeys) auth Nothing Nothing
(sndId, rIds, _) <- withRetry retryCount $ createXFTPChunk c spKey ch (L.map fst rKeys) auth Nothing Nothing
withReconnect a xftpServer retryCount $ \c' -> uploadXFTPChunk c' spKey sndId chunkSpec
logDebug $ "uploaded chunk " <> tshow chunkNo
uploaded <- atomically . stateTVar uploadedChunks $ \cs ->
src/Simplex/FileTransfer/Protocol.hs
+1 -1
View File
@@ -202,7 +202,7 @@ data FileInfo = FileInfo
deriving (Show)
data GrantedStorageTime = GSTExpires {epochSeconds :: Int64}
deriving (Eq, Show)
deriving (Eq, Ord, Show)
xftpNewProofHeader :: SessionId -> SndPublicAuthKey -> ByteString -> BBSPresHeader
xftpNewProofHeader sessionId sndKey digest = BBSPresHeader $ sessionId <> smpEncode sndKey <> digest
src/Simplex/FileTransfer/Types.hs
+5 -2
View File
@@ -41,6 +41,7 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Word (Word32)
import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
import Simplex.FileTransfer.Description
import Simplex.FileTransfer.Protocol (GrantedStorageTime (..))
import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential)
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
import qualified Simplex.Messaging.Crypto as C
@@ -234,7 +235,8 @@ data NewSndChunkReplica = NewSndChunkReplica
{ server :: XFTPServer,
replicaId :: ChunkReplicaId,
replicaKey :: C.APrivateAuthKey,
rcvIdsKeys :: [(ChunkReplicaId, C.APrivateAuthKey)]
rcvIdsKeys :: [(ChunkReplicaId, C.APrivateAuthKey)],
expiresAt :: Maybe GrantedStorageTime
}
deriving (Show)
@@ -246,7 +248,8 @@ data SndFileChunkReplica = SndFileChunkReplica
rcvIdsKeys :: [(ChunkReplicaId, C.APrivateAuthKey)],
replicaStatus :: SndFileReplicaStatus,
delay :: Maybe Int64,
retries :: Int
retries :: Int,
expiresAt :: Maybe GrantedStorageTime
}
deriving (Show)
src/Simplex/Messaging/Agent/Client.hs
+3 -3
View File
@@ -1346,7 +1346,7 @@ runXFTPServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth s
let file = FileInfo {sndKey, size = chSize, digest}
chunkSpec = X.XFTPChunkSpec {filePath, chunkOffset = 0, chunkSize = chSize}
r <- runExceptT $ do
(sId, [rId]) <- liftError (testErr TSCreateFile) $ X.createXFTPChunk xftp spKey file [rcvKey] auth Nothing Nothing
(sId, [rId], _) <- liftError (testErr TSCreateFile) $ X.createXFTPChunk xftp spKey file [rcvKey] auth Nothing Nothing
liftError (testErr TSUploadFile) $ X.uploadXFTPChunk xftp spKey sId chunkSpec
liftError (testErr TSDownloadFile) $ X.downloadXFTPChunk g xftp rpKey rId $ XFTPRcvChunkSpec rcvPath chSize digest
rcvDigest <- liftIO $ C.sha256Hash <$> B.readFile rcvPath
@@ -2194,11 +2194,11 @@ 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
(sndId, rIds) <- withClient c NRMBackground tSess $ \xftp -> do
(sndId, rIds, expiresAt) <- withClient c NRMBackground tSess $ \xftp -> do
proof <- liftIO $ mkEntitlementProof (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}
pure NewSndChunkReplica {server = srv, replicaId = ChunkReplicaId sndId, replicaKey, rcvIdsKeys = L.toList $ xftpRcvIdsKeys rIds rKeys, expiresAt}
where
mkEntitlementProof sessId sndKey =
pure credential
src/Simplex/Messaging/Agent/Protocol.hs
+2 -2
View File
@@ -228,7 +228,7 @@ import Data.Type.Equality
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32)
import Simplex.FileTransfer.Description
import Simplex.FileTransfer.Protocol (FileParty (..))
import Simplex.FileTransfer.Protocol (FileParty (..), GrantedStorageTime)
import Simplex.FileTransfer.Transport (XFTPErrorType)
import Simplex.FileTransfer.Types (FileErrorType)
import Simplex.Messaging.Agent.QueryString
@@ -444,7 +444,7 @@ data AEvent (e :: AEntity) where
RFERR :: AgentErrorType -> AEvent AERcvFile
RFWARN :: AgentErrorType -> AEvent AERcvFile
SFPROG :: Int64 -> Int64 -> AEvent AESndFile
SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> AEvent AESndFile
SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> Maybe GrantedStorageTime -> AEvent AESndFile
SFERR :: AgentErrorType -> AEvent AESndFile
SFWARN :: AgentErrorType -> AEvent AESndFile
src/Simplex/Messaging/Agent/Store/AgentStore.hs
+10 -10
View File
@@ -309,7 +309,7 @@ import Network.Socket (ServiceName)
import qualified Network.TLS as TLS
import Simplex.FileTransfer.Client (XFTPChunkSpec (..))
import Simplex.FileTransfer.Description
import Simplex.FileTransfer.Protocol (FileParty (..), SFileParty (..))
import Simplex.FileTransfer.Protocol (FileParty (..), GrantedStorageTime (..), SFileParty (..))
import Simplex.FileTransfer.Types
import Simplex.Messaging.Crypto.Entitlement (EntitlementCredential)
import Simplex.Messaging.Agent.Protocol
@@ -3511,7 +3511,7 @@ getSndFile db sndFileId = runExceptT $ do
db
[sql|
SELECT
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,
s.xftp_host, s.xftp_port, s.xftp_key_hash
FROM snd_file_chunk_replicas r
JOIN xftp_servers s ON s.xftp_server_id = r.xftp_server_id
@@ -3522,10 +3522,10 @@ getSndFile db sndFileId = runExceptT $ do
rcvIdsKeys <- getChunkReplicaRecipients_ db sndChunkReplicaId
pure (replica :: SndFileChunkReplica) {rcvIdsKeys}
where
toReplica :: (Int64, ChunkReplicaId, C.APrivateAuthKey, SndFileReplicaStatus, Maybe Int64, Int, NonEmpty TransportHost, ServiceName, C.KeyHash) -> SndFileChunkReplica
toReplica (sndChunkReplicaId, replicaId, replicaKey, replicaStatus, delay, retries, host, port, keyHash) =
toReplica :: (Int64, ChunkReplicaId, C.APrivateAuthKey, SndFileReplicaStatus, Maybe Int64, Int, Maybe Int64, NonEmpty TransportHost, ServiceName, C.KeyHash) -> SndFileChunkReplica
toReplica (sndChunkReplicaId, replicaId, replicaKey, replicaStatus, delay, retries, expiresAtSec, host, port, keyHash) =
let server = XFTPServer host port keyHash
in SndFileChunkReplica {sndChunkReplicaId, server, replicaId, replicaKey, replicaStatus, delay, retries, rcvIdsKeys = []}
in SndFileChunkReplica {sndChunkReplicaId, server, replicaId, replicaKey, replicaStatus, delay, retries, expiresAt = GSTExpires <$> expiresAtSec, rcvIdsKeys = []}
getChunkReplicaRecipients_ :: DB.Connection -> Int64 -> IO [(ChunkReplicaId, C.APrivateAuthKey)]
getChunkReplicaRecipients_ db replicaId =
@@ -3606,16 +3606,16 @@ createSndFileReplica :: DB.Connection -> SndFileChunk -> NewSndChunkReplica -> I
createSndFileReplica db SndFileChunk {sndChunkId} = createSndFileReplica_ db sndChunkId
createSndFileReplica_ :: DB.Connection -> Int64 -> NewSndChunkReplica -> IO ()
createSndFileReplica_ db sndChunkId NewSndChunkReplica {server, replicaId, replicaKey, rcvIdsKeys} = do
createSndFileReplica_ db sndChunkId NewSndChunkReplica {server, replicaId, replicaKey, rcvIdsKeys, expiresAt} = do
srvId <- createXFTPServer_ db server
DB.execute
db
[sql|
INSERT INTO snd_file_chunk_replicas
(snd_file_chunk_id, replica_number, xftp_server_id, replica_id, replica_key, replica_status)
VALUES (?,?,?,?,?,?)
(snd_file_chunk_id, replica_number, xftp_server_id, replica_id, replica_key, replica_status, replica_expires_at)
VALUES (?,?,?,?,?,?,?)
|]
(sndChunkId, 1 :: Int, srvId, replicaId, replicaKey, SFRSCreated)
(sndChunkId, 1 :: Int, srvId, replicaId, replicaKey, SFRSCreated, epochSeconds <$> expiresAt)
rId <- insertedRowId db
forM_ rcvIdsKeys $ \(rcvId, rcvKey) -> do
DB.execute
@@ -3688,7 +3688,7 @@ getNextSndChunkToUpload db server@ProtocolServer {host, port, keyHash} ttl = do
chunkSpec,
digest,
filePrefixPath,
replicas = [SndFileChunkReplica {sndChunkReplicaId, server, replicaId, replicaKey, replicaStatus, delay, retries, rcvIdsKeys = []}]
replicas = [SndFileChunkReplica {sndChunkReplicaId, server, replicaId, replicaKey, replicaStatus, delay, retries, expiresAt = Nothing, rcvIdsKeys = []}]
}
updateSndChunkReplicaDelay :: DB.Connection -> Int64 -> Int64 -> IO ()
src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260823_snd_files_entitlement.hs
+2
View File
@@ -11,11 +11,13 @@ m20260823_snd_files_entitlement =
[r|
ALTER TABLE snd_files ADD COLUMN entitlement_credential TEXT;
ALTER TABLE snd_files ADD COLUMN storage_time BIGINT;
ALTER TABLE snd_file_chunk_replicas ADD COLUMN replica_expires_at BIGINT;
|]
down_m20260823_snd_files_entitlement :: Text
down_m20260823_snd_files_entitlement =
[r|
ALTER TABLE snd_file_chunk_replicas DROP COLUMN replica_expires_at;
ALTER TABLE snd_files DROP COLUMN storage_time;
ALTER TABLE snd_files DROP COLUMN entitlement_credential;
|]
src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260823_snd_files_entitlement.hs
+2
View File
@@ -10,11 +10,13 @@ m20260823_snd_files_entitlement =
[sql|
ALTER TABLE snd_files ADD COLUMN entitlement_credential TEXT;
ALTER TABLE snd_files ADD COLUMN storage_time INTEGER;
ALTER TABLE snd_file_chunk_replicas ADD COLUMN replica_expires_at INTEGER;
|]
down_m20260823_snd_files_entitlement :: Query
down_m20260823_snd_files_entitlement =
[sql|
ALTER TABLE snd_file_chunk_replicas DROP COLUMN replica_expires_at;
ALTER TABLE snd_files DROP COLUMN storage_time;
ALTER TABLE snd_files DROP COLUMN entitlement_credential;
|]
tests/AgentTests/SQLiteTests.hs
+2 -1
View File
@@ -798,7 +798,8 @@ newSndChunkReplica1 =
{ server = xftpServer1,
replicaId = ChunkReplicaId $ EntityId "abc",
replicaKey = testFileReplicaKey,
rcvIdsKeys = [(ChunkReplicaId $ EntityId "abc", testFileReplicaKey)]
rcvIdsKeys = [(ChunkReplicaId $ EntityId "abc", testFileReplicaKey)],
expiresAt = Nothing
}
testGetNextSndChunkToUpload :: DBStore -> Expectation
tests/XFTPAgent.hs
+5 -1
View File
@@ -33,7 +33,8 @@ import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
import Simplex.Messaging.Agent (AgentClient, testProtocolServer, xftpDeleteRcvFile, xftpDeleteSndFileInternal, xftpDeleteSndFileRemote, xftpReceiveFile, xftpSendDescription, xftpStartWorkers)
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, xftpCfg)
import Simplex.Messaging.Agent.Protocol (AEvent (..), AgentErrorType (..), BrokerErrorType (..), noAuthSrv)
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.File (CryptoFile (..), CryptoFileArgs)
@@ -56,6 +57,9 @@ import Fixtures
import Simplex.Messaging.Agent.Store.Postgres.Util (dropAllSchemasExceptSystem)
#endif
pattern SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> AEvent 'AESndFile
pattern SFDONE sndDescr rcvDescrs <- A.SFDONE sndDescr rcvDescrs _
xftpAgentTests :: SpecWith AFStoreType
xftpAgentTests =
around_ testBracket
tests/XFTPServerTests.hs
+1 -1
View File
@@ -103,7 +103,7 @@ createTestChunk fp = do
pure bytes
createXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> FileInfo -> NonEmpty C.APublicAuthKey -> Maybe BasicAuth -> ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId)
createXFTPChunk c spKey file rcps auth = A.createXFTPChunk c spKey file rcps auth Nothing Nothing
createXFTPChunk c spKey file rcps auth = (\(sId, rIds, _) -> (sId, rIds)) <$> A.createXFTPChunk c spKey file rcps auth Nothing Nothing
readChunk :: XFTPFileId -> IO ByteString
readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode $ unEntityId sId))
tests/XFTPWebTests.hs
+5 -1
View File
@@ -49,7 +49,8 @@ import Simplex.FileTransfer.Server.Store (STMFileStore)
import XFTPClient (testXFTPServerConfigEd25519SNI, testXFTPServerConfigSNI, withXFTPServerCfg, xftpSendFile, xftpTestPort)
import AgentTests.FunctionalAPITests (rfGet, runRight, runRight_, sfGet, withAgent)
import Simplex.Messaging.Agent (AgentClient, xftpReceiveFile, xftpStartWorkers)
import Simplex.Messaging.Agent.Protocol (AEvent (..))
import Simplex.Messaging.Agent.Protocol hiding (SFDONE)
import qualified Simplex.Messaging.Agent.Protocol as A
import SMPAgentClient (agentCfg, initAgentServers, testDB)
import XFTPCLI (recipientFiles, senderFiles, testBracket)
import qualified Simplex.Messaging.Crypto.File as CF
@@ -168,6 +169,9 @@ impAddr = "import * as Addr from './dist/protocol/address.js';"
jsOut :: String -> String
jsOut expr = "process.stdout.write(Buffer.from(" <> expr <> "));"
pattern SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> AEvent 'AESndFile
pattern SFDONE sndDescr rcvDescrs <- A.SFDONE sndDescr rcvDescrs _
xftpWebTests :: IO () -> Spec
xftpWebTests dbCleanup = do
xftpWebSourceHygieneTests