Compare commits

...
5 Commits
Author SHA1 Message Date
John Roberts dfb0be2c0e migration 2022-03-20 14:50:16 +04:00
John Roberts 2e808192de use server IP addresses 2022-03-20 14:48:09 +04:00
John Roberts 5c6ec96d64 make smp servers configurable for running agent (#326) 2022-03-10 10:49:22 +04:00
Evgeny Poberezkin 7a19ab224b make sending confirmation asynchronous (#327)
* make sending confirmation asynchronous

* confirm first queue synchronously (on JOIN, and delete connection on failure), second queue asynchronously (from REPLY msg)

* test to retry JOIN when the first attempt fails

* process confirmation delivery errors
2022-03-02 15:52:45 +00:00
Efim Poberezkin 7a611bed5a configure systemd service restart and increase file descriptors limit for Linode script (#320) 2022-02-26 18:42:16 +04:00
20 changed files with 339 additions and 207 deletions
+1 -1
View File
@@ -11,7 +11,7 @@ import Simplex.Messaging.Agent.Server (runSMPAgent)
import Simplex.Messaging.Transport (TLS, Transport (..))
cfg :: AgentConfig
cfg = defaultAgentConfig {smpServers = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"]}
cfg = defaultAgentConfig {initialSMPServers = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"]}
logCfg :: LogConfig
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
@@ -16,3 +16,8 @@ brew install hashicorp/tap/packer
cd ./scripts/smp-server-digitalocean-droplet
DIGITALOCEAN_TOKEN=$YOUR_TOKEN packer build -on-error=ask -color=false ./marketplace-image.json
```
**TODO** (see Linode script)
- Increase file descriptors limit
- Configure Restart for systemd service
+10
View File
@@ -44,6 +44,12 @@ ufw allow ssh
ufw allow https
ufw allow 5223
# Increase file descriptors limit
echo 'fs.file-max = 1000000' >> /etc/sysctl.conf
echo 'fs.inode-max = 1000000' >> /etc/sysctl.conf
echo 'root soft nofile unlimited' >> /etc/security/limits.conf
echo 'root hard nofile unlimited' >> /etc/security/limits.conf
# Download latest release
bin_dir="/opt/simplex/bin"
binary="$bin_dir/smp-server"
@@ -151,6 +157,10 @@ Description=SMP server
[Service]
Type=simple
ExecStart=/bin/sh -c "exec $binary start >> /var/opt/simplex/smp-server.log 2>&1"
Restart=always
RestartSec=10
LimitNOFILE=1000000
LimitNOFILESoft=1000000
[Install]
WantedBy=multi-user.target
+2
View File
@@ -40,6 +40,8 @@ library
Simplex.Messaging.Agent.Store.SQLite
Simplex.Messaging.Agent.Store.SQLite.Migrations
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220320_server_ips
Simplex.Messaging.Client
Simplex.Messaging.Crypto
Simplex.Messaging.Crypto.Ratchet
+100 -56
View File
@@ -47,6 +47,7 @@ module Simplex.Messaging.Agent
ackMessage,
suspendConnection,
deleteConnection,
setSMPServers,
logConnection,
)
where
@@ -143,6 +144,10 @@ suspendConnection c = withAgentEnv c . suspendConnection' c
deleteConnection :: AgentErrorMonad m => AgentClient -> ConnId -> m ()
deleteConnection c = withAgentEnv c . deleteConnection' c
-- | Change servers to be used for creating new queues
setSMPServers :: AgentErrorMonad m => AgentClient -> NonEmpty SMPServer -> m ()
setSMPServers c = withAgentEnv c . setSMPServers' c
withAgentEnv :: AgentClient -> ReaderT Env m a -> m a
withAgentEnv c = (`runReaderT` agentEnv c)
@@ -209,7 +214,7 @@ processCommand c (connId, cmd) = case cmd of
newConn :: AgentMonad m => AgentClient -> ConnId -> SConnectionMode c -> m (ConnId, ConnectionRequestUri c)
newConn c connId cMode = do
srv <- getSMPServer
srv <- getSMPServer c
(rq, qUri) <- newRcvQueue c srv
g <- asks idsDrg
let cData = ConnData {connId}
@@ -234,16 +239,20 @@ joinConn c connId (CRInvitationUri (ConnReqUriData _ agentVRange (qUri :| _)) e2
(pk1, pk2, e2eSndParams) <- liftIO . CR.generateE2EParams $ version e2eRcvParams
(_, rcDHRs) <- liftIO C.generateKeyPair'
let rc = CR.initSndRatchet rcDHRr rcDHRs $ CR.x3dhSnd pk1 pk2 e2eRcvParams
(sq, smpConf) <- newSndQueue qInfo cInfo
sq <- newSndQueue qInfo
g <- asks idsDrg
let cData = ConnData {connId}
connId' <- withStore $ \st -> do
connId' <- createSndConn st g cData sq
createRatchet st connId' rc
pure connId'
confirmQueue c connId' sq smpConf $ Just e2eSndParams
void $ enqueueMessage c connId' sq HELLO
pure connId'
tryError (confirmQueue c connId' sq cInfo $ Just e2eSndParams) >>= \case
Right _ -> do
void $ enqueueMessage c connId' sq HELLO
pure connId'
Left e -> do
withStore (`deleteConn` connId')
throwError e
_ -> throwError $ AGENT A_VERSION
joinConn c connId (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInfo =
case ( qUri `compatibleVersion` SMP.smpClientVRange,
@@ -258,7 +267,7 @@ joinConn c connId (CRContactUri (ConnReqUriData _ agentVRange (qUri :| _))) cInf
createReplyQueue :: AgentMonad m => AgentClient -> ConnId -> SndQueue -> m ()
createReplyQueue c connId sq = do
srv <- getSMPServer
srv <- getSMPServer c
(rq, qUri) <- newRcvQueue c srv
-- TODO reply queue version should be the same as send queue, ignoring it in v1
let qInfo = toVersionT qUri SMP.smpClientVersion
@@ -337,12 +346,12 @@ enqueueMessage c connId sq aMessage = do
internalTs <- liftIO getCurrentTime
(internalId, internalSndId, prevMsgHash) <- withStore (`updateSndIds` connId)
let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
agentMessage = smpEncode $ AgentMessage privHeader aMessage
internalHash = C.sha256Hash agentMessage
encAgentMessage <- agentRatchetEncrypt connId agentMessage e2eEncUserMsgLength
agentMsg = AgentMessage privHeader aMessage
agentMsgStr = smpEncode agentMsg
internalHash = C.sha256Hash agentMsgStr
encAgentMessage <- agentRatchetEncrypt connId agentMsgStr e2eEncUserMsgLength
let msgBody = smpEncode $ AgentMsgEnvelope {agentVersion = smpAgentVersion, encAgentMessage}
msgType = aMessageType aMessage
msgType = agentMessageType agentMsg
msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, internalHash, prevMsgHash}
withStore $ \st -> createSndMsg st connId msgData
pure internalId
@@ -392,30 +401,38 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} connId sq = do
notify $ MERR mId (INTERNAL $ show e)
Right (rq_, (msgType, msgBody, internalTs)) ->
withRetryInterval ri $ \loop ->
tryError (sendAgentMessage c sq msgBody) >>= \case
tryError (send msgType c sq msgBody) >>= \case
Left e -> do
let err = if msgType == AM_CONN_INFO then ERR e else MERR mId e
case e of
SMP SMP.QUOTA -> loop
SMP SMP.QUOTA -> case msgType of
AM_CONN_INFO -> connError msgId NOT_AVAILABLE
_ -> loop
SMP SMP.AUTH -> case msgType of
HELLO_ -> do
AM_CONN_INFO -> connError msgId NOT_AVAILABLE
AM_HELLO_ -> do
helloTimeout <- asks $ helloTimeout . config
currentTime <- liftIO getCurrentTime
if diffUTCTime currentTime internalTs > helloTimeout
then case rq_ of
-- party initiating connection
Just _ -> notifyDel msgId . ERR $ CONN NOT_AVAILABLE
Just _ -> connError msgId NOT_AVAILABLE
-- party joining connection
_ -> notifyDel msgId . ERR $ CONN NOT_ACCEPTED
_ -> connError msgId NOT_ACCEPTED
else loop
REPLY_ -> notifyDel msgId $ ERR e
A_MSG_ -> notifyDel msgId $ MERR mId e
SMP (SMP.CMD _) -> notifyDel msgId $ MERR mId e
SMP SMP.LARGE_MSG -> notifyDel msgId $ MERR mId e
SMP {} -> notify (MERR mId e) >> loop
AM_REPLY_ -> notifyDel msgId $ ERR e
AM_A_MSG_ -> notifyDel msgId $ MERR mId e
SMP (SMP.CMD _) -> notifyDel msgId err
SMP SMP.LARGE_MSG -> notifyDel msgId err
SMP {} -> notify err >> loop
_ -> loop
Right () -> do
case msgType of
HELLO_ -> do
AM_CONN_INFO -> do
withStore $ \st -> setSndQueueStatus st sq Confirmed
when (isJust rq_) $ withStore (`removeConfirmations` connId)
void $ enqueueMessage c connId sq HELLO
AM_HELLO_ -> do
withStore $ \st -> setSndQueueStatus st sq Active
case rq_ of
-- party initiating connection
@@ -424,16 +441,20 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} connId sq = do
notify CON
-- party joining connection
_ -> createReplyQueue c connId sq
A_MSG_ -> notify $ SENT mId
AM_A_MSG_ -> notify $ SENT mId
_ -> pure ()
delMsg msgId
where
send = \case
AM_CONN_INFO -> sendConfirmation
_ -> sendAgentMessage
delMsg :: InternalId -> m ()
delMsg msgId = withStore $ \st -> deleteMsg st connId msgId
notify :: ACommand 'Agent -> m ()
notify cmd = atomically $ writeTBQueue subQ ("", connId, cmd)
notifyDel :: InternalId -> ACommand 'Agent -> m ()
notifyDel msgId cmd = notify cmd >> delMsg msgId
connError msgId = notifyDel msgId . ERR . CONN
ackMessage' :: forall m. AgentMonad m => AgentClient -> ConnId -> AgentMsgId -> m ()
ackMessage' c connId msgId = do
@@ -472,9 +493,15 @@ deleteConnection' c connId =
removeSubscription c connId
withStore (`deleteConn` connId)
getSMPServer :: AgentMonad m => m SMPServer
getSMPServer =
asks (smpServers . config) >>= \case
-- | Change servers to be used for creating new queues, in Reader monad
setSMPServers' :: forall m. AgentMonad m => AgentClient -> NonEmpty SMPServer -> m ()
setSMPServers' c servers = do
atomically $ writeTVar (smpServers c) servers
getSMPServer :: AgentMonad m => AgentClient -> m SMPServer
getSMPServer c = do
smpServers <- readTVarIO $ smpServers c
case smpServers of
srv :| [] -> pure srv
servers -> do
gen <- asks randomServer
@@ -519,8 +546,9 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
(SMP.PHEmpty, AgentMsgEnvelope _ encAgentMsg) -> do
agentMsgBody <- agentRatchetDecrypt connId encAgentMsg
parseMessage agentMsgBody >>= \case
AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage -> do
(msgId, msgMeta) <- agentClientMsg prevMsgHash sndMsgId (srvMsgId, systemToUTCTime srvTs) agentMsgBody aMessage
agentMsg@(AgentMessage APrivHeader {sndMsgId, prevMsgHash} aMessage) -> do
let msgType = agentMessageType agentMsg
(msgId, msgMeta) <- agentClientMsg prevMsgHash sndMsgId (srvMsgId, systemToUTCTime srvTs) agentMsgBody msgType
case aMessage of
HELLO -> helloMsg >> ack >> withStore (\st -> deleteMsg st connId msgId)
REPLY cReq -> replyMsg cReq >> ack >> withStore (\st -> deleteMsg st connId msgId)
@@ -610,15 +638,13 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
case qInfo `proveCompatible` SMP.smpClientVRange of
Nothing -> notify . ERR $ AGENT A_VERSION
Just qInfo' -> do
(sq, smpConf) <- newSndQueue qInfo' ownConnInfo
sq <- newSndQueue qInfo'
withStore $ \st -> upgradeRcvConnToDuplex st connId sq
confirmQueue c connId sq smpConf Nothing
withStore (`removeConfirmations` connId)
void $ enqueueMessage c connId sq HELLO
enqueueConfirmation c connId sq ownConnInfo Nothing
_ -> prohibited
agentClientMsg :: PrevRcvMsgHash -> ExternalSndId -> (BrokerId, BrokerTs) -> MsgBody -> AMessage -> m (InternalId, MsgMeta)
agentClientMsg externalPrevSndHash sndMsgId broker msgBody aMessage = do
agentClientMsg :: PrevRcvMsgHash -> ExternalSndId -> (BrokerId, BrokerTs) -> MsgBody -> AgentMessageType -> m (InternalId, MsgMeta)
agentClientMsg externalPrevSndHash sndMsgId broker msgBody msgType = do
logServer "<--" c srv rId "MSG <MSG>"
let internalHash = C.sha256Hash msgBody
internalTs <- liftIO getCurrentTime
@@ -626,7 +652,6 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
let integrity = checkMsgIntegrity prevExtSndId sndMsgId prevRcvMsgHash externalPrevSndHash
recipient = (unId internalId, internalTs)
msgMeta = MsgMeta {integrity, recipient, broker, sndMsgId}
msgType = aMessageType aMessage
rcvMsg = RcvMsgData {msgMeta, msgType, msgBody, internalRcvId, internalHash, externalPrevSndHash}
withStore $ \st -> createRcvMsg st connId rcvMsg
pure (internalId, msgMeta)
@@ -651,8 +676,9 @@ processSMPTransmission c@AgentClient {subQ} (srv, rId, cmd) = do
| internalPrevMsgHash /= receivedPrevMsgHash = MsgError MsgBadHash
| otherwise = MsgError MsgDuplicate -- this case is not possible
confirmQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> SMPConfirmation -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
confirmQueue c connId sq SMPConfirmation {senderKey, e2ePubKey, connInfo} e2eEncryption = do
confirmQueue :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
confirmQueue c connId sq connInfo e2eEncryption = do
_ <- withStore (`updateSndIds` connId)
msg <- mkConfirmation
sendConfirmation c sq msg
withStore $ \st -> setSndQueueStatus st sq Confirmed
@@ -660,9 +686,27 @@ confirmQueue c connId sq SMPConfirmation {senderKey, e2ePubKey, connInfo} e2eEnc
mkConfirmation :: m MsgBody
mkConfirmation = do
encConnInfo <- agentRatchetEncrypt connId (smpEncode $ AgentConnInfo connInfo) e2eEncConnInfoLength
let agentEnvelope = AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo}
agentCbEncrypt sq (Just e2ePubKey) . smpEncode $
SMP.ClientMessage (SMP.PHConfirmation senderKey) $ smpEncode agentEnvelope
pure . smpEncode $ AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo}
enqueueConfirmation :: forall m. AgentMonad m => AgentClient -> ConnId -> SndQueue -> ConnInfo -> Maybe (CR.E2ERatchetParams 'C.X448) -> m ()
enqueueConfirmation c connId sq connInfo e2eEncryption = do
resumeMsgDelivery c connId sq
msgId <- storeConfirmation
queuePendingMsgs c connId sq [msgId]
where
storeConfirmation :: m InternalId
storeConfirmation = do
internalTs <- liftIO getCurrentTime
(internalId, internalSndId, prevMsgHash) <- withStore (`updateSndIds` connId)
let agentMsg = AgentConnInfo connInfo
agentMsgStr = smpEncode agentMsg
internalHash = C.sha256Hash agentMsgStr
encConnInfo <- agentRatchetEncrypt connId agentMsgStr e2eEncConnInfoLength
let msgBody = smpEncode $ AgentConfirmation {agentVersion = smpAgentVersion, e2eEncryption, encConnInfo}
msgType = agentMessageType agentMsg
msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, internalHash, prevMsgHash}
withStore $ \st -> createSndMsg st connId msgData
pure internalId
-- encoded AgentMessage -> encoded EncAgentMessage
agentRatchetEncrypt :: AgentMonad m => ConnId -> ByteString -> Int -> m ByteString
@@ -684,27 +728,27 @@ agentRatchetDecrypt connId encAgentMsg = do
notifyConnected :: AgentMonad m => AgentClient -> ConnId -> m ()
notifyConnected c connId = atomically $ writeTBQueue (subQ c) ("", connId, CON)
newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => Compatible SMPQueueInfo -> ConnInfo -> m (SndQueue, SMPConfirmation)
newSndQueue qInfo cInfo =
newSndQueue :: (MonadUnliftIO m, MonadReader Env m) => Compatible SMPQueueInfo -> m SndQueue
newSndQueue qInfo =
asks (cmdSignAlg . config) >>= \case
C.SignAlg a -> newSndQueue_ a qInfo cInfo
C.SignAlg a -> newSndQueue_ a qInfo
newSndQueue_ ::
(C.SignatureAlgorithm a, C.AlgorithmI a, MonadUnliftIO m) =>
C.SAlgorithm a ->
Compatible SMPQueueInfo ->
ConnInfo ->
m (SndQueue, SMPConfirmation)
newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2ePubDhKey)) cInfo = do
m SndQueue
newSndQueue_ a (Compatible (SMPQueueInfo _clientVersion smpServer senderId rcvE2ePubDhKey)) = do
-- this function assumes clientVersion is compatible - it was tested before
(senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
(sndPublicKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
(e2ePubKey, e2ePrivKey) <- liftIO C.generateKeyPair'
let sndQueue =
SndQueue
{ server = smpServer,
sndId = senderId,
sndPrivateKey,
e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
status = New
}
pure (sndQueue, SMPConfirmation senderKey e2ePubKey cInfo)
pure
SndQueue
{ server = smpServer,
sndId = senderId,
sndPublicKey = Just sndPublicKey,
sndPrivateKey,
e2eDhSecret = C.dh' rcvE2ePubDhKey e2ePrivKey,
e2ePubKey = Just e2ePubKey,
status = New
}
+10 -5
View File
@@ -47,6 +47,7 @@ import Data.Bifunctor (first)
import Data.ByteString.Base64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (isNothing)
@@ -76,6 +77,7 @@ data AgentClient = AgentClient
{ rcvQ :: TBQueue (ATransmission 'Client),
subQ :: TBQueue (ATransmission 'Agent),
msgQ :: TBQueue SMPServerTransmission,
smpServers :: TVar (NonEmpty SMPServer),
smpClients :: TVar (Map SMPServer SMPClientVar),
subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
pendingSubscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
@@ -97,6 +99,7 @@ newAgentClient agentEnv = do
rcvQ <- newTBQueue qSize
subQ <- newTBQueue qSize
msgQ <- newTBQueue qSize
smpServers <- newTVar $ initialSMPServers (config agentEnv)
smpClients <- newTVar M.empty
subscrSrvrs <- newTVar M.empty
pendingSubscrSrvrs <- newTVar M.empty
@@ -108,7 +111,7 @@ newAgentClient agentEnv = do
asyncClients <- newTVar []
clientId <- stateTVar (clientCounter agentEnv) $ \i -> (i + 1, i + 1)
lock <- newTMVar ()
return AgentClient {rcvQ, subQ, msgQ, smpClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, asyncClients, clientId, agentEnv, smpSubscriber = undefined, lock}
return AgentClient {rcvQ, subQ, msgQ, smpServers, smpClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, reconnections, asyncClients, clientId, agentEnv, smpSubscriber = undefined, lock}
-- | Agent monad with MonadReader Env and MonadError AgentErrorType
type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m)
@@ -381,11 +384,13 @@ showServer SMPServer {host, port} =
logSecret :: ByteString -> ByteString
logSecret bs = encode $ B.take 3 bs
-- TODO maybe package E2ERatchetParams into SMPConfirmation
sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
sendConfirmation c SndQueue {server, sndId} encConfirmation =
withLogSMP_ c server sndId "SEND <CONF>" $ \smp ->
liftSMP $ sendSMPMessage smp Nothing sndId encConfirmation
sendConfirmation c sq@SndQueue {server, sndId, sndPublicKey = Just sndPublicKey, e2ePubKey = e2ePubKey@Just {}} agentConfirmation =
withLogSMP_ c server sndId "SEND <CONF>" $ \smp -> do
let clientMsg = SMP.ClientMessage (SMP.PHConfirmation sndPublicKey) agentConfirmation
msg <- agentCbEncrypt sq e2ePubKey $ smpEncode clientMsg
liftSMP $ sendSMPMessage smp Nothing sndId msg
sendConfirmation _ _ _ = throwError $ INTERNAL "sendConfirmation called without snd_queue public key(s) in the database"
sendInvitation :: forall m. AgentMonad m => AgentClient -> Compatible SMPQueueInfo -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> m ()
sendInvitation c (Compatible SMPQueueInfo {smpServer, senderId, dhPublicKey}) connReq connInfo =
+2 -2
View File
@@ -29,7 +29,7 @@ import UnliftIO.STM
data AgentConfig = AgentConfig
{ tcpPort :: ServiceName,
smpServers :: NonEmpty SMPServer,
initialSMPServers :: NonEmpty SMPServer,
cmdSignAlg :: C.SignAlg,
connIdBytes :: Int,
tbqSize :: Natural,
@@ -48,7 +48,7 @@ defaultAgentConfig :: AgentConfig
defaultAgentConfig =
AgentConfig
{ tcpPort = "5224",
smpServers = undefined, -- TODO move it elsewhere?
initialSMPServers = undefined, -- TODO move it elsewhere?
cmdSignAlg = C.SignAlg C.SEd448,
connIdBytes = 12,
tbqSize = 64,
+28 -9
View File
@@ -46,9 +46,9 @@ module Simplex.Messaging.Agent.Protocol
SMPConfirmation (..),
AgentMsgEnvelope (..),
AgentMessage (..),
AgentMessageType (..),
APrivHeader (..),
AMessage (..),
AMsgType (..),
SMPServer (..),
SrvLoc (..),
SMPQueueUri (..),
@@ -89,7 +89,7 @@ module Simplex.Messaging.Agent.Protocol
connModeT,
serializeQueueStatus,
queueStatusT,
aMessageType,
agentMessageType,
-- * TCP transport functions
tPut,
@@ -343,6 +343,31 @@ instance Encoding AgentMessage where
'M' -> AgentMessage <$> smpP <*> smpP
_ -> fail "bad AgentMessage"
data AgentMessageType = AM_CONN_INFO | AM_HELLO_ | AM_REPLY_ | AM_A_MSG_
deriving (Eq, Show)
instance Encoding AgentMessageType where
smpEncode = \case
AM_CONN_INFO -> "C"
AM_HELLO_ -> "H"
AM_REPLY_ -> "R"
AM_A_MSG_ -> "M"
smpP =
A.anyChar >>= \case
'C' -> pure AM_CONN_INFO
'H' -> pure AM_HELLO_
'R' -> pure AM_REPLY_
'M' -> pure AM_A_MSG_
_ -> fail "bad AgentMessageType"
agentMessageType :: AgentMessage -> AgentMessageType
agentMessageType = \case
AgentConnInfo _ -> AM_CONN_INFO
AgentMessage _ aMsg -> case aMsg of
HELLO -> AM_HELLO_
REPLY _ -> AM_REPLY_
A_MSG _ -> AM_A_MSG_
data APrivHeader = APrivHeader
{ -- | sequential ID assigned by the sending agent
sndMsgId :: AgentMsgId,
@@ -371,12 +396,6 @@ instance Encoding AMsgType where
'M' -> pure A_MSG_
_ -> fail "bad AMsgType"
aMessageType :: AMessage -> AMsgType
aMessageType = \case
HELLO -> HELLO_
REPLY _ -> REPLY_
A_MSG _ -> A_MSG_
-- | Messages sent between SMP agents once SMP queue is secured.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/protocol/agent-protocol.md#messages-between-smp-agents
@@ -705,7 +724,7 @@ data ConnectionErrorType
SIMPLEX
| -- | connection not accepted on join HELLO after timeout
NOT_ACCEPTED
| -- | connection not available on reply HELLO after timeout
| -- | connection not available on reply confirmation/HELLO after timeout
NOT_AVAILABLE
deriving (Eq, Generic, Read, Show, Exception)
+7 -4
View File
@@ -62,7 +62,7 @@ class Monad m => MonadAgentStore s m where
createRcvMsg :: s -> ConnId -> RcvMsgData -> m ()
updateSndIds :: s -> ConnId -> m (InternalId, InternalSndId, PrevSndMsgHash)
createSndMsg :: s -> ConnId -> SndMsgData -> m ()
getPendingMsgData :: s -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody, InternalTs))
getPendingMsgData :: s -> ConnId -> InternalId -> m (Maybe RcvQueue, (AgentMessageType, MsgBody, InternalTs))
getPendingMsgs :: s -> ConnId -> m [InternalId]
checkRcvMsg :: s -> ConnId -> InternalId -> m ()
deleteMsg :: s -> ConnId -> InternalId -> m ()
@@ -102,8 +102,11 @@ data SndQueue = SndQueue
{ server :: SMPServer,
-- | sender queue ID
sndId :: SMP.SenderId,
-- | key used by the sender to sign transmissions
-- | key pair used by the sender to sign transmissions
sndPublicKey :: Maybe C.APublicVerifyKey,
sndPrivateKey :: SndPrivateSignKey,
-- | DH public key used to negotiate per-queue e2e encryption
e2ePubKey :: Maybe C.PublicKeyX25519,
-- | shared DH secret agreed for simple per-queue e2e encryption
e2eDhSecret :: C.DhSecretX25519,
-- | queue status
@@ -221,7 +224,7 @@ type PrevSndMsgHash = MsgHash
data RcvMsgData = RcvMsgData
{ msgMeta :: MsgMeta,
msgType :: AMsgType,
msgType :: AgentMessageType,
msgBody :: MsgBody,
internalRcvId :: InternalRcvId,
internalHash :: MsgHash,
@@ -232,7 +235,7 @@ data SndMsgData = SndMsgData
{ internalId :: InternalId,
internalSndId :: InternalSndId,
internalTs :: InternalTs,
msgType :: AMsgType,
msgType :: AgentMessageType,
msgBody :: MsgBody,
internalHash :: MsgHash,
prevMsgHash :: MsgHash
+12 -33
View File
@@ -441,7 +441,7 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto
insertSndMsgDetails_ db connId sndMsgData
updateHashSnd_ db connId sndMsgData
getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (Maybe RcvQueue, (AMsgType, MsgBody, InternalTs))
getPendingMsgData :: SQLiteStore -> ConnId -> InternalId -> m (Maybe RcvQueue, (AgentMessageType, MsgBody, InternalTs))
getPendingMsgData st connId msgId =
liftIOEither . withTransaction st $ \db -> runExceptT $ do
rq_ <- liftIO $ getRcvQueueByConnId_ db connId
@@ -566,9 +566,9 @@ instance ToField InternalId where toField (InternalId x) = toField x
instance FromField InternalId where fromField x = InternalId <$> fromField x
instance ToField AMsgType where toField = toField . smpEncode
instance ToField AgentMessageType where toField = toField . smpEncode
instance FromField AMsgType where fromField = blobFieldParser smpP
instance FromField AgentMessageType where fromField = blobFieldParser smpP
instance ToField MsgIntegrity where toField = toField . strEncode
@@ -656,46 +656,25 @@ upsertServer_ dbConn SMPServer {host, port, keyHash} = do
insertRcvQueue_ :: DB.Connection -> ConnId -> RcvQueue -> IO ()
insertRcvQueue_ dbConn connId RcvQueue {..} = do
DB.executeNamed
DB.execute
dbConn
[sql|
INSERT INTO rcv_queues
( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status)
VALUES
(:host,:port,:rcv_id,:conn_id,:rcv_private_key,:rcv_dh_secret,:e2e_priv_key,:e2e_dh_secret,:snd_id,:status);
( host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, e2e_dh_secret, snd_id, status) VALUES (?,?,?,?,?,?,?,?,?,?);
|]
[ ":host" := host server,
":port" := port server,
":rcv_id" := rcvId,
":conn_id" := connId,
":rcv_private_key" := rcvPrivateKey,
":rcv_dh_secret" := rcvDhSecret,
":e2e_priv_key" := e2ePrivKey,
":e2e_dh_secret" := e2eDhSecret,
":snd_id" := sndId,
":status" := status
]
(host server, port server, rcvId, connId, rcvPrivateKey, rcvDhSecret, e2ePrivKey, e2eDhSecret, sndId, status)
-- * createSndConn helpers
insertSndQueue_ :: DB.Connection -> ConnId -> SndQueue -> IO ()
insertSndQueue_ dbConn connId SndQueue {..} = do
DB.executeNamed
DB.execute
dbConn
[sql|
INSERT INTO snd_queues
( host, port, snd_id, conn_id, snd_private_key, e2e_dh_secret, status)
VALUES
(:host,:port,:snd_id,:conn_id,:snd_private_key,:e2e_dh_secret,:status);
(host, port, snd_id, conn_id, snd_public_key, snd_private_key, e2e_pub_key, e2e_dh_secret, status) VALUES (?,?,?,?,?, ?,?, ?,?);
|]
[ ":host" := host server,
":port" := port server,
":snd_id" := sndId,
":conn_id" := connId,
":snd_private_key" := sndPrivateKey,
":e2e_dh_secret" := e2eDhSecret,
":status" := status
]
(host server, port server, sndId, connId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)
-- * getConn helpers
@@ -746,16 +725,16 @@ getSndQueueByConnId_ dbConn connId =
<$> DB.query
dbConn
[sql|
SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_private_key, q.e2e_dh_secret, q.status
SELECT s.key_hash, q.host, q.port, q.snd_id, q.snd_public_key, q.snd_private_key, q.e2e_pub_key, q.e2e_dh_secret, q.status
FROM snd_queues q
INNER JOIN servers s ON q.host = s.host AND q.port = s.port
WHERE q.conn_id = ?;
|]
(Only connId)
where
sndQueue [(keyHash, host, port, sndId, sndPrivateKey, e2eDhSecret, status)] =
sndQueue [(keyHash, host, port, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status)] =
let server = SMPServer host port keyHash
in Just SndQueue {server, sndId, sndPrivateKey, e2eDhSecret, status}
in Just SndQueue {server, sndId, sndPublicKey, sndPrivateKey, e2ePubKey, e2eDhSecret, status}
sndQueue _ = Nothing
-- * updateRcvIds helpers
@@ -25,13 +25,17 @@ import qualified Database.SQLite.Simple as DB
import Database.SQLite.Simple.QQ (sql)
import qualified Database.SQLite3 as SQLite3
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys
import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220320_server_ips
data Migration = Migration {name :: String, up :: Text}
deriving (Show)
schemaMigrations :: [(String, Query)]
schemaMigrations =
[ ("20220101_initial", m20220101_initial)
[ ("20220101_initial", m20220101_initial),
("20220301_snd_queue_keys", m20220301_snd_queue_keys),
("20220320_server_ips", m20220320_server_ips)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,13 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20220301_snd_queue_keys :: Query
m20220301_snd_queue_keys =
[sql|
ALTER TABLE snd_queues ADD COLUMN snd_public_key BLOB;
ALTER TABLE snd_queues ADD COLUMN e2e_pub_key BLOB;
|]
@@ -0,0 +1,14 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220320_server_ips where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20220320_server_ips :: Query
m20220320_server_ips =
[sql|
UPDATE servers SET host = '178.79.168.175' WHERE host = 'smp8.simplex.im';
UPDATE servers SET host = '178.79.169.107' WHERE host = 'smp9.simplex.im';
UPDATE servers SET host = '45.33.54.229' WHERE host = 'smp10.simplex.im';
|]
+4
View File
@@ -399,6 +399,10 @@ instance StrEncoding SMPServer where
SrvLoc host port <- strP
pure SMPServer {host, port, keyHash}
instance ToJSON SMPServer where
toJSON = strToJSON
toEncoding = strToJEncoding
data SrvLoc = SrvLoc HostName ServiceName
deriving (Eq, Ord, Show)
+1 -1
View File
@@ -75,7 +75,7 @@ validateCertificateChain (C.KeyHash kh) host port cc@(X.CertificateChain sc@[_,
x509validate = XV.validate X.HashSHA256 hooks checks certStore cache serviceID cc
where
hooks = XV.defaultHooks
checks = XV.defaultChecks
checks = XV.defaultChecks {XV.checkFQHN = False}
certStore = XS.makeCertificateStore sc
cache = XV.exceptionValidationCache [] -- we manually check fingerprint only of the identity certificate (ca.crt)
serviceID = (host, port)
+70 -70
View File
@@ -128,25 +128,25 @@ testDuplexConnection _ alice bob = do
bob <# ("", "alice", CON)
alice <# ("", "bob", CON)
-- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 4)
alice <# ("", "bob", SENT 4)
bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
bob #: ("12", "alice", "ACK 4") #> ("12", "alice", OK)
alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 5)
alice #: ("3", "bob", "SEND :hello") #> ("3", "bob", MID 5)
alice <# ("", "bob", SENT 5)
bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK)
alice #: ("4", "bob", "SEND :how are you?") #> ("4", "bob", MID 6)
alice <# ("", "bob", SENT 6)
bob <#= \case ("", "alice", Msg "how are you?") -> True; _ -> False
bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK)
bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 6)
bob <# ("", "alice", SENT 6)
alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
alice #: ("3a", "bob", "ACK 6") #> ("3a", "bob", OK)
bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 7)
bob #: ("13", "alice", "ACK 6") #> ("13", "alice", OK)
bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 7)
bob <# ("", "alice", SENT 7)
alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
alice #: ("3a", "bob", "ACK 7") #> ("3a", "bob", OK)
bob #: ("15", "alice", "SEND 9\nmessage 1") #> ("15", "alice", MID 8)
bob <# ("", "alice", SENT 8)
alice <#= \case ("", "bob", Msg "message 1") -> True; _ -> False
alice #: ("4a", "bob", "ACK 7") #> ("4a", "bob", OK)
alice #: ("4a", "bob", "ACK 8") #> ("4a", "bob", OK)
alice #: ("5", "bob", "OFF") #> ("5", "bob", OK)
bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 8)
bob <# ("", "alice", MERR 8 (SMP AUTH))
bob #: ("17", "alice", "SEND 9\nmessage 3") #> ("17", "alice", MID 9)
bob <# ("", "alice", MERR 9 (SMP AUTH))
alice #: ("6", "bob", "DEL") #> ("6", "bob", OK)
alice #:# "nothing else should be delivered to alice"
@@ -161,25 +161,25 @@ testDuplexConnRandomIds _ alice bob = do
bob <# ("", aliceConn, INFO "alice's connInfo")
bob <# ("", aliceConn, CON)
alice <# ("", bobConn, CON)
alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 4)
alice <# ("", bobConn, SENT 4)
bob <#= \case ("", c, Msg "hello") -> c == aliceConn; _ -> False
bob #: ("12", aliceConn, "ACK 4") #> ("12", aliceConn, OK)
alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 5)
alice #: ("2", bobConn, "SEND :hello") #> ("2", bobConn, MID 5)
alice <# ("", bobConn, SENT 5)
bob <#= \case ("", c, Msg "hello") -> c == aliceConn; _ -> False
bob #: ("12", aliceConn, "ACK 5") #> ("12", aliceConn, OK)
alice #: ("3", bobConn, "SEND :how are you?") #> ("3", bobConn, MID 6)
alice <# ("", bobConn, SENT 6)
bob <#= \case ("", c, Msg "how are you?") -> c == aliceConn; _ -> False
bob #: ("13", aliceConn, "ACK 5") #> ("13", aliceConn, OK)
bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 6)
bob <# ("", aliceConn, SENT 6)
alice <#= \case ("", c, Msg "hello too") -> c == bobConn; _ -> False
alice #: ("3a", bobConn, "ACK 6") #> ("3a", bobConn, OK)
bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 7)
bob #: ("13", aliceConn, "ACK 6") #> ("13", aliceConn, OK)
bob #: ("14", aliceConn, "SEND 9\nhello too") #> ("14", aliceConn, MID 7)
bob <# ("", aliceConn, SENT 7)
alice <#= \case ("", c, Msg "hello too") -> c == bobConn; _ -> False
alice #: ("3a", bobConn, "ACK 7") #> ("3a", bobConn, OK)
bob #: ("15", aliceConn, "SEND 9\nmessage 1") #> ("15", aliceConn, MID 8)
bob <# ("", aliceConn, SENT 8)
alice <#= \case ("", c, Msg "message 1") -> c == bobConn; _ -> False
alice #: ("4a", bobConn, "ACK 7") #> ("4a", bobConn, OK)
alice #: ("4a", bobConn, "ACK 8") #> ("4a", bobConn, OK)
alice #: ("5", bobConn, "OFF") #> ("5", bobConn, OK)
bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 8)
bob <# ("", aliceConn, MERR 8 (SMP AUTH))
bob #: ("17", aliceConn, "SEND 9\nmessage 3") #> ("17", aliceConn, MID 9)
bob <# ("", aliceConn, MERR 9 (SMP AUTH))
alice #: ("6", bobConn, "DEL") #> ("6", bobConn, OK)
alice #:# "nothing else should be delivered to alice"
@@ -196,10 +196,10 @@ testContactConnection _ alice bob tom = do
alice <# ("", "bob", INFO "bob's connInfo 2")
alice <# ("", "bob", CON)
bob <# ("", "alice", CON)
alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 4)
alice <# ("", "bob", SENT 4)
alice #: ("3", "bob", "SEND :hi") #> ("3", "bob", MID 5)
alice <# ("", "bob", SENT 5)
bob <#= \case ("", "alice", Msg "hi") -> True; _ -> False
bob #: ("13", "alice", "ACK 4") #> ("13", "alice", OK)
bob #: ("13", "alice", "ACK 5") #> ("13", "alice", OK)
tom #: ("21", "alice", "JOIN " <> cReq' <> " 14\ntom's connInfo") #> ("21", "alice", OK)
("", "alice_contact", Right (REQ aInvId' "tom's connInfo")) <- (alice <#:)
@@ -209,10 +209,10 @@ testContactConnection _ alice bob tom = do
alice <# ("", "tom", INFO "tom's connInfo 2")
alice <# ("", "tom", CON)
tom <# ("", "alice", CON)
alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 4)
alice <# ("", "tom", SENT 4)
alice #: ("5", "tom", "SEND :hi there") #> ("5", "tom", MID 5)
alice <# ("", "tom", SENT 5)
tom <#= \case ("", "alice", Msg "hi there") -> True; _ -> False
tom #: ("23", "alice", "ACK 4") #> ("23", "alice", OK)
tom #: ("23", "alice", "ACK 5") #> ("23", "alice", OK)
testContactConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
testContactConnRandomIds _ alice bob = do
@@ -232,10 +232,10 @@ testContactConnRandomIds _ alice bob = do
alice <# ("", bobConn, CON)
bob <# ("", aliceConn, CON)
alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 4)
alice <# ("", bobConn, SENT 4)
alice #: ("3", bobConn, "SEND :hi") #> ("3", bobConn, MID 5)
alice <# ("", bobConn, SENT 5)
bob <#= \case ("", c, Msg "hi") -> c == aliceConn; _ -> False
bob #: ("13", aliceConn, "ACK 4") #> ("13", aliceConn, OK)
bob #: ("13", aliceConn, "ACK 5") #> ("13", aliceConn, OK)
testRejectContactRequest :: Transport c => TProxy c -> c -> c -> IO ()
testRejectContactRequest _ alice bob = do
@@ -252,20 +252,20 @@ testRejectContactRequest _ alice bob = do
testSubscription :: Transport c => TProxy c -> c -> c -> c -> IO ()
testSubscription _ alice1 alice2 bob = do
(alice1, "alice") `connect` (bob, "bob")
bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 4)
bob <# ("", "alice", SENT 4)
alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
alice1 #: ("1", "bob", "ACK 4") #> ("1", "bob", OK)
bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 5)
bob #: ("12", "alice", "SEND 5\nhello") #> ("12", "alice", MID 5)
bob <# ("", "alice", SENT 5)
alice1 <#= \case ("", "bob", Msg "hello") -> True; _ -> False
alice1 #: ("1", "bob", "ACK 5") #> ("1", "bob", OK)
bob #: ("13", "alice", "SEND 11\nhello again") #> ("13", "alice", MID 6)
bob <# ("", "alice", SENT 6)
alice1 <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
alice1 #: ("2", "bob", "ACK 5") #> ("2", "bob", OK)
alice1 #: ("2", "bob", "ACK 6") #> ("2", "bob", OK)
alice2 #: ("21", "bob", "SUB") #> ("21", "bob", OK)
alice1 <# ("", "bob", END)
bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 6)
bob <# ("", "alice", SENT 6)
bob #: ("14", "alice", "SEND 2\nhi") #> ("14", "alice", MID 7)
bob <# ("", "alice", SENT 7)
alice2 <#= \case ("", "bob", Msg "hi") -> True; _ -> False
alice2 #: ("22", "bob", "ACK 6") #> ("22", "bob", OK)
alice2 #: ("22", "bob", "ACK 7") #> ("22", "bob", OK)
alice1 #:# "nothing else should be delivered to alice1"
testSubscrNotification :: Transport c => TProxy c -> (ThreadId, ThreadId) -> c -> IO ()
@@ -281,22 +281,22 @@ testMsgDeliveryServerRestart :: Transport c => TProxy c -> c -> c -> IO ()
testMsgDeliveryServerRestart t alice bob = do
withServer $ do
connect (alice, "alice") (bob, "bob")
bob #: ("1", "alice", "SEND 2\nhi") #> ("1", "alice", MID 4)
bob <# ("", "alice", SENT 4)
bob #: ("1", "alice", "SEND 2\nhi") #> ("1", "alice", MID 5)
bob <# ("", "alice", SENT 5)
alice <#= \case ("", "bob", Msg "hi") -> True; _ -> False
alice #: ("11", "bob", "ACK 4") #> ("11", "bob", OK)
alice #: ("11", "bob", "ACK 5") #> ("11", "bob", OK)
alice #:# "nothing else delivered before the server is killed"
alice <# ("", "bob", DOWN)
bob #: ("2", "alice", "SEND 11\nhello again") #> ("2", "alice", MID 5)
bob #: ("2", "alice", "SEND 11\nhello again") #> ("2", "alice", MID 6)
bob #:# "nothing else delivered before the server is restarted"
alice #:# "nothing else delivered before the server is restarted"
withServer $ do
bob <# ("", "alice", SENT 5)
bob <# ("", "alice", SENT 6)
alice <# ("", "bob", UP)
alice <#= \case ("", "bob", Msg "hello again") -> True; _ -> False
alice #: ("12", "bob", "ACK 5") #> ("12", "bob", OK)
alice #: ("12", "bob", "ACK 6") #> ("12", "bob", OK)
removeFile testStoreLogFile
where
@@ -311,7 +311,7 @@ testServerConnectionAfterError t _ = do
bob <# ("", "alice", DOWN)
alice <# ("", "bob", DOWN)
alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 4)
alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 5)
alice #:# "nothing else delivered before the server is restarted"
bob #:# "nothing else delivered before the server is restarted"
@@ -320,13 +320,13 @@ testServerConnectionAfterError t _ = do
bob #: ("1", "alice", "SUB") #> ("1", "alice", ERR (BROKER NETWORK))
alice #: ("1", "bob", "SUB") #> ("1", "bob", ERR (BROKER NETWORK))
withServer $ do
alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 4; _ -> False
alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 4; _ -> False
alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 5; _ -> False
alice <#= \case ("", "bob", cmd) -> cmd == UP || cmd == SENT 5; _ -> False
bob <# ("", "alice", UP)
bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
bob #: ("2", "alice", "ACK 4") #> ("2", "alice", OK)
alice #: ("1", "bob", "SEND 11\nhello again") #> ("1", "bob", MID 5)
alice <# ("", "bob", SENT 5)
bob #: ("2", "alice", "ACK 5") #> ("2", "alice", OK)
alice #: ("1", "bob", "SEND 11\nhello again") #> ("1", "bob", MID 6)
alice <# ("", "bob", SENT 6)
bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False
removeFile testStoreLogFile
@@ -344,14 +344,14 @@ testMsgDeliveryAgentRestart t bob = do
withAgent $ \alice -> do
withServer $ do
connect (bob, "bob") (alice, "alice")
alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 4)
alice <# ("", "bob", SENT 4)
alice #: ("1", "bob", "SEND 5\nhello") #> ("1", "bob", MID 5)
alice <# ("", "bob", SENT 5)
bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
bob #: ("11", "alice", "ACK 4") #> ("11", "alice", OK)
bob #: ("11", "alice", "ACK 5") #> ("11", "alice", OK)
bob #:# "nothing else delivered before the server is down"
bob <# ("", "alice", DOWN)
alice #: ("2", "bob", "SEND 11\nhello again") #> ("2", "bob", MID 5)
alice #: ("2", "bob", "SEND 11\nhello again") #> ("2", "bob", MID 6)
alice #:# "nothing else delivered before the server is restarted"
bob #:# "nothing else delivered before the server is restarted"
@@ -361,11 +361,11 @@ testMsgDeliveryAgentRestart t bob = do
alice <#= \case
(corrId, "bob", cmd) ->
(corrId == "3" && cmd == OK)
|| (corrId == "" && cmd == SENT 5)
|| (corrId == "" && cmd == SENT 6)
_ -> False
bob <# ("", "alice", UP)
bob <#= \case ("", "alice", Msg "hello again") -> True; _ -> False
bob #: ("12", "alice", "ACK 5") #> ("12", "alice", OK)
bob #: ("12", "alice", "ACK 6") #> ("12", "alice", OK)
removeFile testStoreLogFile
removeFile testDB
@@ -393,11 +393,11 @@ testConcurrentMsgDelivery _ alice bob = do
-- alice <# ("", "bob", SENT 1)
-- bob <#= \case ("", "alice", Msg "hello") -> True; _ -> False
-- bob #: ("12", "alice", "ACK 1") #> ("12", "alice", OK)
bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 5)
bob <# ("", "alice", SENT 5)
bob #: ("14", "alice", "SEND 9\nhello too") #> ("14", "alice", MID 6)
bob <# ("", "alice", SENT 6)
-- if delivery is blocked it won't go further
alice <#= \case ("", "bob", Msg "hello too") -> True; _ -> False
alice #: ("3", "bob", "ACK 5") #> ("3", "bob", OK)
alice #: ("3", "bob", "ACK 6") #> ("3", "bob", OK)
testMsgDeliveryQuotaExceeded :: Transport c => TProxy c -> c -> c -> IO ()
testMsgDeliveryQuotaExceeded _ alice bob = do
@@ -410,9 +410,9 @@ testMsgDeliveryQuotaExceeded _ alice bob = do
alice <#= \case ("", "bob", SENT m) -> m == mId; _ -> False
(_, "bob", Right (MID _)) <- alice #: ("5", "bob", "SEND :over quota")
alice #: ("1", "bob2", "SEND :hello") #> ("1", "bob2", MID 4)
alice #: ("1", "bob2", "SEND :hello") #> ("1", "bob2", MID 5)
-- if delivery is blocked it won't go further
alice <# ("", "bob2", SENT 4)
alice <# ("", "bob2", SENT 5)
connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO ()
connect (h1, name1) (h2, name2) = do
@@ -468,7 +468,7 @@ syntaxTests t = do
"a",
"JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2F"
<> urlEncode True "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
<> "%40localhost%3A5001%2F3456-w%3D%3D%23"
<> "%40127.0.0.1%3A5001%2F3456-w%3D%3D%23"
<> urlEncode True sampleDhKey
<> "&v=1"
<> "&e2e=v%3D1%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D"
+46 -20
View File
@@ -10,7 +10,7 @@ module AgentTests.FunctionalAPITests (functionalAPITests) where
import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.IO.Unlift
import SMPAgentClient
import SMPClient (withSmpServer)
import SMPClient (testPort, withSmpServer, withSmpServerStoreLogOn)
import Simplex.Messaging.Agent
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
import Simplex.Messaging.Agent.Protocol
@@ -44,6 +44,8 @@ functionalAPITests t = do
withSmpServer t testAsyncJoiningOfflineBeforeActivation
it "should connect with both clients going offline" $
withSmpServer t testAsyncBothOffline
it "should connect on the second attempt if server was offline" $
testAsyncServerOffline t
it "should notify after HELLO timeout" $
withSmpServer t testAsyncHelloTimeout
@@ -59,26 +61,26 @@ testAgentClient = do
get alice ##> ("", bobId, CON)
get bob ##> ("", aliceId, INFO "alice's connInfo")
get bob ##> ("", aliceId, CON)
-- message IDs 1 to 3 get assigned to control messages, so first MSG is assigned ID 4
4 <- sendMessage alice bobId "hello"
get alice ##> ("", bobId, SENT 4)
5 <- sendMessage alice bobId "how are you?"
-- message IDs 1 to 4 get assigned to control messages, so first MSG is assigned ID 5
5 <- sendMessage alice bobId "hello"
get alice ##> ("", bobId, SENT 5)
6 <- sendMessage alice bobId "how are you?"
get alice ##> ("", bobId, SENT 6)
get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
ackMessage bob aliceId 4
get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
ackMessage bob aliceId 5
6 <- sendMessage bob aliceId "hello too"
get bob ##> ("", aliceId, SENT 6)
7 <- sendMessage bob aliceId "message 1"
get bob =##> \case ("", c, Msg "how are you?") -> c == aliceId; _ -> False
ackMessage bob aliceId 6
7 <- sendMessage bob aliceId "hello too"
get bob ##> ("", aliceId, SENT 7)
8 <- sendMessage bob aliceId "message 1"
get bob ##> ("", aliceId, SENT 8)
get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
ackMessage alice bobId 6
get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
ackMessage alice bobId 7
get alice =##> \case ("", c, Msg "message 1") -> c == bobId; _ -> False
ackMessage alice bobId 8
suspendConnection alice bobId
8 <- sendMessage bob aliceId "message 2"
get bob ##> ("", aliceId, MERR 8 (SMP AUTH))
9 <- sendMessage bob aliceId "message 2"
get bob ##> ("", aliceId, MERR 9 (SMP AUTH))
deleteConnection alice bobId
liftIO $ noMessages alice "nothing else should be delivered to alice"
pure ()
@@ -148,6 +150,30 @@ testAsyncBothOffline = do
exchangeGreetings alice' bobId bob' aliceId
pure ()
testAsyncServerOffline :: ATransport -> IO ()
testAsyncServerOffline t = do
alice <- getSMPAgentClient cfg
bob <- getSMPAgentClient cfg {dbFile = testDB2}
-- create connection and shutdown the server
Right (bobId, cReq) <- withSmpServerStoreLogOn t testPort $ \_ ->
runExceptT $ createConnection alice SCMInvitation
-- connection fails
Left (BROKER NETWORK) <- runExceptT $ joinConnection bob cReq "bob's connInfo"
("", bobId1, DOWN) <- get alice
bobId1 `shouldBe` bobId
-- connection succeeds after server start
Right () <- withSmpServerStoreLogOn t testPort $ \_ -> runExceptT $ do
("", bobId2, UP) <- get alice
liftIO $ bobId2 `shouldBe` bobId
aliceId <- joinConnection bob cReq "bob's connInfo"
("", _, CONF confId "bob's connInfo") <- get alice
allowConnection alice bobId confId "alice's connInfo"
get alice ##> ("", bobId, CON)
get bob ##> ("", aliceId, INFO "alice's connInfo")
get bob ##> ("", aliceId, CON)
exchangeGreetings alice bobId bob aliceId
pure ()
testAsyncHelloTimeout :: IO ()
testAsyncHelloTimeout = do
alice <- getSMPAgentClient cfg
@@ -161,11 +187,11 @@ testAsyncHelloTimeout = do
exchangeGreetings :: AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
exchangeGreetings alice bobId bob aliceId = do
4 <- sendMessage alice bobId "hello"
get alice ##> ("", bobId, SENT 4)
5 <- sendMessage alice bobId "hello"
get alice ##> ("", bobId, SENT 5)
get bob =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
ackMessage bob aliceId 4
5 <- sendMessage bob aliceId "hello too"
get bob ##> ("", aliceId, SENT 5)
ackMessage bob aliceId 5
6 <- sendMessage bob aliceId "hello too"
get bob ##> ("", aliceId, SENT 6)
get alice =##> \case ("", c, Msg "hello too") -> c == bobId; _ -> False
ackMessage alice bobId 5
ackMessage alice bobId 6
+6 -2
View File
@@ -173,7 +173,9 @@ sndQueue1 =
SndQueue
{ server = SMPServer "smp.simplex.im" "5223" testKeyHash,
sndId = "3456",
sndPublicKey = Nothing,
sndPrivateKey = testPrivateSignKey,
e2ePubKey = Nothing,
e2eDhSecret = testDhSecret,
status = New
}
@@ -303,7 +305,9 @@ testUpgradeRcvConnToDuplex =
SndQueue
{ server = SMPServer "smp.simplex.im" "5223" testKeyHash,
sndId = "2345",
sndPublicKey = Nothing,
sndPrivateKey = testPrivateSignKey,
e2ePubKey = Nothing,
e2eDhSecret = testDhSecret,
status = New
}
@@ -393,7 +397,7 @@ mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
sndMsgId = externalSndId,
broker = (brokerId, ts)
},
msgType = A_MSG_,
msgType = AM_A_MSG_,
msgBody = hw,
internalHash,
externalPrevSndHash = "hash_from_sender"
@@ -422,7 +426,7 @@ mkSndMsgData internalId internalSndId internalHash =
{ internalId,
internalSndId,
internalTs = ts,
msgType = A_MSG_,
msgType = AM_A_MSG_,
msgBody = hw,
internalHash,
prevMsgHash = internalHash
+2 -2
View File
@@ -157,7 +157,7 @@ cfg :: AgentConfig
cfg =
defaultAgentConfig
{ tcpPort = agentTestPort,
smpServers = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
initialSMPServers = L.fromList ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@127.0.0.1:5001"],
tbqSize = 1,
dbFile = testDB,
smpCfg =
@@ -174,7 +174,7 @@ cfg =
withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
withSmpAgentThreadOn_ t (port', smpPort', db') afterProcess =
let cfg' = cfg {tcpPort = port', dbFile = db', smpServers = L.fromList [SMPServer "localhost" smpPort' testKeyHash]}
let cfg' = cfg {tcpPort = port', dbFile = db', initialSMPServers = L.fromList [SMPServer "127.0.0.1" smpPort' testKeyHash]}
in serverBracket
(\started -> runSMPAgentBlocking t started cfg')
afterProcess
+1 -1
View File
@@ -29,7 +29,7 @@ import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, takeTMVar)
import UnliftIO.Timeout (timeout)
testHost :: HostName
testHost = "localhost"
testHost = "127.0.0.1"
testPort :: ServiceName
testPort = "5001"