transport encryption (#65)

* transport encryption (WIP - using fixed key, parsing/serialization works, SMP tests fail)

* transport encryption

* transport encryption: separate keys to receive and to send, counter-based IVs

* docs: update transport encryption and handshake

* transport encryption handshake (TODO: validate key hash, welcome block, move keys to system environment)

* change KeyHash type to newtype of Digest SHA256

* transport encryption: validate public key hash

* send and receive welcome block with SMP version

* refactor: parsing SMPServer

* remove unused function

* verify that client version is compatible with server version (major version is not smaller)

* update (fix) SMP server tests

apps/dog-food/ChatOptions.hs

@@ -2,10 +2,10 @@
 
 module ChatOptions (getChatOpts, ChatOpts (..)) where
 
-import qualified Data.Attoparsec.ByteString.Char8 as A
 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 System.Info (os)
 import Types
@@ -58,7 +58,7 @@ chatOpts appDir =
       | otherwise = TermModeEditor
 
 parseSMPServer :: ReadM SMPServer
-parseSMPServer = eitherReader $ A.parseOnly (smpServerP <* A.endOfInput) . B.pack
+parseSMPServer = eitherReader $ parseAll smpServerP . B.pack
 
 parseTermMode :: ReadM TermMode
 parseTermMode = maybeReader $ \case

apps/dog-food/Main.hs

@@ -26,6 +26,7 @@ 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 (bshow, raceAny_)
 import System.Directory (getAppUserDataDirectory)
 import System.Exit (exitFailure)
@@ -124,7 +125,7 @@ main = do
   t <- getChatClient smpServer user
   ct <- newChatTerminal (tbqSize cfg) user termMode
   -- setLogLevel LogInfo -- LogError
-  -- withGlobalLogging logCfg $
+  -- withGlobalLogging logCfg $ do
   env <- newSMPAgentEnv cfg {dbFile = dbFileName}
   dogFoodChat t ct env
 
@@ -172,7 +173,7 @@ newChatClient qSize smpServer name = do
 receiveFromChatTerm :: ChatClient -> ChatTerminal -> IO ()
 receiveFromChatTerm t ct = forever $ do
   atomically (readTBQueue $ inputQ ct)
-    >>= processOrError . A.parseOnly (chatCommandP <* A.endOfInput)
+    >>= processOrError . parseAll chatCommandP
   where
     processOrError = \case
       Left err -> atomically . writeTBQueue (outQ t) . ErrorInput $ B.pack err

rfcs/2021-01-26-crypto.md

@@ -16,49 +16,46 @@ For initial implementation I propose approach to be as simple as possible as lon
 
 One of the consideration is to use [noise protocol framework](https://noiseprotocol.org/noise.html), this section describes ad hoc protocol though.
 
-During TCP session both client and server should use symmetric AES 256 bit encryption using the session key that will be established during the handshake.
+During TCP session both client and server should use symmetric AES 256 bit encryption using two session keys and two base IVs that will be agreed during the handshake. Both client and the server should maintain two 32-bit word counters, one for sent and one for the received messages. The IV for each message should be computed by xor-ing the sequential message counter, starting from 0, with the first 32 bits of agreed base IV. TODO - explain it in a more formal way, also document how 32-bit word is encoded - with the most or least significant byte first (currently encodeWord32 from Network.Transport.Internal is used)
 
-To establish the session key, the server should have an asymmetric key pair generated during server deployment and unknown to the clients. The users should know the key hash (256 bits) and additional server ID (256 bits) in advance in order to be able to establish connection.
+To establish the session keys and base IVs, the server should have an asymmetric key pair generated during server deployment and unknown to the clients. The users should know the key hash (256 bits) in advance in order to be able to establish connection.
 
-The handshake sequence could be the following:
+The handshake sequence is the following:
 
-1. Once the connection is established, the server sends its public key to the client
-2. The client compares the hash of the received key with the hash it already has (e.g. received as part of connection invitation or server in NEW command). If the hash does not match, the client must terminate the connection.
-3. If the hash is the same, the client should generate a random symmetric AES key and IV that will be used as a session key both by the client and the server.
-4. The client then should encrypt this symmetric key with the public key that the server sent and send back to the server the result and the server ID also shared with the client in advance: `rsa-encrypt(aes-key, iv, server-id)`.
-5. The server should decrypt the received key, IV and server id with its private key.
-6. The server should compare the `server-id` sent by the client and if it does not match its ID terminate the connection.
-7. In case of successful decryption and matching server ID, the server should send encrypted welcome header.
+1. Once the connection is established, the server sends its public 2048 bit key to the client. TODO currently the key will be sent as a line terminated with CRLF, using ad-hoc key serialization we use.
+2. The client compares the hash of the received key with the hash it already has (e.g. received as part of connection invitation or server in NEW command). If the hash does not match, the client must terminate the connection. TODO as the hash is optional in server syntax at the moment, hash comparison will be optional as well. Probably it should become required.
+3. If the hash is the same, the client should generate random symmetric AES keys and base IVs that will be used as session keys/IVs by the client and the server.
+4. The client then should encrypt these symmetric keys and base IVs with the public key that the server sent, and send to the server the result of the encryption: `rsa-encrypt(snd-aes-key, snd-base-iv, rcv-aes-key, rcv-base-iv)`. `snd-aes-key` and `snd-base-iv` will be used by the client to encrypt **sent** messages and by the server to decrypt them, `rcv-aes-key` and `rcv-base-iv` will be used by the client to decrypt **received** messages and by the server to encrypt them.
+5. The server should decrypt the received keys and base IVs with its private key.
+6. In case of successful decryption, the server should send encrypted welcome block (encrypted_welcome_block) that contains SMP protocol version.
 
-```abnf
-aes_welcome_header = aes_header_auth_tag aes_encrypted_header
-welcome_header = smp_version ["," smp_mode] *SP ; decrypt(aes_encrypted_header) - 32 bytes
-smp_version = %s"v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ["-" 1*ALPHA "." 1*DIGIT] ; in semver format
-  ; for example: v123.456.789-alpha.7
-smp_mode = smp_public / smp_authenticated
-smp_public = %s"pub" ; public (default) - no auth to create and manage queues
-smp_authenticated = %s"auth" ; server authentication with AUTH command (TBD) is required to create and manage queues
-aes_header_auth_tag = aes_auth_tag
-aes_auth_tag = 16*16(OCTET)
-```
-
-No payload should follow this header, it is only used to confirm successful handshake and send the SMP protocol version that the server supports.
-
-All the subsequent data both from the client and from the server should be sent encrypted using symmetric AES key and IV sent by the client during the handshake.
+All the subsequent data both from the client and from the server should be sent encrypted using symmetric AES keys and base IVs (incremented by counters on both sides) sent by the client during the handshake.
 
 Each transport block sent by the client and the server has this syntax:
 
 ```abnf
-transport_block = aes_header_auth_tag aes_encrypted_header aes_body_auth_tag aes_encrypted_body
-aes_encrypted_header = 32*32(OCTET)
-header = padded_body_size payload_size reserved ; decrypt(aes_encrypted_header) - 32 bytes
+transport_block = aes_body_auth_tag aes_encrypted_body ; fixed at 8192 bits
 aes_encrypted_body = 1*OCTET
-body = payload pad
-padded_body_size = size ; body size in bytes
-payload_size = size ; payload_size in bytes
-size = 4*4(OCTET)
-reserved = 24*24(OCTET)
-aes_body_auth_tag = aes_auth_tag
+aes_body_auth_tag = 16*16(OCTET)
+
+encrypted_welcome_block = transport_block
+welcome_block = smp_version SP pad ; decrypt(encrypted_welcome_block)
+smp_version = %s"v" 1*DIGIT "." 1*DIGIT "." 1*DIGIT ["-" 1*ALPHA "." 1*DIGIT] ; in semver format
+  ; for example: v123.456.789-alpha.7
+pad = 1*OCTET
+```
+
+## Possible future improvements/changes
+
+- server id (256 bits), so that only the users that have it can connect to the server. This ID will have to be passed to the server during the handshake
+- block size agreed during handshake
+- transport encryption protocol agreed during handshake
+- welcome block containing SMP mode (smp_mode)
+
+```abnf
+smp_mode = smp_public / smp_authenticated
+smp_public = %s"pub" ; public (default) - no auth to create and manage queues
+smp_authenticated = %s"auth" ; server authentication with AUTH command (TBD) is required to create and manage queues
 ```
 
 ## Initial handshake

rfcs/2021-03-18-groups.md

@@ -0,0 +1,25 @@
+# SMP agent groups
+
+## Problems
+
+- device/user profile synchronisation
+- chat group communication
+
+Both problems would require message broadcast between a group of SMP agents.
+
+## Solution: basic symmetric groups via SMP agent protocol
+
+Additional commands and message envelopes to SMP agent protocol to provide an abstraction layer for device synchronisation and chat groups.
+
+The groups are fully symmetric, all agent who are members of the group have equal rights and can join and leave group at any time.
+
+All the information about the groups is stored only in agents, the commands are used to synchronise the group state between the agents.
+
+```abnf
+group_command = create_group / add_to_group / remove_from_group / leave_group
+group_response = group_created / added_to_group / removed_from_group
+group_notification = added_to_group_by / removed_from_group_by / left_group
+create_group = %s"GNEW " group_name ; cAlias must be empty
+add_to_group = %s"GADD " group_name ; cAlias is the connection to add to the group
+added_to_group = %s"GADDED " name ; cAlias is the connection added to the group
+```

src/Simplex/Messaging/Agent.hs

@@ -35,7 +35,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (CorrId (..), MsgBody, SenderPublicKey)
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (putLn, runTCPServer)
-import Simplex.Messaging.Util (liftError)
+import Simplex.Messaging.Util (bshow, liftError)
 import System.IO (Handle)
 import UnliftIO.Async (race_)
 import UnliftIO.Exception (SomeException)
@@ -94,7 +94,7 @@ send h c@AgentClient {sndQ} = forever $ do
 
 logClient :: MonadUnliftIO m => AgentClient -> ByteString -> ATransmission a -> m ()
 logClient AgentClient {clientId} dir (CorrId corrId, cAlias, cmd) = do
-  logInfo . decodeUtf8 $ B.unwords [B.pack $ show clientId, dir, "A :", corrId, cAlias, B.takeWhile (/= ' ') $ serializeCommand cmd]
+  logInfo . decodeUtf8 $ B.unwords [bshow clientId, dir, "A :", corrId, cAlias, B.takeWhile (/= ' ') $ serializeCommand cmd]
 
 client :: (MonadUnliftIO m, MonadReader Env m) => AgentClient -> SQLiteStore -> m ()
 client c@AgentClient {rcvQ, sndQ} st = forever $ do
@@ -278,7 +278,7 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do
       removeSubscription c connAlias
       logServer "<--" c srv rId "END"
       notify connAlias END
-    _ -> logServer "<--" c srv rId $ "unexpected:" <> (B.pack . show) cmd
+    _ -> logServer "<--" c srv rId $ "unexpected:" <> bshow cmd
   where
     notify :: ConnAlias -> ACommand 'Agent -> m ()
     notify connAlias msg = atomically $ writeTBQueue sndQ ("", connAlias, msg)

src/Simplex/Messaging/Agent/Client.hs

@@ -47,7 +47,7 @@ import Simplex.Messaging.Agent.Transmission
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgBody, QueueId, SenderPublicKey)
-import Simplex.Messaging.Util (liftError)
+import Simplex.Messaging.Util (bshow, liftError)
 import UnliftIO.Concurrent
 import UnliftIO.Exception (IOException)
 import qualified UnliftIO.Exception as E
@@ -133,7 +133,7 @@ withSMP c srv action =
 
     logServerError :: AgentErrorType -> m a
     logServerError e = do
-      logServer "<--" c srv "" $ (B.pack . show) e
+      logServer "<--" c srv "" $ bshow e
       throwError e
 
 withLogSMP :: AgentMonad m => AgentClient -> SMPServer -> QueueId -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> m a
@@ -196,7 +196,7 @@ removeSubscription AgentClient {subscrConns, subscrSrvrs} connAlias = atomically
 
 logServer :: AgentMonad m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
 logServer dir AgentClient {clientId} srv qId cmdStr =
-  logInfo . decodeUtf8 $ B.unwords ["A", "(" <> (B.pack . show) clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
+  logInfo . decodeUtf8 $ B.unwords ["A", "(" <> bshow clientId <> ")", dir, showServer srv, ":", logSecret qId, cmdStr]
 
 showServer :: SMPServer -> ByteString
 showServer srv = B.pack $ host srv <> maybe "" (":" <>) (port srv)

src/Simplex/Messaging/Agent/Transmission.hs

@@ -152,7 +152,7 @@ serializeSMPMessage = \case
      in smpMessage "" header body
   where
     messageHeader msgId ts prevMsgHash =
-      B.unwords [B.pack $ show msgId, B.pack $ formatISO8601Millis ts, encode prevMsgHash]
+      B.unwords [bshow msgId, B.pack $ formatISO8601Millis ts, encode prevMsgHash]
     smpMessage smpHeader aHeader aBody = B.intercalate "\n" [smpHeader, aHeader, aBody, ""]
 
 agentMessageP :: Parser AMessage
@@ -173,11 +173,17 @@ smpQueueInfoP =
   "smp::" *> (SMPQueueInfo <$> smpServerP <* "::" <*> base64P <* "::" <*> C.pubKeyP)
 
 smpServerP :: Parser SMPServer
-smpServerP = SMPServer <$> server <*> port <*> msgHash
+smpServerP = SMPServer <$> server <*> port <*> kHash
   where
     server = B.unpack <$> A.takeTill (A.inClass ":# ")
-    port = A.char ':' *> (Just . show <$> (A.decimal :: Parser Int)) <|> pure Nothing
-    msgHash = A.char '#' *> (Just <$> base64P) <|> pure Nothing
+    port = fromChar ':' $ show <$> (A.decimal :: Parser Int)
+    kHash = fromChar '#' C.keyHashP
+    fromChar :: Char -> Parser a -> Parser (Maybe a)
+    fromChar ch parser = do
+      c <- A.peekChar
+      if c == Just ch
+        then A.char ch *> (Just <$> parser)
+        else pure Nothing
 
 parseAgentMessage :: ByteString -> Either AgentErrorType AMessage
 parseAgentMessage = parse agentMessageP $ SYNTAX errBadMessage
@@ -194,17 +200,15 @@ serializeSmpQueueInfo (SMPQueueInfo srv qId ek) =
 
 serializeServer :: SMPServer -> ByteString
 serializeServer SMPServer {host, port, keyHash} =
-  B.pack $ host <> maybe "" (':' :) port <> maybe "" (('#' :) . B.unpack) keyHash
+  B.pack $ host <> maybe "" (':' :) port <> maybe "" (('#' :) . B.unpack . C.serializeKeyHash) keyHash
 
 data SMPServer = SMPServer
   { host :: HostName,
     port :: Maybe ServiceName,
-    keyHash :: Maybe KeyHash
+    keyHash :: Maybe C.KeyHash
   }
   deriving (Eq, Ord, Show)
 
-type KeyHash = Encoded
-
 type ConnAlias = ByteString
 
 type OtherPartyId = Encoded
@@ -354,7 +358,7 @@ serializeCommand = \case
   OFF -> "OFF"
   DEL -> "DEL"
   CON -> "CON"
-  ERR e -> "ERR " <> B.pack (show e)
+  ERR e -> "ERR " <> bshow e
   OK -> "OK"
   where
     replyMode :: ReplyMode -> ByteString
@@ -370,13 +374,13 @@ serializeCommand = \case
       MsgError e ->
         "ERR" <> case e of
           MsgSkipped fromMsgId toMsgId ->
-            B.unwords ["NO_ID", B.pack $ show fromMsgId, B.pack $ show toMsgId]
-          MsgBadId aMsgId -> "ID " <> B.pack (show aMsgId)
+            B.unwords ["NO_ID", bshow fromMsgId, bshow toMsgId]
+          MsgBadId aMsgId -> "ID " <> bshow aMsgId
           MsgBadHash -> "HASH"
 
 -- TODO - save function as in the server Transmission - re-use?
 serializeMsg :: ByteString -> ByteString
-serializeMsg body = B.pack (show $ B.length body) <> "\n" <> body
+serializeMsg body = bshow (B.length body) <> "\n" <> body
 
 tPutRaw :: Handle -> ARawTransmission -> IO ()
 tPutRaw h (corrId, connAlias, command) = do

src/Simplex/Messaging/Client.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -35,7 +36,6 @@ import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except
 import qualified Crypto.PubKey.RSA.Types as RSA
 import Data.ByteString.Char8 (ByteString)
-import qualified Data.ByteString.Char8 as B
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -46,7 +46,7 @@ import Simplex.Messaging.Agent.Transmission (SMPServer (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
-import Simplex.Messaging.Util (liftEitherError, raceAny_)
+import Simplex.Messaging.Util (bshow, liftEitherError, raceAny_)
 import System.IO
 import System.IO.Error
 import System.Timeout
@@ -91,7 +91,7 @@ data Request = Request
 
 getSMPClient :: SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO SMPClient
 getSMPClient
-  smpServer@SMPServer {host, port}
+  smpServer@SMPServer {host, port, keyHash}
   SMPClientConfig {qSize, defaultPort, tcpTimeout, smpPing}
   msgQ
   disconnected = do
@@ -103,7 +103,7 @@ getSMPClient
           `finally` atomically (putTMVar started False)
     tcpTimeout `timeout` atomically (takeTMVar started) >>= \case
       Just True -> return c {action}
-      _ -> throwIO err
+      _ -> throwIO err -- TODO report handshake error too, not only connection timeout
     where
       err :: IOException
       err = mkIOError TimeExpired "connection timeout" Nothing Nothing
@@ -128,18 +128,24 @@ getSMPClient
             }
 
       client :: SMPClient -> TMVar Bool -> Handle -> IO ()
-      client c started h = do
-        _ <- getLn h -- "Welcome to SMP"
+      client c started h =
+        runExceptT (clientHandshake h keyHash) >>= \case
+          Right th -> clientTransport c started th
+          -- TODO report error instead of True/False
+          Left _ -> atomically $ putTMVar started False
+
+      clientTransport :: SMPClient -> TMVar Bool -> THandle -> IO ()
+      clientTransport c started th = do
         atomically $ do
-          modifyTVar (connected c) (const True)
+          writeTVar (connected c) True
           putTMVar started True
-        raceAny_ [send c h, process c, receive c h, ping c]
+        raceAny_ [send c th, process c, receive c th, ping c]
           `finally` disconnected
 
-      send :: SMPClient -> Handle -> IO ()
+      send :: SMPClient -> THandle -> IO ()
       send SMPClient {sndQ} h = forever $ atomically (readTBQueue sndQ) >>= tPut h
 
-      receive :: SMPClient -> Handle -> IO ()
+      receive :: SMPClient -> THandle -> IO ()
       receive SMPClient {rcvQ} h = forever $ tGet fromServer h >>= atomically . writeTBQueue rcvQ
 
       ping :: SMPClient -> IO ()
@@ -241,7 +247,7 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId} pKey qId cmd = do
     getNextCorrId = do
       i <- (+ 1) <$> readTVar clientCorrId
       writeTVar clientCorrId i
-      return . CorrId . B.pack $ show i
+      return . CorrId $ bshow i
 
     signTransmission :: ByteString -> ExceptT SMPClientError IO SignedRawTransmission
     signTransmission t = case pKey of

src/Simplex/Messaging/Crypto.hs

@@ -10,17 +10,33 @@ module Simplex.Messaging.Crypto
     PublicKey (..),
     Signature (..),
     CryptoError (..),
+    KeyPair,
+    Key (..),
+    IV (..),
+    KeyHash (..),
     generateKeyPair,
+    publicKeySize,
     sign,
     verify,
     encrypt,
     decrypt,
+    encryptOAEP,
+    decryptOAEP,
+    encryptAES,
+    decryptAES,
     serializePrivKey,
     serializePubKey,
-    parsePrivKey,
-    parsePubKey,
+    serializeKeyHash,
     privKeyP,
     pubKeyP,
+    keyHashP,
+    authTagSize,
+    authTagToBS,
+    bsToAuthTag,
+    randomAesKey,
+    randomIV,
+    aesKeyP,
+    ivP,
   )
 where
 
@@ -30,7 +46,7 @@ import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)
 import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Error as CE
-import Crypto.Hash.Algorithms (SHA256 (..))
+import Crypto.Hash (Digest, SHA256 (..), digestFromByteString)
 import Crypto.Number.Generate (generateMax)
 import Crypto.Number.Prime (findPrimeFrom)
 import Crypto.Number.Serialize (i2osp, os2ip)
@@ -53,7 +69,7 @@ import Database.SQLite.Simple.Internal (Field (..))
 import Database.SQLite.Simple.Ok (Ok (Ok))
 import Database.SQLite.Simple.ToField (ToField (..))
 import Network.Transport.Internal (decodeWord32, encodeWord32)
-import Simplex.Messaging.Parsers (base64P)
+import Simplex.Messaging.Parsers (base64P, parseAll)
 import Simplex.Messaging.Util (bshow, liftEitherError, (<$$>))
 
 newtype PublicKey = PublicKey {rsaPublicKey :: R.PublicKey} deriving (Eq, Show)
@@ -71,14 +87,14 @@ instance ToField PublicKey where toField = toField . serializePubKey
 
 instance FromField PrivateKey where
   fromField f@(Field (SQLBlob b) _) =
-    case parsePrivKey b of
+    case parseAll privKeyP b of
       Right k -> Ok k
       Left e -> returnError ConversionFailed f ("couldn't parse PrivateKey field: " ++ e)
   fromField f = returnError ConversionFailed f "expecting SQLBlob column type"
 
 instance FromField PublicKey where
   fromField f@(Field (SQLBlob b) _) =
-    case parsePubKey b of
+    case parseAll pubKeyP b of
       Right k -> Ok k
       Left e -> returnError ConversionFailed f ("couldn't parse PublicKey field: " ++ e)
   fromField f = returnError ConversionFailed f "expecting SQLBlob column type"
@@ -124,6 +140,9 @@ generateKeyPair size = loop
             then loop
             else return (PublicKey pub, privateKey s n d)
 
+publicKeySize :: PublicKey -> Int
+publicKeySize = R.public_size . rsaPublicKey
+
 data Header = Header
   { aesKey :: Key,
     ivBytes :: IV,
@@ -135,52 +154,83 @@ newtype Key = Key {unKey :: ByteString}
 
 newtype IV = IV {unIV :: ByteString}
 
+newtype KeyHash = KeyHash {unKeyHash :: Digest SHA256} deriving (Eq, Ord, Show)
+
+instance IsString KeyHash where
+  fromString = either error id . parseAll keyHashP . fromString
+
+instance ToField KeyHash where toField = toField . serializeKeyHash
+
+instance FromField KeyHash where
+  fromField f@(Field (SQLBlob b) _) =
+    case parseAll keyHashP b of
+      Right k -> Ok k
+      Left e -> returnError ConversionFailed f ("couldn't parse KeyHash field: " ++ e)
+  fromField f = returnError ConversionFailed f "expecting SQLBlob column type"
+
+serializeKeyHash :: KeyHash -> ByteString
+serializeKeyHash = encode . BA.convert . unKeyHash
+
+keyHashP :: Parser KeyHash
+keyHashP = do
+  bs <- base64P
+  case digestFromByteString bs of
+    Just d -> pure $ KeyHash d
+    _ -> fail "invalid digest"
+
 serializeHeader :: Header -> ByteString
 serializeHeader Header {aesKey, ivBytes, authTag, msgSize} =
   unKey aesKey <> unIV ivBytes <> authTagToBS authTag <> (encodeWord32 . fromIntegral) msgSize
 
 headerP :: Parser Header
 headerP = do
-  aesKey <- Key <$> A.take aesKeySize
-  ivBytes <- IV <$> A.take (ivSize @AES256)
+  aesKey <- aesKeyP
+  ivBytes <- ivP
   authTag <- bsToAuthTag <$> A.take authTagSize
   msgSize <- fromIntegral . decodeWord32 <$> A.take 4
   return Header {aesKey, ivBytes, authTag, msgSize}
 
+aesKeyP :: Parser Key
+aesKeyP = Key <$> A.take aesKeySize
+
+ivP :: Parser IV
+ivP = IV <$> A.take (ivSize @AES256)
+
 parseHeader :: ByteString -> Either CryptoError Header
-parseHeader = first CryptoHeaderError . A.parseOnly (headerP <* A.endOfInput)
+parseHeader = first CryptoHeaderError . parseAll headerP
 
 encrypt :: PublicKey -> Int -> ByteString -> ExceptT CryptoError IO ByteString
 encrypt k paddedSize msg = do
-  aesKey <- Key <$> randomBytes aesKeySize
-  ivBytes <- IV <$> randomBytes (ivSize @AES256)
+  aesKey <- liftIO randomAesKey
+  ivBytes <- liftIO randomIV
+  (authTag, msg') <- encryptAES aesKey ivBytes paddedSize msg
+  let header = Header {aesKey, ivBytes, authTag, msgSize = B.length msg}
+  encHeader <- encryptOAEP k $ serializeHeader header
+  return $ encHeader <> msg'
+
+decrypt :: PrivateKey -> ByteString -> ExceptT CryptoError IO ByteString
+decrypt pk msg'' = do
+  let (encHeader, msg') = B.splitAt (private_size pk) msg''
+  header <- decryptOAEP pk encHeader
+  Header {aesKey, ivBytes, authTag, msgSize} <- except $ parseHeader header
+  msg <- decryptAES aesKey ivBytes msg' authTag
+  return $ B.take msgSize msg
+
+encryptAES :: Key -> IV -> Int -> ByteString -> ExceptT CryptoError IO (AES.AuthTag, ByteString)
+encryptAES aesKey ivBytes paddedSize msg = do
   aead <- initAEAD @AES256 aesKey ivBytes
   msg' <- paddedMsg
-  let (authTag, msg'') = encryptAES aead msg'
-      header = Header {aesKey, ivBytes, authTag, msgSize = B.length msg}
-  encHeader <- encryptOAEP k $ serializeHeader header
-  return $ encHeader <> msg''
+  return $ AES.aeadSimpleEncrypt aead B.empty msg' authTagSize
   where
     len = B.length msg
     paddedMsg
       | len >= paddedSize = throwE CryptoLargeMsgError
       | otherwise = return (msg <> B.replicate (paddedSize - len) '#')
 
-decrypt :: PrivateKey -> ByteString -> ExceptT CryptoError IO ByteString
-decrypt pk msg'' = do
-  let (encHeader, msg') = B.splitAt (private_size pk) msg''
-  header <- decryptOAEP pk encHeader
-  Header {aesKey, ivBytes, authTag, msgSize} <- ExceptT . return $ parseHeader header
+decryptAES :: Key -> IV -> ByteString -> AES.AuthTag -> ExceptT CryptoError IO ByteString
+decryptAES aesKey ivBytes msg authTag = do
   aead <- initAEAD @AES256 aesKey ivBytes
-  msg <- decryptAES aead msg' authTag
-  return $ B.take msgSize msg
-
-encryptAES :: AES.AEAD AES256 -> ByteString -> (AES.AuthTag, ByteString)
-encryptAES aead plaintext = AES.aeadSimpleEncrypt aead B.empty plaintext authTagSize
-
-decryptAES :: AES.AEAD AES256 -> ByteString -> AES.AuthTag -> ExceptT CryptoError IO ByteString
-decryptAES aead ciphertext authTag =
-  maybeError CryptoDecryptError $ AES.aeadSimpleDecrypt aead B.empty ciphertext authTag
+  maybeError CryptoDecryptError $ AES.aeadSimpleDecrypt aead B.empty msg authTag
 
 initAEAD :: forall c. AES.BlockCipher c => Key -> IV -> ExceptT CryptoError IO (AES.AEAD c)
 initAEAD (Key aesKey) (IV ivBytes) = do
@@ -189,15 +239,18 @@ initAEAD (Key aesKey) (IV ivBytes) = do
     cipher <- AES.cipherInit aesKey
     AES.aeadInit AES.AEAD_GCM cipher iv
 
+randomAesKey :: IO Key
+randomAesKey = Key <$> getRandomBytes aesKeySize
+
+randomIV :: IO IV
+randomIV = IV <$> getRandomBytes (ivSize @AES256)
+
 ivSize :: forall c. AES.BlockCipher c => Int
 ivSize = AES.blockSize (undefined :: c)
 
 makeIV :: AES.BlockCipher c => ByteString -> ExceptT CryptoError IO (AES.IV c)
 makeIV bs = maybeError CryptoIVError $ AES.makeIV bs
 
-randomBytes :: Int -> ExceptT CryptoError IO ByteString
-randomBytes n = ExceptT $ Right <$> getRandomBytes n
-
 maybeError :: CryptoError -> Maybe a -> ExceptT CryptoError IO a
 maybeError e = maybe (throwE e) return
 
@@ -253,12 +306,6 @@ privKeyP = do
   (private_size, private_n, private_d) <- keyParser_
   return PrivateKey {private_size, private_n, private_d}
 
-parsePubKey :: ByteString -> Either String PublicKey
-parsePubKey = A.parseOnly (pubKeyP <* A.endOfInput)
-
-parsePrivKey :: ByteString -> Either String PrivateKey
-parsePrivKey = A.parseOnly (privKeyP <* A.endOfInput)
-
 keyParser_ :: Parser (Int, Integer, Integer)
 keyParser_ = (,,) <$> (A.decimal <* ",") <*> (intP <* ",") <*> intP
   where

src/Simplex/Messaging/Parsers.hs

@@ -20,4 +20,7 @@ tsISO8601P :: Parser UTCTime
 tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill (== ' ')
 
 parse :: Parser a -> e -> (ByteString -> Either e a)
-parse parser err = first (const err) . A.parseOnly (parser <* A.endOfInput)
+parse parser err = first (const err) . parseAll parser
+
+parseAll :: Parser a -> (ByteString -> Either String a)
+parseAll parser = A.parseOnly (parser <* A.endOfInput)

src/Simplex/Messaging/Protocol.hs

@@ -13,7 +13,7 @@ module Simplex.Messaging.Protocol where
 
 import Control.Applicative ((<|>))
 import Control.Monad
-import Control.Monad.IO.Class
+import Control.Monad.Except
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Base64
@@ -28,8 +28,6 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Util
-import System.IO
-import Text.Read
 
 data Party = Broker | Recipient | Sender
   deriving (Show)
@@ -108,7 +106,7 @@ type MsgId = Encoded
 
 type MsgBody = ByteString
 
-data ErrorType = PROHIBITED | SYNTAX Int | SIZE | AUTH | INTERNAL | DUPLICATE deriving (Show, Eq)
+data ErrorType = PROHIBITED | SYNTAX Int | AUTH | INTERNAL | DUPLICATE deriving (Show, Eq)
 
 errBadTransmission :: Int
 errBadTransmission = 1
@@ -128,6 +126,16 @@ errNoQueueId = 5
 errMessageBody :: Int
 errMessageBody = 6
 
+transmissionP :: Parser RawTransmission
+transmissionP = do
+  signature <- segment
+  corrId <- segment
+  queueId <- segment
+  command <- A.takeByteString
+  return (signature, corrId, queueId, command)
+  where
+    segment = A.takeTill (== ' ') <* " "
+
 commandP :: Parser Cmd
 commandP =
   "NEW " *> newCmd
@@ -148,60 +156,47 @@ commandP =
     newCmd = Cmd SRecipient . NEW <$> C.pubKeyP
     idsResp = Cmd SBroker <$> (IDS <$> (base64P <* A.space) <*> base64P)
     keyCmd = Cmd SRecipient . KEY <$> C.pubKeyP
-    sendCmd = Cmd SSender . SEND <$> A.takeWhile A.isDigit
+    sendCmd = do
+      size <- A.decimal <* A.space
+      Cmd SSender . SEND <$> A.take size <* A.space
     message = do
       msgId <- base64P <* A.space
       ts <- tsISO8601P <* A.space
-      Cmd SBroker . MSG msgId ts <$> A.takeWhile A.isDigit
+      size <- A.decimal <* A.space
+      Cmd SBroker . MSG msgId ts <$> A.take size <* A.space
     serverError = Cmd SBroker . ERR <$> errorType
     errorType =
       "PROHIBITED" $> PROHIBITED
         <|> "SYNTAX " *> (SYNTAX <$> A.decimal)
-        <|> "SIZE" $> SIZE
         <|> "AUTH" $> AUTH
         <|> "INTERNAL" $> INTERNAL
 
+-- TODO ignore the end of block, no need to parse it
 parseCommand :: ByteString -> Either ErrorType Cmd
-parseCommand = parse commandP $ SYNTAX errBadSMPCommand
+parseCommand = parse (commandP <* " " <* A.takeByteString) $ SYNTAX errBadSMPCommand
 
 serializeCommand :: Cmd -> ByteString
 serializeCommand = \case
   Cmd SRecipient (NEW rKey) -> "NEW " <> C.serializePubKey rKey
   Cmd SRecipient (KEY sKey) -> "KEY " <> C.serializePubKey sKey
-  Cmd SRecipient cmd -> B.pack $ show cmd
-  Cmd SSender (SEND msgBody) -> "SEND" <> serializeMsg msgBody
+  Cmd SRecipient cmd -> bshow cmd
+  Cmd SSender (SEND msgBody) -> "SEND " <> serializeMsg msgBody
   Cmd SSender PING -> "PING"
   Cmd SBroker (MSG msgId ts msgBody) ->
-    B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts] <> serializeMsg msgBody
+    B.unwords ["MSG", encode msgId, B.pack $ formatISO8601Millis ts, serializeMsg msgBody]
   Cmd SBroker (IDS rId sId) -> B.unwords ["IDS", encode rId, encode sId]
-  Cmd SBroker (ERR err) -> "ERR " <> B.pack (show err)
-  Cmd SBroker resp -> B.pack $ show resp
+  Cmd SBroker (ERR err) -> "ERR " <> bshow err
+  Cmd SBroker resp -> bshow resp
   where
-    serializeMsg msgBody = " " <> B.pack (show $ B.length msgBody) <> "\r\n" <> msgBody
+    serializeMsg msgBody = bshow (B.length msgBody) <> " " <> msgBody <> " "
 
-tPutRaw :: Handle -> RawTransmission -> IO ()
-tPutRaw h (signature, corrId, queueId, command) = do
-  putLn h signature
-  putLn h corrId
-  putLn h queueId
-  putLn h command
-
-tGetRaw :: Handle -> IO RawTransmission
-tGetRaw h = do
-  signature <- getLn h
-  corrId <- getLn h
-  queueId <- getLn h
-  command <- getLn h
-  return (signature, corrId, queueId, command)
-
-tPut :: Handle -> SignedRawTransmission -> IO ()
-tPut h (C.Signature sig, t) = do
-  putLn h $ encode sig
-  putLn h t
+tPut :: THandle -> SignedRawTransmission -> IO (Either TransportError ())
+tPut th (C.Signature sig, t) =
+  tPutEncrypted th $ encode sig <> " " <> t <> " "
 
 serializeTransmission :: Transmission -> ByteString
 serializeTransmission (CorrId corrId, queueId, command) =
-  B.intercalate "\r\n" [corrId, encode queueId, serializeCommand command]
+  B.intercalate " " [corrId, encode queueId, serializeCommand command]
 
 fromClient :: Cmd -> Either ErrorType Cmd
 fromClient = \case
@@ -213,22 +208,28 @@ fromServer = \case
   cmd@(Cmd SBroker _) -> Right cmd
   _ -> Left PROHIBITED
 
+tGetParse :: THandle -> IO (Either TransportError RawTransmission)
+tGetParse th = (>>= parse transmissionP TransportParsingError) <$> tGetEncrypted th
+
 -- | get client and server transmissions
 -- `fromParty` is used to limit allowed senders - `fromClient` or `fromServer` should be used
-tGet :: forall m. MonadIO m => (Cmd -> Either ErrorType Cmd) -> Handle -> m SignedTransmissionOrError
-tGet fromParty h = do
-  (signature, corrId, queueId, command) <- liftIO $ tGetRaw h
-  let decodedTransmission = liftM2 (,corrId,,command) (decode signature) (decode queueId)
-  either (const $ tError corrId) tParseLoadBody decodedTransmission
+tGet :: forall m. MonadIO m => (Cmd -> Either ErrorType Cmd) -> THandle -> m SignedTransmissionOrError
+tGet fromParty th = liftIO (tGetParse th) >>= decodeParseValidate
   where
+    decodeParseValidate :: Either TransportError RawTransmission -> m SignedTransmissionOrError
+    decodeParseValidate = \case
+      Right (signature, corrId, queueId, command) ->
+        let decodedTransmission = liftM2 (,corrId,,command) (decode signature) (decode queueId)
+         in either (const $ tError corrId) tParseValidate decodedTransmission
+      Left _ -> tError ""
+
     tError :: ByteString -> m SignedTransmissionOrError
     tError corrId = return (C.Signature B.empty, (CorrId corrId, B.empty, Left $ SYNTAX errBadTransmission))
 
-    tParseLoadBody :: RawTransmission -> m SignedTransmissionOrError
-    tParseLoadBody t@(sig, corrId, queueId, command) = do
+    tParseValidate :: RawTransmission -> m SignedTransmissionOrError
+    tParseValidate t@(sig, corrId, queueId, command) = do
       let cmd = parseCommand command >>= fromParty >>= tCredentials t
-      fullCmd <- either (return . Left) cmdWithMsgBody cmd
-      return (C.Signature sig, (CorrId corrId, queueId, fullCmd))
+      return (C.Signature sig, (CorrId corrId, queueId, cmd))
 
     tCredentials :: RawTransmission -> Cmd -> Either ErrorType Cmd
     tCredentials (signature, _, queueId, _) cmd = case cmd of
@@ -261,19 +262,3 @@ tGet fromParty h = do
       Cmd SRecipient _
         | B.null signature || B.null queueId -> Left $ SYNTAX errNoCredentials
         | otherwise -> Right cmd
-
-    cmdWithMsgBody :: Cmd -> m (Either ErrorType Cmd)
-    cmdWithMsgBody = \case
-      Cmd SSender (SEND sizeStr) ->
-        Cmd SSender . SEND <$$> getMsgBody sizeStr
-      Cmd SBroker (MSG msgId ts sizeStr) ->
-        Cmd SBroker . MSG msgId ts <$$> getMsgBody sizeStr
-      cmd -> return $ Right cmd
-
-    getMsgBody :: MsgBody -> m (Either ErrorType MsgBody)
-    getMsgBody sizeStr = case readMaybe (B.unpack sizeStr) :: Maybe Int of
-      Just size -> liftIO $ do
-        body <- B.hGet h size
-        s <- getLn h
-        return $ if B.null s then Right body else Left SIZE
-      Nothing -> return $ Left INTERNAL

src/Simplex/Messaging/Server.hs

@@ -15,6 +15,7 @@ module Simplex.Messaging.Server (runSMPServer, randomBytes) where
 
 import Control.Concurrent.STM (stateTVar)
 import Control.Monad
+import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
 import Crypto.Random
@@ -59,11 +60,17 @@ runSMPServer cfg@ServerConfig {tcpPort} = do
 
 runClient :: (MonadUnliftIO m, MonadReader Env m) => Handle -> m ()
 runClient h = do
-  liftIO $ putLn h "Welcome to SMP v0.2.0"
+  keyPair <- asks serverKeyPair
+  liftIO (runExceptT $ serverHandshake h keyPair) >>= \case
+    Right th -> runClientTransport th
+    Left _ -> pure ()
+
+runClientTransport :: (MonadUnliftIO m, MonadReader Env m) => THandle -> m ()
+runClientTransport th = do
   q <- asks $ tbqSize . config
   c <- atomically $ newClient q
   s <- asks server
-  raceAny_ [send h c, client c s, receive h c]
+  raceAny_ [send th c, client c s, receive th c]
     `finally` cancelSubscribers c
 
 cancelSubscribers :: MonadUnliftIO m => Client -> m ()
@@ -75,7 +82,7 @@ cancelSub = \case
   Sub {subThread = SubThread t} -> killThread t
   _ -> return ()
 
-receive :: (MonadUnliftIO m, MonadReader Env m) => Handle -> Client -> m ()
+receive :: (MonadUnliftIO m, MonadReader Env m) => THandle -> Client -> m ()
 receive h Client {rcvQ} = forever $ do
   (signature, (corrId, queueId, cmdOrError)) <- tGet fromClient h
   t <- case cmdOrError of
@@ -83,7 +90,7 @@ receive h Client {rcvQ} = forever $ do
     Right cmd -> verifyTransmission (signature, (corrId, queueId, cmd))
   atomically $ writeTBQueue rcvQ t
 
-send :: MonadUnliftIO m => Handle -> Client -> m ()
+send :: MonadUnliftIO m => THandle -> Client -> m ()
 send h Client {sndQ} = forever $ do
   t <- atomically $ readTBQueue sndQ
   liftIO $ tPut h ("", serializeTransmission t)

src/Simplex/Messaging/Server/Env/STM.hs

@@ -5,11 +5,13 @@ module Simplex.Messaging.Server.Env.STM where
 
 import Control.Concurrent (ThreadId)
 import Control.Monad.IO.Unlift
+import qualified Crypto.PubKey.RSA as R
 import Crypto.Random
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Network.Socket (ServiceName)
 import Numeric.Natural
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.QueueStore.STM
@@ -27,7 +29,9 @@ data Env = Env
     server :: Server,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
-    idsDrg :: TVar ChaChaDRG
+    idsDrg :: TVar ChaChaDRG,
+    serverKeyPair :: C.KeyPair
+    -- serverId :: ByteString
   }
 
 data Server = Server
@@ -72,4 +76,24 @@ newEnv config = do
   queueStore <- atomically newQueueStore
   msgStore <- atomically newMsgStore
   idsDrg <- drgNew >>= newTVarIO
-  return Env {config, server, queueStore, msgStore, idsDrg}
+  -- TODO these keys should be set in the environment, not in the code
+  return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair}
+  where
+    serverKeyPair =
+      ( C.PublicKey
+          { rsaPublicKey =
+              R.PublicKey
+                { public_size = 256,
+                  public_n = 24491401566218566997383105010202223087300892576089255259580984651333137614713737618097624532507176450266480395052797332730303098565954279378701980313049999952643146946493842983667770915603693980339519205455913124235423278419181501399080069195664300809453039371169996023512911587381435574254546266774756319955237750224266282550919563293672568339958353047135257914364920805066749904289452712976534358633568668875150094910205741579097517675339029147403213185924413178887675432745168542469043448659751499651038006514754218441022754807971535895895877162103157702709155894482782232155817331812261258282431796597840952464257,
+                  public_e = 8750208418393523480444709183090020123776537336553019181250117771363000810675051423462439348759073000328325050011503730211252469588880505946970399702607609166796825215104414212088697348613726705621594590369250976359268097976909710311654938358716518878047036682173044667792903503207106314854901036618348367397
+                }
+          },
+        C.PrivateKey
+          { private_size = 256,
+            private_n = 24491401566218566997383105010202223087300892576089255259580984651333137614713737618097624532507176450266480395052797332730303098565954279378701980313049999952643146946493842983667770915603693980339519205455913124235423278419181501399080069195664300809453039371169996023512911587381435574254546266774756319955237750224266282550919563293672568339958353047135257914364920805066749904289452712976534358633568668875150094910205741579097517675339029147403213185924413178887675432745168542469043448659751499651038006514754218441022754807971535895895877162103157702709155894482782232155817331812261258282431796597840952464257,
+            private_d = 7597313014691047671352664508683652467940113991200105893460705315744177757772923044415828427601194535604492873282390112577565179730319668643740113323630387082584239892956534048712048059175569855278723311295064858148623887611800385925820852572241607131360121661598015161261779381845187797044113149447495567589968956065009916550602209418325870594974390014927949966324558614396231902374868077411836997835082564279358230227298823445650053370542685308691044175390251929540772677009245507450972026595993054141350350385685400540681305852935721245601287301749047921282924410369389293829570448007237832101875085500166095784749
+          }
+      )
+
+-- public key hash:
+-- "8Cvd+AYVxLpSsB/glEhVxkKuEzMNBFdAL5yr7p9DGGk="

src/Simplex/Messaging/Transport.hs

@@ -1,21 +1,37 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Transport where
 
-import Control.Monad.IO.Class
+import Control.Monad.Except
 import Control.Monad.IO.Unlift
-import Control.Monad.Reader
+import Control.Monad.Trans.Except (throwE)
+import Crypto.Cipher.Types (AuthTag)
+import Crypto.Hash (hash)
+import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Bifunctor (first)
+import Data.ByteArray (xor)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Set (Set)
 import qualified Data.Set as S
+import Data.Word (Word32)
 import GHC.IO.Exception (IOErrorType (..))
+import GHC.IO.Handle.Internals (ioe_EOF)
 import Network.Socket
+import Network.Transport.Internal (encodeWord32)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Parsers (parse, parseAll)
+import Simplex.Messaging.Util (bshow, liftError)
 import System.IO
 import System.IO.Error
 import UnliftIO.Concurrent
@@ -24,6 +40,8 @@ import qualified UnliftIO.Exception as E
 import qualified UnliftIO.IO as IO
 import UnliftIO.STM
 
+-- * TCP transport
+
 runTCPServer :: MonadUnliftIO m => ServiceName -> (Handle -> m ()) -> m ()
 runTCPServer port server = do
   clients <- newTVarIO S.empty
@@ -96,3 +114,177 @@ getLn h = trim_cr <$> B.hGetLine h
   where
     trim_cr "" = ""
     trim_cr s = if B.last s == '\r' then B.init s else s
+
+-- * Encrypted transport
+
+data SMPVersion = SMPVersion Int Int Int Int
+  deriving (Eq, Ord)
+
+major :: SMPVersion -> (Int, Int)
+major (SMPVersion a b _ _) = (a, b)
+
+currentSMPVersion :: SMPVersion
+currentSMPVersion = SMPVersion 0 2 0 0
+
+serializeSMPVersion :: SMPVersion -> ByteString
+serializeSMPVersion (SMPVersion a b c d) = B.intercalate "." [bshow a, bshow b, bshow c, bshow d]
+
+smpVersionP :: Parser SMPVersion
+smpVersionP =
+  let ver = A.decimal <* A.char '.'
+   in SMPVersion <$> ver <*> ver <*> ver <*> A.decimal
+
+data THandle = THandle
+  { handle :: Handle,
+    sndKey :: SessionKey,
+    rcvKey :: SessionKey,
+    blockSize :: Int
+  }
+
+data SessionKey = SessionKey
+  { aesKey :: C.Key,
+    baseIV :: C.IV,
+    counter :: TVar Word32
+  }
+
+data HandshakeKeys = HandshakeKeys
+  { sndKey :: SessionKey,
+    rcvKey :: SessionKey
+  }
+
+data TransportError
+  = TransportCryptoError C.CryptoError
+  | TransportParsingError
+  | TransportHandshakeError String
+  deriving (Eq, Show, Exception)
+
+tPutEncrypted :: THandle -> ByteString -> IO (Either TransportError ())
+tPutEncrypted THandle {handle = h, sndKey, blockSize} block =
+  encryptBlock sndKey (blockSize - C.authTagSize) block >>= \case
+    Left e -> return . Left $ TransportCryptoError e
+    Right (authTag, msg) -> Right <$> B.hPut h (C.authTagToBS authTag <> msg)
+
+tGetEncrypted :: THandle -> IO (Either TransportError ByteString)
+tGetEncrypted THandle {handle = h, rcvKey, blockSize} =
+  B.hGet h blockSize >>= decryptBlock rcvKey >>= \case
+    Left e -> pure . Left $ TransportCryptoError e
+    Right "" -> ioe_EOF
+    Right msg -> pure $ Right msg
+
+encryptBlock :: SessionKey -> Int -> ByteString -> IO (Either C.CryptoError (AuthTag, ByteString))
+encryptBlock k@SessionKey {aesKey} size block = do
+  ivBytes <- makeNextIV k
+  runExceptT $ C.encryptAES aesKey ivBytes size block
+
+decryptBlock :: SessionKey -> ByteString -> IO (Either C.CryptoError ByteString)
+decryptBlock k@SessionKey {aesKey} block = do
+  let (authTag, msg') = B.splitAt C.authTagSize block
+  ivBytes <- makeNextIV k
+  runExceptT $ C.decryptAES aesKey ivBytes msg' (C.bsToAuthTag authTag)
+
+makeNextIV :: SessionKey -> IO C.IV
+makeNextIV SessionKey {baseIV, counter} = atomically $ do
+  c <- readTVar counter
+  writeTVar counter $ c + 1
+  pure $ iv c
+  where
+    (start, rest) = B.splitAt 4 $ C.unIV baseIV
+    iv c = C.IV $ (start `xor` encodeWord32 c) <> rest
+
+-- | implements server transport handshake as per /rfcs/2021-01-26-crypto.md#transport-encryption
+-- The numbers in function names refer to the steps in the document
+serverHandshake :: Handle -> C.KeyPair -> ExceptT TransportError IO THandle
+serverHandshake h (k, pk) = do
+  liftIO sendPublicKey_1
+  encryptedKeys <- receiveEncryptedKeys_4
+  HandshakeKeys {sndKey, rcvKey} <- decryptParseKeys_5 encryptedKeys
+  th <- liftIO $ transportHandle h rcvKey sndKey -- keys are swapped here
+  sendWelcome_6 th
+  pure th
+  where
+    sendPublicKey_1 :: IO ()
+    sendPublicKey_1 = putLn h $ C.serializePubKey k
+    receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString
+    receiveEncryptedKeys_4 =
+      liftIO (B.hGet h $ C.publicKeySize k) >>= \case
+        "" -> throwE $ TransportHandshakeError "EOF"
+        ks -> pure ks
+    decryptParseKeys_5 :: ByteString -> ExceptT TransportError IO HandshakeKeys
+    decryptParseKeys_5 encKeys =
+      liftError TransportCryptoError (C.decryptOAEP pk encKeys)
+        >>= liftEither . parseHandshakeKeys
+    sendWelcome_6 :: THandle -> ExceptT TransportError IO ()
+    sendWelcome_6 th = ExceptT . tPutEncrypted th $ serializeSMPVersion currentSMPVersion <> " "
+
+-- | implements client transport handshake as per /rfcs/2021-01-26-crypto.md#transport-encryption
+-- The numbers in function names refer to the steps in the document
+clientHandshake :: Handle -> Maybe C.KeyHash -> ExceptT TransportError IO THandle
+clientHandshake h keyHash = do
+  k <- getPublicKey_1_2
+  keys@HandshakeKeys {sndKey, rcvKey} <- liftIO generateKeys_3
+  sendEncryptedKeys_4 k keys
+  th <- liftIO $ transportHandle h sndKey rcvKey
+  getWelcome_6 th >>= checkVersion
+  pure th
+  where
+    getPublicKey_1_2 :: ExceptT TransportError IO C.PublicKey
+    getPublicKey_1_2 = do
+      s <- liftIO $ getLn h
+      maybe (pure ()) (validateKeyHash_2 s) keyHash
+      liftEither $ parseKey s
+    parseKey :: ByteString -> Either TransportError C.PublicKey
+    parseKey = first TransportHandshakeError . parseAll C.pubKeyP
+    validateKeyHash_2 :: ByteString -> C.KeyHash -> ExceptT TransportError IO ()
+    validateKeyHash_2 k (C.KeyHash kHash)
+      | hash k == kHash = pure ()
+      | otherwise = throwE $ TransportHandshakeError "wrong key hash"
+    generateKeys_3 :: IO HandshakeKeys
+    generateKeys_3 = HandshakeKeys <$> generateKey <*> generateKey
+    generateKey :: IO SessionKey
+    generateKey = do
+      aesKey <- C.randomAesKey
+      baseIV <- C.randomIV
+      pure SessionKey {aesKey, baseIV, counter = undefined}
+    sendEncryptedKeys_4 :: C.PublicKey -> HandshakeKeys -> ExceptT TransportError IO ()
+    sendEncryptedKeys_4 k keys =
+      liftError TransportCryptoError (C.encryptOAEP k $ serializeHandshakeKeys keys)
+        >>= liftIO . B.hPut h
+    getWelcome_6 :: THandle -> ExceptT TransportError IO SMPVersion
+    getWelcome_6 th = ExceptT $ (>>= parseSMPVersion) <$> tGetEncrypted th
+    parseSMPVersion :: ByteString -> Either TransportError SMPVersion
+    parseSMPVersion = first TransportHandshakeError . A.parseOnly (smpVersionP <* A.space)
+    checkVersion :: SMPVersion -> ExceptT TransportError IO ()
+    checkVersion smpVersion =
+      when (major smpVersion > major currentSMPVersion) . throwE $
+        TransportHandshakeError "SMP server version"
+
+serializeHandshakeKeys :: HandshakeKeys -> ByteString
+serializeHandshakeKeys HandshakeKeys {sndKey, rcvKey} =
+  serializeKey sndKey <> serializeKey rcvKey
+  where
+    serializeKey :: SessionKey -> ByteString
+    serializeKey SessionKey {aesKey, baseIV} = C.unKey aesKey <> C.unIV baseIV
+
+handshakeKeysP :: Parser HandshakeKeys
+handshakeKeysP = HandshakeKeys <$> keyP <*> keyP
+  where
+    keyP :: Parser SessionKey
+    keyP = do
+      aesKey <- C.aesKeyP
+      baseIV <- C.ivP
+      pure SessionKey {aesKey, baseIV, counter = undefined}
+
+parseHandshakeKeys :: ByteString -> Either TransportError HandshakeKeys
+parseHandshakeKeys = parse handshakeKeysP $ TransportHandshakeError "parsing keys"
+
+transportHandle :: Handle -> SessionKey -> SessionKey -> IO THandle
+transportHandle h sk rk = do
+  sndCounter <- newTVarIO 0
+  rcvCounter <- newTVarIO 0
+  pure
+    THandle
+      { handle = h,
+        sndKey = sk {counter = sndCounter},
+        rcvKey = rk {counter = rcvCounter},
+        blockSize = 8192
+      }

tests/AgentTests.hs

@@ -13,6 +13,7 @@ import Control.Concurrent
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import SMPAgentClient
+import SMPClient (teshKeyHashStr)
 import Simplex.Messaging.Agent.Transmission
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import System.IO (Handle)
@@ -139,8 +140,8 @@ syntaxTests = do
       -- TODO: add tests with defined connection alias
       xit "only server" $ ("211", "", "NEW localhost") >#>= \case ("211", "", "INV" : _) -> True; _ -> False
       it "with port" $ ("212", "", "NEW localhost:5000") >#>= \case ("212", "", "INV" : _) -> True; _ -> False
-      xit "with keyHash" $ ("213", "", "NEW localhost#1234") >#>= \case ("213", "", "INV" : _) -> True; _ -> False
-      it "with port and keyHash" $ ("214", "", "NEW localhost:5000#1234") >#>= \case ("214", "", "INV" : _) -> True; _ -> False
+      xit "with keyHash" $ ("213", "", "NEW localhost#" <> teshKeyHashStr) >#>= \case ("213", "", "INV" : _) -> True; _ -> False
+      it "with port and keyHash" $ ("214", "", "NEW localhost:5000#" <> teshKeyHashStr) >#>= \case ("214", "", "INV" : _) -> True; _ -> False
     describe "invalid" do
       -- TODO: add tests with defined connection alias
       it "no parameters" $ ("221", "", "NEW") >#> ("221", "", "ERR SYNTAX 11")

tests/AgentTests/SQLiteTests.hs

@@ -13,6 +13,7 @@ import Data.Time
 import Data.Word (Word32)
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
+import SMPClient (teshKeyHash)
 import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite
 import Simplex.Messaging.Agent.Transmission
@@ -96,7 +97,7 @@ testForeignKeysEnabled = do
 rcvQueue1 :: RcvQueue
 rcvQueue1 =
   RcvQueue
-    { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
+    { server = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash,
       rcvId = "1234",
       connAlias = "conn1",
       rcvPrivateKey = C.PrivateKey 1 2 3,
@@ -110,7 +111,7 @@ rcvQueue1 =
 sndQueue1 :: SndQueue
 sndQueue1 =
   SndQueue
-    { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
+    { server = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash,
       sndId = "3456",
       connAlias = "conn1",
       sndPrivateKey = C.PrivateKey 1 2 3,
@@ -156,7 +157,7 @@ testGetAllConnAliases = do
 testGetRcvQueue :: SpecWith SQLiteStore
 testGetRcvQueue = do
   it "should get RcvQueue" $ \store -> do
-    let smpServer = SMPServer "smp.simplex.im" (Just "5223") (Just "1234")
+    let smpServer = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash
     let recipientId = "1234"
     createRcvConn store rcvQueue1
       `returnsResult` ()
@@ -211,7 +212,7 @@ testUpgradeRcvConnToDuplex = do
       `returnsResult` ()
     let anotherSndQueue =
           SndQueue
-            { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
+            { server = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash,
               sndId = "2345",
               connAlias = "conn1",
               sndPrivateKey = C.PrivateKey 1 2 3,
@@ -233,7 +234,7 @@ testUpgradeSndConnToDuplex = do
       `returnsResult` ()
     let anotherRcvQueue =
           RcvQueue
-            { server = SMPServer "smp.simplex.im" (Just "5223") (Just "1234"),
+            { server = SMPServer "smp.simplex.im" (Just "5223") teshKeyHash,
               rcvId = "3456",
               connAlias = "conn1",
               rcvPrivateKey = C.PrivateKey 1 2 3,

tests/SMPClient.hs

@@ -1,13 +1,19 @@
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module SMPClient where
 
+import Control.Monad (void)
+import Control.Monad.Except (runExceptT)
 import Control.Monad.IO.Unlift
 import Crypto.Random
+import Data.ByteString.Base64 (encode)
+import qualified Data.ByteString.Char8 as B
 import Network.Socket
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server
 import Simplex.Messaging.Server.Env.STM
@@ -15,7 +21,6 @@ import Simplex.Messaging.Transport
 import Test.Hspec
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
-import UnliftIO.IO
 
 testHost :: HostName
 testHost = "localhost"
@@ -23,14 +28,19 @@ testHost = "localhost"
 testPort :: ServiceName
 testPort = "5000"
 
-testSMPClient :: MonadUnliftIO m => (Handle -> m a) -> m a
+teshKeyHashStr :: B.ByteString
+teshKeyHashStr = "8Cvd+AYVxLpSsB/glEhVxkKuEzMNBFdAL5yr7p9DGGk="
+
+teshKeyHash :: Maybe C.KeyHash
+teshKeyHash = Just "8Cvd+AYVxLpSsB/glEhVxkKuEzMNBFdAL5yr7p9DGGk="
+
+testSMPClient :: MonadUnliftIO m => (THandle -> m a) -> m a
 testSMPClient client = do
   threadDelay 250_000 -- TODO hack: thread delay for SMP server to start
-  runTCPClient testHost testPort $ \h -> do
-    line <- liftIO $ getLn h
-    if line == "Welcome to SMP v0.2.0"
-      then client h
-      else error "not connected"
+  runTCPClient testHost testPort $ \h ->
+    liftIO (runExceptT $ clientHandshake h teshKeyHash) >>= \case
+      Right th -> client th
+      Left e -> error $ show e
 
 cfg :: ServerConfig
 cfg =
@@ -53,33 +63,43 @@ withSmpServerOn port = withSmpServerThreadOn port . const
 withSmpServer :: (MonadUnliftIO m, MonadRandom m) => m a -> m a
 withSmpServer = withSmpServerOn testPort
 
-runSmpTest :: (MonadUnliftIO m, MonadRandom m) => (Handle -> m a) -> m a
+runSmpTest :: (MonadUnliftIO m, MonadRandom m) => (THandle -> m a) -> m a
 runSmpTest test = withSmpServer $ testSMPClient test
 
-runSmpTestN :: forall m a. (MonadUnliftIO m, MonadRandom m) => Int -> ([Handle] -> m a) -> m a
+runSmpTestN :: forall m a. (MonadUnliftIO m, MonadRandom m) => Int -> ([THandle] -> m a) -> m a
 runSmpTestN nClients test = withSmpServer $ run nClients []
   where
-    run :: Int -> [Handle] -> m a
+    run :: Int -> [THandle] -> m a
     run 0 hs = test hs
     run n hs = testSMPClient $ \h -> run (n - 1) (h : hs)
 
 smpServerTest :: RawTransmission -> IO RawTransmission
 smpServerTest cmd = runSmpTest $ \h -> tPutRaw h cmd >> tGetRaw h
 
-smpTest :: (Handle -> IO ()) -> Expectation
+smpTest :: (THandle -> IO ()) -> Expectation
 smpTest test' = runSmpTest test' `shouldReturn` ()
 
-smpTestN :: Int -> ([Handle] -> IO ()) -> Expectation
+smpTestN :: Int -> ([THandle] -> IO ()) -> Expectation
 smpTestN n test' = runSmpTestN n test' `shouldReturn` ()
 
-smpTest2 :: (Handle -> Handle -> IO ()) -> Expectation
+smpTest2 :: (THandle -> THandle -> IO ()) -> Expectation
 smpTest2 test' = smpTestN 2 _test
   where
     _test [h1, h2] = test' h1 h2
     _test _ = error "expected 2 handles"
 
-smpTest3 :: (Handle -> Handle -> Handle -> IO ()) -> Expectation
+smpTest3 :: (THandle -> THandle -> THandle -> IO ()) -> Expectation
 smpTest3 test' = smpTestN 3 _test
   where
     _test [h1, h2, h3] = test' h1 h2 h3
     _test _ = error "expected 3 handles"
+
+tPutRaw :: THandle -> RawTransmission -> IO ()
+tPutRaw h (sig, corrId, queueId, command) = do
+  let t = B.intercalate " " [corrId, queueId, command]
+  void $ tPut h (C.Signature sig, t)
+
+tGetRaw :: THandle -> IO RawTransmission
+tGetRaw h = do
+  ("", (CorrId corrId, qId, Right cmd)) <- tGet fromServer h
+  pure ("", corrId, encode qId, serializeCommand cmd)

tests/ServerTests.hs

@@ -13,7 +13,7 @@ import qualified Data.ByteString.Char8 as B
 import SMPClient
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
-import System.IO (Handle)
+import Simplex.Messaging.Transport
 import System.Timeout
 import Test.HUnit
 import Test.Hspec
@@ -34,14 +34,14 @@ serverTests = do
 pattern Resp :: CorrId -> QueueId -> Command 'Broker -> SignedTransmissionOrError
 pattern Resp corrId queueId command <- ("", (corrId, queueId, Right (Cmd SBroker command)))
 
-sendRecv :: Handle -> (ByteString, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
+sendRecv :: THandle -> (ByteString, ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
 sendRecv h (sgn, corrId, qId, cmd) = tPutRaw h (sgn, corrId, encode qId, cmd) >> tGet fromServer h
 
-signSendRecv :: Handle -> C.PrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
+signSendRecv :: THandle -> C.PrivateKey -> (ByteString, ByteString, ByteString) -> IO SignedTransmissionOrError
 signSendRecv h pk (corrId, qId, cmd) = do
-  let t = B.intercalate "\r\n" [corrId, encode qId, cmd]
+  let t = B.intercalate " " [corrId, encode qId, cmd]
   Right sig <- C.sign pk t
-  tPut h (sig, t)
+  _ <- tPut h (sig, t)
   tGet fromServer h
 
 cmdSEND :: ByteString -> ByteString
@@ -61,7 +61,7 @@ testCreateSecure =
       Resp "abcd" rId1 (IDS rId sId) <- signSendRecv h rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
       (rId1, "") #== "creates queue"
 
-      Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, "SEND 5\r\nhello")
+      Resp "bcda" sId1 ok1 <- sendRecv h ("", "bcda", sId, "SEND 5 hello ")
       (ok1, OK) #== "accepts unsigned SEND"
       (sId1, sId) #== "same queue ID in response 1"
 
@@ -75,7 +75,7 @@ testCreateSecure =
       (err6, ERR PROHIBITED) #== "replies ERR when message acknowledged without messages"
 
       (sPub, sKey) <- C.generateKeyPair rsaKeySize
-      Resp "abcd" sId2 err1 <- signSendRecv h sKey ("abcd", sId, "SEND 5\r\nhello")
+      Resp "abcd" sId2 err1 <- signSendRecv h sKey ("abcd", sId, "SEND 5 hello ")
       (err1, ERR AUTH) #== "rejects signed SEND"
       (sId2, sId) #== "same queue ID in response 2"
 
@@ -93,7 +93,7 @@ testCreateSecure =
       Resp "abcd" _ err4 <- signSendRecv h rKey ("abcd", rId, keyCmd)
       (err4, ERR AUTH) #== "rejects KEY if already secured"
 
-      Resp "bcda" _ ok3 <- signSendRecv h sKey ("bcda", sId, "SEND 11\r\nhello again")
+      Resp "bcda" _ ok3 <- signSendRecv h sKey ("bcda", sId, "SEND 11 hello again ")
       (ok3, OK) #== "accepts signed SEND"
 
       Resp "" _ (MSG _ _ msg) <- tGet fromServer h
@@ -102,7 +102,7 @@ testCreateSecure =
       Resp "cdab" _ ok5 <- signSendRecv h rKey ("cdab", rId, "ACK")
       (ok5, OK) #== "replies OK when message acknowledged 2"
 
-      Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, "SEND 5\r\nhello")
+      Resp "dabc" _ err5 <- sendRecv h ("", "dabc", sId, "SEND 5 hello ")
       (err5, ERR AUTH) #== "rejects unsigned SEND"
 
 testCreateDelete :: Spec
@@ -117,10 +117,10 @@ testCreateDelete =
       Resp "bcda" _ ok1 <- signSendRecv rh rKey ("bcda", rId, "KEY " <> C.serializePubKey sPub)
       (ok1, OK) #== "secures queue"
 
-      Resp "cdab" _ ok2 <- signSendRecv sh sKey ("cdab", sId, "SEND 5\r\nhello")
+      Resp "cdab" _ ok2 <- signSendRecv sh sKey ("cdab", sId, "SEND 5 hello ")
       (ok2, OK) #== "accepts signed SEND"
 
-      Resp "dabc" _ ok7 <- signSendRecv sh sKey ("dabc", sId, "SEND 7\r\nhello 2")
+      Resp "dabc" _ ok7 <- signSendRecv sh sKey ("dabc", sId, "SEND 7 hello 2 ")
       (ok7, OK) #== "accepts signed SEND 2 - this message is not delivered because the first is not ACKed"
 
       Resp "" _ (MSG _ _ msg1) <- tGet fromServer rh
@@ -136,10 +136,10 @@ testCreateDelete =
       (ok3, OK) #== "suspends queue"
       (rId2, rId) #== "same queue ID in response 2"
 
-      Resp "dabc" _ err3 <- signSendRecv sh sKey ("dabc", sId, "SEND 5\r\nhello")
+      Resp "dabc" _ err3 <- signSendRecv sh sKey ("dabc", sId, "SEND 5 hello ")
       (err3, ERR AUTH) #== "rejects signed SEND"
 
-      Resp "abcd" _ err4 <- sendRecv sh ("", "abcd", sId, "SEND 5\r\nhello")
+      Resp "abcd" _ err4 <- sendRecv sh ("", "abcd", sId, "SEND 5 hello ")
       (err4, ERR AUTH) #== "reject unsigned SEND too"
 
       Resp "bcda" _ ok4 <- signSendRecv rh rKey ("bcda", rId, "OFF")
@@ -158,10 +158,10 @@ testCreateDelete =
       (ok6, OK) #== "deletes queue"
       (rId3, rId) #== "same queue ID in response 3"
 
-      Resp "cdab" _ err7 <- signSendRecv sh sKey ("cdab", sId, "SEND 5\r\nhello")
+      Resp "cdab" _ err7 <- signSendRecv sh sKey ("cdab", sId, "SEND 5 hello ")
       (err7, ERR AUTH) #== "rejects signed SEND when deleted"
 
-      Resp "dabc" _ err8 <- sendRecv sh ("", "dabc", sId, "SEND 5\r\nhello")
+      Resp "dabc" _ err8 <- sendRecv sh ("", "dabc", sId, "SEND 5 hello ")
       (err8, ERR AUTH) #== "rejects unsigned SEND too when deleted"
 
       Resp "abcd" _ err11 <- signSendRecv rh rKey ("abcd", rId, "ACK")
@@ -211,7 +211,7 @@ testDuplex =
       (aliceKey, C.serializePubKey asPub) #== "key received from Alice"
       Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, "KEY " <> aliceKey)
 
-      Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, "SEND 8\r\nhi alice")
+      Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, "SEND 8 hi alice ")
 
       Resp "" _ (MSG _ _ msg4) <- tGet fromServer alice
       Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, "ACK")
@@ -229,7 +229,7 @@ testSwitchSub =
     smpTest3 \rh1 rh2 sh -> do
       (rPub, rKey) <- C.generateKeyPair rsaKeySize
       Resp "abcd" _ (IDS rId sId) <- signSendRecv rh1 rKey ("abcd", "", "NEW " <> C.serializePubKey rPub)
-      Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, "SEND 5\r\ntest1")
+      Resp "bcda" _ ok1 <- sendRecv sh ("", "bcda", sId, "SEND 5 test1 ")
       (ok1, OK) #== "sent test message 1"
       Resp "cdab" _ ok2 <- sendRecv sh ("", "cdab", sId, cmdSEND "test2, no ACK")
       (ok2, OK) #== "sent test message 2"
@@ -246,7 +246,7 @@ testSwitchSub =
       Resp "" _ end <- tGet fromServer rh1
       (end, END) #== "unsubscribed the 1st TCP connection"
 
-      Resp "dabc" _ OK <- sendRecv sh ("", "dabc", sId, "SEND 5\r\ntest3")
+      Resp "dabc" _ OK <- sendRecv sh ("", "dabc", sId, "SEND 5 test3 ")
 
       Resp "" _ (MSG _ _ msg3) <- tGet fromServer rh2
       (msg3, "test3") #== "delivered to the 2nd TCP connection"
@@ -280,13 +280,13 @@ syntaxTests = do
   noParamsSyntaxTest "OFF"
   noParamsSyntaxTest "DEL"
   describe "SEND" do
-    it "valid syntax 1" $ ("1234", "cdab", "12345678", "SEND 5\r\nhello") >#> ("", "cdab", "12345678", "ERR AUTH")
-    it "valid syntax 2" $ ("1234", "dabc", "12345678", "SEND 11\r\nhello there") >#> ("", "dabc", "12345678", "ERR AUTH")
+    it "valid syntax 1" $ ("1234", "cdab", "12345678", "SEND 5 hello ") >#> ("", "cdab", "12345678", "ERR AUTH")
+    it "valid syntax 2" $ ("1234", "dabc", "12345678", "SEND 11 hello there ") >#> ("", "dabc", "12345678", "ERR AUTH")
     it "no parameters" $ ("1234", "abcd", "12345678", "SEND") >#> ("", "abcd", "12345678", "ERR SYNTAX 2")
-    it "no queue ID" $ ("1234", "bcda", "", "SEND 5\r\nhello") >#> ("", "bcda", "", "ERR SYNTAX 5")
-    it "bad message body 1" $ ("1234", "cdab", "12345678", "SEND 11 hello") >#> ("", "cdab", "12345678", "ERR SYNTAX 2")
-    it "bad message body 2" $ ("1234", "dabc", "12345678", "SEND hello") >#> ("", "dabc", "12345678", "ERR SYNTAX 2")
-    it "bigger body" $ ("1234", "abcd", "12345678", "SEND 4\r\nhello") >#> ("", "abcd", "12345678", "ERR SIZE")
+    it "no queue ID" $ ("1234", "bcda", "", "SEND 5 hello ") >#> ("", "bcda", "", "ERR SYNTAX 5")
+    it "bad message body 1" $ ("1234", "cdab", "12345678", "SEND 11 hello ") >#> ("", "cdab", "12345678", "ERR SYNTAX 2")
+    it "bad message body 2" $ ("1234", "dabc", "12345678", "SEND hello ") >#> ("", "dabc", "12345678", "ERR SYNTAX 2")
+    it "bigger body" $ ("1234", "abcd", "12345678", "SEND 4 hello ") >#> ("", "abcd", "12345678", "ERR SYNTAX 2")
   describe "PING" do
     it "valid syntax" $ ("", "abcd", "", "PING") >#> ("", "abcd", "", "PONG")
   describe "broker response not allowed" do
@@ -295,6 +295,6 @@ syntaxTests = do
     noParamsSyntaxTest :: ByteString -> Spec
     noParamsSyntaxTest cmd = describe (B.unpack cmd) do
       it "valid syntax" $ ("1234", "abcd", "12345678", cmd) >#> ("", "abcd", "12345678", "ERR AUTH")
-      it "parameters" $ ("1234", "bcda", "12345678", cmd <> " 1") >#> ("", "bcda", "12345678", "ERR SYNTAX 2")
+      it "wrong terminator" $ ("1234", "bcda", "12345678", cmd <> "=") >#> ("", "bcda", "12345678", "ERR SYNTAX 2")
       it "no signature" $ ("", "cdab", "12345678", cmd) >#> ("", "cdab", "12345678", "ERR SYNTAX 3")
       it "no queue ID" $ ("1234", "dabc", "", cmd) >#> ("", "dabc", "", "ERR SYNTAX 3")