agent: extend xrcp certificate validity 1 hour in the past, to allow out of sync clocks (#1601)

This commit is contained in:
Evgeny
2025-08-14 22:48:11 +01:00
committed by GitHub
parent 86fb2cddc5
commit e345671c76
2 changed files with 3 additions and 11 deletions

View File

@@ -25,14 +25,6 @@ import qualified Simplex.Messaging.Crypto as C
import qualified Time.System as Hourglass
import qualified Time.Types as HT
-- | Generate a certificate chain to be used with TLS fingerprint-pinning
--
-- @
-- genTlsCredentials = do
-- ca <- genCredentials Nothing (-25, 365 * 24) "Root" -- long-lived root cert
-- leaf <- genCredentials (Just ca) (0, 1) "Entity" -- session-signing cert
-- pure $ tlsCredentials (leaf :| [ca])
-- @
tlsCredentials :: NonEmpty Credentials -> (C.KeyHash, TLS.Credential)
tlsCredentials credentials = (C.KeyHash rootFP, (X509.CertificateChain certs, privateToTls $ snd leafKey))
where

View File

@@ -85,7 +85,7 @@ encInvitationSize = 900
newRCHostPairing :: TVar ChaChaDRG -> IO RCHostPairing
newRCHostPairing drg = do
((_, caKey), caCert) <- genCredentials drg Nothing (-25, 24 * 999999) "ca"
((_, caKey), caCert) <- genCredentials drg Nothing (25, 24 * 999999) "ca"
(_, idPrivKey) <- atomically $ C.generateKeyPair drg
pure RCHostPairing {caKey, caCert, idPrivKey, knownHost = Nothing}
@@ -193,7 +193,7 @@ connectRCHost drg pairing@RCHostPairing {caKey, caCert, idPrivKey, knownHost} ct
genTLSCredentials :: TVar ChaChaDRG -> C.APrivateSignKey -> X.SignedCertificate -> IO TLS.Credential
genTLSCredentials drg caKey caCert = do
let caCreds = (C.signatureKeyPair caKey, caCert)
leaf <- genCredentials drg (Just caCreds) (0, 24 * 999999) "localhost" -- session-signing cert
leaf <- genCredentials drg (Just caCreds) (1, 24 * 999999) "localhost" -- session-signing cert
pure . snd $ tlsCredentials (leaf :| [caCreds])
certFingerprint :: X.SignedCertificate -> C.KeyHash
@@ -259,7 +259,7 @@ connectRCCtrl drg (RCVerifiedInvitation inv@RCInvitation {ca, idkey}) pairing_ h
where
newCtrlPairing :: IO RCCtrlPairing
newCtrlPairing = do
((_, caKey), caCert) <- genCredentials drg Nothing (0, 24 * 999999) "ca"
((_, caKey), caCert) <- genCredentials drg Nothing (1, 24 * 999999) "ca"
(_, dhPrivKey) <- atomically $ C.generateKeyPair drg
pure RCCtrlPairing {caKey, caCert, ctrlFingerprint = ca, idPubKey = idkey, dhPrivKey, prevDhPrivKey = Nothing}
updateCtrlPairing :: RCCtrlPairing -> ExceptT RCErrorType IO RCCtrlPairing