wip

Author: spaced4ndy

src/Simplex/Messaging/Agent.hs

@@ -347,7 +347,7 @@ createConnectionAsync c userId aCorrId enableNtfs = withAgentEnv c .:. newConnAs
 {-# INLINE createConnectionAsync #-}
 
 -- | Create or update user's contact connection short link (LSET command) asynchronously, no synchronous response
-setConnShortLinkAsync :: AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE ()
+setConnShortLinkAsync :: ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AE ()
 setConnShortLinkAsync c = withAgentEnv c .::. setConnShortLinkAsync' c
 {-# INLINE setConnShortLinkAsync #-}
 
@@ -892,10 +892,15 @@ checkClientNotices AgentClient {clientNotices, presetServers} (ProtoServerWithAu
         when (maybe True (ts <) expires_) $
           throwError NOTICE {server = safeDecodeUtf8 $ strEncode $ L.head host, preset = isNothing srvKey, expiresAt = roundedToUTCTime <$> expires_}
 
-setConnShortLinkAsync' :: AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM ()
+setConnShortLinkAsync' :: forall c. ConnectionModeI c => AgentClient -> ACorrId -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM ()
 setConnShortLinkAsync' c corrId connId cMode userLinkData clientData =
-  -- enqueue command LSET
-  undefined
+  withConnLock c connId "setConnShortLinkAsync" $ do
+    SomeConn _ conn <- withStore c (`getConn` connId)
+    srv <- case (conn, cMode, userLinkData) of
+      (ContactConnection _ RcvQueue {server}, SCMContact, UserContactLinkData {}) -> pure server
+      (RcvConnection _ RcvQueue {server}, SCMInvitation, UserInvLinkData {}) -> pure server
+      _ -> throwE $ CMD PROHIBITED "setConnShortLinkAsync: invalid connection or mode"
+    enqueueCommand c corrId connId (Just srv) $ AClientCommand $ LSET (AUCLD cMode userLinkData) clientData
 
 setConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> AM (ConnShortLink c)
 setConnShortLink' c nm connId cMode userLinkData clientData =
@@ -1668,10 +1673,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
           tryCommand . withNextSrv c userId storageSrvs triedHosts [] $ \srv -> do
             (CCLink cReq _, service) <- newRcvConnSrv c NRMBackground userId connId enableNtfs cMode Nothing Nothing pqEnc subMode srv
             notify $ INV (ACR cMode cReq) service
-        LSET {} ->
-          -- create link (reuse setConnShortLink')
-          -- notify - LINK
-          undefined
+        LSET (AUCLD cMode userLinkData) clientData ->
+          withServer' . tryCommand $ do
+            link <- setConnShortLink' c NRMBackground connId cMode userLinkData clientData
+            notify $ LINK (ACSL cMode link)
         JOIN enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc subMode connInfo -> noServer $ do
           triedHosts <- newTVarIO S.empty
           tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do

src/Simplex/Messaging/Agent/Protocol.hs

@@ -112,6 +112,7 @@ module Simplex.Messaging.Agent.Protocol
     ServiceScheme,
     FixedLinkData (..),
     ConnLinkData (..),
+    AUserConnLinkData (..),
     UserConnLinkData (..),
     UserContactData (..),
     UserLinkData (..),
@@ -436,7 +437,7 @@ deriving instance Show AEvtTag
 
 data ACommand
   = NEW Bool AConnectionMode InitialKeys SubscriptionMode -- response INV
-  | LSET AConnectionMode AUserConnLinkData (Maybe CRClientData) -- response LINK
+  | LSET AUserConnLinkData (Maybe CRClientData) -- response LINK
   | JOIN Bool AConnectionRequestUri PQSupport SubscriptionMode ConnInfo
   | LET ConfirmationId ConnInfo -- ConnInfo is from client
   | ACK AgentMsgId (Maybe MsgReceiptInfo)
@@ -1709,17 +1710,30 @@ data UserContactData = UserContactData
     relays :: [ConnShortLink 'CMContact],
     userData :: UserLinkData
   }
+  deriving (Eq, Show)
 
 newtype UserLinkData = UserLinkData ByteString
+  deriving (Eq, Show)
 
 data AConnLinkData = forall m. ConnectionModeI m => ACLD (SConnectionMode m) (ConnLinkData m)
 
 data UserConnLinkData c where
   UserInvLinkData :: UserLinkData -> UserConnLinkData 'CMInvitation
   UserContactLinkData :: UserContactData -> UserConnLinkData 'CMContact
 
+deriving instance Eq (UserConnLinkData m)
+
+deriving instance Show (UserConnLinkData m)
+
 data AUserConnLinkData = forall m. ConnectionModeI m => AUCLD (SConnectionMode m) (UserConnLinkData m)
 
+instance Eq AUserConnLinkData where
+  AUCLD m d == AUCLD 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
@@ -1746,6 +1760,7 @@ data OwnerAuth = OwnerAuth
     -- Owner validation should detect and reject loops.
     authOwnerSig :: C.Signature 'C.Ed25519
   }
+  deriving (Eq, Show)
 
 instance Encoding OwnerAuth where
   smpEncode OwnerAuth {ownerId, ownerKey, ownerSig, authOwnerId, authOwnerSig} =
@@ -1785,9 +1800,35 @@ instance Encoding AConnLinkData where
         let cd = UserContactData {direct, owners, relays, userData}
         pure $ ACLD SCMContact $ ContactLinkData vr cd
 
+instance ConnectionModeI c => Encoding (UserConnLinkData c) where
+  smpEncode = \case
+    UserInvLinkData userData -> smpEncode (CMInvitation, userData)
+    UserContactLinkData UserContactData {direct, owners, relays, userData} ->
+      B.concat [smpEncode (CMContact, direct), smpEncodeList owners, smpEncodeList relays, smpEncode userData]
+  smpP = (\(AUCLD _ d) -> checkConnMode d) <$?> smpP
+  {-# INLINE smpP #-}
+
 instance Encoding AUserConnLinkData where
-  smpEncode = undefined
-  smpP = undefined
+  smpEncode (AUCLD _ d) = smpEncode d
+  {-# INLINE smpEncode #-}
+  smpP =
+    smpP >>= \case
+      CMInvitation -> do
+        userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
+        pure $ AUCLD SCMInvitation $ UserInvLinkData userData
+      CMContact -> do
+        direct <- smpP
+        owners <- smpListP
+        relays <- smpListP
+        userData <- smpP <* A.takeByteString -- ignoring tail for forward compatibility with the future link data encoding
+        let cd = UserContactData {direct, owners, relays, userData}
+        pure $ AUCLD SCMContact $ UserContactLinkData cd
+
+instance StrEncoding AUserConnLinkData where
+  strEncode = smpEncode
+  {-# INLINE strEncode #-}
+  strP = smpP
+  {-# INLINE strP #-}
 
 instance Encoding UserLinkData where
   smpEncode (UserLinkData s) = if B.length s <= 254 then smpEncode s else smpEncode ('\255', Large s)
@@ -2009,7 +2050,7 @@ commandP binaryP =
   strP
     >>= \case
       NEW_ -> s (NEW <$> strP_ <*> strP_ <*> pqIKP <*> (strP <|> pure SMP.SMSubscribe))
-      LSET_ -> undefined
+      LSET_ -> s (LSET <$> strP <*> optional (A.space *> 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))
@@ -2027,7 +2068,7 @@ commandP binaryP =
 serializeCommand :: ACommand -> ByteString
 serializeCommand = \case
   NEW ntfs cMode pqIK subMode -> s (NEW_, ntfs, cMode, pqIK, subMode)
-  LSET {} -> undefined
+  LSET uld cd_ -> s (LSET_, uld) <> maybe "" (B.cons ' ' . s) cd_
   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_

tests/AgentTests/EqInstances.hs

@@ -5,7 +5,7 @@
 module AgentTests.EqInstances where
 
 import Data.Type.Equality
-import Simplex.Messaging.Agent.Protocol (ConnLinkData (..), OwnerAuth (..), UserContactData (..), UserLinkData (..))
+import Simplex.Messaging.Agent.Protocol (ConnLinkData (..))
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Client (ProxiedRelay (..))
 
@@ -32,18 +32,6 @@ deriving instance Show (ConnLinkData c)
 
 deriving instance Eq (ConnLinkData c)
 
-deriving instance Show UserContactData
-
-deriving instance Eq UserContactData
-
-deriving instance Show UserLinkData
-
-deriving instance Eq UserLinkData
-
-deriving instance Show OwnerAuth
-
-deriving instance Eq OwnerAuth
-
 deriving instance Show ProxiedRelay
 
 deriving instance Eq ProxiedRelay

tests/AgentTests/FunctionalAPITests.hs

@@ -450,7 +450,7 @@ functionalAPITests ps = do
     it "should send multiple messages to the same connection" $ withSmpServer ps testSendMessagesB
     it "should send messages to the 2 connections" $ withSmpServer ps testSendMessagesB2
   describe "Async agent commands" $ do
-    describe "connect using async agent commands" $
+    fdescribe "connect using async agent commands" $
       testBasicMatrix2 ps testAsyncCommands
     it "should restore and complete async commands on restart" $
       testAsyncCommandsRestore ps
@@ -2583,6 +2583,9 @@ testAsyncCommands sqSecured alice bob baseId =
     bobId <- createConnectionAsync alice 1 "1" True SCMInvitation IKPQOn SMSubscribe
     ("1", bobId', INV (ACR _ qInfo)) <- get alice
     liftIO $ bobId' `shouldBe` bobId
+    setConnShortLinkAsync alice "1a" bobId SCMInvitation (UserInvLinkData $ UserLinkData "test") Nothing
+    ("1a", bobId'', LINK (ACSL SCMInvitation _)) <- get alice
+    liftIO $ bobId'' `shouldBe` bobId
     aliceId <- joinConnectionAsync bob 1 "2" True qInfo "bob's connInfo" PQSupportOn SMSubscribe
     ("2", aliceId', JOINED sqSecured') <- get bob
     liftIO $ do