dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-09-02 15:53:45 +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
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;
|]