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

authorize via crypto_box

Browse Source
This commit is contained in:
Evgeny Poberezkin
2024-02-06 22:39:20 +00:00
parent 9a93c6ba80
commit 38cfd57862
8 changed files with 82 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/FileTransfer/Server.hs
+3 -2
View File
@@ -264,8 +264,9 @@ verifyXFTPTransmission tAuth authorized fId cmd =
where
verify = \case
Right (fr, k) -> XFTPReqCmd fId fr cmd `verifyWith` k
_ -> dummyVerifyCmd authorized tAuth `seq` VRFailed
req `verifyWith` k = if verifyCmdSignature tAuth authorized k then VRVerified req else VRFailed
_ -> dummyVerifyCmd Nothing authorized tAuth `seq` VRFailed
-- TODO verify with DH authorization
req `verifyWith` k = if verifyCmdSignature Nothing tAuth authorized k then VRVerified req else VRFailed
processXFTPRequest :: HTTP2Body -> XFTPRequest -> M (FileResponse, Maybe ServerFile)
processXFTPRequest HTTP2Body {bodyPart} = \case
src/Simplex/Messaging/Crypto.hs
+12 -3
View File
@@ -124,6 +124,7 @@ module Simplex.Messaging.Crypto
cbEncryptNoPad,
cbEncryptMaxLenBS,
cbDecrypt,
cbDecryptNoPad,
sbDecrypt_,
sbEncrypt_,
cbNonce,
@@ -1182,7 +1183,7 @@ dh' (PublicKeyX448 k) (PrivateKeyX448 pk _) = DhSecretX448 $ X448.dh k pk
cbEncrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
cbEncrypt (DhSecretX25519 secret) = sbEncrypt_ secret
-- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce.
-- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce (without padding).
cbEncryptNoPad :: DhSecret X25519 -> CbNonce -> ByteString -> ByteString
cbEncryptNoPad (DhSecretX25519 secret) (CbNonce nonce) = cryptoBox secret nonce
@@ -1207,15 +1208,23 @@ cryptoBox secret nonce s = BA.convert tag <> c
cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
cbDecrypt (DhSecretX25519 secret) = sbDecrypt_ secret
-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
cbDecryptNoPad :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
cbDecryptNoPad (DhSecretX25519 secret) = sbDecryptNoPad_ secret
-- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce.
sbDecrypt :: SbKey -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecrypt (SbKey key) = sbDecrypt_ key
-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
sbDecrypt_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecrypt_ secret (CbNonce nonce) packet
sbDecrypt_ secret nonce = unPad <=< sbDecryptNoPad_ secret nonce
-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
sbDecryptNoPad_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString
sbDecryptNoPad_ secret (CbNonce nonce) packet
| B.length packet < 16 = Left CBDecryptError
| BA.constEq tag' tag = unPad msg
| BA.constEq tag' tag = Right msg
| otherwise = Left CBDecryptError
where
(tag', c) = B.splitAt 16 packet
src/Simplex/Messaging/Crypto/SNTRUP761.hs
+1 -1
View File
@@ -19,7 +19,7 @@ newtype KEMHybridSecret = KEMHybridSecret ScrubbedBytes
-- | NaCl @crypto_box@ decrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
kcbDecrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Either CryptoError ByteString
kcbDecrypt (KEMHybridSecret k) = sbDecrypt_ k
kcbDecrypt (KEMHybridSecret k) nonce = sbDecrypt_ k nonce
-- | NaCl @crypto_box@ encrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
kcbEncrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
src/Simplex/Messaging/Notifications/Server.hs
+10 -10
View File
@@ -48,7 +48,7 @@ import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Server
import Simplex.Messaging.Server.Stats
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (ATransport (..), THandle (..), TProxy, Transport (..))
import Simplex.Messaging.Transport (ATransport (..), THandle (..), THandleAuth (..), TProxy, Transport (..))
import Simplex.Messaging.Transport.Server (runTransportServer)
import Simplex.Messaging.Util
import System.Exit (exitFailure)
@@ -352,7 +352,7 @@ clientDisconnected :: NtfServerClient -> IO ()
clientDisconnected NtfServerClient {connected} = atomically $ writeTVar connected False
receive :: Transport c => THandle c -> NtfServerClient -> M ()
receive th NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
receive th@THandle {thAuth} NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
ts <- liftIO $ tGet th
forM_ ts $ \t@(_, _, (corrId, entId, cmdOrError)) -> do
atomically . writeTVar rcvActiveAt =<< liftIO getSystemTime
@@ -360,7 +360,7 @@ receive th NtfServerClient {rcvQ, sndQ, rcvActiveAt} = forever $ do
case cmdOrError of
Left e -> write sndQ (corrId, entId, NRErr e)
Right cmd ->
verifyNtfTransmission t cmd >>= \case
verifyNtfTransmission ((,C.cbNonce (SMP.bs corrId)) <$> thAuth) t cmd >>= \case
VRVerified req -> write rcvQ req
VRFailed -> write sndQ (corrId, entId, NRErr AUTH)
where
@@ -377,14 +377,14 @@ send h@THandle {thVersion = v} NtfServerClient {sndQ, sessionId, sndActiveAt} =
data VerificationResult = VRVerified NtfRequest | VRFailed
verifyNtfTransmission :: SignedTransmission ErrorType NtfCmd -> NtfCmd -> M VerificationResult
verifyNtfTransmission (tAuth, authorized, (corrId, entId, _)) cmd = do
verifyNtfTransmission :: Maybe (THandleAuth, C.CbNonce) -> SignedTransmission ErrorType NtfCmd -> NtfCmd -> M VerificationResult
verifyNtfTransmission auth_ (tAuth, authorized, (corrId, entId, _)) cmd = do
st <- asks store
case cmd of
NtfCmd SToken c@(TNEW tkn@(NewNtfTkn _ k _)) -> do
r_ <- atomically $ getNtfTokenRegistration st tkn
pure $
if verifyCmdSignature tAuth authorized k
if verifyCmdSignature auth_ tAuth authorized k
then case r_ of
Just t@NtfTknData {tknVerifyKey}
| k == tknVerifyKey -> verifiedTknCmd t c
@@ -405,7 +405,7 @@ verifyNtfTransmission (tAuth, authorized, (corrId, entId, _)) cmd = do
then do
t_ <- atomically $ getActiveNtfToken st subTknId
verifyToken' t_ $ verifiedSubCmd s c
else pure $ dummyVerifyCmd authorized tAuth `seq` VRFailed
else pure $ dummyVerifyCmd auth_ authorized tAuth `seq` VRFailed
NtfCmd SSubscription PING -> pure $ VRVerified $ NtfReqPing corrId entId
NtfCmd SSubscription c -> do
s_ <- atomically $ getNtfSubscription st entId
@@ -413,7 +413,7 @@ verifyNtfTransmission (tAuth, authorized, (corrId, entId, _)) cmd = do
Just s@NtfSubData {tokenId = subTknId} -> do
t_ <- atomically $ getActiveNtfToken st subTknId
verifyToken' t_ $ verifiedSubCmd s c
_ -> pure $ dummyVerifyCmd authorized tAuth `seq` VRFailed
_ -> pure $ dummyVerifyCmd auth_ authorized tAuth `seq` VRFailed
where
verifiedTknCmd t c = VRVerified (NtfReqCmd SToken (NtfTkn t) (corrId, entId, c))
verifiedSubCmd s c = VRVerified (NtfReqCmd SSubscription (NtfSub s) (corrId, entId, c))
@@ -421,10 +421,10 @@ verifyNtfTransmission (tAuth, authorized, (corrId, entId, _)) cmd = do
verifyToken t_ positiveVerificationResult =
pure $ case t_ of
Just t@NtfTknData {tknVerifyKey} ->
if verifyCmdSignature tAuth authorized tknVerifyKey
if verifyCmdSignature auth_ tAuth authorized tknVerifyKey
then positiveVerificationResult t
else VRFailed
_ -> dummyVerifyCmd authorized tAuth `seq` VRFailed
_ -> dummyVerifyCmd auth_ authorized tAuth `seq` VRFailed
verifyToken' :: Maybe NtfTknData -> VerificationResult -> M VerificationResult
verifyToken' t_ = verifyToken t_ . const
src/Simplex/Messaging/Server.hs
+31 -18
View File
@@ -417,7 +417,7 @@ cancelSub sub =
_ -> return ()
receive :: Transport c => THandle c -> Client -> M ()
receive th Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
receive th@THandle {thAuth} Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
forever $ do
ts <- L.toList <$> liftIO (tGet th)
@@ -427,10 +427,10 @@ receive th Client {rcvQ, sndQ, rcvActiveAt, sessionId} = do
write rcvQ $ snd as
where
cmdAction :: SignedTransmission ErrorType Cmd -> M (Either (Transmission BrokerMsg) (Maybe QueueRec, Transmission Cmd))
cmdAction (auth, authorized, (corrId, queueId, cmdOrError)) =
cmdAction (tAuth, authorized, (corrId, queueId, cmdOrError)) =
case cmdOrError of
Left e -> pure $ Left (corrId, queueId, ERR e)
Right cmd -> verified <$> verifyTransmission auth authorized queueId cmd
Right cmd -> verified <$> verifyTransmission ((,C.cbNonce (bs corrId)) <$> thAuth) tAuth authorized queueId cmd
where
verified = \case
VRVerified qr -> Right (qr, (corrId, queueId, cmd))
@@ -467,11 +467,11 @@ disconnectTransport THandle {connection, sessionId} rcvActiveAt sndActiveAt expC
data VerificationResult = VRVerified (Maybe QueueRec) | VRFailed
verifyTransmission :: TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
verifyTransmission auth authorized queueId cmd =
verifyTransmission :: Maybe (THandleAuth, C.CbNonce) -> TransmissionAuth -> ByteString -> QueueId -> Cmd -> M VerificationResult
verifyTransmission auth_ tAuth authorized queueId cmd =
case cmd of
Cmd SRecipient (NEW k _ _ _) -> pure $ Nothing `verified` verifyCmdSignature auth authorized k
Cmd SRecipient _ -> verifyCmd SRecipient $ verifyCmdSignature auth authorized . recipientKey
Cmd SRecipient (NEW k _ _ _) -> pure $ Nothing `verified` verifyCmdSignature auth_ tAuth authorized k
Cmd SRecipient _ -> verifyCmd SRecipient $ verifyCmdSignature auth_ tAuth authorized . recipientKey
Cmd SSender SEND {} -> verifyCmd SSender $ verifyMaybe . senderKey
Cmd SSender PING -> pure $ VRVerified Nothing
Cmd SNotifier NSUB -> verifyCmd SNotifier $ verifyMaybe . fmap notifierKey . notifier
@@ -482,28 +482,41 @@ verifyTransmission auth authorized queueId cmd =
q_ <- atomically $ getQueue st party queueId
pure $ case q_ of
Right q -> Just q `verified` f q
_ -> dummyVerifyCmd authorized auth `seq` VRFailed
_ -> dummyVerifyCmd auth_ authorized tAuth `seq` VRFailed
verifyMaybe :: Maybe C.APublicAuthKey -> Bool
verifyMaybe = maybe (isAuthNone auth) $ verifyCmdSignature auth authorized
verifyMaybe = maybe (isAuthNone tAuth) $ verifyCmdSignature auth_ tAuth authorized
verified q cond = if cond then VRVerified q else VRFailed
verifyCmdSignature :: TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
verifyCmdSignature auth authorized key = case auth of
verifyCmdSignature :: Maybe (THandleAuth, C.CbNonce) -> TransmissionAuth -> ByteString -> C.APublicAuthKey -> Bool
verifyCmdSignature auth_ tAuth authorized key = case tAuth of
TAuthNone -> False
TAuthSignature sig -> verify key sig
TAuthEncHash _ -> False
TAuthEncHash s -> authorize key s
where
verify :: C.APublicAuthKey -> C.ASignature -> Bool
verify (C.APublicAuthKey a k) sig@(C.ASignature a' s) =
case testEquality a a' of
Just Refl | C.signatureSize k == C.signatureSize s -> C.verify' k s authorized
_ -> dummyVerifyCmd authorized (TAuthSignature sig) `seq` False
_ -> dummyVerifyCmd auth_ authorized (TAuthSignature sig) `seq` False
authorize :: C.APublicAuthKey -> ByteString -> Bool
authorize (C.APublicAuthKey a k) s =
case a of
C.SX25519 -> authorizeCmd auth_ k s authorized
_ -> dummyVerifyCmd auth_ authorized (TAuthEncHash s) `seq` False
dummyVerifyCmd :: ByteString -> TransmissionAuth -> Bool
dummyVerifyCmd authorized = \case
authorizeCmd :: Maybe (THandleAuth, C.CbNonce) -> C.PublicKeyX25519 -> ByteString -> ByteString -> Bool
authorizeCmd auth_ k s authorized = case auth_ of
Just (THandleAuth {privKey}, nonce) -> cbAuthorize k privKey nonce s authorized
Nothing -> False
cbAuthorize :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> ByteString -> Bool
cbAuthorize k pk nonce s authorized = C.cbDecryptNoPad (C.dh' k pk) nonce s == Right (C.sha512Hash authorized)
dummyVerifyCmd :: Maybe (THandleAuth, C.CbNonce) -> ByteString -> TransmissionAuth -> Bool
dummyVerifyCmd auth_ authorized = \case
TAuthNone -> False
TAuthSignature (C.ASignature a s) -> C.verify' (dummyPublicKey a) s authorized
TAuthEncHash _ -> False
TAuthEncHash s -> authorizeCmd auth_ dummyKeyX25519 s authorized
-- These dummy keys are used with `dummyVerify` function to mitigate timing attacks
-- by having the same time of the response whether a queue exists or nor, for all valid key/signature sizes
@@ -521,10 +534,10 @@ dummyKeyEd448 :: C.PublicKey 'C.Ed448
dummyKeyEd448 = "MEMwBQYDK2VxAzoA6ibQc9XpkSLtwrf7PLvp81qW/etiumckVFImCMRdftcG/XopbOSaq9qyLhrgJWKOLyNrQPNVvpMA"
dummyKeyX25519 :: C.PublicKey 'C.X25519
dummyKeyX25519 = ""
dummyKeyX25519 = "MCowBQYDK2VuAyEA4JGSMYht18H4mas_jHeBwfcM7jLwNYJNOAhi2_g4RXg="
dummyKeyX448 :: C.PublicKey 'C.X448
dummyKeyX448 = ""
dummyKeyX448 = "MEIwBQYDK2VvAzkAs6Z2fErHib1C2QfKcrDeNlfi8Xtb1UTWF-slWubEmfbk0M0N-qh9A2JBNZebrVUMW4--skAjJ3I="
client :: forall m. (MonadUnliftIO m, MonadReader Env m) => Client -> Server -> m ()
client clnt@Client {thVersion, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId} Server {subscribedQ, ntfSubscribedQ, notifiers} = do
src/Simplex/Messaging/Transport.hs
+3 -2
View File
@@ -279,6 +279,7 @@ data THandle c = THandle
data THandleAuth = THandleAuth
{ peerPubKey :: C.PublicKeyX25519, -- used only in the client to combine with per-queue key
privKey :: C.PrivateKeyX25519, -- used to combine with peer's per-queue key (currently only in the server)
dhSecret :: C.DhSecretX25519 -- used by both parties to encrypt entity IDs in for version >= 7
}
@@ -415,9 +416,9 @@ smpClientHandshake c (k, pk) keyHash smpVRange = do
Nothing -> throwE $ TEHandshake VERSION
smpThHandle :: forall c. THandle c -> Version -> C.PrivateKeyX25519 -> Maybe C.PublicKeyX25519 -> THandle c
smpThHandle th v pk k_ =
smpThHandle th v pk k_ =
-- TODO drop SMP v6: make thAuth non-optional
let thAuth = (\k -> THandleAuth {peerPubKey = k, dhSecret = C.dh' k pk}) <$> k_
let thAuth = (\k -> THandleAuth {peerPubKey = k, privKey = pk, dhSecret = C.dh' k pk}) <$> k_
in (th :: THandle c) {thVersion = v, thAuth, batch = v >= batchCmdsSMPVersion}
sendHandshake :: (Transport c, Encoding smp) => THandle c -> smp -> ExceptT TransportError IO ()