diff --git a/Dockerfile b/Dockerfile deleted file mode 100644 index c03da4a..0000000 --- a/Dockerfile +++ /dev/null @@ -1,10 +0,0 @@ -FROM haskell:8.8.4 AS build-stage -# if you encounter "version `GLIBC_2.28' not found" error when running -# chat client executable, build with the following base image instead: -# FROM haskell:8.8.4-stretch AS build-stage -COPY . /project -WORKDIR /project -RUN stack install - -FROM scratch AS export-stage -COPY --from=build-stage /root/.local/bin/dog-food / diff --git a/README.md b/README.md index 5058fe2..b2e75cf 100644 --- a/README.md +++ b/README.md @@ -1,223 +1,69 @@ -# simplex-messaging +# SimpleXMQ -[![GitHub build](https://github.com/simplex-chat/simplex-messaging/workflows/build/badge.svg)](https://github.com/simplex-chat/simplex-messaging/actions?query=workflow%3Abuild) -[![GitHub release](https://img.shields.io/github/v/release/simplex-chat/simplex-messaging)](https://github.com/simplex-chat/simplex-messaging/releases) +[![GitHub build](https://github.com/simplex-chat/simplexmq/workflows/build/badge.svg)](https://github.com/simplex-chat/simplexmq/actions?query=workflow%3Abuild) +[![GitHub release](https://img.shields.io/github/v/release/simplex-chat/simplexmq)](https://github.com/simplex-chat/simplexmq/releases) -## Federated chat - private, secure, decentralised +## Message broker for unidirectional (simplex) queues -See [simplex.chat](https://simplex.chat) website for chat demo and the explanations of the system and how SMP protocol works. +SimpleXMQ is a message broker for managing message queues and sending messages over public network. It consists of SMP server, SMP client library and SMP agent that implement [SMP protocol](./protocol/simplex-messaging.md) for client-server communication and [SMP agent protocol](./protocol/agent-protocol.md) to manage duplex connections via simplex queues on multiple SMP servers. -SMP protocol is semi-formally defined [here](https://github.com/simplex-chat/protocol). +SMP protocol is inspired by [Redis serialization protocol](https://redis.io/topics/protocol), but it is much simpler - it currently has only 8 client commands and 6 server responses. -Currently only these features are available: -- simple 1-to-1 chat with multiple people in the same terminal window. -- auto-populated recipient name - just type your messages. -- default server is available to play with - `smp.simplex.im:5223` - and you can deploy your own (`smp-server` executable in this repo). -- no global identity or names visible to the server(s) - for the privacy of contacts and conversations. -- E2E encryption, with public key that has to be passed out-of-band (see below) -- authentication of each command/message with automatically generated RSA key pairs, separate for each conversation, the keys are not used as identity (2048 bit keys are used, it can be changed in [code via rsaKeySize setting](https://github.com/simplex-chat/simplex-messaging/blob/master/apps/dog-food/Main.hs)) +SimpleXMQ is implemented in Haskell - it benefits from robust software transactional memory (STM) and concurrency primitives that Haskell provides. -Limitations/disclaimers: -- no support for chat groups. It is coming in the next major version (i.e., not very soon:) -- no delivery notifications - coming soon -- no TCP transport encryption - coming soon (messages are encrypted e2e though, only random connection IDs and server commands are visible, but not the contents of the message) -- system and protocol security was not audited yet, so you probably should NOT use it yet for high security communications - unless you know what you are doing. +## SimpleXMQ roadmap -## How to run chat client locally +- Streams - high performance message queues. See [Streams RFC](./rfcs/2021-02-28-streams.md) for details. +- "Small" connection groups, when each message will be sent by the SMP agent to multiple connections with a single client command. See [Groups RFC](./rfcs/2021-03-18-groups.md) for details. +- SMP agents cluster to share connections and message management by multiple agents (for example, it would enable multi-device use for [simplex-chat](https://github.com/simplex-chat/simplex-chat)). +- SMP queue redundancy and rotation in SMP agent duplex connections. +- "Large" groups design and implementation. -Install [Haskell stack](https://docs.haskellstack.org/en/stable/README/): +## Components -```shell -curl -sSL https://get.haskellstack.org/ | sh -``` +### SMP server -and build the project: +[SMP server](./apps/smp-server/Main.hs) can be run on any Linux distribution without any dependencies. It uses in-memory persistence with an optional append-only log of created queues that allows to re-start the server without losing the connections. This log is compacted on every server restart, permanently removing suspended and removed queues. -```shell -$ git clone git@github.com:simplex-chat/simplex-messaging.git -$ cd simplex-messaging -$ stack install -$ dog-food -``` +To enable the queue logging, uncomment `enable: on` option in `smp-server.ini` configuration file that is created the first time the server is started. -If you'd prefer to not set up Haskell locally, on Linux you may instead build the chat client executable using [docker build with custom output](https://docs.docker.com/engine/reference/commandline/build/#custom-build-outputs): +On the first start the server generates an RSA key pair for encrypted transport handshake and outputs hash of the public key every time it runs - this hash should be used as part of the server address: `:5223#`. -```shell -$ git clone git@github.com:simplex-chat/simplex-messaging.git -$ cd simplex-messaging -$ DOCKER_BUILDKIT=1 docker build --output ~/.local/bin . -$ dog-food -``` +SMP server implements [SMP protocol](./protocol/simplex-messaging.md). -> **NOTE:** When running chat client executable built with the latter approach, if you encounter ``version `GLIBC_2.28' not found`` error, rebuild it with `haskell:8.8.4-stretch` base image instead (you'd have to change it in your local [Dockerfile](Dockerfile)). +### SMP client library -`dog-food` (as in "eating your own dog food" - it is an early prototype) starts chat client with default parameters. By default, app data directory is created in the home directory (`~/.simplex`, or `%APPDATA%/simplex` on Windows), and SQLite database file `smp-chat.db` is initialized in it. The default SMP server is `smp.simplex.im:5223`. +[SMP client](./src/Simplex/Messaging/Client.hs) is a Haskell library to connect to SMP servers that allows to: +- execute commands with a functional API. +- receive messages and other notifications via STM queue. +- automatically send keep-alive commands. -To specify a different file path for the chat database use `-d` command line option: +### SMP agent -```shell -$ dog-food -d my-chat.db -``` +[SMP agent library](./src/Simplex/Messaging/Agent.hs) can be used to run SMP agent as part of another application and to communicate with the agent via STM queues, without serializing and parsing commands and responses. -If you deployed your own SMP server you can set client to use it via `-s` option: +Haskell type [ACommand](./src/Simplex/Messaging/Agent/Transmission.hs) represents SMP agent protocol to communicate via STM queues. -```shell -$ dog-food -s smp.example.com:5223 -``` +See [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI for the example of integrating SMP agent into another application. -You can still talk to people using default or any other server, it only affects the location of the message queue when you initiate the connection (and the reply queue can be on another server, as set by the other party's client). +[SMP agent executable](./apps/smp-agent/Main.hs) can be used to run a standalone SMP agent process that implements plaintext [SMP agent protocol](./protocol/agent-protocol.md) via TCP port 5224, so it can be used via telnet. It can be deployed in private networks to share access to the connections between multiple applications and services. -Run `dog-food --help` to see all available options. +## Using SMP server and SMP agent -### Using chat client +You can either run SMP server locally or try local SMP agent with the deployed demo server: -Once chat client is started, use `/add ` to create a new connection and generate an invitation to send to your contact via any other communication channel (`` - is any name you want to use for that contact). +`smp1.simplex.im:5223#pLdiGvm0jD1CMblnov6Edd/391OrYsShw+RgdfR0ChA=` -Invitation has format `smp::::::` - this needs to be shared with another party, via any other chat. It can only be used once - even if this is intercepted, the attacker would not be able to use it to send you the messages via this queue once your contact confirms that the connection is established. +It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.com/simplex-chat/simplex-chat) terminal UI. -The party that received the invitation should use `/accept ` to accept the connection (`` is any name that the accepting party wants to use for you). +## SMP server design -For example, if Alice and Bob want to chat, with Alice initiating, Alice would use [in her chat client]: +![SMP server design](./design/server.svg) -``` -/add bob -``` +## SMP agent design -And then send the generated invitation to Bob out-of-band. Bob then would use [in his chat client]: +![SMP agent design](./design/agent2.svg) -``` -/accept alice -``` +## License -They would then use `@ ` commands to send messages. One may also press Space or just start typing a message to send a message to the contact that was the last. - -If you exit from chat client (or if internet connection is interrupted) you need to use `/chat ` to activate conversation with respective contact - it is not resumed automatically (it will improve soon). - -Since SMP doesn't use global identity (all account information is managed by clients), you should configure your name to use in invitations for your contacts: - -``` -/name alice -``` - -Now Alice's invitations would be generated with her name in it for others' convenience. - -Use `/help` in chat to see the list of available commands and their explanation. - -### Accessing chat history - -You can access your chat history by opening a connection to your SQLite database file and querying `messages` table, for example: - -```sql -select * from messages -where conn_alias = cast('alice' as blob) -order by internal_id desc; - -select * from messages -where conn_alias = cast('alice' as blob) -and body like '%cats%'; -``` - -> **NOTE:** Beware that SQLite foreign key constraints are disabled by default, and must be **[enabled separately for each database connection](https://sqlite.org/foreignkeys.html#fk_enable)**. The latter can be achieved by running `PRAGMA foreign_keys = ON;` command on an open database connection. By running data altering queries without enabling foreign keys prior to that, you may risk putting your database in an inconsistent state. - -## 🚧 [further README not up to date] SMP server demo 🏗 - -This is a demo implementation of SMP ([simplex messaging protocol](https://github.com/simplex-chat/protocol/blob/master/simplex-messaging.md)) server. - -It has a very limited utility (if any) for real applications, as it lacks the following protocol features: - -- cryptographic signature verification, instead it simply compares provided "signature" with stored "public key", effectively treating them as plain text passwords. -- there is no transport encryption - -Because of these limitations, it is easy to experiment with the protocol logic via telnet. - -You can either run it locally or try with the deployed demo server: - -```bash -telnet smp.simplex.im 5223 -``` - -## Run locally - -[Install stack](https://docs.haskellstack.org/en/stable/install_and_upgrade/) and `stack run`. - -## Usage example - -Lines you should send are prefixed with `>` character, you should not type them. - -Comments are prefixed with `--`, they are not part of transmissions. - -`>` on its own means you need to press `return` - telnet should be configured to send it as CRLF. - -1. Create simplex message queue: - -```telnet -> -> abcd -- correlation ID, any string -> -> NEW 1234 -- 1234 is recipient's key - -abcd - -IDS QuCLU4YxgS7wcPFA YB4CCATREHkaQcEh -- recipient and sender IDs for the queue -``` - -2. Sender can send their "key" to the queue: - -```telnet -> -- no signature (just press enter) -> bcda -- correlation ID, any string -> YB4CCATREHkaQcEh -- sender ID for the queue -> SEND :key abcd - -bcda -YB4CCATREHkaQcEh -OK -``` - -3. Secure queue with sender's "key" - -```telnet -> 1234 -- recipient's "signature" - same as "key" in the demo -> cdab -> QuCLU4YxgS7wcPFA -- recipient ID -> KEY abcd -- "key" provided by sender - -cdab -QuCLU4YxgS7wcPFA -OK -``` - -4. Sender can now send messages to the queue - -```telnet -> abcd -- sender's "signature" - same as "key" in the demo -> dabc -- correlation ID -> YB4CCATREHkaQcEh -- sender ID -> SEND :hello - -dabc -YB4CCATREHkaQcEh -OK -``` - -5. Recipient recieves the message and acknowledges it to receive further messages - -```telnet - --- no correlation ID for messages delivered without client command -QuCLU4YxgS7wcPFA -MSG ECA3w3ID 2020-10-18T20:19:36.874Z 5 -hello -> 1234 -> abcd -> QuCLU4YxgS7wcPFA -> ACK - -abcd -QuCLU4YxgS7wcPFA -OK -``` - -## Design - -![server design](design/server.svg) +[AGPL v3](./LICENSE) diff --git a/apps/dog-food/ChatOptions.hs b/apps/dog-food/ChatOptions.hs deleted file mode 100644 index 8d0a056..0000000 --- a/apps/dog-food/ChatOptions.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - -module ChatOptions (getChatOpts, ChatOpts (..)) where - -import qualified Data.ByteString.Char8 as B -import Options.Applicative -import Simplex.Messaging.Agent.Transmission (SMPServer (..), smpServerP) -import Simplex.Messaging.Parsers (parseAll) -import System.FilePath (combine) -import Types - -data ChatOpts = ChatOpts - { dbFileName :: String, - smpServer :: SMPServer, - termMode :: TermMode - } - -chatOpts :: FilePath -> Parser ChatOpts -chatOpts appDir = - ChatOpts - <$> strOption - ( long "database" - <> short 'd' - <> metavar "DB_FILE" - <> help ("sqlite database file path (" <> defaultDbFilePath <> ")") - <> value defaultDbFilePath - ) - <*> option - parseSMPServer - ( 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=")) - ) - <*> option - parseTermMode - ( long "term" - <> short 't' - <> metavar "TERM" - <> help ("terminal mode: editor or basic (" <> termModeName TermModeEditor <> ")") - <> value TermModeEditor - ) - where - defaultDbFilePath = combine appDir "smp-chat.db" - -parseSMPServer :: ReadM SMPServer -parseSMPServer = eitherReader $ parseAll smpServerP . B.pack - -parseTermMode :: ReadM TermMode -parseTermMode = maybeReader $ \case - "basic" -> Just TermModeBasic - "editor" -> Just TermModeEditor - _ -> Nothing - -getChatOpts :: FilePath -> IO ChatOpts -getChatOpts appDir = execParser opts - where - opts = - info - (chatOpts appDir <**> helper) - ( fullDesc - <> header "Chat prototype using Simplex Messaging Protocol (SMP)" - <> progDesc "Start chat with DB_FILE file and use SERVER as SMP server" - ) diff --git a/apps/dog-food/ChatTerminal.hs b/apps/dog-food/ChatTerminal.hs deleted file mode 100644 index 9a09027..0000000 --- a/apps/dog-food/ChatTerminal.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} - -module ChatTerminal - ( ChatTerminal (..), - newChatTerminal, - chatTerminal, - ttyContact, - ttyFromContact, - ) -where - -import ChatTerminal.Basic -import ChatTerminal.Core -import ChatTerminal.Editor -import Control.Concurrent (threadDelay) -import Control.Concurrent.Async (race_) -import Control.Monad -import Numeric.Natural -import Styled -import System.Terminal -import Types -import UnliftIO.STM - -newChatTerminal :: Natural -> TermMode -> IO ChatTerminal -newChatTerminal qSize termMode = do - inputQ <- newTBQueueIO qSize - outputQ <- newTBQueueIO qSize - activeContact <- newTVarIO Nothing - termSize <- withTerminal . runTerminalT $ getWindowSize - let lastRow = height termSize - 1 - termState <- newTVarIO newTermState - termLock <- newTMVarIO () - nextMessageRow <- newTVarIO lastRow - threadDelay 500000 -- this delay is the same as timeout in getTerminalSize - return ChatTerminal {inputQ, outputQ, activeContact, termMode, termState, termSize, nextMessageRow, termLock} - -newTermState :: TerminalState -newTermState = - TerminalState - { inputString = "", - inputPosition = 0, - inputPrompt = "> ", - previousInput = "" - } - -chatTerminal :: ChatTerminal -> IO () -chatTerminal ct - | termSize ct == Size 0 0 || termMode ct == TermModeBasic = - run basicReceiveFromTTY basicSendToTTY - | otherwise = do - withTerminal . runTerminalT $ updateInput ct - run receiveFromTTY sendToTTY - where - run receive send = race_ (receive ct) (send ct) - -basicReceiveFromTTY :: ChatTerminal -> IO () -basicReceiveFromTTY ct = - forever $ getLn >>= atomically . writeTBQueue (inputQ ct) - -basicSendToTTY :: ChatTerminal -> IO () -basicSendToTTY ct = forever $ readOutputQ ct >>= mapM_ putStyledLn - -withTermLock :: MonadTerminal m => ChatTerminal -> m () -> m () -withTermLock ChatTerminal {termLock} action = do - _ <- atomically $ takeTMVar termLock - action - atomically $ putTMVar termLock () - -receiveFromTTY :: ChatTerminal -> IO () -receiveFromTTY ct@ChatTerminal {inputQ, activeContact, termSize, termState} = - withTerminal . runTerminalT . forever $ - getKey >>= processKey >> withTermLock ct (updateInput ct) - where - processKey :: MonadTerminal m => (Key, Modifiers) -> m () - processKey = \case - (EnterKey, _) -> submitInput - key -> atomically $ do - ac <- readTVar activeContact - modifyTVar termState $ updateTermState ac (width termSize) key - - submitInput :: MonadTerminal m => m () - submitInput = do - msg <- atomically $ do - ts <- readTVar termState - let s = inputString ts - writeTVar termState $ ts {inputString = "", inputPosition = 0, previousInput = s} - writeTBQueue inputQ s - return s - withTermLock ct $ printMessage ct [styleMessage msg] - -sendToTTY :: ChatTerminal -> IO () -sendToTTY ct = forever $ do - -- `readOutputQ` should be outside of `withTerminal` (see #94) - msg <- readOutputQ ct - withTerminal . runTerminalT . withTermLock ct $ do - printMessage ct msg - updateInput ct - -readOutputQ :: ChatTerminal -> IO [StyledString] -readOutputQ = atomically . readTBQueue . outputQ diff --git a/apps/dog-food/ChatTerminal/Basic.hs b/apps/dog-food/ChatTerminal/Basic.hs deleted file mode 100644 index 875313c..0000000 --- a/apps/dog-food/ChatTerminal/Basic.hs +++ /dev/null @@ -1,89 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -module ChatTerminal.Basic where - -import Control.Monad.IO.Class (liftIO) -import Styled -import System.Console.ANSI.Types -import System.Exit (exitSuccess) -import System.Terminal as C - -getLn :: IO String -getLn = withTerminal $ runTerminalT getTermLine - -putStyledLn :: StyledString -> IO () -putStyledLn s = - withTerminal . runTerminalT $ - putStyled s >> C.putLn >> flush - --- Currently it is assumed that the message does not have internal line breaks. --- Previous implementation "kind of" supported them, --- but it was not determining the number of printed lines correctly --- because of accounting for control sequences in length -putStyled :: MonadTerminal m => StyledString -> m () -putStyled (s1 :<>: s2) = putStyled s1 >> putStyled s2 -putStyled (Styled [] s) = putString s -putStyled (Styled sgr s) = setSGR sgr >> putString s >> resetAttributes - -setSGR :: MonadTerminal m => [SGR] -> m () -setSGR = mapM_ $ \case - Reset -> resetAttributes - SetConsoleIntensity BoldIntensity -> setAttribute bold - SetConsoleIntensity _ -> resetAttribute bold - SetItalicized True -> setAttribute italic - SetItalicized _ -> resetAttribute italic - SetUnderlining NoUnderline -> resetAttribute underlined - SetUnderlining _ -> setAttribute underlined - SetSwapForegroundBackground True -> setAttribute inverted - SetSwapForegroundBackground _ -> resetAttribute inverted - SetColor l i c -> setAttribute . layer l . intensity i $ color c - SetBlinkSpeed _ -> pure () - SetVisible _ -> pure () - SetRGBColor _ _ -> pure () - SetPaletteColor _ _ -> pure () - SetDefaultColor _ -> pure () - where - layer = \case - Foreground -> foreground - Background -> background - intensity = \case - Dull -> id - Vivid -> bright - color = \case - Black -> black - Red -> red - Green -> green - Yellow -> yellow - Blue -> blue - Magenta -> magenta - Cyan -> cyan - White -> white - -getKey :: MonadTerminal m => m (Key, Modifiers) -getKey = - flush >> awaitEvent >>= \case - Left Interrupt -> liftIO exitSuccess - Right (KeyEvent key ms) -> pure (key, ms) - _ -> getKey - -getTermLine :: MonadTerminal m => m String -getTermLine = getChars "" - where - getChars s = - getKey >>= \(key, ms) -> case key of - CharKey c - | ms == mempty || ms == shiftKey -> do - C.putChar c - flush - getChars (c : s) - | otherwise -> getChars s - EnterKey -> do - C.putLn - flush - pure $ reverse s - BackspaceKey -> do - moveCursorBackward 1 - eraseChars 1 - flush - getChars $ if null s then s else tail s - _ -> getChars s diff --git a/apps/dog-food/ChatTerminal/Core.hs b/apps/dog-food/ChatTerminal/Core.hs deleted file mode 100644 index ab001cb..0000000 --- a/apps/dog-food/ChatTerminal/Core.hs +++ /dev/null @@ -1,139 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} - -module ChatTerminal.Core where - -import Control.Concurrent.STM -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as B -import Data.List (dropWhileEnd) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding -import Styled -import System.Console.ANSI.Types -import System.Terminal hiding (insertChars) -import Types - -data ChatTerminal = ChatTerminal - { inputQ :: TBQueue String, - outputQ :: TBQueue [StyledString], - activeContact :: TVar (Maybe Contact), - termMode :: TermMode, - termState :: TVar TerminalState, - termSize :: Size, - nextMessageRow :: TVar Int, - termLock :: TMVar () - } - -data TerminalState = TerminalState - { inputPrompt :: String, - inputString :: String, - inputPosition :: Int, - previousInput :: String - } - -inputHeight :: TerminalState -> ChatTerminal -> Int -inputHeight ts ct = length (inputPrompt ts <> inputString ts) `div` width (termSize ct) + 1 - -positionRowColumn :: Int -> Int -> Position -positionRowColumn wid pos = - let row = pos `div` wid - col = pos - row * wid - in Position {row, col} - -updateTermState :: Maybe Contact -> Int -> (Key, Modifiers) -> TerminalState -> TerminalState -updateTermState ac tw (key, ms) ts@TerminalState {inputString = s, inputPosition = p} = case key of - CharKey c - | ms == mempty || ms == shiftKey -> insertCharsWithContact [c] - | ms == altKey && c == 'b' -> setPosition prevWordPos - | ms == altKey && c == 'f' -> setPosition nextWordPos - | otherwise -> ts - TabKey -> insertCharsWithContact " " - BackspaceKey -> backDeleteChar - DeleteKey -> deleteChar - HomeKey -> setPosition 0 - EndKey -> setPosition $ length s - ArrowKey d -> case d of - Leftwards -> setPosition leftPos - Rightwards -> setPosition rightPos - Upwards - | ms == mempty && null s -> let s' = previousInput ts in ts' (s', length s') - | ms == mempty -> let p' = p - tw in if p' > 0 then setPosition p' else ts - | otherwise -> ts - Downwards - | ms == mempty -> let p' = p + tw in if p' <= length s then setPosition p' else ts - | otherwise -> ts - _ -> ts - where - insertCharsWithContact cs - | null s && cs /= "@" && cs /= "/" = - insertChars $ contactPrefix <> cs - | otherwise = insertChars cs - insertChars = ts' . if p >= length s then append else insert - append cs = let s' = s <> cs in (s', length s') - insert cs = let (b, a) = splitAt p s in (b <> cs <> a, p + length cs) - contactPrefix = case ac of - Just (Contact c) -> "@" <> B.unpack c <> " " - Nothing -> "" - backDeleteChar - | p == 0 || null s = ts - | p >= length s = ts' (init s, length s - 1) - | otherwise = let (b, a) = splitAt p s in ts' (init b <> a, p - 1) - deleteChar - | p >= length s || null s = ts - | p == 0 = ts' (tail s, 0) - | otherwise = let (b, a) = splitAt p s in ts' (b <> tail a, p) - leftPos - | ms == mempty = max 0 (p - 1) - | ms == shiftKey = 0 - | ms == ctrlKey = prevWordPos - | ms == altKey = prevWordPos - | otherwise = p - rightPos - | ms == mempty = min (length s) (p + 1) - | ms == shiftKey = length s - | ms == ctrlKey = nextWordPos - | ms == altKey = nextWordPos - | otherwise = p - setPosition p' = ts' (s, p') - prevWordPos - | p == 0 || null s = p - | otherwise = - let before = take p s - beforeWord = dropWhileEnd (/= ' ') $ dropWhileEnd (== ' ') before - in max 0 $ p - length before + length beforeWord - nextWordPos - | p >= length s || null s = p - | otherwise = - let after = drop p s - afterWord = dropWhile (/= ' ') $ dropWhile (== ' ') after - in min (length s) $ p + length after - length afterWord - ts' (s', p') = ts {inputString = s', inputPosition = p'} - -styleMessage :: String -> StyledString -styleMessage = \case - "" -> "" - s@('@' : _) -> let (c, rest) = span (/= ' ') s in Styled selfSGR c <> markdown rest - s -> markdown s - where - markdown :: String -> StyledString - markdown = styleMarkdownText . T.pack - -safeDecodeUtf8 :: ByteString -> Text -safeDecodeUtf8 = decodeUtf8With onError - where - onError _ _ = Just '?' - -ttyContact :: Contact -> StyledString -ttyContact (Contact a) = Styled contactSGR $ B.unpack a - -ttyFromContact :: Contact -> StyledString -ttyFromContact (Contact a) = Styled contactSGR $ B.unpack a <> "> " - -contactSGR :: [SGR] -contactSGR = [SetColor Foreground Vivid Yellow] - -selfSGR :: [SGR] -selfSGR = [SetColor Foreground Vivid Cyan] diff --git a/apps/dog-food/ChatTerminal/Editor.hs b/apps/dog-food/ChatTerminal/Editor.hs deleted file mode 100644 index d4e6a98..0000000 --- a/apps/dog-food/ChatTerminal/Editor.hs +++ /dev/null @@ -1,61 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module ChatTerminal.Editor where - -import ChatTerminal.Basic -import ChatTerminal.Core -import Styled -import System.Terminal -import UnliftIO.STM - --- debug :: MonadTerminal m => String -> m () --- debug s = do --- saveCursor --- setCursorPosition $ Position 0 0 --- putString s --- restoreCursor - -updateInput :: forall m. MonadTerminal m => ChatTerminal -> m () -updateInput ct@ChatTerminal {termSize = Size {height, width}, termState, nextMessageRow} = do - hideCursor - ts <- readTVarIO termState - nmr <- readTVarIO nextMessageRow - let ih = inputHeight ts ct - iStart = height - ih - prompt = inputPrompt ts - Position {row, col} = positionRowColumn width $ length prompt + inputPosition ts - if nmr >= iStart - then atomically $ writeTVar nextMessageRow iStart - else clearLines nmr iStart - setCursorPosition $ Position {row = max nmr iStart, col = 0} - putString $ prompt <> inputString ts <> " " - eraseInLine EraseForward - setCursorPosition $ Position {row = iStart + row, col} - showCursor - flush - where - clearLines :: Int -> Int -> m () - clearLines from till - | from >= till = return () - | otherwise = do - setCursorPosition $ Position {row = from, col = 0} - eraseInLine EraseForward - clearLines (from + 1) till - -printMessage :: forall m. MonadTerminal m => ChatTerminal -> [StyledString] -> m () -printMessage ChatTerminal {termSize = Size {height, width}, nextMessageRow} msg = do - nmr <- readTVarIO nextMessageRow - setCursorPosition $ Position {row = nmr, col = 0} - mapM_ printStyled msg - flush - let lc = sum $ map lineCount msg - atomically . writeTVar nextMessageRow $ min (height - 1) (nmr + lc) - where - lineCount :: StyledString -> Int - lineCount s = sLength s `div` width + 1 - printStyled :: StyledString -> m () - printStyled s = do - putStyled s - eraseInLine EraseForward - putLn diff --git a/apps/dog-food/Main.hs b/apps/dog-food/Main.hs deleted file mode 100644 index e96d16d..0000000 --- a/apps/dog-food/Main.hs +++ /dev/null @@ -1,289 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Main where - -import ChatOptions -import ChatTerminal -import ChatTerminal.Core -import Control.Applicative ((<|>)) -import Control.Concurrent.STM -import Control.Logger.Simple -import Control.Monad.Reader -import Data.Attoparsec.ByteString.Char8 (Parser) -import qualified Data.Attoparsec.ByteString.Char8 as A -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as B -import Data.Functor (($>)) -import Data.List (intersperse) -import qualified Data.Text as T -import Data.Text.Encoding -import Numeric.Natural -import Simplex.Markdown -import Simplex.Messaging.Agent (getSMPAgentClient, runSMPAgentClient) -import Simplex.Messaging.Agent.Client (AgentClient (..)) -import Simplex.Messaging.Agent.Env.SQLite -import Simplex.Messaging.Agent.Transmission -import Simplex.Messaging.Client (smpDefaultConfig) -import Simplex.Messaging.Parsers (parseAll) -import Simplex.Messaging.Util (raceAny_) -import Styled -import System.Console.ANSI.Types -import System.Directory (getAppUserDataDirectory) -import Types - -cfg :: AgentConfig -cfg = - AgentConfig - { tcpPort = undefined, -- TODO maybe take it out of config - rsaKeySize = 2048 `div` 8, - connIdBytes = 12, - tbqSize = 16, - dbFile = "smp-chat.db", - smpCfg = smpDefaultConfig - } - -logCfg :: LogConfig -logCfg = LogConfig {lc_file = Nothing, lc_stderr = True} - -data ChatClient = ChatClient - { inQ :: TBQueue ChatCommand, - outQ :: TBQueue ChatResponse, - smpServer :: SMPServer - } - --- | GroupMessage ChatGroup ByteString --- | AddToGroup Contact -data ChatCommand - = ChatHelp - | MarkdownHelp - | AddConnection Contact - | Connect Contact SMPQueueInfo - | DeleteConnection Contact - | SendMessage Contact ByteString - -chatCommandP :: Parser ChatCommand -chatCommandP = - ("/help" <|> "/h") $> ChatHelp - <|> ("/markdown" <|> "/m") $> MarkdownHelp - <|> ("/add " <|> "/a ") *> (AddConnection <$> contact) - <|> ("/connect " <> "/c ") *> connect - <|> ("/delete " <> "/d ") *> (DeleteConnection <$> contact) - <|> "@" *> sendMessage - where - connect = Connect <$> contact <* A.space <*> smpQueueInfoP - sendMessage = SendMessage <$> contact <* A.space <*> A.takeByteString - contact = Contact <$> A.takeTill (== ' ') - -data ChatResponse - = ChatHelpInfo - | MarkdownInfo - | Invitation SMPQueueInfo - | Connected Contact - | Confirmation Contact - | ReceivedMessage Contact ByteString - | Disconnected Contact - | YesYes - | ContactError ConnectionErrorType Contact - | ErrorInput ByteString - | ChatError AgentErrorType - | NoChatResponse - -serializeChatResponse :: ChatResponse -> [StyledString] -serializeChatResponse = \case - ChatHelpInfo -> chatHelpInfo - MarkdownInfo -> markdownInfo - Invitation qInfo -> - [ "pass this invitation to your contact (via any channel): ", - "", - (bPlain . serializeSmpQueueInfo) qInfo, - "", - "and ask them to connect: /c " - ] - Connected c -> [ttyContact c <> " connected"] - Confirmation c -> [ttyContact c <> " ok"] - ReceivedMessage c t -> prependFirst (ttyFromContact c) $ msgPlain t - -- TODO either add command to re-connect or update message below - Disconnected c -> ["disconnected from " <> ttyContact c <> " - try \"/chat " <> bPlain (toBs c) <> "\""] - YesYes -> ["you got it!"] - ContactError e c -> case e of - UNKNOWN -> ["no contact " <> ttyContact c] - DUPLICATE -> ["contact " <> ttyContact c <> " already exists"] - SIMPLEX -> ["contact " <> ttyContact c <> " did not accept invitation yet"] - ErrorInput t -> ["invalid input: " <> bPlain t] - ChatError e -> ["chat error: " <> plain (show e)] - NoChatResponse -> [""] - where - prependFirst :: StyledString -> [StyledString] -> [StyledString] - prependFirst s [] = [s] - prependFirst s (s' : ss) = (s <> s') : ss - msgPlain :: ByteString -> [StyledString] - msgPlain = map styleMarkdownText . T.lines . safeDecodeUtf8 - -chatHelpInfo :: [StyledString] -chatHelpInfo = - map - styleMarkdown - [ Markdown (Colored Cyan) "Using Simplex chat prototype.", - "Follow these steps to set up a connection:", - "", - Markdown (Colored Green) "Step 1: " <> Markdown (Colored Cyan) "/add bob" <> " -- Alice adds her contact, Bob (she can use any name).", - indent <> "Alice should send the invitation printed by the /add command", - indent <> "to her contact, Bob, out-of-band, via any trusted channel.", - "", - Markdown (Colored Green) "Step 2: " <> Markdown (Colored Cyan) "/connect alice " <> " -- Bob accepts the invitation.", - indent <> "Bob also can use any name for his contact, Alice,", - indent <> "followed by the invitation he received out-of-band.", - "", - Markdown (Colored Green) "Step 3: " <> "Bob and Alice are notified that the connection is set up,", - indent <> "both can now send messages:", - indent <> Markdown (Colored Cyan) "@bob Hello, Bob!" <> " -- Alice messages Bob.", - indent <> Markdown (Colored Cyan) "@alice Hey, Alice!" <> " -- Bob replies to Alice.", - "", - Markdown (Colored Green) "Other commands:", - indent <> Markdown (Colored Cyan) "/delete" <> " -- deletes contact and all messages with them.", - indent <> Markdown (Colored Cyan) "/markdown" <> " -- prints the supported markdown syntax.", - "", - "The commands may be abbreviated to a single letter: " <> listCommands ["/a", "/c", "/d", "/m"] - ] - where - listCommands = mconcat . intersperse ", " . map highlight - highlight = Markdown (Colored Cyan) - indent = " " - -markdownInfo :: [StyledString] -markdownInfo = - map - styleMarkdown - [ "Markdown:", - " *bold* - " <> Markdown Bold "bold text", - " _italic_ - " <> Markdown Italic "italic text" <> " (shown as underlined)", - " +underlined+ - " <> Markdown Underline "underlined text", - " ~strikethrough~ - " <> Markdown StrikeThrough "strikethrough text" <> " (shown as inverse)", - " `code snippet` - " <> Markdown Snippet "a + b // no *markdown* here", - " !1 text! - " <> red "red text" <> " (1-6: red, green, blue, yellow, cyan, magenta)", - " #secret# - " <> Markdown Secret "secret text" <> " (can be copy-pasted)" - ] - where - red = Markdown (Colored Red) - -main :: IO () -main = do - ChatOpts {dbFileName, smpServer, termMode} <- welcomeGetOpts - t <- getChatClient smpServer - ct <- newChatTerminal (tbqSize cfg) termMode - -- setLogLevel LogInfo -- LogError - -- withGlobalLogging logCfg $ do - env <- newSMPAgentEnv cfg {dbFile = dbFileName} - dogFoodChat t ct env - -welcomeGetOpts :: IO ChatOpts -welcomeGetOpts = do - appDir <- getAppUserDataDirectory "simplex" - opts@ChatOpts {dbFileName} <- getChatOpts appDir - putStrLn "SimpleX chat prototype" - putStrLn $ "db: " <> dbFileName - putStrLn "type \"/help\" or \"/h\" for usage info" - pure opts - -dogFoodChat :: ChatClient -> ChatTerminal -> Env -> IO () -dogFoodChat t ct env = do - c <- runReaderT getSMPAgentClient env - raceAny_ - [ runReaderT (runSMPAgentClient c) env, - sendToAgent t ct c, - sendToChatTerm t ct, - receiveFromAgent t ct c, - receiveFromChatTerm t ct, - chatTerminal ct - ] - -getChatClient :: SMPServer -> IO ChatClient -getChatClient srv = atomically $ newChatClient (tbqSize cfg) srv - -newChatClient :: Natural -> SMPServer -> STM ChatClient -newChatClient qSize smpServer = do - inQ <- newTBQueue qSize - outQ <- newTBQueue qSize - return ChatClient {inQ, outQ, smpServer} - -receiveFromChatTerm :: ChatClient -> ChatTerminal -> IO () -receiveFromChatTerm t ct = forever $ do - atomically (readTBQueue $ inputQ ct) - >>= processOrError . parseAll chatCommandP . encodeUtf8 . T.pack - where - processOrError = \case - Left err -> writeOutQ . ErrorInput $ B.pack err - Right ChatHelp -> writeOutQ ChatHelpInfo - Right MarkdownHelp -> writeOutQ MarkdownInfo - Right cmd -> atomically $ writeTBQueue (inQ t) cmd - writeOutQ = atomically . writeTBQueue (outQ t) - -sendToChatTerm :: ChatClient -> ChatTerminal -> IO () -sendToChatTerm ChatClient {outQ} ChatTerminal {outputQ} = forever $ do - atomically (readTBQueue outQ) >>= \case - NoChatResponse -> return () - resp -> atomically . writeTBQueue outputQ $ serializeChatResponse resp - -sendToAgent :: ChatClient -> ChatTerminal -> AgentClient -> IO () -sendToAgent ChatClient {inQ, smpServer} ct AgentClient {rcvQ} = do - atomically $ writeTBQueue rcvQ ("1", "", SUBALL) -- hack for subscribing to all - forever . atomically $ do - cmd <- readTBQueue inQ - writeTBQueue rcvQ `mapM_` agentTransmission cmd - setActiveContact cmd - where - setActiveContact :: ChatCommand -> STM () - setActiveContact = \case - SendMessage a _ -> setActive ct a - DeleteConnection a -> unsetActive ct a - _ -> pure () - agentTransmission :: ChatCommand -> Maybe (ATransmission 'Client) - agentTransmission = \case - AddConnection a -> transmission a $ NEW smpServer - Connect a qInfo -> transmission a $ JOIN qInfo $ ReplyVia smpServer - DeleteConnection a -> transmission a DEL - SendMessage a msg -> transmission a $ SEND msg - ChatHelp -> Nothing - MarkdownHelp -> Nothing - transmission :: Contact -> ACommand 'Client -> Maybe (ATransmission 'Client) - transmission (Contact a) cmd = Just ("1", a, cmd) - -receiveFromAgent :: ChatClient -> ChatTerminal -> AgentClient -> IO () -receiveFromAgent t ct c = forever . atomically $ do - resp <- chatResponse <$> readTBQueue (sndQ c) - writeTBQueue (outQ t) resp - setActiveContact resp - where - chatResponse :: ATransmission 'Agent -> ChatResponse - chatResponse (_, a, resp) = case resp of - INV qInfo -> Invitation qInfo - CON -> Connected contact - END -> Disconnected contact - MSG {msgBody} -> ReceivedMessage contact msgBody - SENT _ -> NoChatResponse - OK -> Confirmation contact - ERR (CONN e) -> ContactError e contact - ERR e -> ChatError e - where - contact = Contact a - setActiveContact :: ChatResponse -> STM () - setActiveContact = \case - Connected a -> setActive ct a - ReceivedMessage a _ -> setActive ct a - Disconnected a -> unsetActive ct a - _ -> pure () - -setActive :: ChatTerminal -> Contact -> STM () -setActive ct = writeTVar (activeContact ct) . Just - -unsetActive :: ChatTerminal -> Contact -> STM () -unsetActive ct a = modifyTVar (activeContact ct) unset - where - unset a' = if Just a == a' then Nothing else a' diff --git a/apps/dog-food/Styled.hs b/apps/dog-food/Styled.hs deleted file mode 100644 index 87f28a7..0000000 --- a/apps/dog-food/Styled.hs +++ /dev/null @@ -1,60 +0,0 @@ -module Styled - ( StyledString (..), - bPlain, - plain, - styleMarkdown, - styleMarkdownText, - sLength, - ) -where - -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as B -import Data.String -import Data.Text (Text) -import qualified Data.Text as T -import Simplex.Markdown -import System.Console.ANSI.Types - -data StyledString = Styled [SGR] String | StyledString :<>: StyledString - -instance Semigroup StyledString where (<>) = (:<>:) - -instance Monoid StyledString where mempty = plain "" - -instance IsString StyledString where fromString = plain - -plain :: String -> StyledString -plain = Styled [] - -bPlain :: ByteString -> StyledString -bPlain = Styled [] . B.unpack - -styleMarkdownText :: Text -> StyledString -styleMarkdownText = styleMarkdown . parseMarkdown - -styleMarkdown :: Markdown -> StyledString -styleMarkdown (s1 :|: s2) = styleMarkdown s1 <> styleMarkdown s2 -styleMarkdown (Markdown Snippet s) = '`' `wrap` styled Snippet s -styleMarkdown (Markdown Secret s) = '#' `wrap` styled Secret s -styleMarkdown (Markdown f s) = styled f s - -wrap :: Char -> StyledString -> StyledString -wrap c s = plain [c] <> s <> plain [c] - -styled :: Format -> Text -> StyledString -styled f = Styled sgr . T.unpack - where - sgr = case f of - Bold -> [SetConsoleIntensity BoldIntensity] - Italic -> [SetUnderlining SingleUnderline, SetItalicized True] - Underline -> [SetUnderlining SingleUnderline] - StrikeThrough -> [SetSwapForegroundBackground True] - Colored c -> [SetColor Foreground Vivid c] - Secret -> [SetColor Foreground Dull Black, SetColor Background Dull Black] - Snippet -> [] - NoFormat -> [] - -sLength :: StyledString -> Int -sLength (Styled _ s) = length s -sLength (s1 :<>: s2) = sLength s1 + sLength s2 diff --git a/apps/dog-food/Types.hs b/apps/dog-food/Types.hs deleted file mode 100644 index 016073c..0000000 --- a/apps/dog-food/Types.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -module Types where - -import Data.ByteString.Char8 (ByteString) - -newtype Contact = Contact {toBs :: ByteString} deriving (Eq) - -data TermMode = TermModeBasic | TermModeEditor deriving (Eq) - -termModeName :: TermMode -> String -termModeName = \case - TermModeBasic -> "basic" - TermModeEditor -> "editor" diff --git a/design/agent2.gv b/design/agent2.gv index bf3f577..a93a1fc 100644 --- a/design/agent2.gv +++ b/design/agent2.gv @@ -8,7 +8,7 @@ digraph SMPAgent { subgraph clusterPersistence { graph [fontsize=11 color=gray] - label="persistence (sqlite)\nQ: can multiple threads use it" + label="persistence (sqlite)" connectionsStore [shape=cylinder label="duplex connections,\nSMP queues,\nrecent messages"] } diff --git a/design/agent2.svg b/design/agent2.svg new file mode 100644 index 0000000..b4f2a0c --- /dev/null +++ b/design/agent2.svg @@ -0,0 +1,394 @@ + + + + + + +SMPAgent + + +clusterPersistence + +persistence (sqlite) + + +clusterAgent + +agent threads + + +clusterUserTCP + +1 group per user TCP connection + + +clusterUserTCPThreads + +user TCP threads + + +clusterUser + +1 group per user TCP connection + + +clusterUserInterface + +user queues + + +clusterUserThreads + +user threads +Note: `user agent` sends +all commands to `commands TBQueue`s +(invalid commands with attached responses), +and only valid commands to `server TBQueue`. +It is used to respond in correct order. + + +clusterClient + +1 group per SMP client/server connection + + +clusterServerThreads + +SMP client threads + + + +main + +main +thread + + + +connectClnt + +connectClnt + + + +main->connectClnt + + +race + + + +runClnt + +runClnt + + + +main->runClnt + + +race + + + +aSock + +user agent TCP socket + + + +aSock->connectClnt + + + + + +connectionsStore + + +duplex connections, +SMP queues, +recent messages + + + +uSock + +user connection TCP socket + + + +connectClnt->uSock + + +connect + + + +uRcv + +user +receive + + + +connectClnt->uRcv + + +race + + + +uSnd + +user +send + + + +connectClnt->uSnd + + +race + + + +uAgent + +user +agent + + + +runClnt->uAgent + + +race + + + +uProcess + +process +responses + + + +runClnt->uProcess + + +race + + + +uSock->uRcv + + + + + +uInq + +user +receive +TBQueue + + + +uRcv->uInq + + + + + +uOutq + +user +send +TBQueue + + + +uRcv->uOutq + + + + + +uSnd->uSock + + + + + +uInq->uAgent + + + + + +uOutq->uSnd + + + + + +uAgent->connectionsStore + + + + + + +uAgent->uOutq + + + + + +runClient + +runClient + + + +uAgent->runClient + + +fork + + + +sOutq + +srv send +TBQueue + + + +uAgent->sOutq + + + + + +userState + +connected +servers, +subscribed +queues, +sent +commands +(STM) + + + +uAgent->userState + + + + + + +uProcess->connectionsStore + + + + + + +uProcess->uOutq + + + + + +uProcess->sOutq + + + + + +uProcess->userState + + + + + + +uRespq + +user +SMP +TBQueue + + + +uRespq->uProcess + + + + + +sAgent + +server +receive + + + +runClient->sAgent + + +race + + + +sSnd + +server +send + + + +runClient->sSnd + + +race + + + +sOutq->sSnd + + + + + +sSock + +SMP client connection TCP socket + + + +sSock->sAgent + + + + + +sAgent->uRespq + + + + + +sSnd->sSock + + + + + diff --git a/package.yaml b/package.yaml index 99d3db3..00fdfb0 100644 --- a/package.yaml +++ b/package.yaml @@ -65,17 +65,6 @@ executables: ghc-options: - -threaded - dog-food: - source-dirs: apps/dog-food - main: Main.hs - dependencies: - - ansi-terminal == 0.10.* - - optparse-applicative == 0.15.* - - simplexmq - - terminal == 0.2.* - ghc-options: - - -threaded - tests: smp-server-test: source-dirs: tests diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index db0ec7e..1feb14d 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -74,7 +74,7 @@ Creating and using the queue requires sending commands to the SMP server from th The out-of-band message with the queue information is sent via some trusted alternative channel from the recipient to the sender. This message is used to share the encryption (a.k.a. "public") key that the sender will use to encrypt the messages (to be decrypted by the recipient), sender queue ID, server hostname and any other information necessary to establish secure encrypted connection with SMP server (see [Appendix A](#appendix-a) for SMP transport protocol). -The [ABNF][8] syntax of the message is: +The [ABNF][8] syntax of the message is: ```abnf outOfBandMsg = "smp::" server "::" queueId "::" encryptionKey diff --git a/rfcs/2021-02-28-streams.md b/rfcs/2021-02-28-streams.md index a2211fb..838f174 100644 --- a/rfcs/2021-02-28-streams.md +++ b/rfcs/2021-02-28-streams.md @@ -6,15 +6,15 @@ Managing dedicated SMP queues for fast synchronous communication SMP agent protocol implementation provides the most secure way to distribute keys achieving the following qualities: -- compromising the sender agent/device allows to send messages, but not to read them -- compromising the recipient agent/device allows to receive messages, but not to send them (neither public encryption key is stored - TBC if public key can be restored from the private - nor server authentication key is available) -- compromising the server does not expose any information about messages content, as encrypted section has the same size +- compromising the sender agent/device allows to send messages, but not to read them. +- compromising the recipient agent/device allows to receive messages, but not to send them (neither public encryption key is stored - TBC if public key can be restored from the private - nor server authentication key is available). +- compromising the server does not expose any information about messages content, as encrypted section has the same size. The current hybrid encryption scheme uses a new symmetric key for each message, and because the symmetric key is not persisted at any point, it is difficult to obtain it and send counterfeit messages on behalf of the sender (even in case both the server and recipient are compromised). There are 2 downsides of the current scheme: -1. RSA encryption/decryption is relatively slow even for 2048 key size and gets much slower for larger key sizes. It is not a problem for the chat messages (and any content updates) that happen infrequently but it makes the transmission of large files and any other streaming communication slow. +1. RSA encryption/decryption is relatively slow even for 2048 key size and gets much slower for larger key sizes. It is not a problem for the chat messages (and any content updates) that happen infrequently, but it makes the transmission of large files and any other streaming communication slow. 2. If the large file or voice/video calls were to be sent via the same queue as normal messages/content updates, the server and any passive observer would be able to understand when such transmissions happen (even if performance was not a problem). diff --git a/stack.yaml b/stack.yaml index 4dd8b8b..5cc76cc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -39,7 +39,6 @@ extra-deps: - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - 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 # - network-run-0.2.4@sha256:7dbb06def522dab413bce4a46af476820bffdff2071974736b06f52f4ab57c96,885 # - git: https://github.com/commercialhaskell/stack.git # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a