transport, crypto: certificate chain, keys and DH secret (#1964)

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

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).

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]

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 $

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 =