update for SMP agent protocol 0.3.1 - SMP servers are in agent config… (#53)

* update for SMP agent protocol 0.3.1 - SMP servers are in agent config, not in commands

* remove explicit server port

* update simplexmq

apps/dog-food/ChatOptions.hs

@@ -3,7 +3,10 @@
 
 module ChatOptions (getChatOpts, ChatOpts (..)) where
 
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as L
 import Options.Applicative
 import Simplex.Messaging.Agent.Transmission (SMPServer (..), smpServerP)
 import Simplex.Messaging.Parsers (parseAll)
@@ -11,8 +14,8 @@ import System.FilePath (combine)
 import Types
 
 data ChatOpts = ChatOpts
-  { dbFileName :: String,
-    smpServer :: SMPServer,
+  { dbFile :: String,
+    smpServers :: NonEmpty SMPServer,
     termMode :: TermMode
   }
 
@@ -31,8 +34,8 @@ chatOpts appDir =
       ( long "server"
           <> short 's'
           <> metavar "SERVER"
-          <> help "SMP server to use (smp1.simplex.im:5223#pLdiGvm0jD1CMblnov6Edd/391OrYsShw+RgdfR0ChA=)"
-          <> value (SMPServer "smp1.simplex.im" (Just "5223") (Just "pLdiGvm0jD1CMblnov6Edd/391OrYsShw+RgdfR0ChA="))
+          <> help "SMP server(s) to use (smp1.simplex.im#pLdiGvm0jD1CMblnov6Edd/391OrYsShw+RgdfR0ChA=)"
+          <> value (L.fromList ["smp1.simplex.im#pLdiGvm0jD1CMblnov6Edd/391OrYsShw+RgdfR0ChA="])
       )
     <*> option
       parseTermMode
@@ -45,8 +48,10 @@ chatOpts appDir =
   where
     defaultDbFilePath = combine appDir "smp-chat.db"
 
-parseSMPServer :: ReadM SMPServer
-parseSMPServer = eitherReader $ parseAll smpServerP . B.pack
+parseSMPServer :: ReadM (NonEmpty SMPServer)
+parseSMPServer = eitherReader $ parseAll servers . B.pack
+  where
+    servers = L.fromList <$> smpServerP `A.sepBy1` A.char ','
 
 parseTermMode :: ReadM TermMode
 parseTermMode = maybeReader $ \case

apps/dog-food/ChatTerminal.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}

apps/dog-food/Main.hs

@@ -44,7 +44,8 @@ import Types
 cfg :: AgentConfig
 cfg =
   AgentConfig
-    { tcpPort = undefined, -- TODO maybe take it out of config
+    { tcpPort = undefined, -- agent does not listen to TCP
+      smpServers = undefined, -- filled in from options
       rsaKeySize = 2048 `div` 8,
       connIdBytes = 12,
       tbqSize = 16,
@@ -57,8 +58,7 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
 data ChatClient = ChatClient
   { inQ :: TBQueue ChatCommand,
-    outQ :: TBQueue ChatResponse,
-    smpServer :: SMPServer
+    outQ :: TBQueue ChatResponse
   }
 
 -- | GroupMessage ChatGroup ByteString
@@ -199,20 +199,20 @@ markdownInfo =
 
 main :: IO ()
 main = do
-  opts@ChatOpts {dbFileName, smpServer, termMode} <- welcomeGetOpts
-  t <- getChatClient smpServer
+  opts@ChatOpts {dbFile, smpServers, termMode} <- welcomeGetOpts
+  t <- atomically $ newChatClient (tbqSize cfg)
   ct <- newChatTerminal (tbqSize cfg) termMode
   -- setLogLevel LogInfo -- LogError
   -- withGlobalLogging logCfg $ do
-  env <- newSMPAgentEnv cfg {dbFile = dbFileName}
+  env <- newSMPAgentEnv cfg {dbFile, smpServers}
   dogFoodChat t ct env opts
 
 welcomeGetOpts :: IO ChatOpts
 welcomeGetOpts = do
   appDir <- getAppUserDataDirectory "simplex"
-  opts@ChatOpts {dbFileName} <- getChatOpts appDir
+  opts@ChatOpts {dbFile} <- getChatOpts appDir
   putStrLn "SimpleX chat prototype v0.3.0"
-  putStrLn $ "db: " <> dbFileName
+  putStrLn $ "db: " <> dbFile
   putStrLn "type \"/help\" or \"/h\" for usage info"
   pure opts
 
@@ -229,14 +229,11 @@ dogFoodChat t ct env opts = do
       chatTerminal ct
     ]
 
-getChatClient :: SMPServer -> IO ChatClient
-getChatClient srv = atomically $ newChatClient (tbqSize cfg) srv
-
-newChatClient :: Natural -> SMPServer -> STM ChatClient
-newChatClient qSize smpServer = do
+newChatClient :: Natural -> STM ChatClient
+newChatClient qSize = do
   inQ <- newTBQueue qSize
   outQ <- newTBQueue qSize
-  return ChatClient {inQ, outQ, smpServer}
+  return ChatClient {inQ, outQ}
 
 receiveFromChatTerm :: ChatClient -> ChatTerminal -> IO ()
 receiveFromChatTerm t ct = forever $ do
@@ -259,7 +256,7 @@ sendToChatTerm ChatClient {outQ} ChatTerminal {outputQ} opts localTz = forever $
       atomically . writeTBQueue outputQ $ serializeChatResponse opts localTz currentTime resp
 
 sendToAgent :: ChatClient -> ChatTerminal -> AgentClient -> IO ()
-sendToAgent ChatClient {inQ, smpServer} ct AgentClient {rcvQ} = do
+sendToAgent ChatClient {inQ} ct AgentClient {rcvQ} = do
   atomically $ writeTBQueue rcvQ ("1", "", SUBALL) -- hack for subscribing to all
   forever . atomically $ do
     cmd <- readTBQueue inQ
@@ -273,8 +270,8 @@ sendToAgent ChatClient {inQ, smpServer} ct AgentClient {rcvQ} = do
       _ -> pure ()
     agentTransmission :: ChatCommand -> Maybe (ATransmission 'Client)
     agentTransmission = \case
-      AddConnection a -> transmission a $ NEW smpServer
-      Connect a qInfo -> transmission a $ JOIN qInfo $ ReplyVia smpServer
+      AddConnection a -> transmission a NEW
+      Connect a qInfo -> transmission a $ JOIN qInfo $ ReplyMode On
       DeleteConnection a -> transmission a DEL
       SendMessage a msg -> transmission a $ SEND msg
       ChatHelp -> Nothing

stack.yaml

@@ -40,8 +40,9 @@ extra-deps:
   - simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
   - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
   - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
+  # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 2b0950e78e390b41cf4064818534d7791aa293ae
+    commit: 4b9ebbbab2fb8912cf08a289fa73050ec86ddf51
 # - network-run-0.2.4@sha256:7dbb06def522dab413bce4a46af476820bffdff2071974736b06f52f4ab57c96,885
 # - git: https://github.com/commercialhaskell/stack.git
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a