Merge branch 'master' into v5

src/Simplex/Messaging/Agent.hs

@@ -47,6 +47,7 @@ module Simplex.Messaging.Agent
     joinConnection,
     allowConnection,
     acceptContact,
+    rejectContact,
     subscribeConnection,
     sendMessage,
     ackMessage,
@@ -84,7 +85,7 @@ import Simplex.Messaging.Client (SMPServerTransmission)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (MsgBody, SenderPublicKey)
 import qualified Simplex.Messaging.Protocol as SMP
-import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), runTransportServer)
+import Simplex.Messaging.Transport (ATransport (..), TProxy, Transport (..), currentSMPVersionStr, runTransportServer)
 import Simplex.Messaging.Util (bshow, tryError, unlessM)
 import System.Random (randomR)
 import UnliftIO.Async (async, race_)
@@ -108,7 +109,7 @@ runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort} = runReader
   where
     smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
     smpAgent _ = runTransportServer started tcpPort $ \(h :: c) -> do
-      liftIO $ putLn h "Welcome to SMP v0.4.1 agent"
+      liftIO . putLn h $ "Welcome to SMP agent v" <> currentSMPVersionStr
       c <- getAgentClient
       logConnection c True
       race_ (connectClient h c) (runAgentClient c)
@@ -137,14 +138,18 @@ createConnection c cMode = withAgentEnv c $ newConn c "" cMode
 joinConnection :: AgentErrorMonad m => AgentClient -> ConnectionRequest c -> ConnInfo -> m ConnId
 joinConnection c = withAgentEnv c .: joinConn c ""
 
--- | Approve confirmation (ACPT INV command)
+-- | Allow connection to continue after CONF notification (LET command)
 allowConnection :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
 allowConnection c = withAgentEnv c .:. allowConnection' c
 
--- | Approve contact (ACPT CON command)
+-- | Accept contact after REQ notification (ACPT command)
 acceptContact :: AgentErrorMonad m => AgentClient -> ConfirmationId -> ConnInfo -> m ConnId
 acceptContact c = withAgentEnv c .: acceptContact' c ""
 
+-- | Reject contact (RJCT command)
+rejectContact :: AgentErrorMonad m => AgentClient -> ConnId -> ConfirmationId -> m ()
+rejectContact c = withAgentEnv c .: rejectContact' c
+
 -- | Subscribe to receive connection messages (SUB command)
 subscribeConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
 subscribeConnection c = withAgentEnv c . subscribeConnection' c
@@ -236,6 +241,7 @@ withStore action = do
       SEConnDuplicate -> CONN DUPLICATE
       SEBadConnType CRcv -> CONN SIMPLEX
       SEBadConnType CSnd -> CONN SIMPLEX
+      SEInvitationNotFound -> CMD PROHIBITED
       e -> INTERNAL $ show e
 
 -- | execute any SMP agent command
@@ -245,6 +251,7 @@ processCommand c (connId, cmd) = case cmd of
   JOIN (ACR _ cReq) connInfo -> (,OK) <$> joinConn c connId cReq connInfo
   LET confId ownCInfo -> allowConnection' c connId confId ownCInfo $> (connId, OK)
   ACPT invId ownCInfo -> (,OK) <$> acceptContact' c connId invId ownCInfo
+  RJCT invId -> rejectContact' c connId invId $> (connId, OK)
   SUB -> subscribeConnection' c connId $> (connId, OK)
   SEND msgBody -> (connId,) . MID <$> sendMessage' c connId msgBody
   ACK msgId -> ackMessage' c connId msgId $> (connId, OK)
@@ -291,7 +298,7 @@ activateQueueJoining c connId sq verifyKey retryInterval =
       withStore $ \st -> upgradeSndConnToDuplex st connId rq
       sendControlMessage c sq . REPLY $ CRInvitation $ ConnReqData CRSSimplex [qUri'] encryptKey
 
--- | Approve confirmation (ACPT INV command) in Reader monad
+-- | Approve confirmation (LET command) in Reader monad
 allowConnection' :: AgentMonad m => AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> m ()
 allowConnection' c connId confId ownConnInfo = do
   withStore (`getConn` connId) >>= \case
@@ -300,7 +307,7 @@ allowConnection' c connId confId ownConnInfo = do
       processConfirmation c rq senderKey
     _ -> throwError $ CMD PROHIBITED
 
--- | Accept contact (ACPT CON command) in Reader monad
+-- | Accept contact (ACPT command) in Reader monad
 acceptContact' :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> ConnInfo -> m ConnId
 acceptContact' c connId invId ownConnInfo = do
   Invitation {contactConnId, connReq} <- withStore (`getInvitation` invId)
@@ -310,6 +317,11 @@ acceptContact' c connId invId ownConnInfo = do
       joinConn c connId connReq ownConnInfo
     _ -> throwError $ CMD PROHIBITED
 
+-- | Reject contact (RJCT command) in Reader monad
+rejectContact' :: AgentMonad m => AgentClient -> ConnId -> InvitationId -> m ()
+rejectContact' _ contactConnId invId =
+  withStore $ \st -> deleteInvitation st contactConnId invId
+
 processConfirmation :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
 processConfirmation c rq sndKey = do
   withStore $ \st -> setRcvQueueStatus st rq Confirmed
@@ -469,7 +481,8 @@ deleteConnection' c connId =
   withStore (`getConn` connId) >>= \case
     SomeConn _ (DuplexConnection _ rq _) -> delete rq
     SomeConn _ (RcvConnection _ rq) -> delete rq
-    _ -> withStore (`deleteConn` connId)
+    SomeConn _ (ContactConnection _ rq) -> delete rq
+    SomeConn _ (SndConnection _ _) -> withStore (`deleteConn` connId)
   where
     delete :: RcvQueue -> m ()
     delete rq = do

src/Simplex/Messaging/Agent/Protocol.hs

@@ -186,6 +186,7 @@ data ACommand (p :: AParty) where
   LET :: ConfirmationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
   REQ :: InvitationId -> ConnInfo -> ACommand Agent -- ConnInfo is from sender
   ACPT :: InvitationId -> ConnInfo -> ACommand Client -- ConnInfo is from client
+  RJCT :: InvitationId -> ACommand Client
   INFO :: ConnInfo -> ACommand Agent
   CON :: ACommand Agent -- notification that connection is established
   SUB :: ACommand Client
@@ -645,6 +646,7 @@ commandP =
     <|> "LET " *> letCmd
     <|> "REQ " *> reqMsg
     <|> "ACPT " *> acptCmd
+    <|> "RJCT " *> rjctCmd
     <|> "INFO " *> infoCmd
     <|> "SUB" $> ACmd SClient SUB
     <|> "END" $> ACmd SAgent END
@@ -669,6 +671,7 @@ commandP =
     letCmd = ACmd SClient <$> (LET <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
     reqMsg = ACmd SAgent <$> (REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
     acptCmd = ACmd SClient <$> (ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    rjctCmd = ACmd SClient . RJCT <$> A.takeByteString
     infoCmd = ACmd SAgent . INFO <$> A.takeByteString
     sendCmd = ACmd SClient . SEND <$> A.takeByteString
     msgIdResp = ACmd SAgent . MID <$> A.decimal
@@ -708,6 +711,7 @@ serializeCommand = \case
   LET confId cInfo -> B.unwords ["LET", confId, serializeBinary cInfo]
   REQ invId cInfo -> B.unwords ["REQ", invId, serializeBinary cInfo]
   ACPT invId cInfo -> B.unwords ["ACPT", invId, serializeBinary cInfo]
+  RJCT invId -> "RJCT " <> invId
   INFO cInfo -> "INFO " <> serializeBinary cInfo
   SUB -> "SUB"
   END -> "END"

src/Simplex/Messaging/Agent/Store.hs

@@ -55,6 +55,7 @@ class Monad m => MonadAgentStore s m where
   createInvitation :: s -> TVar ChaChaDRG -> NewInvitation -> m InvitationId
   getInvitation :: s -> InvitationId -> m Invitation
   acceptInvitation :: s -> InvitationId -> ConnInfo -> m ()
+  deleteInvitation :: s -> ConnId -> InvitationId -> m ()
 
   -- Msg management
   updateRcvIds :: s -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)

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

@@ -394,6 +394,15 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
           ":invitation_id" := invitationId
         ]
 
+  deleteInvitation :: SQLiteStore -> ConnId -> InvitationId -> m ()
+  deleteInvitation st contactConnId invId =
+    liftIOEither . withTransaction st $ \db ->
+      runExceptT $
+        ExceptT (getConn_ db contactConnId) >>= \case
+          SomeConn SCContact _ ->
+            liftIO $ DB.execute db "DELETE FROM conn_invitations WHERE contact_conn_id = ? AND invitation_id = ?" (contactConnId, invId)
+          _ -> throwError SEConnNotFound
+
   updateRcvIds :: SQLiteStore -> ConnId -> m (InternalId, InternalRcvId, PrevExternalSndId, PrevRcvMsgHash)
   updateRcvIds st connId =
     liftIO . withTransaction st $ \db -> do

src/Simplex/Messaging/Transport.hs

@@ -46,6 +46,7 @@ module Simplex.Messaging.Transport
     tGetEncrypted,
     serializeTransportError,
     transportErrorP,
+    currentSMPVersionStr,
 
     -- * Trim trailing CR
     trimCR,
@@ -222,7 +223,10 @@ major :: SMPVersion -> (Int, Int)
 major (SMPVersion a b _ _) = (a, b)
 
 currentSMPVersion :: SMPVersion
-currentSMPVersion = "0.4.1.0"
+currentSMPVersion = "0.5.0.0"
+
+currentSMPVersionStr :: ByteString
+currentSMPVersionStr = serializeSMPVersion currentSMPVersion
 
 serializeSMPVersion :: SMPVersion -> ByteString
 serializeSMPVersion (SMPVersion a b c d) = B.intercalate "." [bshow a, bshow b, bshow c, bshow d]
@@ -373,7 +377,7 @@ serverHandshake c srvBlockSize (k, pk) = do
       liftError (const $ TEHandshake DECRYPT) (C.decryptOAEP pk encKeys)
         >>= liftEither . parseClientHandshake
     sendWelcome_6 :: THandle c -> ExceptT TransportError IO ()
-    sendWelcome_6 th = ExceptT . tPutEncrypted th $ serializeSMPVersion currentSMPVersion <> " "
+    sendWelcome_6 th = ExceptT . tPutEncrypted th $ currentSMPVersionStr <> " "
 
 -- | Client SMP encrypted transport handshake.
 --