From 2c5530c9f0d0e30bdcdb29947599d818533523bf Mon Sep 17 00:00:00 2001 From: Evgeny Date: Tue, 1 Apr 2025 22:32:49 +0100 Subject: [PATCH] agent: binary protocol encoding for connection request (#1503) * agent: binary protocol encoding for connection request * enable tests * test --- src/Simplex/Messaging/Agent/Protocol.hs | 54 +++++++++++++++++++--- src/Simplex/Messaging/Crypto/Ratchet.hs | 39 ++++++++++++++-- tests/AgentTests/ConnectionRequestTests.hs | 27 +++++++++++ tests/AgentTests/FunctionalAPITests.hs | 5 +- 4 files changed, 111 insertions(+), 14 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index dcf9e0329..f27ffbcd2 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -690,19 +690,23 @@ instance Eq AConnectionMode where cmInvitation :: AConnectionMode cmInvitation = ACM SCMInvitation +{-# INLINE cmInvitation #-} cmContact :: AConnectionMode cmContact = ACM SCMContact +{-# INLINE cmContact #-} deriving instance Show AConnectionMode connMode :: SConnectionMode m -> ConnectionMode connMode SCMInvitation = CMInvitation connMode SCMContact = CMContact +{-# INLINE connMode #-} connMode' :: ConnectionMode -> AConnectionMode connMode' CMInvitation = cmInvitation connMode' CMContact = cmContact +{-# INLINE connMode' #-} class ConnectionModeI (m :: ConnectionMode) where sConnectionMode :: SConnectionMode m @@ -1054,10 +1058,27 @@ instance ConnectionModeI m => StrEncoding (ConnectionRequestUri m) where <> maybe [] (\cd -> [("data", encodeUtf8 cd)]) crClientData strP = connReqUriP' (Just SSSimplex) --- TODO [short links] do not use StrEncoding instance instance ConnectionModeI m => Encoding (ConnectionRequestUri m) where - smpEncode = smpEncode . Large . strEncode - smpP = strDecode . unLarge <$?> smpP + smpEncode = \case + CRInvitationUri crData e2eParams -> smpEncode (CMInvitation, crData, e2eParams) + CRContactUri crData -> smpEncode (CMContact, crData) + smpP = (\(ACR _ cr) -> checkConnMode cr) <$?> smpP + {-# INLINE smpP #-} + +instance Encoding AConnectionRequestUri where + smpEncode (ACR _ cr) = smpEncode cr + {-# INLINE smpEncode #-} + smpP = + smpP >>= \case + CMInvitation -> ACR SCMInvitation <$> (CRInvitationUri <$> smpP <*> smpP) + CMContact -> ACR SCMContact . CRContactUri <$> smpP + +instance Encoding ConnReqUriData where + smpEncode ConnReqUriData {crAgentVRange, crSmpQueues, crClientData} = + smpEncode (crAgentVRange, crSmpQueues, Large . encodeUtf8 <$> crClientData) + smpP = do + (crAgentVRange, crSmpQueues, clientData) <- smpP + pure ConnReqUriData {crScheme = SSSimplex, crAgentVRange, crSmpQueues, crClientData = safeDecodeUtf8 . unLarge <$> clientData} connReqUriP' :: forall m. ConnectionModeI m => Maybe ServiceScheme -> Parser (ConnectionRequestUri m) connReqUriP' overrideScheme = do @@ -1122,6 +1143,16 @@ instance StrEncoding AConnectionMode where strEncode (ACM cMode) = strEncode $ connMode cMode strP = connMode' <$> strP +instance Encoding ConnectionMode where + smpEncode = \case + CMInvitation -> "I" + CMContact -> "C" + smpP = + A.anyChar >>= \case + 'I' -> pure CMInvitation + 'C' -> pure CMContact + _ -> fail "bad connection mode" + connModeT :: Text -> Maybe ConnectionMode connModeT = \case "INV" -> Just CMInvitation @@ -1170,7 +1201,7 @@ data SMPQueueInfo = SMPQueueInfo {clientVersion :: VersionSMPC, queueAddress :: instance Encoding SMPQueueInfo where smpEncode (SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}) - | clientVersion >= shortLinksSMPClientVersion = addrEnc <> smpEncode queueMode + | clientVersion >= shortLinksSMPClientVersion = addrEnc <> maybe "" smpEncode queueMode | clientVersion >= sndAuthKeySMPClientVersion && sndSecure = addrEnc <> smpEncode sndSecure | clientVersion > initialSMPClientVersion = addrEnc | otherwise = smpEncode clientVersion <> legacyEncodeServer smpServer <> smpEncode (senderId, dhPublicKey) @@ -1181,7 +1212,7 @@ instance Encoding SMPQueueInfo where clientVersion <- smpP smpServer <- if clientVersion > initialSMPClientVersion then smpP else updateSMPServerHosts <$> legacyServerP (senderId, dhPublicKey) <- smpP - queueMode <- smpP <|> optional ((\ss -> if ss then QMMessaging else QMContact) <$> smpP) + queueMode <- queueModeP pure $ SMPQueueInfo clientVersion SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode} -- This instance seems contrived and there was a temptation to split a common part of both types. @@ -1276,7 +1307,7 @@ instance Encoding SMPQueueUri where smpEncode (SMPQueueUri clientVRange@(VersionRange minV maxV) SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode}) -- The condition is for minVersion as earlier clients won't be able to support it. -- The alternative would be to encode both queueMode and sndSecure - | minV >= shortLinksSMPClientVersion = addrEnc <> smpEncode queueMode + | minV >= shortLinksSMPClientVersion = addrEnc <> maybe "" smpEncode queueMode -- Earlier versions won't be able to ignore sndSecure, so we don't include it when it is False | minV >= sndAuthKeySMPClientVersion || (maxV >= sndAuthKeySMPClientVersion && sndSecure) = addrEnc <> smpEncode sndSecure | otherwise = addrEnc @@ -1285,9 +1316,12 @@ instance Encoding SMPQueueUri where sndSecure = senderCanSecure queueMode smpP = do (clientVRange, smpServer, senderId, dhPublicKey) <- smpP - queueMode <- smpP <|> optional ((\ss -> if ss then QMMessaging else QMContact) <$> smpP) + queueMode <- queueModeP pure $ SMPQueueUri clientVRange SMPQueueAddress {smpServer, senderId, dhPublicKey, queueMode} +queueModeP :: Parser (Maybe QueueMode) +queueModeP = Just <$> smpP <|> optional ((\case True -> QMMessaging; _ -> QMContact) <$> smpP) + data ConnectionRequestUri (m :: ConnectionMode) where CRInvitationUri :: ConnReqUriData -> RcvE2ERatchetParamsUri 'C.X448 -> ConnectionRequestUri CMInvitation -- contact connection request does NOT contain E2E encryption parameters for double ratchet - @@ -1374,6 +1408,12 @@ sameConnReqContact (CRContactUri ConnReqUriData {crSmpQueues = qs}) (CRContactUr where same (q, q') = sameQAddress (qAddress q) (qAddress q') +checkConnMode :: forall t m m'. (ConnectionModeI m, ConnectionModeI m') => t m' -> Either String (t m) +checkConnMode c = case testEquality (sConnectionMode @m) (sConnectionMode @m') of + Just Refl -> Right c + Nothing -> Left "bad connection mode" +{-# INLINE checkConnMode #-} + data ConnReqUriData = ConnReqUriData { crScheme :: ServiceScheme, crAgentVRange :: VersionRangeSMPA, diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs index 8c79503c8..576e78c03 100644 --- a/src/Simplex/Messaging/Crypto/Ratchet.hs +++ b/src/Simplex/Messaging/Crypto/Ratchet.hs @@ -306,11 +306,13 @@ instance (RatchetKEMStateI s, AlgorithmI a) => StrEncoding (E2ERatchetParamsUri | otherwise = case kem of RKParamsProposed k -> [("kem_key", strEncode k)] RKParamsAccepted ct k -> [("kem_ct", strEncode ct), ("kem_key", strEncode k)] - strP = toParamsURI <$?> strP - where - toParamsURI = \case - AE2ERatchetParamsUri _ (E2ERatchetParamsUri vr k1 k2 Nothing) -> Right $ E2ERatchetParamsUri vr k1 k2 Nothing - AE2ERatchetParamsUri _ ps -> checkRatchetKEMState ps + strP = toE2ERatchetParamsUri <$?> strP + {-# INLINE strP #-} + +toE2ERatchetParamsUri :: RatchetKEMStateI s => AE2ERatchetParamsUri a -> Either String (E2ERatchetParamsUri s a) +toE2ERatchetParamsUri = \case + AE2ERatchetParamsUri _ (E2ERatchetParamsUri vr k1 k2 Nothing) -> Right $ E2ERatchetParamsUri vr k1 k2 Nothing + AE2ERatchetParamsUri _ ps -> checkRatchetKEMState ps instance AlgorithmI a => StrEncoding (AE2ERatchetParamsUri a) where strEncode (AE2ERatchetParamsUri _ ps) = strEncode ps @@ -340,6 +342,33 @@ instance StrEncoding AnyE2ERatchetParamsUri where Nothing -> ARKP SRKSProposed $ RKParamsProposed k Just ct -> ARKP SRKSAccepted $ RKParamsAccepted ct k +instance (RatchetKEMStateI s, AlgorithmI a) => Encoding (E2ERatchetParamsUri s a) where + smpEncode (E2ERatchetParamsUri vr k1 k2 kem_) = smpEncode (vr, k1, k2, kem_) + {-# INLINE smpEncode #-} + smpP = toE2ERatchetParamsUri <$?> smpP + {-# INLINE smpP #-} + +instance AlgorithmI a => Encoding (AE2ERatchetParamsUri a) where + smpEncode (AE2ERatchetParamsUri _ ps) = smpEncode ps + {-# INLINE smpEncode #-} + smpP = (\(AnyE2ERatchetParamsUri s _ ps) -> AE2ERatchetParamsUri s <$> checkAlgorithm ps) <$?> smpP + {-# INLINE smpP #-} + +instance Encoding AnyE2ERatchetParamsUri where + smpEncode (AnyE2ERatchetParamsUri _ _ ps) = smpEncode ps + {-# INLINE smpEncode #-} + smpP = do + vr <- smpP @VersionRangeE2E + APublicDhKey a k1 <- smpP + APublicDhKey a' k2 <- smpP + case testEquality a a' of + Nothing -> fail "bad e2e params: different key algorithms" + Just Refl -> + let result = \case + Just (ARKP s kem) -> AnyE2ERatchetParamsUri s a $ E2ERatchetParamsUri vr k1 k2 (Just kem) + Nothing -> AnyE2ERatchetParamsUri SRKSProposed a $ E2ERatchetParamsUri vr k1 k2 Nothing + in result <$> smpP + type RcvE2ERatchetParams a = E2ERatchetParams 'RKSProposed a type SndE2ERatchetParams a = AE2ERatchetParams a diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 4a8b52cd5..5465bca1b 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/tests/AgentTests/ConnectionRequestTests.hs @@ -21,6 +21,7 @@ import Network.HTTP.Types (urlEncode) import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet +import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (EntityId (..), ProtocolServer (..), QueueMode (..), currentSMPClientVersion, supportedSMPClientVRange, pattern VersionSMPC) import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) @@ -253,3 +254,29 @@ connectionRequestTests = contactAddressV2 #== ("https://simplex.chat/contact#/?v=1-2&smp=" <> url queueStr) -- adjusted to v2 contactAddressV2 #== ("https://simplex.chat/contact#/?v=2-2&smp=" <> url queueStr) contactAddressClientData #==# ("simplex:/contact#/?v=2-7&smp=" <> url queueStr <> "&data=" <> url "{\"type\":\"group_link\", \"group_link_id\":\"abc\"}") + it "should serialize / parse queue address, connection invitations and contact addresses as binary" $ do + smpEncodingTest queue + smpEncodingTest queueSK + smpEncodingTest queue1 + smpEncodingTest queueNew + smpEncodingTest queueNew1 + smpEncodingTest queueNewNoPort + smpEncodingTest queueNew1NoPort + smpEncodingTest queueV1 + smpEncodingTest queueV1NoPort + smpEncodingTest connectionRequest + smpEncodingTest connectionRequestSK + smpEncodingTest connectionRequest1 + smpEncodingTest connectionRequest2queues + smpEncodingTest connectionRequestNew + smpEncodingTest connectionRequestNew1 + smpEncodingTest connectionRequest2queuesNew + smpEncodingTest connectionRequestClientDataEmpty + smpEncodingTest contactAddress + smpEncodingTest contactAddress2queues + smpEncodingTest contactAddressNew + smpEncodingTest contactAddress2queuesNew + smpEncodingTest contactAddressV2 + smpEncodingTest contactAddressClientData + where + smpEncodingTest a = smpDecode (smpEncode a) `shouldBe` Right a \ No newline at end of file diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs index 43cfd0d1e..2904f9576 100644 --- a/tests/AgentTests/FunctionalAPITests.hs +++ b/tests/AgentTests/FunctionalAPITests.hs @@ -93,6 +93,7 @@ import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), 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 +import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Transport (NTFVersion, pattern VersionNTF) import Simplex.Messaging.Protocol (BasicAuth, ErrorType (..), MsgBody, ProtocolServer (..), SubscriptionMode (..), initialSMPClientVersion, srvHostnamesSMPClientVersion, supportedSMPClientVRange) @@ -1132,7 +1133,7 @@ testContactShortLink ps = withAgentClients3 $ \a b c -> withSmpServer ps $ do let userData = "some user data" (contactId, (connReq0, Just shortLink)) <- runRight $ A.createConnection a 1 True SCMContact (Just userData) Nothing CR.IKPQOn SMSubscribe - Right connReq <- pure $ strDecode (strEncode connReq0) + Right connReq <- pure $ smpDecode (smpEncode connReq0) (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink strDecode (strEncode shortLink) `shouldBe` Right shortLink connReq' `shouldBe` connReq @@ -1177,7 +1178,7 @@ testAddContactShortLink :: HasCallStack => (ATransport, AStoreType) -> IO () testAddContactShortLink ps = withAgentClients3 $ \a b c -> withSmpServer ps $ do (contactId, (connReq0, Nothing)) <- runRight $ A.createConnection a 1 True SCMContact Nothing Nothing CR.IKPQOn SMSubscribe - Right connReq <- pure $ strDecode (strEncode connReq0) + Right connReq <- pure $ smpDecode (smpEncode connReq0) -- let userData = "some user data" shortLink <- runRight $ setContactShortLink a contactId userData (connReq', userData') <- runRight $ getConnShortLink b 1 shortLink