From 86fb2cddc58d8ea783cbbbc51ad33af6c95c2e85 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Tue, 12 Aug 2025 07:31:32 +0100 Subject: [PATCH 1/3] smp server: support short SimpleX addresses in server information / pages (#1600) --- src/Simplex/Messaging/Agent/Protocol.hs | 2 +- src/Simplex/Messaging/Server/Information.hs | 4 ++-- src/Simplex/Messaging/Server/Main.hs | 5 +++-- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 44662754e..74a6221b5 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1129,7 +1129,7 @@ instance StrEncoding AConnectionRequestUri where connReqUriP :: Maybe ServiceScheme -> Parser AConnectionRequestUri connReqUriP overrideScheme = do - crScheme <- (`fromMaybe` overrideScheme) <$> strP + crScheme <- (`fromMaybe` overrideScheme) <$> strP -- always parse, but use the passed one if any crMode <- A.char '/' *> crModeP <* optional (A.char '/') <* "#/?" query <- strP aVRange <- queryParam "v" query diff --git a/src/Simplex/Messaging/Server/Information.hs b/src/Simplex/Messaging/Server/Information.hs index 422dab224..a94148dbe 100644 --- a/src/Simplex/Messaging/Server/Information.hs +++ b/src/Simplex/Messaging/Server/Information.hs @@ -14,7 +14,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Int (Int64) import Data.Maybe (isJust) import Data.Text (Text) -import Simplex.Messaging.Agent.Protocol (ConnectionMode (..), ConnectionRequestUri) +import Simplex.Messaging.Agent.Protocol (ConnectionLink, ConnectionMode (..), ConnectionRequestUri) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON) @@ -100,7 +100,7 @@ data Entity = Entity {name :: Text, country :: Maybe Text} deriving (Show) data ServerContactAddress = ServerContactAddress - { simplex :: Maybe (ConnectionRequestUri 'CMContact), + { simplex :: Maybe (ConnectionLink 'CMContact), email :: Maybe Text, -- it is recommended that it matches DNS email address, if either is present pgp :: Maybe PGPKey } diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 17c5de7e3..c5292b4e5 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -37,7 +37,7 @@ import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) import qualified Data.Text.IO as T import Options.Applicative -import Simplex.Messaging.Agent.Protocol (connReqUriP') +import Simplex.Messaging.Agent.Protocol (ConnectionLink (..), connReqUriP') import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..)) import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..)) import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SMPWebPortServers (..), SocksMode (..), defaultNetworkConfig, textToHostMode) @@ -638,7 +638,8 @@ serverPublicInfo ini = serverInfo <$!> infoValue "source_code" <$!> infoValue nameField countryValue field = (either error id . validCountryValue (T.unpack field) . T.unpack) <$!> infoValue field iniContacts simplexField emailField pgpKeyUriField pgpKeyFingerprintField = - let simplex = either error id . parseAll (connReqUriP' Nothing) . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini) + let simplex = either error id . parseAll linkP . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini) + linkP = CLFull <$> connReqUriP' Nothing <|> CLShort <$> strP email = infoValue emailField pkURI_ = infoValue pgpKeyUriField pkFingerprint_ = infoValue pgpKeyFingerprintField From e345671c76392443491523c88ea14826e7a057b4 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Thu, 14 Aug 2025 22:48:11 +0100 Subject: [PATCH 2/3] agent: extend xrcp certificate validity 1 hour in the past, to allow out of sync clocks (#1601) --- src/Simplex/Messaging/Transport/Credentials.hs | 8 -------- src/Simplex/RemoteControl/Client.hs | 6 +++--- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/src/Simplex/Messaging/Transport/Credentials.hs b/src/Simplex/Messaging/Transport/Credentials.hs index 3d6155da0..f610ab943 100644 --- a/src/Simplex/Messaging/Transport/Credentials.hs +++ b/src/Simplex/Messaging/Transport/Credentials.hs @@ -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 diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs index a4b4c9038..bde72fb23 100644 --- a/src/Simplex/RemoteControl/Client.hs +++ b/src/Simplex/RemoteControl/Client.hs @@ -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 From 2cedb66667fe4c6b0fed1a7a6f57cbb160695be1 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Fri, 15 Aug 2025 07:24:37 +0100 Subject: [PATCH 3/3] agent: chat relay address type for short links (#1602) --- apps/smp-server/static/link.html | 2 ++ apps/smp-server/web/Static.hs | 1 + src/Simplex/Messaging/Agent/Protocol.hs | 4 +++- 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/apps/smp-server/static/link.html b/apps/smp-server/static/link.html index b5be2d7ab..396f3dc12 100644 --- a/apps/smp-server/static/link.html +++ b/apps/smp-server/static/link.html @@ -512,6 +512,8 @@ element.innerHTML = 'This is a one-time link of the SimpleX network user' } else if (url.includes('/c')) { element.innerHTML = 'This is a public channel address on SimpleX network' + } else if (url.includes('/r')) { + element.innerHTML = 'This is a chat relay address on SimpleX network' } } diff --git a/apps/smp-server/web/Static.hs b/apps/smp-server/web/Static.hs index 50e4415eb..dc8f24ec9 100644 --- a/apps/smp-server/web/Static.hs +++ b/apps/smp-server/web/Static.hs @@ -103,6 +103,7 @@ generateSite si onionHost sitePath = do createLinkPage "a" createLinkPage "c" createLinkPage "g" + createLinkPage "r" createLinkPage "i" logInfo $ "Generated static site contents at " <> tshow sitePath where diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 74a6221b5..f1d5f2ec8 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -1445,7 +1445,7 @@ instance ConnectionModeI c => ToField (ConnShortLink c) where toField = toField instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fromField = blobFieldDecoder strDecode -data ContactConnType = CCTContact | CCTChannel | CCTGroup deriving (Eq, Show) +data ContactConnType = CCTContact | CCTChannel | CCTGroup | CCTRelay deriving (Eq, Show) data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m) @@ -1593,6 +1593,7 @@ ctTypeP = \case 'A' -> pure CCTContact 'C' -> pure CCTChannel 'G' -> pure CCTGroup + 'R' -> pure CCTRelay _ -> fail "unknown contact address type" {-# INLINE ctTypeP #-} @@ -1601,6 +1602,7 @@ ctTypeChar = \case CCTContact -> 'A' CCTChannel -> 'C' CCTGroup -> 'G' + CCTRelay -> 'R' {-# INLINE ctTypeChar #-} -- the servers passed to this function should be all preset servers, not servers configured by the user.