agent: getConnShortLinkAsync; implement joinConnectionAsync for contact connections; narrow setConnShortLinkAsync only to Contact connections

src/Simplex/Messaging/Agent/Protocol.hs

@@ -20,8 +20,8 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 -- |
 -- Module      : Simplex.Messaging.Agent.Protocol
@@ -112,6 +112,7 @@ module Simplex.Messaging.Agent.Protocol
     CRClientData,
     ServiceScheme,
     FixedLinkData (..),
+    AConnLinkData (..),
     ConnLinkData (..),
     AUserConnLinkData (..),
     UserConnLinkData (..),
@@ -255,10 +256,10 @@ import Simplex.Messaging.Protocol
     legacyStrEncodeServer,
     noAuthSrv,
     sameSrvAddr,
+    senderCanSecure,
+    shortLinksSMPClientVersion,
     sndAuthKeySMPClientVersion,
     srvHostnamesSMPClientVersion,
-    shortLinksSMPClientVersion,
-    senderCanSecure,
     pattern ProtoServerWithAuth,
     pattern SMPServer,
   )
@@ -386,7 +387,8 @@ type SndQueueSecured = Bool
 -- | Parameterized type for SMP agent events
 data AEvent (e :: AEntity) where
   INV :: AConnectionRequestUri -> Maybe ClientServiceId -> AEvent AEConn
-  LINK :: AConnShortLink -> AUserConnLinkData -> AEvent AEConn
+  LINK :: ConnShortLink 'CMContact -> UserConnLinkData 'CMContact -> AEvent AEConn
+  LDATA :: FixedLinkData 'CMContact -> ConnLinkData 'CMContact -> AEvent AEConn
   CONF :: ConfirmationId -> PQSupport -> [SMPServer] -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender, [SMPServer] will be empty only in v1 handshake
   REQ :: InvitationId -> PQSupport -> NonEmpty SMPServer -> ConnInfo -> AEvent AEConn -- ConnInfo is from sender
   INFO :: PQSupport -> ConnInfo -> AEvent AEConn
@@ -440,7 +442,8 @@ deriving instance Show AEvtTag
 
 data ACommand
   = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV
-  | LSET AUserConnLinkData (Maybe CRClientData) -- response LINK
+  | LSET (UserConnLinkData 'CMContact) (Maybe CRClientData) -- response LINK
+  | LGET (ConnShortLink 'CMContact) -- response LDATA
   | JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo
   | LET ConfirmationId ConnInfo -- ConnInfo is from client
   | ACK AgentMsgId (Maybe MsgReceiptInfo)
@@ -451,6 +454,7 @@ data ACommand
 data ACommandTag
   = NEW_
   | LSET_
+  | LGET_
   | JOIN_
   | LET_
   | ACK_
@@ -461,6 +465,7 @@ data ACommandTag
 data AEventTag (e :: AEntity) where
   INV_ :: AEventTag AEConn
   LINK_ :: AEventTag AEConn
+  LDATA_ :: AEventTag AEConn
   CONF_ :: AEventTag AEConn
   REQ_ :: AEventTag AEConn
   INFO_ :: AEventTag AEConn
@@ -508,6 +513,7 @@ aCommandTag :: ACommand -> ACommandTag
 aCommandTag = \case
   NEW {} -> NEW_
   LSET {} -> LSET_
+  LGET _ -> LGET_
   JOIN {} -> JOIN_
   LET {} -> LET_
   ACK {} -> ACK_
@@ -518,6 +524,7 @@ aEventTag :: AEvent e -> AEventTag e
 aEventTag = \case
   INV {} -> INV_
   LINK {} -> LINK_
+  LDATA {} -> LDATA_
   CONF {} -> CONF_
   REQ {} -> REQ_
   INFO {} -> INFO_
@@ -1706,14 +1713,19 @@ type CRClientData = Text
 data FixedLinkData c = FixedLinkData
   { agentVRange :: VersionRangeSMPA,
     rootKey :: C.PublicKeyEd25519,
-    connReq :: ConnectionRequestUri c,
+    linkConnReq :: ConnectionRequestUri c,
     linkEntityId :: Maybe ByteString
   }
+  deriving (Eq, Show)
 
 data ConnLinkData c where
   InvitationLinkData :: VersionRangeSMPA -> UserLinkData -> ConnLinkData 'CMInvitation
   ContactLinkData :: VersionRangeSMPA -> UserContactData -> ConnLinkData 'CMContact
 
+deriving instance Eq (ConnLinkData c)
+
+deriving instance Show (ConnLinkData c)
+
 data UserContactData = UserContactData
   { -- direct connection via connReq in fixed data is allowed.
     direct :: Bool,
@@ -1740,13 +1752,6 @@ deriving instance Show (UserConnLinkData m)
 
 data AUserConnLinkData = forall m. ConnectionModeI m => AULD (SConnectionMode m) (UserConnLinkData m)
 
-instance Eq AUserConnLinkData where
-  AULD m d == AULD m' d' = case testEquality m m' of
-    Just Refl -> d == d'
-    Nothing -> False
-
-deriving instance Show AUserConnLinkData
-
 linkUserData :: ConnLinkData c -> UserLinkData
 linkUserData = \case
   InvitationLinkData _ d -> d
@@ -1787,10 +1792,10 @@ validateOwners shortLink_ UserContactData {owners} = case shortLink_ of
     where
       hasOwner = isNothing linkRootSigKey || any ((k ==) . ownerKey) owners
       k = C.publicKey linkPrivSigKey
-          
+
 validateLinkOwners :: C.PublicKeyEd25519 -> [OwnerAuth] -> Either String ()
 validateLinkOwners rootKey = go []
-  where   
+  where
     go _ [] = Right ()
     go prev (o : os) = validOwner o >> go (o : prev) os
       where
@@ -1805,12 +1810,12 @@ validateLinkOwners rootKey = go []
             signedBy k' = C.verify' k' sig (oId <> C.encodePubKey k)
 
 instance ConnectionModeI c => Encoding (FixedLinkData c) where
-  smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId} =
-    smpEncode (agentVRange, rootKey, connReq) <> maybe "" smpEncode linkEntityId
+  smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId} =
+    smpEncode (agentVRange, rootKey, linkConnReq) <> maybe "" smpEncode linkEntityId
   smpP = do
-    (agentVRange, rootKey, connReq) <- smpP
+    (agentVRange, rootKey, linkConnReq) <- smpP
     linkEntityId <- (smpP <|> pure Nothing) <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
-    pure FixedLinkData {agentVRange, rootKey, connReq, linkEntityId}
+    pure FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId}
 
 instance ConnectionModeI c => Encoding (ConnLinkData c) where
   smpEncode = \case
@@ -1849,7 +1854,7 @@ instance Encoding AUserConnLinkData where
       CMContact ->
         AULD SCMContact . UserContactLinkData <$> smpP
 
-instance StrEncoding AUserConnLinkData where
+instance ConnectionModeI c => StrEncoding (UserConnLinkData c) where
   strEncode = smpEncode
   {-# INLINE strEncode #-}
   strP = smpP
@@ -2065,6 +2070,7 @@ instance StrEncoding ACommandTag where
     A.takeTill (== ' ') >>= \case
       "NEW" -> pure NEW_
       "LSET" -> pure LSET_
+      "LGET" -> pure LGET_
       "JOIN" -> pure JOIN_
       "LET" -> pure LET_
       "ACK" -> pure ACK_
@@ -2074,6 +2080,7 @@ instance StrEncoding ACommandTag where
   strEncode = \case
     NEW_ -> "NEW"
     LSET_ -> "LSET"
+    LGET_ -> "LGET"
     JOIN_ -> "JOIN"
     LET_ -> "LET"
     ACK_ -> "ACK"
@@ -2086,6 +2093,7 @@ commandP binaryP =
     >>= \case
       NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe))
       LSET_ -> s (LSET <$> strP <*> optional (A.space *> strP))
+      LGET_ -> s (LGET <$> strP)
       JOIN_ -> s (JOIN <$> strP_ <*> strP_ <*> pqSupP <*> (strP_ <|> pure SMP.SMSubscribe) <*> binaryP)
       LET_ -> s (LET <$> A.takeTill (== ' ') <* A.space <*> binaryP)
       ACK_ -> s (ACK <$> A.decimal <*> optional (A.space *> binaryP))
@@ -2104,6 +2112,7 @@ serializeCommand :: ACommand -> ByteString
 serializeCommand = \case
   NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode)
   LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_
+  LGET sl -> s (LGET_, sl)
   JOIN ntfs cReq pqSup subMode cInfo -> s (JOIN_, ntfs, cReq, pqSup, subMode, Str $ serializeBinary cInfo)
   LET confId cInfo -> B.unwords [s LET_, confId, serializeBinary cInfo]
   ACK mId rcptInfo_ -> s (ACK_, mId) <> maybe "" (B.cons ' ' . serializeBinary) rcptInfo_

src/Simplex/Messaging/Agent/Store/AgentStore.hs

@@ -36,6 +36,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
     checkUser,
 
     -- * Queues and connections
+    createServer,
     createNewConn,
     updateNewConnRcv,
     updateNewConnSnd,
@@ -57,6 +58,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
     setConnUserId,
     setConnAgentVersion,
     setConnPQSupport,
+    updateNewConnJoin,
     getDeletedConnIds,
     getDeletedWaitingDeliveryConnIds,
     setConnRatchetSync,
@@ -432,7 +434,7 @@ createSndConn db gVar cData q@SndQueue {server} =
   -- check confirmed snd queue doesn't already exist, to prevent it being deleted by REPLACE in insertSndQueue_
   ifM (liftIO $ checkConfirmedSndQueueExists_ db q) (pure $ Left SESndQueueExists) $
     createConn_ db gVar cData $ \connId -> do
-      serverKeyHash_ <- createServer_ db server
+      serverKeyHash_ <- createServer db server
       createConnRecord db connId cData SCMInvitation
       insertSndQueue_ db connId q serverKeyHash_
 
@@ -519,7 +521,7 @@ addConnRcvQueue db connId rq subMode =
 
 addConnRcvQueue_ :: DB.Connection -> ConnId -> NewRcvQueue -> SubscriptionMode -> IO RcvQueue
 addConnRcvQueue_ db connId rq@RcvQueue {server} subMode = do
-  serverKeyHash_ <- createServer_ db server
+  serverKeyHash_ <- createServer db server
   insertRcvQueue_ db connId rq subMode serverKeyHash_
 
 addConnSndQueue :: DB.Connection -> ConnId -> NewSndQueue -> IO (Either StoreError SndQueue)
@@ -531,7 +533,7 @@ addConnSndQueue db connId sq =
 
 addConnSndQueue_ :: DB.Connection -> ConnId -> NewSndQueue -> IO SndQueue
 addConnSndQueue_ db connId sq@SndQueue {server} = do
-  serverKeyHash_ <- createServer_ db server
+  serverKeyHash_ <- createServer db server
   insertSndQueue_ db connId sq serverKeyHash_
 
 setRcvQueueStatus :: DB.Connection -> RcvQueue -> QueueStatus -> IO ()
@@ -829,7 +831,7 @@ deleteInvShortLink db srv lnkId =
 
 createInvShortLink :: DB.Connection -> InvShortLink -> IO ()
 createInvShortLink db InvShortLink {server, linkId, linkKey, sndPrivateKey, sndId} = do
-  serverKeyHash_ <- createServer_ db server
+  serverKeyHash_ <- createServer db server
   DB.execute
     db
     [sql|
@@ -2024,8 +2026,8 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
 -- * Server helper
 
 -- | Creates a new server, if it doesn't exist, and returns the passed key hash if it is different from stored.
-createServer_ :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
-createServer_ db newSrv@ProtocolServer {host, port, keyHash} = do
+createServer :: DB.Connection -> SMPServer -> IO (Maybe C.KeyHash)
+createServer db newSrv@ProtocolServer {host, port, keyHash} = do
   r <- insertNewServer_
   if null r
     then getServerKeyHash_ db newSrv >>= either E.throwIO pure
@@ -2406,6 +2408,10 @@ setConnPQSupport :: DB.Connection -> ConnId -> PQSupport -> IO ()
 setConnPQSupport db connId pqSupport =
   DB.execute db "UPDATE connections SET pq_support = ? WHERE conn_id = ?" (pqSupport, connId)
 
+updateNewConnJoin :: DB.Connection -> ConnId -> VersionSMPA -> PQSupport -> Bool -> IO ()
+updateNewConnJoin db connId aVersion pqSupport enableNtfs =
+  DB.execute db "UPDATE connections SET smp_agent_version = ?, pq_support = ?, enable_ntfs = ? WHERE conn_id = ?" (aVersion, pqSupport, BI enableNtfs, connId)
+
 getDeletedConnIds :: DB.Connection -> IO [ConnId]
 getDeletedConnIds db = map fromOnly <$> DB.query db "SELECT conn_id FROM connections WHERE deleted = ?" (Only (BI True))
 

src/Simplex/Messaging/Crypto/ShortLink.hs

@@ -33,7 +33,7 @@ import Simplex.Messaging.Agent.Client (cryptoError)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Protocol (EntityId (..), LinkId, EncDataBytes (..), QueueLinkData)
+import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), LinkId, QueueLinkData)
 import Simplex.Messaging.Util (liftEitherWith)
 
 fixedDataPaddedLength :: Int
@@ -51,8 +51,8 @@ invShortLinkKdf :: LinkKey -> C.SbKey
 invShortLinkKdf (LinkKey k) = C.unsafeSbKey $ C.hkdf "" k "SimpleXInvLink" 32
 
 encodeSignLinkData :: ConnectionModeI c => C.KeyPairEd25519 -> VersionRangeSMPA -> ConnectionRequestUri c -> UserConnLinkData c -> (LinkKey, (ByteString, ByteString))
-encodeSignLinkData (rootKey, pk) agentVRange connReq userData =
-  let fd = smpEncode FixedLinkData {agentVRange, rootKey, connReq, linkEntityId = Nothing}
+encodeSignLinkData (rootKey, pk) agentVRange linkConnReq userData =
+  let fd = smpEncode FixedLinkData {agentVRange, rootKey, linkConnReq, linkEntityId = Nothing}
       md = smpEncode $ connLinkData agentVRange userData
    in (LinkKey (C.sha3_256 fd), (encodeSign pk fd, encodeSign pk md))
 
@@ -82,11 +82,11 @@ encryptData g k len s = do
   ct <- liftEitherWith cryptoError $ C.sbEncrypt k nonce s len
   pure $ EncDataBytes $ smpEncode nonce <> ct
 
-decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (ConnectionRequestUri c, ConnLinkData c)
+decryptLinkData :: forall c. ConnectionModeI c => LinkKey -> C.SbKey -> QueueLinkData -> Either AgentErrorType (FixedLinkData c, ConnLinkData c)
 decryptLinkData linkKey k (encFD, encMD) = do
   (sig1, fd) <- decrypt encFD
   (sig2, md) <- decrypt encMD
-  FixedLinkData {rootKey, connReq} <- decode fd
+  fd'@FixedLinkData {rootKey} <- decode fd
   md' <- decode @(ConnLinkData c) md
   let signedBy k' = C.verify' k' sig2 md
   if
@@ -97,7 +97,7 @@ decryptLinkData linkKey k (encFD, encMD) = do
         ContactLinkData _ UserContactData {owners} -> do
           first (AGENT . A_LINK) $ validateLinkOwners rootKey owners
           unless (signedBy rootKey || any (signedBy . ownerKey) owners) $ linkErr "user data signature"
-  Right (connReq, md')
+  Right (fd', md')
   where
     decrypt (EncDataBytes d) = do
       (nonce, Tail ct) <- decode d

tests/AgentTests/EqInstances.hs

@@ -5,7 +5,7 @@
 module AgentTests.EqInstances where
 
 import Data.Type.Equality
-import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), ShortLinkCreds (..))
+import Simplex.Messaging.Agent.Protocol (ShortLinkCreds (..))
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client (ProxiedRelay (..))
 
@@ -28,10 +28,6 @@ deriving instance Eq ClientNtfCreds
 
 deriving instance Eq ShortLinkCreds
 
-deriving instance Show (ConnLinkData c)
-
-deriving instance Eq (ConnLinkData c)
-
 deriving instance Show ProxiedRelay
 
 deriving instance Eq ProxiedRelay