dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-09-01 22:29:01 +00:00
Code Issues Packages Projects Releases Wiki Activity

refactor

Browse Source
This commit is contained in:
Evgeny @ SimpleX Chat
2026-08-27 20:00:26 +00:00
parent 83accac0bb
commit 3aad156114
2 changed files with 11 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Agent/Client.hs
+7 -5
View File
@@ -2195,14 +2195,16 @@ agentXFTPNewChunk c SndFileChunk {userId, chunkSpec = XFTPChunkSpec {chunkSize},
logServer "-->" c srv NoEntity "FNEW"
tSess <- mkTransportSession c userId srv chunkDigest
(sndId, rIds) <- withClient c NRMBackground tSess $ \xftp -> do
proof <- liftIO $ case credential of
Nothing -> pure Nothing
Just cred@EntitlementCredential {issuerKeyIdx} -> case M.lookup issuerKeyIdx entitlementIssuerKeys of
Nothing -> pure Nothing
Just pk -> either (const Nothing) Just <$> generateEntitlementProof pk cred (xftpNewProofHeader (sessionId $ X.thParams xftp) sndKey chunkDigest)
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}
where
mkEntitlementProof sessId sndKey =
pure (credential >>= \cred@EntitlementCredential {issuerKeyIdx} -> (cred,) <$> M.lookup issuerKeyIdx entitlementIssuerKeys) $>>= \(cred, pk) ->
generateEntitlementProof pk cred (xftpNewProofHeader sessId sndKey chunkDigest) >>= \case
Right p -> pure $ Just p
Left e -> Nothing <$ logError ("entitlement proof error: " <> tshow e)
agentXFTPUploadChunk :: AgentClient -> UserId -> FileDigest -> SndFileChunkReplica -> XFTPChunkSpec -> AM ()
agentXFTPUploadChunk c userId (FileDigest chunkDigest) SndFileChunkReplica {server, replicaId = ChunkReplicaId fId, replicaKey} chunkSpec =
src/Simplex/Messaging/Crypto/Entitlement.hs
+4 -3
View File
@@ -24,6 +24,7 @@ module Simplex.Messaging.Crypto.Entitlement
)
where
import Control.Monad (forM)
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson.TH as JQ
import Data.ByteString.Char8 (ByteString)
@@ -120,9 +121,9 @@ generateEntitlementProof pk EntitlementCredential {issuerKeyIdx, masterKey, issu
-- against the supplied presentation header. Nothing means the key index is not
-- among the configured keys.
verifyEntitlement :: Map Int BBSPublicKey -> BBSPresHeader -> EntitlementProof -> IO (Maybe Bool)
verifyEntitlement keys ph EntitlementProof {issuerKeyIdx, proof, entitlement} = case M.lookup issuerKeyIdx keys of
Nothing -> pure Nothing
Just pk -> Just <$> bbsProofVerify pk proof entitlementBBSHeader ph entitlementDisclosedIndexes entitlementMessageCount (disclosedMessages entitlement)
verifyEntitlement keys ph EntitlementProof {issuerKeyIdx, proof, entitlement} =
forM (M.lookup issuerKeyIdx keys) $ \pk ->
bbsProofVerify pk proof entitlementBBSHeader ph entitlementDisclosedIndexes entitlementMessageCount (disclosedMessages entitlement)
entitlementIssuerKeys :: Map Int BBSPublicKey
entitlementIssuerKeys =