Skip to content

Commit e5d8e3b

Browse files
epoberezkinepoberezkin
committed
wip
1 parent d348462 commit e5d8e3b

2 files changed

Lines changed: 93 additions & 39 deletions

File tree

‎src/Simplex/Messaging/Agent/Protocol.hs‎

Lines changed: 90 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -109,7 +109,7 @@ module Simplex.Messaging.Agent.Protocol
109109
CRClientData,
110110
ServiceScheme,
111111
FixedLinkData (..),
112-
UserLinkData (..),
112+
MutableLinkData (..),
113113
OwnerAuth (..),
114114
OwnerId,
115115
ConnectionLink (..),
@@ -167,7 +167,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
167167
import qualified Data.ByteString.Base64.URL as B64
168168
import Data.ByteString.Char8 (ByteString)
169169
import qualified Data.ByteString.Char8 as B
170-
import Data.Char (isDigit)
170+
import Data.Char (isDigit, toLower, toUpper)
171171
import Data.Foldable (find)
172172
import Data.Functor (($>))
173173
import Data.Int (Int64)
@@ -1349,7 +1349,7 @@ deriving instance Show AConnectionRequestUri
13491349

13501350
data ConnShortLink (m :: ConnectionMode) where
13511351
CSLInvitation :: SMPServer -> SMP.LinkId -> LinkKey -> ConnShortLink 'CMInvitation
1352-
CSLContact :: SMPServer -> ContactConnType -> LinkKey -> ConnShortLink 'CMContact
1352+
CSLContact :: ContactConnType -> SMPServer -> LinkKey -> ConnShortLink 'CMContact
13531353

13541354
deriving instance Eq (ConnShortLink m)
13551355

@@ -1369,7 +1369,7 @@ instance ConnectionModeI c => ToField (ConnShortLink c) where toField = toField
13691369

13701370
instance (Typeable c, ConnectionModeI c) => FromField (ConnShortLink c) where fromField = blobFieldDecoder strDecode
13711371

1372-
data ContactConnType = CCTContact | CCTGroup deriving (Eq, Show)
1372+
data ContactConnType = CCTContact | CCTChannel | CCTGroup deriving (Eq, Show)
13731373

13741374
data AConnShortLink = forall m. ConnectionModeI m => ACSL (SConnectionMode m) (ConnShortLink m)
13751375

@@ -1406,50 +1406,84 @@ instance ConnectionModeI m => FromJSON (ConnectionLink m) where
14061406

14071407
instance ConnectionModeI m => StrEncoding (ConnShortLink m) where
14081408
strEncode = \case
1409-
CSLInvitation srv (SMP.EntityId lnkId) (LinkKey k) -> encLink srv (lnkId <> k) "i"
1410-
CSLContact srv ct (LinkKey k) -> encLink srv k $ case ct of CCTContact -> "c"; CCTGroup -> "g"
1409+
CSLInvitation srv (SMP.EntityId lnkId) (LinkKey k) -> encLink srv (lnkId <> k) 'i'
1410+
CSLContact ct srv (LinkKey k) -> encLink srv k $ toLower $ ctTypeChar ct
14111411
where
14121412
encLink (SMPServer (h :| hs) port (C.KeyHash kh)) linkUri linkType =
1413-
"https://" <> strEncode h <> port' <> "/" <> linkType <> "#" <> khStr <> hosts <> B64.encodeUnpadded linkUri
1413+
B.concat ["https://", strEncode h, port', "/", B.singleton linkType, "#", khStr, hosts, B64.encodeUnpadded linkUri]
14141414
where
14151415
port' = if null port then "" else B.pack (':' : port)
14161416
hosts = if null hs then "" else strEncode (TransportHosts_ hs) <> "/"
14171417
khStr = if B.null kh then "" else B64.encodeUnpadded kh <> "@"
1418-
strP = do
1419-
ACSL m l <- strP
1420-
case testEquality m $ sConnectionMode @m of
1421-
Just Refl -> pure l
1422-
_ -> fail "bad short link mode"
1418+
strP = (\(ACSL _ l) -> checkConnMode l) <$?> strP
1419+
{-# INLINE strP #-}
14231420

14241421
instance StrEncoding AConnShortLink where
14251422
strEncode (ACSL _ l) = strEncode l
1423+
{-# INLINE strEncode #-}
14261424
strP = do
14271425
h <- "https://" *> strP
14281426
port <- A.char ':' *> (B.unpack <$> A.takeWhile1 isDigit) <|> pure ""
1429-
linkType <- A.char '/' *> A.anyChar
1427+
contactType <- A.char '/' *> contactTypeP
14301428
keyHash <- optional (A.char '/') *> A.char '#' *> (strP <* A.char '@' <|> pure (C.KeyHash ""))
14311429
TransportHosts_ hs <- strP <* "/" <|> pure (TransportHosts_ [])
14321430
linkUri <- strP
14331431
let srv = SMPServer (h :| hs) port keyHash
1434-
case linkType of
1435-
'i'
1432+
case contactType of
1433+
Nothing
14361434
| B.length linkUri == 56 ->
14371435
let (lnkId, k) = B.splitAt 24 linkUri
14381436
in pure $ ACSL SCMInvitation $ CSLInvitation srv (SMP.EntityId lnkId) (LinkKey k)
14391437
| otherwise -> fail "bad ConnShortLink: incorrect linkID and key length"
1440-
'c' -> contactP srv CCTContact linkUri
1441-
'g' -> contactP srv CCTGroup linkUri
1442-
_ -> fail "bad ConnShortLink: unknown link type"
1438+
Just ct
1439+
| B.length linkUri == 32 -> pure $ ACSL SCMContact $ CSLContact ct srv (LinkKey linkUri)
1440+
| otherwise -> fail "bad ConnShortLink: incorrect key length"
14431441
where
1444-
contactP srv ct k
1445-
| B.length k == 32 = pure $ ACSL SCMContact $ CSLContact srv ct (LinkKey k)
1446-
| otherwise = fail "bad ConnShortLink: incorrect key length"
1442+
contactTypeP = do
1443+
Just <$> (A.anyChar >>= ctTypeP . toUpper)
1444+
<|> A.char 'i' $> Nothing
1445+
<|> fail "unknown link type"
1446+
1447+
instance ConnectionModeI m => Encoding (ConnShortLink m) where
1448+
smpEncode = \case
1449+
CSLInvitation srv lnkId (LinkKey k) -> smpEncode (CMInvitation, srv, lnkId, k)
1450+
CSLContact ct srv (LinkKey k) -> smpEncode (CMContact, ctTypeChar ct, srv, k)
1451+
smpP = (\(ACSL _ l) -> checkConnMode l) <$?> smpP
1452+
{-# INLINE smpP #-}
1453+
1454+
instance Encoding AConnShortLink where
1455+
smpEncode (ACSL _ l) = smpEncode l
1456+
{-# INLINE smpEncode #-}
1457+
smpP =
1458+
smpP >>= \case
1459+
CMInvitation -> do
1460+
(srv, lnkId, k) <- smpP
1461+
pure $ ACSL SCMInvitation $ CSLInvitation srv lnkId (LinkKey k)
1462+
CMContact -> do
1463+
ct <- ctTypeP =<< A.anyChar
1464+
(srv, k) <- smpP
1465+
pure $ ACSL SCMContact $ CSLContact ct srv (LinkKey k)
1466+
1467+
ctTypeP :: Char -> Parser ContactConnType
1468+
ctTypeP = \case
1469+
'A' -> pure CCTContact
1470+
'C' -> pure CCTChannel
1471+
'G' -> pure CCTGroup
1472+
_ -> fail "unknown contact address type"
1473+
{-# INLINE ctTypeP #-}
1474+
1475+
ctTypeChar :: ContactConnType -> Char
1476+
ctTypeChar = \case
1477+
CCTContact -> 'A'
1478+
CCTChannel -> 'C'
1479+
CCTGroup -> 'G'
1480+
{-# INLINE ctTypeChar #-}
14471481

14481482
-- the servers passed to this function should be all preset servers, not servers configured by the user.
14491483
shortenShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
14501484
shortenShortLink presetSrvs = \case
14511485
CSLInvitation srv lnkId linkKey -> CSLInvitation (shortServer srv) lnkId linkKey
1452-
CSLContact srv ct linkKey -> CSLContact (shortServer srv) ct linkKey
1486+
CSLContact ct srv linkKey -> CSLContact ct (shortServer srv) linkKey
14531487
where
14541488
shortServer srv@(SMPServer hs@(h :| _) p kh) =
14551489
if isPresetServer then SMPServer [h] "" (C.KeyHash "") else srv
@@ -1465,7 +1499,7 @@ shortenShortLink presetSrvs = \case
14651499
restoreShortLink :: NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
14661500
restoreShortLink presetSrvs = \case
14671501
CSLInvitation srv lnkId linkKey -> CSLInvitation (fullServer srv) lnkId linkKey
1468-
CSLContact srv ct linkKey -> CSLContact (fullServer srv) ct linkKey
1502+
CSLContact ct srv linkKey -> CSLContact ct (fullServer srv) linkKey
14691503
where
14701504
fullServer = \case
14711505
s@(SMPServer [_] "" (C.KeyHash "")) -> fromMaybe s $ findPresetServer s presetSrvs
@@ -1503,11 +1537,17 @@ data FixedLinkData c = FixedLinkData
15031537
connReq :: Maybe (ConnectionRequestUri c)
15041538
}
15051539

1506-
data UserLinkData = UserLinkData
1507-
{ agentVRange :: VersionRangeSMPA,
1508-
owners :: [OwnerAuth],
1509-
userData :: ConnInfo
1510-
}
1540+
data MutableLinkData c where
1541+
InvitationLinkData :: VersionRangeSMPA -> ConnInfo -> MutableLinkData 'CMInvitation
1542+
ContactLinkData ::
1543+
{ agentVRange :: VersionRangeSMPA,
1544+
direct :: Bool,
1545+
owners :: [OwnerAuth],
1546+
relays :: [ConnShortLink 'CMContact],
1547+
userData :: ConnInfo
1548+
} -> MutableLinkData 'CMContact
1549+
1550+
data AMutableLinkData = forall m. ConnectionModeI m => AMLD (SConnectionMode m) (MutableLinkData m)
15111551

15121552
type OwnerId = ByteString
15131553

@@ -1540,14 +1580,28 @@ instance ConnectionModeI c => Encoding (FixedLinkData c) where
15401580
(agentVRange, rootKey, connReq) <- smpP
15411581
pure FixedLinkData {agentVRange, rootKey, connReq}
15421582

1543-
instance Encoding UserLinkData where
1544-
smpEncode UserLinkData {agentVRange, owners, userData} =
1545-
smpEncode agentVRange <> smpEncodeList owners <> smpEncode (Large userData)
1546-
smpP = do
1547-
agentVRange <- smpP
1548-
owners <- smpListP
1549-
Large userData <- smpP
1550-
pure UserLinkData {agentVRange, owners, userData}
1583+
instance ConnectionModeI c => Encoding (MutableLinkData c) where
1584+
smpEncode = \case
1585+
InvitationLinkData vr userData -> smpEncode (CMInvitation, vr, userData)
1586+
ContactLinkData {agentVRange, direct, owners, relays, userData} ->
1587+
B.concat [smpEncode (CMContact, agentVRange, direct), smpEncodeList owners, smpEncodeList relays, smpEncode userData]
1588+
smpP = (\(AMLD _ d) -> checkConnMode d) <$?> smpP
1589+
{-# INLINE smpP #-}
1590+
1591+
instance Encoding AMutableLinkData where
1592+
smpEncode (AMLD _ d) = smpEncode d
1593+
{-# INLINE smpEncode #-}
1594+
smpP =
1595+
smpP >>= \case
1596+
CMInvitation -> do
1597+
(vr, userData) <- smpP
1598+
pure $ AMLD SCMInvitation $ InvitationLinkData vr userData
1599+
CMContact -> do
1600+
(agentVRange, direct) <- smpP
1601+
owners <- smpListP
1602+
relays <- smpListP
1603+
userData <- smpP
1604+
pure $ AMLD SCMContact ContactLinkData {agentVRange, direct, owners, relays, userData}
15511605

15521606
-- | SMP queue status.
15531607
data QueueStatus

‎src/Simplex/Messaging/Crypto/ShortLink.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -49,12 +49,12 @@ invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
4949
encodeSignLinkData :: ConnectionModeI c => C.KeyPair 'C.Ed25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> ConnInfo -> (LinkKey, (ByteString, ByteString))
5050
encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
5151
let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq = Just connReq}
52-
ud = smpEncode UserLinkData {agentVRange, owners = [], userData}
52+
ud = smpEncode MutableLinkData {agentVRange, owners = [], userData}
5353
in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk ud))
5454

5555
encodeSignUserData :: C.PrivateKeyEd25519 -> VersionRangeSMPA -> ConnInfo -> ByteString
5656
encodeSignUserData pk agentVRange userData =
57-
encodeSign pk $ smpEncode UserLinkData {agentVRange, owners = [], userData}
57+
encodeSign pk $ smpEncode MutableLinkData {agentVRange, owners = [], userData}
5858

5959
encodeSign :: C.PrivateKeyEd25519 -> ByteString -> ByteString
6060
encodeSign pk s = smpEncode (C.sign' pk s) <> s
@@ -78,7 +78,7 @@ decryptLinkData linkKey k (encFD, encUD) = do
7878
(sig1, fd) <- decrypt encFD
7979
(sig2, ud) <- decrypt encUD
8080
FixedLinkData {rootKey, connReq} <- decode fd
81-
UserLinkData {userData} <- decode ud
81+
MutableLinkData {userData} <- decode ud
8282
if
8383
| LinkKey (C.sha3_256 fd) /= linkKey -> linkErr "link data hash"
8484
| not (C.verify' rootKey sig1 fd) -> linkErr "link data signature"

0 commit comments

Comments
 (0)