mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-23 14:20:00 +00:00
smp protocol: remove creating notifications from NEW command, new ideas for notifications (#1500)
This commit is contained in:
Evgeny
@@ -908,8 +908,9 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s
|
||||
createRcvQueue :: Maybe C.CbNonce -> ClntQueueReqData -> C.KeyPairX25519 -> AM (RcvQueue, SMPQueueUri)
|
||||
createRcvQueue nonce_ qd e2eKeys = do
|
||||
AgentConfig {smpClientVRange = vr} <- asks config
|
||||
let ntfCreds_ = Nothing -- TODO [short links]
|
||||
(rq, qUri, tSess, sessId) <- newRcvQueue_ c userId connId srvWithAuth vr qd subMode ntfCreds_ nonce_ e2eKeys `catchAgentError` \e -> liftIO (print e) >> throwE e
|
||||
-- TODO [notifications] send correct NTF credentials here
|
||||
-- let ntfCreds_ = Nothing
|
||||
(rq, qUri, tSess, sessId) <- newRcvQueue_ c userId connId srvWithAuth vr qd subMode nonce_ e2eKeys `catchAgentError` \e -> liftIO (print e) >> throwE e
|
||||
atomically $ incSMPServerStat c userId srv connCreated
|
||||
rq' <- withStore c $ \db -> updateNewConnRcv db connId rq
|
||||
lift . when (subMode == SMSubscribe) $ addNewQueueSubscription c rq' tSess sessId
|
||||
@@ -934,7 +935,8 @@ newRcvConnSrv c userId connId enableNtfs cMode userData_ clientData pqInitKeys s
|
||||
nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
|
||||
sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
|
||||
AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
|
||||
let sndId = SMP.EntityId $ C.sha3_256 corrId
|
||||
-- TODO [notifications] the remaining 24 bytes are reserved for notifier ID
|
||||
let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
|
||||
sndSecure = case cMode of SCMContact -> False; SCMInvitation -> True
|
||||
qUri = SMPQueueUri vr $ SMPQueueAddress srv sndId e2eDhKey sndSecure
|
||||
connReq <- createConnReq qUri
|
||||
@@ -1117,8 +1119,8 @@ joinConnSrvAsync _c _userId _connId _enableNtfs (CRContactUri _) _cInfo _subMode
|
||||
|
||||
createReplyQueue :: AgentClient -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
|
||||
createReplyQueue c ConnData {userId, connId, enableNtfs} SndQueue {smpClientVersion} subMode srv = do
|
||||
-- TODO [short links] ntf credentials
|
||||
(rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) SCMInvitation subMode Nothing
|
||||
-- TODO [notifications] send correct NTF credentials here
|
||||
(rq, qUri, tSess, sessId) <- newRcvQueue c userId connId srv (versionToRange smpClientVersion) SCMInvitation subMode -- Nothing
|
||||
atomically $ incSMPServerStat c userId (qServer rq) connCreated
|
||||
let qInfo = toVersionT qUri smpClientVersion
|
||||
rq' <- withStore c $ \db -> upgradeSndConnToDuplex db connId rq
|
||||
@@ -1886,8 +1888,8 @@ switchDuplexConnection c (DuplexConnection cData@ConnData {connId, userId} rqs s
|
||||
-- try to get the server that is different from all queues, or at least from the primary rcv queue
|
||||
srvAuth@(ProtoServerWithAuth srv _) <- getNextSMPServer c userId $ map qServer (L.toList rqs) <> map qServer (L.toList sqs)
|
||||
srv' <- if srv == server then getNextSMPServer c userId [server] else pure srvAuth
|
||||
-- TODO [short links] send correct NTF credentials here
|
||||
(q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SCMInvitation SMSubscribe Nothing
|
||||
-- TODO [notifications] send correct NTF credentials here
|
||||
(q, qUri, tSess, sessId) <- newRcvQueue c userId connId srv' clientVRange SCMInvitation SMSubscribe -- Nothing
|
||||
let rq' = (q :: NewRcvQueue) {primary = True, dbReplaceQueueId = Just dbQueueId}
|
||||
rq'' <- withStore c $ \db -> addConnRcvQueue db connId rq'
|
||||
lift $ addNewQueueSubscription c rq'' tSess sessId
|
||||
|
||||
@@ -267,7 +267,6 @@ import Simplex.Messaging.Protocol
|
||||
SubscriptionMode (..),
|
||||
QueueReqData (..),
|
||||
QueueLinkData,
|
||||
NewNtfCreds,
|
||||
UserProtocol,
|
||||
VersionRangeSMPC,
|
||||
VersionSMPC,
|
||||
@@ -1232,7 +1231,8 @@ runSMPServerTest c userId (ProtoServerWithAuth srv auth) = do
|
||||
(sKey, spKey) <- atomically $ C.generateAuthKeyPair sa g
|
||||
(dhKey, _) <- atomically $ C.generateKeyPair g
|
||||
r <- runExceptT $ do
|
||||
SMP.QIK {rcvId, sndId, queueMode} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp Nothing rKeys dhKey auth SMSubscribe (QRMessaging Nothing) Nothing
|
||||
-- TODO [notifications]
|
||||
SMP.QIK {rcvId, sndId, queueMode} <- liftError (testErr TSCreateQueue) $ createSMPQueue smp Nothing rKeys dhKey auth SMSubscribe (QRMessaging Nothing) -- Nothing
|
||||
liftError (testErr TSSecureQueue) $
|
||||
case queueMode of
|
||||
Just QMMessaging -> secureSndSMPQueue smp spKey sndId sKey
|
||||
@@ -1343,12 +1343,12 @@ getSessionMode :: MonadIO m => AgentClient -> m TransportSessionMode
|
||||
getSessionMode = fmap sessionMode . getNetworkConfig
|
||||
{-# INLINE getSessionMode #-}
|
||||
|
||||
-- TODO [short links] add ntf credentials to RcvQueue
|
||||
newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SConnectionMode c -> SubscriptionMode -> Maybe NewNtfCreds -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
|
||||
newRcvQueue c userId connId srv vRange cMode subMode ntfCreds = do
|
||||
-- TODO [notifications]
|
||||
newRcvQueue :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> SConnectionMode c -> SubscriptionMode -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
|
||||
newRcvQueue c userId connId srv vRange cMode subMode = do
|
||||
let qrd = case cMode of SCMInvitation -> CQRMessaging Nothing; SCMContact -> CQRContact Nothing
|
||||
e2eKeys <- atomically . C.generateKeyPair =<< asks random
|
||||
newRcvQueue_ c userId connId srv vRange qrd subMode ntfCreds Nothing e2eKeys
|
||||
newRcvQueue_ c userId connId srv vRange qrd subMode Nothing e2eKeys
|
||||
|
||||
data ClntQueueReqData
|
||||
= CQRMessaging (Maybe (CQRData (SMP.SenderId, QueueLinkData)))
|
||||
@@ -1365,18 +1365,18 @@ queueReqData = \case
|
||||
CQRMessaging d -> QRMessaging $ srvReq <$> d
|
||||
CQRContact d -> QRContact $ srvReq <$> d
|
||||
|
||||
newRcvQueue_ :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> ClntQueueReqData -> SubscriptionMode -> Maybe NewNtfCreds -> Maybe C.CbNonce -> C.KeyPairX25519 -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
|
||||
newRcvQueue_ c userId connId (ProtoServerWithAuth srv auth) vRange cqrd subMode ntfCreds nonce_ (e2eDhKey, e2ePrivKey) = do
|
||||
newRcvQueue_ :: AgentClient -> UserId -> ConnId -> SMPServerWithAuth -> VersionRangeSMPC -> ClntQueueReqData -> SubscriptionMode -> Maybe C.CbNonce -> C.KeyPairX25519 -> AM (NewRcvQueue, SMPQueueUri, SMPTransportSession, SessionId)
|
||||
newRcvQueue_ c userId connId (ProtoServerWithAuth srv auth) vRange cqrd subMode nonce_ (e2eDhKey, e2ePrivKey) = do
|
||||
C.AuthAlg a <- asks (rcvAuthAlg . config)
|
||||
g <- asks random
|
||||
rKeys@(_, rcvPrivateKey) <- atomically $ C.generateAuthKeyPair a g
|
||||
(dhKey, privDhKey) <- atomically $ C.generateKeyPair g
|
||||
logServer "-->" c srv NoEntity "NEW"
|
||||
tSess <- mkTransportSession c userId srv connId
|
||||
-- TODO [short links] serverNtfCreds
|
||||
r@(thParams', QIK {rcvId, sndId, rcvPublicDhKey, queueMode, serverNtfCreds}) <-
|
||||
-- TODO [notifications]
|
||||
r@(thParams', QIK {rcvId, sndId, rcvPublicDhKey, queueMode}) <-
|
||||
withClient c tSess $ \(SMPConnectedClient smp _) ->
|
||||
(thParams smp,) <$> createSMPQueue smp nonce_ rKeys dhKey auth subMode (queueReqData cqrd) ntfCreds
|
||||
(thParams smp,) <$> createSMPQueue smp nonce_ rKeys dhKey auth subMode (queueReqData cqrd)
|
||||
liftIO . logServer "<--" c srv NoEntity $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
|
||||
shortLink <- mkShortLinkCreds r
|
||||
let rq =
|
||||
@@ -1398,7 +1398,7 @@ newRcvQueue_ c userId connId (ProtoServerWithAuth srv auth) vRange cqrd subMode
|
||||
dbReplaceQueueId = Nothing,
|
||||
rcvSwchStatus = Nothing,
|
||||
smpClientVersion = maxVersion vRange,
|
||||
clientNtfCreds = Nothing, -- TODO [short links]
|
||||
clientNtfCreds = Nothing,
|
||||
deleteErrors = 0
|
||||
}
|
||||
qUri = SMPQueueUri vRange $ SMPQueueAddress srv sndId e2eDhKey sndSecure
|
||||
|
||||
@@ -719,10 +719,11 @@ createSMPQueue ::
|
||||
Maybe BasicAuth ->
|
||||
SubscriptionMode ->
|
||||
QueueReqData ->
|
||||
Maybe NewNtfCreds ->
|
||||
-- TODO [notifications]
|
||||
-- Maybe NewNtfCreds ->
|
||||
ExceptT SMPClientError IO QueueIdsKeys
|
||||
createSMPQueue c nonce_ (rKey, rpKey) dhKey auth subMode qrd ntfCreds =
|
||||
sendProtocolCommand_ c nonce_ Nothing (Just rpKey) NoEntity (Cmd SRecipient $ NEW $ NewQueueReq rKey dhKey auth subMode (Just qrd) ntfCreds) >>= \case
|
||||
createSMPQueue c nonce_ (rKey, rpKey) dhKey auth subMode qrd =
|
||||
sendProtocolCommand_ c nonce_ Nothing (Just rpKey) NoEntity (Cmd SRecipient $ NEW $ NewQueueReq rKey dhKey auth subMode (Just qrd)) >>= \case
|
||||
IDS qik -> pure qik
|
||||
r -> throwE $ unexpectedResponse r
|
||||
|
||||
|
||||
@@ -171,6 +171,7 @@ module Simplex.Messaging.Crypto
|
||||
sha256Hash,
|
||||
sha512Hash,
|
||||
sha3_256,
|
||||
sha3_384,
|
||||
|
||||
-- * Message padding / un-padding
|
||||
canPad,
|
||||
@@ -211,7 +212,7 @@ import Crypto.Cipher.AES (AES256)
|
||||
import qualified Crypto.Cipher.Types as AES
|
||||
import qualified Crypto.Cipher.XSalsa as XSalsa
|
||||
import qualified Crypto.Error as CE
|
||||
import Crypto.Hash (Digest, SHA256 (..), SHA3_256, SHA512 (..), hash, hashDigestSize)
|
||||
import Crypto.Hash (Digest, SHA3_256, SHA3_384, SHA256 (..), SHA512 (..), hash, hashDigestSize)
|
||||
import qualified Crypto.KDF.HKDF as H
|
||||
import qualified Crypto.MAC.Poly1305 as Poly1305
|
||||
import qualified Crypto.PubKey.Curve25519 as X25519
|
||||
@@ -978,6 +979,11 @@ sha3_256 :: ByteString -> ByteString
|
||||
sha3_256 = BA.convert . (hash :: ByteString -> Digest SHA3_256)
|
||||
{-# INLINE sha3_256 #-}
|
||||
|
||||
-- | SHA3-384 digest.
|
||||
sha3_384 :: ByteString -> ByteString
|
||||
sha3_384 = BA.convert . (hash :: ByteString -> Digest SHA3_384)
|
||||
{-# INLINE sha3_384 #-}
|
||||
|
||||
-- | AEAD-GCM encryption with associated data.
|
||||
--
|
||||
-- Used as part of double ratchet encryption.
|
||||
|
||||
@@ -65,7 +65,6 @@ module Simplex.Messaging.Protocol
|
||||
EncFixedDataBytes,
|
||||
EncUserDataBytes,
|
||||
EncDataBytes (..),
|
||||
NewNtfCreds (..),
|
||||
Party (..),
|
||||
Cmd (..),
|
||||
DirectParty,
|
||||
@@ -73,7 +72,6 @@ module Simplex.Messaging.Protocol
|
||||
SParty (..),
|
||||
PartyI (..),
|
||||
QueueIdsKeys (..),
|
||||
ServerNtfCreds (..),
|
||||
ProtocolErrorType (..),
|
||||
ErrorType (..),
|
||||
CommandError (..),
|
||||
@@ -457,8 +455,9 @@ data NewQueueReq = NewQueueReq
|
||||
rcvDhKey :: RcvPublicDhKey,
|
||||
auth_ :: Maybe BasicAuth,
|
||||
subMode :: SubscriptionMode,
|
||||
queueReqData :: Maybe QueueReqData,
|
||||
ntfCreds :: Maybe NewNtfCreds
|
||||
queueReqData :: Maybe QueueReqData
|
||||
-- TODO [notifications]
|
||||
-- ntfCreds :: Maybe NewNtfCreds
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
@@ -502,7 +501,8 @@ instance ToField EncDataBytes where
|
||||
toField (EncDataBytes s) = toField (Binary s)
|
||||
{-# INLINE toField #-}
|
||||
|
||||
data NewNtfCreds = NewNtfCreds NtfPublicAuthKey RcvNtfPublicDhKey deriving (Show)
|
||||
-- TODO [notifications]
|
||||
-- data NewNtfCreds = NewNtfCreds NtfPublicAuthKey RcvNtfPublicDhKey deriving (Show)
|
||||
|
||||
instance StrEncoding SubscriptionMode where
|
||||
strEncode = \case
|
||||
@@ -533,9 +533,10 @@ instance Encoding QueueReqData where
|
||||
'C' -> QRContact <$> smpP
|
||||
_ -> fail "bad QueueReqData"
|
||||
|
||||
instance Encoding NewNtfCreds where
|
||||
smpEncode (NewNtfCreds authKey dhKey) = smpEncode (authKey, dhKey)
|
||||
smpP = NewNtfCreds <$> smpP <*> smpP
|
||||
-- TODO [notifications]
|
||||
-- instance Encoding NewNtfCreds where
|
||||
-- smpEncode (NewNtfCreds authKey dhKey) = smpEncode (authKey, dhKey)
|
||||
-- smpP = NewNtfCreds <$> smpP <*> smpP
|
||||
|
||||
type SenderCanSecure = Bool
|
||||
|
||||
@@ -1243,17 +1244,19 @@ data QueueIdsKeys = QIK
|
||||
sndId :: SenderId,
|
||||
rcvPublicDhKey :: RcvPublicDhKey,
|
||||
queueMode :: Maybe QueueMode, -- TODO remove Maybe when min version is 9 (sndAuthKeySMPVersion)
|
||||
linkId :: Maybe LinkId,
|
||||
serverNtfCreds :: Maybe ServerNtfCreds
|
||||
linkId :: Maybe LinkId
|
||||
-- TODO [notifications]
|
||||
-- serverNtfCreds :: Maybe ServerNtfCreds
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ServerNtfCreds = ServerNtfCreds NotifierId RcvNtfPublicDhKey
|
||||
deriving (Eq, Show)
|
||||
-- TODO [notifications]
|
||||
-- data ServerNtfCreds = ServerNtfCreds NotifierId RcvNtfPublicDhKey
|
||||
-- deriving (Eq, Show)
|
||||
|
||||
instance Encoding ServerNtfCreds where
|
||||
smpEncode (ServerNtfCreds nId dhKey) = smpEncode (nId, dhKey)
|
||||
smpP = ServerNtfCreds <$> smpP <*> smpP
|
||||
-- instance Encoding ServerNtfCreds where
|
||||
-- smpEncode (ServerNtfCreds nId dhKey) = smpEncode (nId, dhKey)
|
||||
-- smpP = ServerNtfCreds <$> smpP <*> smpP
|
||||
|
||||
-- | Recipient's private key used by the recipient to authorize (v6: sign, v7: encrypt hash) SMP commands.
|
||||
--
|
||||
@@ -1481,8 +1484,8 @@ class ProtocolMsgTag (Tag msg) => ProtocolEncoding v err msg | msg -> err, msg -
|
||||
instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
|
||||
type Tag (Command p) = CommandTag p
|
||||
encodeProtocol v = \case
|
||||
NEW NewQueueReq {rcvAuthKey = rKey, rcvDhKey = dhKey, auth_, subMode, queueReqData, ntfCreds}
|
||||
| v >= shortLinksSMPVersion -> new <> e (auth_, subMode, queueReqData, ntfCreds)
|
||||
NEW NewQueueReq {rcvAuthKey = rKey, rcvDhKey = dhKey, auth_, subMode, queueReqData}
|
||||
| v >= shortLinksSMPVersion -> new <> e (auth_, subMode, queueReqData)
|
||||
| v >= sndAuthKeySMPVersion -> new <> e (auth_, subMode, senderCanSecure (queueReqMode <$> queueReqData))
|
||||
| otherwise -> new <> auth <> e subMode
|
||||
where
|
||||
@@ -1556,18 +1559,19 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
|
||||
CT SRecipient tag ->
|
||||
Cmd SRecipient <$> case tag of
|
||||
NEW_
|
||||
| v >= shortLinksSMPVersion -> NEW <$> new smpP smpP smpP
|
||||
| v >= sndAuthKeySMPVersion -> NEW <$> new smpP (qReq <$> smpP) (pure Nothing)
|
||||
| otherwise -> NEW <$> new auth (pure Nothing) (pure Nothing)
|
||||
| v >= shortLinksSMPVersion -> NEW <$> new smpP smpP
|
||||
| v >= sndAuthKeySMPVersion -> NEW <$> new smpP (qReq <$> smpP)
|
||||
| otherwise -> NEW <$> new auth (pure Nothing)
|
||||
where
|
||||
new p1 p2 p3 = do
|
||||
new p1 p2 = do
|
||||
rcvAuthKey <- _smpP
|
||||
rcvDhKey <- smpP
|
||||
auth_ <- p1
|
||||
subMode <- smpP
|
||||
queueReqData <- p2
|
||||
ntfCreds <- p3
|
||||
pure NewQueueReq {rcvAuthKey, rcvDhKey, auth_, subMode, queueReqData, ntfCreds}
|
||||
-- TODO [notifications]
|
||||
-- ntfCreds <- p3
|
||||
pure NewQueueReq {rcvAuthKey, rcvDhKey, auth_, subMode, queueReqData} -- ntfCreds
|
||||
auth = optional (A.char 'A' *> smpP)
|
||||
qReq sndSecure = Just $ if sndSecure then QRMessaging Nothing else QRContact Nothing
|
||||
SUB_ -> pure SUB
|
||||
@@ -1605,8 +1609,8 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
|
||||
instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
|
||||
type Tag BrokerMsg = BrokerMsgTag
|
||||
encodeProtocol v = \case
|
||||
IDS QIK {rcvId, sndId, rcvPublicDhKey = srvDh, queueMode, linkId, serverNtfCreds}
|
||||
| v >= shortLinksSMPVersion -> ids <> e queueMode <> e linkId <> e serverNtfCreds
|
||||
IDS QIK {rcvId, sndId, rcvPublicDhKey = srvDh, queueMode, linkId}
|
||||
| v >= shortLinksSMPVersion -> ids <> e queueMode <> e linkId
|
||||
| v >= sndAuthKeySMPVersion -> ids <> e (senderCanSecure queueMode)
|
||||
| otherwise -> ids
|
||||
where
|
||||
@@ -1640,13 +1644,21 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
|
||||
where
|
||||
bodyP = EncRcvMsgBody . unTail <$> smpP
|
||||
IDS_
|
||||
| v >= shortLinksSMPVersion -> ids smpP smpP smpP
|
||||
| v >= sndAuthKeySMPVersion -> ids (qm <$> smpP) nothing nothing
|
||||
| otherwise -> ids nothing nothing nothing
|
||||
| v >= shortLinksSMPVersion -> ids smpP smpP
|
||||
| v >= sndAuthKeySMPVersion -> ids (qm <$> smpP) nothing
|
||||
| otherwise -> ids nothing nothing
|
||||
where
|
||||
qm sndSecure = Just $ if sndSecure then QMMessaging else QMContact
|
||||
nothing = pure Nothing
|
||||
ids p1 p2 p3 = IDS <$> (QIK <$> _smpP <*> smpP <*> smpP <*> p1 <*> p2 <*> p3)
|
||||
ids p1 p2 = do
|
||||
rcvId <- _smpP
|
||||
sndId <- smpP
|
||||
rcvPublicDhKey <- smpP
|
||||
queueMode <- p1
|
||||
linkId <- p2
|
||||
-- TODO [notifications]
|
||||
-- serverNtfCreds <- p3
|
||||
pure $ IDS QIK {rcvId, sndId, rcvPublicDhKey, queueMode, linkId}
|
||||
LNK_ -> LNK <$> _smpP <*> smpP
|
||||
NID_ -> NID <$> _smpP <*> smpP
|
||||
NMSG_ -> NMSG <$> _smpP <*> smpP
|
||||
|
||||
@@ -1278,15 +1278,18 @@ client
|
||||
QUE -> withQueue $ \q qr -> (corrId,entId,) <$> getQueueInfo q qr
|
||||
where
|
||||
createQueue :: NewQueueReq -> M (Transmission BrokerMsg)
|
||||
createQueue NewQueueReq {rcvAuthKey, rcvDhKey, subMode, queueReqData, ntfCreds} = time "NEW" $ do
|
||||
createQueue NewQueueReq {rcvAuthKey, rcvDhKey, subMode, queueReqData} = time "NEW" $ do
|
||||
g <- asks random
|
||||
idSize <- asks $ queueIdBytes . config
|
||||
updatedAt <- Just <$> liftIO getSystemDate
|
||||
(rcvPublicDhKey, privDhKey) <- atomically $ C.generateKeyPair g
|
||||
ntfKeys_ <- forM ntfCreds $ \(NewNtfCreds notifierKey dhKey) -> do
|
||||
(ntfPubDhKey, ntfPrivDhKey) <- atomically $ C.generateKeyPair g
|
||||
pure (notifierKey, C.dh' dhKey ntfPrivDhKey, ntfPubDhKey)
|
||||
-- TODO [notifications]
|
||||
-- ntfKeys_ <- forM ntfCreds $ \(NewNtfCreds notifierKey dhKey) -> do
|
||||
-- (ntfPubDhKey, ntfPrivDhKey) <- atomically $ C.generateKeyPair g
|
||||
-- pure (notifierKey, C.dh' dhKey ntfPrivDhKey, ntfPubDhKey)
|
||||
let randId = EntityId <$> atomically (C.randomBytes idSize g)
|
||||
-- TODO [notifications] the remaining 24 bytes are reserver for notifier ID
|
||||
sndId' = B.take 24 $ C.sha3_384 (bs corrId)
|
||||
tryCreate 0 = pure $ ERR INTERNAL
|
||||
tryCreate n = do
|
||||
(sndId, clntIds, queueData) <- case queueReqData of
|
||||
@@ -1296,13 +1299,14 @@ client
|
||||
-- The condition that client-provided sender ID must match hash of correlation ID
|
||||
-- prevents "ID oracle" attack, when creating queue with supplied ID can be used to check
|
||||
-- if queue with this ID still exists.
|
||||
if clntIds && unEntityId sndId /= C.sha3_256 (bs corrId)
|
||||
if clntIds && unEntityId sndId /= sndId'
|
||||
then pure $ ERR $ CMD PROHIBITED
|
||||
else do
|
||||
rcvId <- randId
|
||||
ntf <- forM ntfKeys_ $ \(notifierKey, rcvNtfDhSecret, rcvPubDhKey) -> do
|
||||
notifierId <- randId
|
||||
pure (NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}, ServerNtfCreds notifierId rcvPubDhKey)
|
||||
-- TODO [notifications]
|
||||
-- ntf <- forM ntfKeys_ $ \(notifierKey, rcvNtfDhSecret, rcvPubDhKey) -> do
|
||||
-- notifierId <- randId
|
||||
-- pure (NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}, ServerNtfCreds notifierId rcvPubDhKey)
|
||||
let queueMode = queueReqMode <$> queueReqData
|
||||
qr =
|
||||
QueueRec
|
||||
@@ -1312,7 +1316,8 @@ client
|
||||
senderKey = Nothing,
|
||||
queueMode,
|
||||
queueData,
|
||||
notifier = fst <$> ntf,
|
||||
-- TODO [notifications]
|
||||
notifier = Nothing, -- fst <$> ntf,
|
||||
status = EntityActive,
|
||||
updatedAt
|
||||
}
|
||||
@@ -1325,11 +1330,12 @@ client
|
||||
stats <- asks serverStats
|
||||
incStat $ qCreated stats
|
||||
incStat $ qCount stats
|
||||
when (isJust ntf) $ incStat $ ntfCreated stats
|
||||
-- TODO [notifications]
|
||||
-- when (isJust ntf) $ incStat $ ntfCreated stats
|
||||
case subMode of
|
||||
SMOnlyCreate -> pure ()
|
||||
SMSubscribe -> void $ subscribeQueue q qr
|
||||
pure $ IDS QIK {rcvId, sndId, rcvPublicDhKey, queueMode, linkId = fst <$> queueData, serverNtfCreds = snd <$> ntf}
|
||||
pure $ IDS QIK {rcvId, sndId, rcvPublicDhKey, queueMode, linkId = fst <$> queueData} -- , serverNtfCreds = snd <$> ntf
|
||||
(corrId,entId,) <$> tryCreate (3 :: Int)
|
||||
|
||||
checkMode :: QueueMode -> QueueRec -> M (Either ErrorType BrokerMsg) -> M (Transmission BrokerMsg)
|
||||
|
||||
@@ -148,7 +148,7 @@ smpBlockSize = 16384
|
||||
-- 11 - additional encryption of transport blocks with forward secrecy (10/06/2024)
|
||||
-- 12 - BLOCKED error for blocked queues (1/11/2025)
|
||||
-- 14 - proxyServer handshake property to disable transport encryption between server and proxy (1/19/2025)
|
||||
-- 15 - short links, include creating NTF credentials in NEW command
|
||||
-- 15 - short links, with associated data passed in NEW of LSET command (3/30/2025)
|
||||
|
||||
data SMPVersion
|
||||
|
||||
|
||||
Reference in New Issue
Block a user