mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-27 22:34:59 +00:00
agent: binary protocol encoding for connection request (#1503)
* agent: binary protocol encoding for connection request * enable tests * test
This commit is contained in:
Evgeny
@@ -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,
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user