diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index 9989a96eb..8a77836f9 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/src/Simplex/Messaging/Client.hs @@ -1139,9 +1139,9 @@ connectSMPProxiedRelay c@ProtocolClient {client_ = PClient {tcpConnectTimeout, t hostName = B.unpack $ strEncode $ transportHost' c validateRelay :: X.CertificateChain -> X.SignedExact X.PubKey -> ExceptT String IO C.PublicKeyX25519 validateRelay chain exact = case chainIdCaCerts chain of - CCValid {leafCert, idCert, caCert} + CCValid {leafCert, idCert} | XV.Fingerprint kh == XV.getFingerprint idCert X.HashSHA256 -> do - errs <- liftIO $ x509validate caCert (hostName, B.pack relayPort) chain + errs <- liftIO $ x509validate (hostName, B.pack relayPort) chain unless (null errs) $ throwError "bad certificate" serverKey <- liftEither $ C.x509ToPublic' $ X.certPubKey $ X.signedObject $ X.getSigned leafCert liftEither $ C.x509ToPublic' =<< C.verifyX509 serverKey exact diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index 858e040e4..cc2d5cc50 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -1343,7 +1343,9 @@ cryptoBox secret nonce s = BA.convert tag <> c -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce. cbDecrypt :: CbNonceI n => DhSecret X25519 -> n -> ByteString -> Either CryptoError ByteString -cbDecrypt (DhSecretX25519 secret) = sbDecrypt_ secret . toCbNonce +cbDecrypt (DhSecretX25519 secret) nonce msg + | BA.constEq secret (B.replicate x25519_size '\0') = Left CBDecryptError + | otherwise = sbDecrypt_ secret (toCbNonce nonce) msg {-# INLINE cbDecrypt #-} -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding). diff --git a/src/Simplex/Messaging/Transport/Client.hs b/src/Simplex/Messaging/Transport/Client.hs index 5d85e7aab..dd84b5070 100644 --- a/src/Simplex/Messaging/Transport/Client.hs +++ b/src/Simplex/Messaging/Transport/Client.hs @@ -312,9 +312,9 @@ validateCertificateChain :: C.KeyHash -> HostName -> ByteString -> X.Certificate validateCertificateChain (C.KeyHash kh) host port cc = case chainIdCaCerts cc of CCEmpty -> pure [XV.EmptyChain] CCSelf _ -> pure [XV.EmptyChain] - CCValid {idCert, caCert} -> validate idCert caCert + CCValid {idCert} -> validate idCert CCLong -> pure [XV.AuthorityTooDeep] where - validate idCert caCert - | Fingerprint kh == XV.getFingerprint idCert X.HashSHA256 = x509validate caCert (host, port) cc + validate idCert + | Fingerprint kh == XV.getFingerprint idCert X.HashSHA256 = x509validate (host, port) cc | otherwise = pure [XV.UnknownCA] diff --git a/src/Simplex/Messaging/Transport/Server.hs b/src/Simplex/Messaging/Transport/Server.hs index 561c23e4f..568efb3bc 100644 --- a/src/Simplex/Messaging/Transport/Server.hs +++ b/src/Simplex/Messaging/Transport/Server.hs @@ -289,11 +289,11 @@ paramsAskClientCert clientCert params = validateClientCertificate :: X.CertificateChain -> IO (Maybe T.CertificateRejectReason) validateClientCertificate cc = case chainIdCaCerts cc of CCEmpty -> pure Nothing -- client certificates are only used for services - CCSelf cert -> validate cert - CCValid {caCert} -> validate caCert + CCSelf _ -> validate + CCValid {} -> validate CCLong -> pure $ Just $ T.CertificateRejectOther "chain too long" where - validate caCert = usage <$> x509validate caCert ("", B.empty) cc + validate = usage <$> x509validate ("", B.empty) cc usage [] = Nothing usage r = Just $ diff --git a/src/Simplex/Messaging/Transport/Shared.hs b/src/Simplex/Messaging/Transport/Shared.hs index 204ef3f5e..060a41f54 100644 --- a/src/Simplex/Messaging/Transport/Shared.hs +++ b/src/Simplex/Messaging/Transport/Shared.hs @@ -12,33 +12,48 @@ module Simplex.Messaging.Transport.Shared import Control.Concurrent.STM import qualified Control.Exception as E import Control.Logger.Simple (logError) +import qualified Crypto.PubKey.RSA as RSA import Data.ByteString (ByteString) import qualified Data.X509 as X import qualified Data.X509.CertificateStore as XS import qualified Data.X509.Validation as XV import Network.Socket (HostName) +import Time.System (dateCurrent) data ChainCertificates = CCEmpty | CCSelf X.SignedCertificate - | CCValid {leafCert :: X.SignedCertificate, idCert :: X.SignedCertificate, caCert :: X.SignedCertificate} + | CCValid {leafCert :: X.SignedCertificate, idCert :: X.SignedCertificate} | CCLong chainIdCaCerts :: X.CertificateChain -> ChainCertificates chainIdCaCerts (X.CertificateChain chain) = case chain of [] -> CCEmpty [cert] -> CCSelf cert - [leafCert, cert] -> CCValid {leafCert, idCert = cert, caCert = cert} -- current long-term online/offline certificates chain - [leafCert, idCert, caCert] -> CCValid {leafCert, idCert, caCert} -- with additional operator certificate (preset in the client) - [leafCert, idCert, _, caCert] -> CCValid {leafCert, idCert, caCert} -- with network certificate + [leafCert, idCert] -> CCValid {leafCert, idCert} -- current long-term online/offline certificates chain + [leafCert, idCert, _] -> CCValid {leafCert, idCert} -- with additional operator certificate (preset in the client) + [leafCert, idCert, _, _] -> CCValid {leafCert, idCert} -- with network certificate _ -> CCLong -x509validate :: X.SignedCertificate -> (HostName, ByteString) -> X.CertificateChain -> IO [XV.FailedReason] -x509validate caCert serviceID = XV.validate X.HashSHA256 XV.defaultHooks checks certStore noCache serviceID +x509validate :: (HostName, ByteString) -> X.CertificateChain -> IO [XV.FailedReason] +x509validate _ (X.CertificateChain []) = pure [XV.EmptyChain] +x509validate serviceID (X.CertificateChain certs) + | all (supportedKey . X.certPubKey . X.getCertificate) certs = concat <$> sequence (zipWith signedBy certs (drop 1 certs) <> [validateTop]) + | otherwise = pure [XV.InvalidSignature XV.SignatureUnimplemented] where + top = last certs + validateTop + | length certs <= 2 = signedBy top top + | otherwise = (\now -> XV.hookValidateTime XV.defaultHooks now $ X.getCertificate top) <$> dateCurrent + signedBy cert issuer = XV.validate X.HashSHA256 XV.defaultHooks checks (XS.makeCertificateStore [issuer]) noCache serviceID (X.CertificateChain [cert]) checks = XV.defaultChecks {XV.checkFQHN = False} - certStore = XS.makeCertificateStore [caCert] noCache = XV.ValidationCache (\_ _ _ -> pure XV.ValidationCacheUnknown) (\_ _ _ -> pure ()) + supportedKey = \case + X.PubKeyEd25519 _ -> True + X.PubKeyEd448 _ -> True + X.PubKeyEC X.PubKeyEC_Named {} -> True + X.PubKeyRSA k -> RSA.public_size k <= 512 && RSA.public_e k > 0 && RSA.public_e k < 2 ^ (32 :: Int) + _ -> False takePeerCertChain :: TMVar (Maybe X.CertificateChain) -> IO (X.CertificateChain) takePeerCertChain peerCert = diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 65dcffadb..eff3b594c 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -65,6 +65,8 @@ import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Monad import Control.Monad.Except import Control.Monad.Reader +import Crypto.Error (throwCryptoError) +import qualified Crypto.PubKey.Curve25519 as X25519 import Data.Bifunctor (first) import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 (ByteString) @@ -98,7 +100,7 @@ import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction) import Simplex.Messaging.Agent.Store.Interface import qualified Simplex.Messaging.Agent.Store.DB as DB import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationConfirmation (..), MigrationError (..)) -import Simplex.Messaging.Client (pattern NRMInteractive, NetworkConfig (..), ProtocolClientConfig (..), TransportSessionMode (..), defaultClientConfig) +import Simplex.Messaging.Client (pattern NRMInteractive, NetworkConfig (..), ProtocolClientConfig (..), TransportSessionMode (..), defaultClientConfig, defaultSMPClientConfig, getProtocolClient, sendSMPMessage) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR @@ -346,8 +348,9 @@ functionalAPITests ps = do testPQMatrix2 ps $ runAgentClientTestPQ True describe "Establishing duplex connection v2, different Ratchet versions" $ testRatchetMatrix2 ps runAgentClientTest - describe "Establish duplex connection via contact address" $ + describe "Establish duplex connection via contact address" $ do testMatrix2 ps runAgentClientContactTest + it "should not decrypt contact request with zero DH secret" $ testContactRequestZeroSecret ps describe "Establish duplex connection via contact address, different PQ settings" $ do testPQMatrix2NoInv ps $ runAgentClientContactTestPQ True True describe "Establish duplex connection via contact address v2, different Ratchet versions" $ @@ -1054,6 +1057,25 @@ runAgentClientContactTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId = where msgId = subtract baseId . fst +testContactRequestZeroSecret :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO () +testContactRequestZeroSecret ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do + (contactId, qInfo@(CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId} :| _} _)) <- runRight $ createConnection alice 1 True SCMContact Nothing SMSubscribe + (_, cReq) <- runRight $ createConnection bob 1 True SCMInvitation Nothing SMSubscribe + g <- C.newRandom + (_, pk) <- atomically $ C.generateKeyPair g + nonce <- atomically $ C.randomCbNonce g + let k = C.PublicKeyX25519 . throwCryptoError . X25519.publicKey $ B.replicate 32 '\0' + inv = AgentInvitation {agentVersion = currentSMPAgentVersion, connReq = cReq, connInfo = "bob's connInfo"} + Right encBody <- pure $ C.cbEncrypt (C.dh' k pk) nonce (smpEncode $ SMP.ClientMessage SMP.PHEmpty $ smpEncode inv) SMP.e2eEncConfirmationLength + let msg = smpEncode $ SMP.ClientMsgEnvelope (SMP.PubHeader SMP.currentSMPClientVersion (Just k)) nonce encBody + ts <- getCurrentTime + smp <- either (fail . show) pure =<< getProtocolClient g NRMInteractive (1, testSMPServer, Nothing) defaultSMPClientConfig [] Nothing ts (\_ -> pure ()) + runRight_ $ sendSMPMessage smp NRMInteractive Nothing senderId SMP.noMsgFlags msg + get alice ##> ("", contactId, ERR $ AGENT $ A_CRYPTO DECRYPT_CB) + runRight_ $ do + void $ joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe + get alice =##> \case ("", c, REQ _ _ "bob's connInfo") -> c == contactId; _ -> False + allowConfirmGreet :: HasCallStack => AgentClient -> ConnId -> AgentClient -> ConnId -> ConfirmationId -> InitialKeys -> PQEncryption -> ExceptT AgentErrorType IO () allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc = do allowConnection bob aliceId confId "bob's connInfo" diff --git a/tests/CoreTests/CryptoTests.hs b/tests/CoreTests/CryptoTests.hs index ad5550b55..41d93e6c2 100644 --- a/tests/CoreTests/CryptoTests.hs +++ b/tests/CoreTests/CryptoTests.hs @@ -10,6 +10,10 @@ import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar) import Control.Concurrent.STM import Control.Exception (bracket, evaluate) import Control.Monad.Except +import Crypto.Error (throwCryptoError) +import Crypto.Number.Serialize.LE (i2ospOf_) +import qualified Crypto.PubKey.Curve25519 as X25519 +import qualified Crypto.PubKey.RSA as RSA import qualified Data.Aeson as J import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB @@ -41,6 +45,7 @@ import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (RNGFunc) import Simplex.Messaging.Encoding (Large (..), smpDecode, smpEncode) import Simplex.Messaging.Encoding.String (strDecode, strEncode) import Simplex.Messaging.Transport.Client +import Simplex.Messaging.Transport.Credentials (genCredentials) import System.Timeout (timeout) import Test.Hspec hiding (fit, it) import Test.Hspec.QuickCheck (modifyMaxSuccess) @@ -101,7 +106,9 @@ cryptoTests = do describe "Ed signatures" $ do describe "Ed25519" $ testSignature C.SEd25519 describe "Ed448" $ testSignature C.SEd448 - describe "DH X25519 + cryptobox" testDHCryptoBox + describe "DH X25519 + cryptobox" $ do + testDHCryptoBox + it "should not decrypt with zero DH secret" testDHCryptoBoxZeroSecret describe "secretbox" testSecretBox describe "lazy secretbox" $ do testLazySecretBox @@ -176,6 +183,21 @@ testDHCryptoBox = it "should encrypt / decrypt string with asymmetric DH keys" . plain = C.cbDecrypt (C.dh' sk rpk) nonce =<< cipher in isRight cipher && cipher /= plain && Right b == plain +testDHCryptoBoxZeroSecret :: IO () +testDHCryptoBoxZeroSecret = do + g <- C.newRandom + (_, pk) <- atomically $ C.generateKeyPair g + nonce <- atomically $ C.randomCbNonce g + mapM_ (decryptWithKey pk nonce) [u + b | u <- us, b <- [0, 2 ^ (255 :: Int)]] + where + p = 2 ^ (255 :: Int) - 19 + us = [0, 1, 325606250916557431795983626356110631294008115727848805560023387167927233504, 39382357235489614581723060781553021112529911719440698176882885853963445705823, p - 1, p, p + 1] + decryptWithKey pk nonce u = do + let k = C.PublicKeyX25519 . throwCryptoError . X25519.publicKey $ (i2ospOf_ 32 u :: B.ByteString) + secret = C.dh' k pk + Right cipher <- pure $ C.cbEncrypt secret nonce "hello" 64 + C.cbDecrypt secret nonce cipher `shouldBe` Left C.CBDecryptError + testSecretBox :: Spec testSecretBox = it "should encrypt / decrypt string with a random symmetric key" . ioProperty $ do g <- C.newRandom @@ -292,12 +314,39 @@ testValidateX509 = do -- messed up key rotation or other configuration problems checkChain [server2, ca] `shouldReturn` [XV.InvalidSignature XV.SignatureInvalid] + checkChain [server, ca, ca, ca] `shouldReturn` [] + checkChain [server, ca, ca2] `shouldReturn` [XV.InvalidSignature XV.SignatureInvalid] + checkChain [server, ca, ca, ca2] `shouldReturn` [XV.InvalidSignature XV.SignatureInvalid] + checkChain [server2, ca, ca2] `shouldReturn` [XV.InvalidSignature XV.SignatureInvalid, XV.InvalidSignature XV.SignatureInvalid] + -- self-signed, unrelated to CA ssCreds <- XS.readCertificates "tests/fixtures/ss.crt" ssCreds `shouldNotBe` [] let ss = head ssCreds checkChain [ss, ca] `shouldReturn` [XV.SelfSigned] + let rsaKey = X.PubKeyRSA $ RSA.PublicKey 1024 (2 ^ (8192 :: Int) - 1) 65537 + rsaCert = fst $ X.objectToSignedExact (\_ -> ("", X.SignatureALG_IntrinsicHash X.PubKeyALG_Ed448, ())) (X.getCertificate server) {X.certPubKey = rsaKey} + checkChain [rsaCert, ca] `shouldReturn` [XV.InvalidSignature XV.SignatureUnimplemented] + + g <- C.newRandom + root <- genCredentials g Nothing (1, 24) "root" + op <- genCredentials g (Just root) (1, 24) "operator" + ident <- genCredentials g (Just op) (1, 24) "identity" + leaf <- genCredentials g (Just ident) (1, 24) "leaf" + expiredOp <- genCredentials g (Just root) (48, -24) "operator" + expiredOpIdent <- genCredentials g (Just expiredOp) (1, 24) "identity" + expiredOpLeaf <- genCredentials g (Just expiredOpIdent) (1, 24) "leaf" + let checkPinned creds = validateCertificateChain (C.KeyHash fp) "localhost" "5223" $ X.CertificateChain $ map snd creds + where + XV.Fingerprint fp = XV.getFingerprint (snd $ creds !! 1) X.HashSHA256 + checkPinned [leaf, ident, op] `shouldReturn` [] + checkPinned [expiredOpLeaf, expiredOpIdent, expiredOp] `shouldReturn` [XV.Expired] + checkPinned [leaf, ident] `shouldReturn` [XV.UnknownCA] + otherCA <- genCredentials g Nothing (1, 24) "other" + otherLeaf <- genCredentials g (Just otherCA) (1, 24) "leaf" + checkPinned [otherLeaf, ident, otherCA] `shouldReturn` [XV.UnknownCA, XV.UnknownCA] + testSNTRUP761 :: IO () testSNTRUP761 = do drg <- C.newRandom