TLS 1.3 transport (#203)

* TLS as Transport class instance with pre-defined server certificate/key * refactor error logging * remove Ed25519 * refactor TLS.cGet * TLS over TCP for Transport * Plain -> TLS * comment * getLn, change supported cipher * use non fixed certificates * comment * check options earlier * wording * headers * Update apps/smp-server/Main.hs Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> * Update apps/smp-server/Main.hs Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> * localhost -> server * Update apps/smp-server/Main.hs Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> * remove comment * agent key and cert fixtures WIP * certificate and key in correct order * exitFailure * refactor loadServerCertificate * remove liftIO Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>
2026-03-30 14:16:00 +00:00 · 2021-12-15 07:48:57 +00:00
parent 7dba734ab8
commit 83d352cfbe
17 changed files with 343 additions and 127 deletions
--- a/README.md
+++ b/README.md
@@ -29,6 +29,25 @@ On the first start the server generates an RSA key pair for encrypted transport

 SMP server implements [SMP protocol](https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md).

+#### Running SMP server on MacOS
+
+SMP server requires OpenSSL library for initialization. On MacOS OpenSSL library may be replaced with LibreSSL, which doesn't support required algorithms. Before initializing SMP server verify you have OpenSSL installed:
+
+```sh
+openssl version
+```
+
+If it says "LibreSSL", please install original OpenSSL:
+
+```sh
+brew update
+brew install openssl
+echo 'PATH="/opt/homebrew/opt/openssl@3/bin:$PATH"' >> ~/.zprofile # or follow whatever instructions brew suggests
+. ~/.zprofile # or restart your terminal to start a new session
+```
+
+Now `openssl version` should be saying "OpenSSL". You can now run `smp-server init` to initialize your SMP server.
+
 ### SMP client library

 [SMP client](https://github.com/simplex-chat/simplexmq/blob/master/src/Simplex/Messaging/Client.hs) is a Haskell library to connect to SMP servers that allows to:
@@ -61,7 +80,7 @@ It's the easiest to try SMP agent via a prototype [simplex-chat](https://github.

 You can get Linode [free credits](https://www.linode.com/lp/affiliate-referral/?irclickid=02-QkdTEpxyLW0W0EOSREQreUkB2DtzGE2lGTE0&irgwc=1&utm_source=impact) to deploy SMP server.

-Deployment on [Linode](https://www.linode.com/) is performed via StackScripts, which serve as recipes for Linode instances, also called Linodes. To deploy SMP server on Linode:
+Deployment on Linode is performed via StackScripts, which serve as recipes for Linode instances, also called Linodes. To deploy SMP server on Linode:

 - Create a Linode account or login with an already existing one.
 - Open [SMP server StackScript](https://cloud.linode.com/stackscripts/748014) and click "Deploy New Linode".
--- a/apps/smp-agent/Main.hs
+++ b/apps/smp-agent/Main.hs
@@ -8,7 +8,7 @@ import Control.Logger.Simple
 import qualified Data.List.NonEmpty as L
 import Simplex.Messaging.Agent (runSMPAgent)
 import Simplex.Messaging.Agent.Env.SQLite
-import Simplex.Messaging.Transport (TCP, Transport (..))
+import Simplex.Messaging.Transport (TLS, Transport (..))

 cfg :: AgentConfig
 cfg = defaultAgentConfig {smpServers = L.fromList ["localhost:5223#bU0K+bRg24xWW//lS0umO1Zdw/SXqpJNtm1/RrPLViE="]}
@@ -20,4 +20,4 @@ main :: IO ()
 main = do
  putStrLn $ "SMP agent listening on port " ++ tcpPort (cfg :: AgentConfig)
  setLogLevel LogInfo -- LogError
-  withGlobalLogging logCfg $ runSMPAgent (transport @TCP) cfg
+  withGlobalLogging logCfg $ runSMPAgent (transport @TLS) cfg
--- a/apps/smp-server/Main.hs
+++ b/apps/smp-server/Main.hs
@@ -23,12 +23,13 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
-import Simplex.Messaging.Transport (ATransport (..), TCP, Transport (..))
+import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
 import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
 import System.IO (IOMode (..), hFlush, stdout)
+import System.Process (readCreateProcess, shell)
 import Text.Read (readEither)

 defaultServerPort :: ServiceName
@@ -49,7 +50,9 @@ serverConfig =
      transports = undefined,
      storeLog = undefined,
      blockSize = undefined,
-      serverPrivateKey = undefined
+      serverPrivateKey = undefined, -- TODO delete
+      serverPrivateKeyFile = undefined,
+      serverCertificateFile = undefined
    }

 newKeySize :: Int
@@ -70,9 +73,16 @@ iniFile = combine cfgDir "smp-server.ini"
 defaultKeyFile :: FilePath
 defaultKeyFile = combine cfgDir "server_key"

+defaultPrivateKeyFile :: FilePath
+defaultPrivateKeyFile = combine cfgDir "server.key"
+
+defaultCertificateFile :: FilePath
+defaultCertificateFile = combine cfgDir "server.crt"
+
 main :: IO ()
 main = do
  opts <- getServerOpts
+  checkPubkeyAlgorihtm $ pubkeyAlgorihtm opts
  case serverCommand opts of
    ServerInit ->
      runExceptT (getConfig opts) >>= \case
@@ -94,6 +104,11 @@ main = do
    ServerDelete -> do
      deleteServer
      putStrLn "Server key, config file and store log deleted"
+  where
+    checkPubkeyAlgorihtm :: String -> IO ()
+    checkPubkeyAlgorihtm alg
+      | alg == "ED448" || alg == "ED25519" = pure ()
+      | otherwise = putStrLn ("unsupported public-key algorithm " <> alg) >> exitFailure

 getConfig :: ServerOpts -> ExceptT String IO ServerConfig
 getConfig opts = do
@@ -103,9 +118,10 @@ getConfig opts = do
  pure $ makeConfig ini pk storeLog

 makeConfig :: IniOpts -> C.PrivateKey 'C.RSA -> Maybe (StoreLog 'ReadMode) -> ServerConfig
-makeConfig IniOpts {serverPort, blockSize, enableWebsockets} pk storeLog =
-  let transports = (serverPort, transport @TCP) : [("80", transport @WS) | enableWebsockets]
-   in serverConfig {serverPrivateKey = pk, storeLog, blockSize, transports}
+makeConfig IniOpts {serverPort, blockSize, enableWebsockets, serverPrivateKeyFile, serverCertificateFile} pk storeLog =
+  -- let transports = (serverPort, transport @TLS) : [("80", transport @WS) | enableWebsockets]
+  let transports = [(serverPort, transport @TLS)]
+   in serverConfig {transports, storeLog, blockSize, serverPrivateKey = pk, serverPrivateKeyFile, serverCertificateFile}

 printConfig :: ServerConfig -> IO ()
 printConfig ServerConfig {serverPrivateKey, storeLog} = do
@@ -116,9 +132,10 @@ printConfig ServerConfig {serverPrivateKey, storeLog} = do

 initializeServer :: ServerOpts -> IO ServerConfig
 initializeServer opts = do
-  createDirectoryIfMissing False cfgDir
+  createDirectoryIfMissing True cfgDir
  ini <- createIni opts
  pk <- createKey ini
+  createKeyAndCertificate ini opts
  storeLog <- openStoreLog opts ini
  pure $ makeConfig ini pk storeLog

@@ -134,20 +151,26 @@ deleteServer = do
  ini <- runExceptT readIni
  deleteIfExists iniFile
  case ini of
-    Right IniOpts {storeLogFile, serverKeyFile} -> do
+    Right IniOpts {storeLogFile, serverKeyFile, serverPrivateKeyFile, serverCertificateFile} -> do
      deleteIfExists storeLogFile
      deleteIfExists serverKeyFile
+      deleteIfExists serverPrivateKeyFile
+      deleteIfExists serverCertificateFile
    Left _ -> do
-      deleteIfExists defaultKeyFile
      deleteIfExists defaultStoreLogFile
+      deleteIfExists defaultKeyFile
+      deleteIfExists defaultPrivateKeyFile
+      deleteIfExists defaultCertificateFile

 data IniOpts = IniOpts
  { enableStoreLog :: Bool,
    storeLogFile :: FilePath,
-    serverKeyFile :: FilePath,
    serverPort :: ServiceName,
    blockSize :: Int,
-    enableWebsockets :: Bool
+    enableWebsockets :: Bool,
+    serverKeyFile :: FilePath,
+    serverPrivateKeyFile :: FilePath,
+    serverCertificateFile :: FilePath
  }

 readIni :: ExceptT String IO IniOpts
@@ -156,11 +179,13 @@ readIni = do
  ini <- ExceptT $ readIniFile iniFile
  let enableStoreLog = (== Right "on") $ lookupValue "STORE_LOG" "enable" ini
      storeLogFile = opt defaultStoreLogFile "STORE_LOG" "file" ini
-      serverKeyFile = opt defaultKeyFile "TRANSPORT" "key_file" ini
      serverPort = opt defaultServerPort "TRANSPORT" "port" ini
      enableWebsockets = (== Right "on") $ lookupValue "TRANSPORT" "websockets" ini
+      serverKeyFile = opt defaultKeyFile "TRANSPORT" "key_file" ini
+      serverPrivateKeyFile = opt defaultPrivateKeyFile "TRANSPORT" "private_key_file" ini
+      serverCertificateFile = opt defaultCertificateFile "TRANSPORT" "certificate_file" ini
  blockSize <- liftEither . readEither $ opt (show defaultBlockSize) "TRANSPORT" "block_size" ini
-  pure IniOpts {enableStoreLog, storeLogFile, serverKeyFile, serverPort, blockSize, enableWebsockets}
+  pure IniOpts {enableStoreLog, storeLogFile, serverPort, blockSize, enableWebsockets, serverKeyFile, serverPrivateKeyFile, serverCertificateFile}
  where
    opt :: String -> Text -> Text -> Ini -> String
    opt def section key ini = either (const def) T.unpack $ lookupValue section key ini
@@ -183,6 +208,12 @@ createIni ServerOpts {enableStoreLog} = do
         \[TRANSPORT]\n\n\
         \# key_file: "
      <> defaultKeyFile
+      <> "\n\
+         \# private_key_file: "
+      <> defaultPrivateKeyFile
+      <> "\n\
+         \# certificate_file: "
+      <> defaultCertificateFile
      <> "\n\
         \# port: "
      <> defaultServerPort
@@ -195,12 +226,29 @@ createIni ServerOpts {enableStoreLog} = do
    IniOpts
      { enableStoreLog,
        storeLogFile = defaultStoreLogFile,
-        serverKeyFile = defaultKeyFile,
        serverPort = defaultServerPort,
        blockSize = defaultBlockSize,
-        enableWebsockets = True
+        enableWebsockets = True,
+        serverKeyFile = defaultKeyFile,
+        serverPrivateKeyFile = defaultPrivateKeyFile,
+        serverCertificateFile = defaultCertificateFile
      }

+-- To generate self-signed certificate:
+-- https://blog.pinterjann.is/ed25519-certificates.html
+
+createKeyAndCertificate :: IniOpts -> ServerOpts -> IO ()
+createKeyAndCertificate IniOpts {serverPrivateKeyFile, serverCertificateFile} ServerOpts {pubkeyAlgorihtm} = do
+  run $ "openssl genpkey -algorithm " <> pubkeyAlgorihtm <> " -out " <> serverPrivateKeyFile
+  run $ "openssl req -new -key " <> serverPrivateKeyFile <> " -subj \"/CN=localhost\" -out " <> csrPath
+  run $ "openssl x509 -req -days 999999 -in " <> csrPath <> " -signkey " <> serverPrivateKeyFile <> " -out " <> serverCertificateFile
+  run $ "rm " <> csrPath
+  where
+    run :: String -> IO ()
+    run cmd = void $ readCreateProcess (shell cmd) ""
+    csrPath :: String
+    csrPath = combine cfgDir "localhost.csr"
+
 readKey :: IniOpts -> ExceptT String IO (C.PrivateKey 'C.RSA)
 readKey IniOpts {serverKeyFile} = do
  fileExists serverKeyFile
@@ -246,7 +294,8 @@ openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', store

 data ServerOpts = ServerOpts
  { serverCommand :: ServerCommand,
-    enableStoreLog :: Bool
+    enableStoreLog :: Bool,
+    pubkeyAlgorihtm :: String
  }

 data ServerCommand = ServerInit | ServerStart | ServerDelete
@@ -264,6 +313,15 @@ serverOpts =
          <> short 'l'
          <> help "enable store log for SMP queues persistence"
      )
+    <*> strOption
+      ( long "pubkey-algorithm"
+          <> short 'a'
+          <> help
+            ( "public-key algorithm used for certificate generation,"
+                <> "\nsupported algorithms: ED448 (default) and ED25519"
+            )
+          <> value "ED448"
+      )

 getServerOpts :: IO ServerOpts
 getServerOpts = customExecParser p opts
--- a/package.yaml
+++ b/package.yaml
@@ -35,6 +35,7 @@ dependencies:
  - constraints >= 0.12 && < 0.14
  - containers == 0.6.*
  - cryptonite >= 0.27 && < 0.30
+  - data-default == 0.7.*
  - direct-sqlite == 2.3.*
  - directory == 1.3.*
  - file-embed >= 0.0.14.0 && <= 0.0.15.0
@@ -54,6 +55,7 @@ dependencies:
  - template-haskell == 2.16.*
  - text == 1.2.*
  - time == 1.9.*
+  - tls == 1.5.*
  - transformers == 0.5.*
  - unliftio == 0.2.*
  - unliftio-core == 0.2.*
@@ -71,6 +73,7 @@ executables:
      - cryptostore == 0.2.*
      - ini == 0.4.*
      - optparse-applicative >= 0.15 && < 0.17
+      - process == 1.6.*
      - simplexmq
    ghc-options:
      - -threaded
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -75,6 +75,7 @@ library
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
    , cryptonite >=0.27 && <0.30
+    , data-default ==0.7.*
    , direct-sqlite ==2.3.*
    , directory ==1.3.*
    , file-embed >=0.0.14.0 && <=0.0.15.0
@@ -93,6 +94,7 @@ library
    , template-haskell ==2.16.*
    , text ==1.2.*
    , time ==1.9.*
+    , tls ==1.5.*
    , transformers ==0.5.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -121,6 +123,7 @@ executable smp-agent
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
    , cryptonite >=0.27 && <0.30
+    , data-default ==0.7.*
    , direct-sqlite ==2.3.*
    , directory ==1.3.*
    , file-embed >=0.0.14.0 && <=0.0.15.0
@@ -140,6 +143,7 @@ executable smp-agent
    , template-haskell ==2.16.*
    , text ==1.2.*
    , time ==1.9.*
+    , tls ==1.5.*
    , transformers ==0.5.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -169,6 +173,7 @@ executable smp-server
    , containers ==0.6.*
    , cryptonite >=0.27 && <0.30
    , cryptostore ==0.2.*
+    , data-default ==0.7.*
    , direct-sqlite ==2.3.*
    , directory ==1.3.*
    , file-embed >=0.0.14.0 && <=0.0.15.0
@@ -182,6 +187,7 @@ executable smp-server
    , network ==3.1.*
    , network-transport ==0.5.*
    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
    , random >=1.1 && <1.3
    , simple-logger ==0.1.*
    , simplexmq
@@ -190,6 +196,7 @@ executable smp-server
    , template-haskell ==2.16.*
    , text ==1.2.*
    , time ==1.9.*
+    , tls ==1.5.*
    , transformers ==0.5.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
@@ -228,6 +235,7 @@ test-suite smp-server-test
    , constraints >=0.12 && <0.14
    , containers ==0.6.*
    , cryptonite >=0.27 && <0.30
+    , data-default ==0.7.*
    , direct-sqlite ==2.3.*
    , directory ==1.3.*
    , file-embed >=0.0.14.0 && <=0.0.15.0
@@ -250,6 +258,7 @@ test-suite smp-server-test
    , text ==1.2.*
    , time ==1.9.*
    , timeit ==2.0.*
+    , tls ==1.5.*
    , transformers ==0.5.*
    , unliftio ==0.2.*
    , unliftio-core ==0.2.*
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -105,15 +105,18 @@ runSMPAgent t cfg = do
 -- This function uses passed TMVar to signal when the server is ready to accept TCP requests (True)
 -- and when it is disconnected from the TCP socket once the server thread is killed (False).
 runSMPAgentBlocking :: (MonadRandom m, MonadUnliftIO m) => ATransport -> TMVar Bool -> AgentConfig -> m ()
-runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort} = runReaderT (smpAgent t) =<< newSMPAgentEnv cfg
+runSMPAgentBlocking (ATransport t) started cfg@AgentConfig {tcpPort} = do
+  runReaderT (smpAgent t) =<< newSMPAgentEnv cfg
  where
    smpAgent :: forall c m'. (Transport c, MonadUnliftIO m', MonadReader Env m') => TProxy c -> m' ()
-    smpAgent _ = runTransportServer started tcpPort $ \(h :: c) -> do
-      liftIO . putLn h $ "Welcome to SMP agent v" <> currentSMPVersionStr
-      c <- getAgentClient
-      logConnection c True
-      race_ (connectClient h c) (runAgentClient c)
-        `E.finally` disconnectAgentClient c
+    smpAgent _ = do
+      credential <- asks agentCredential
+      runTransportServer started tcpPort credential $ \(h :: c) -> do
+        liftIO . putLn h $ "Welcome to SMP agent v" <> currentSMPVersionStr
+        c <- getAgentClient
+        logConnection c True
+        race_ (connectClient h c) (runAgentClient c)
+          `E.finally` disconnectAgentClient c

 -- | Creates an SMP agent client instance
 getSMPAgentClient :: (MonadRandom m, MonadUnliftIO m) => AgentConfig -> m AgentClient
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -10,6 +10,7 @@ import Control.Monad.IO.Unlift
 import Crypto.Random
 import Data.List.NonEmpty (NonEmpty)
 import Network.Socket
+import qualified Network.TLS as T
 import Numeric.Natural
 import Simplex.Messaging.Agent.Protocol (SMPServer)
 import Simplex.Messaging.Agent.RetryInterval
@@ -17,6 +18,7 @@ import Simplex.Messaging.Agent.Store.SQLite
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Transport (loadServerCredential)
 import System.Random (StdGen, newStdGen)
 import UnliftIO.STM

@@ -31,7 +33,9 @@ data AgentConfig = AgentConfig
    dbPoolSize :: Int,
    smpCfg :: SMPClientConfig,
    retryInterval :: RetryInterval,
-    reconnectInterval :: RetryInterval
+    reconnectInterval :: RetryInterval,
+    agentPrivateKeyFile :: FilePath,
+    agentCertificateFile :: FilePath
  }

 minute :: Int
@@ -60,7 +64,10 @@ defaultAgentConfig =
          { initialInterval = 1_000_000,
            increaseAfter = 10_000_000,
            maxInterval = 10_000_000
-          }
+          },
+      -- ! we do not generate these key and certificate
+      agentPrivateKeyFile = "/etc/opt/simplex-agent/agent.key",
+      agentCertificateFile = "/etc/opt/simplex-agent/agent.crt"
    }

 data Env = Env
@@ -69,7 +76,8 @@ data Env = Env
    idsDrg :: TVar ChaChaDRG,
    clientCounter :: TVar Int,
    reservedMsgSize :: Int,
-    randomServer :: TVar StdGen
+    randomServer :: TVar StdGen,
+    agentCredential :: T.Credential
  }

 newSMPAgentEnv :: (MonadUnliftIO m, MonadRandom m) => AgentConfig -> m Env
@@ -78,7 +86,8 @@ newSMPAgentEnv cfg = do
  store <- liftIO $ createSQLiteStore (dbFile cfg) (dbPoolSize cfg) Migrations.app
  clientCounter <- newTVarIO 0
  randomServer <- newTVarIO =<< liftIO newStdGen
-  return Env {config = cfg, store, idsDrg, clientCounter, reservedMsgSize, randomServer}
+  agentCredential <- liftIO $ loadServerCredential (agentPrivateKeyFile cfg) (agentCertificateFile cfg)
+  return Env {config = cfg, store, idsDrg, clientCounter, reservedMsgSize, randomServer, agentCredential}
  where
    -- 1st rsaKeySize is used by the RSA signature in each command,
    -- 2nd - by encrypted message body header
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -64,7 +64,7 @@ import Numeric.Natural
 import Simplex.Messaging.Agent.Protocol (SMPServer (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Transport (ATransport (..), TCP, THandle (..), TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
+import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import Simplex.Messaging.Util (bshow, liftError, raceAny_)
 import System.Timeout (timeout)
@@ -114,7 +114,7 @@ smpDefaultConfig :: SMPClientConfig
 smpDefaultConfig =
  SMPClientConfig
    { qSize = 16,
-      defaultTransport = ("5223", transport @TCP),
+      defaultTransport = ("5223", transport @TLS),
      tcpTimeout = 4_000_000,
      smpPing = 30_000_000,
      smpBlockSize = Just 8192,
@@ -174,8 +174,8 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
    useTransport :: (ServiceName, ATransport)
    useTransport = case port smpServer of
      Nothing -> defaultTransport cfg
-      Just "80" -> ("80", transport @WS)
-      Just p -> (p, transport @TCP)
+      -- Just "80" -> ("80", transport @WS)
+      Just p -> (p, transport @TLS)

    client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError Int) -> c -> IO ()
    client _ c thVar h =
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -83,7 +83,9 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do
        `finally` withLog closeStoreLog

    runServer :: (MonadUnliftIO m', MonadReader Env m') => (ServiceName, ATransport) -> m' ()
-    runServer (tcpPort, ATransport t) = runTransportServer started tcpPort (runClient t)
+    runServer (tcpPort, ATransport t) = do
+      credential <- asks serverCredential
+      runTransportServer started tcpPort credential (runClient t)

    serverThread ::
      forall m' s.
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -11,27 +11,30 @@ import Crypto.Random
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Network.Socket (ServiceName)
+import qualified Network.TLS as T
 import Numeric.Natural
-import qualified Simplex.Messaging.Crypto as C
+import qualified Simplex.Messaging.Crypto as C -- TODO delete
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.QueueStore (QueueRec (..))
 import Simplex.Messaging.Server.QueueStore.STM
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Transport (ATransport)
+import Simplex.Messaging.Transport (ATransport, loadServerCredential)
 import System.IO (IOMode (..))
 import UnliftIO.STM

 data ServerConfig = ServerConfig
-  { transports :: [(ServiceName, ATransport)],
-    tbqSize :: Natural,
+  { tbqSize :: Natural,
    msgQueueQuota :: Natural,
    queueIdBytes :: Int,
-    msgIdBytes :: Int, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
+    msgIdBytes :: Int,
+    transports :: [(ServiceName, ATransport)],
    storeLog :: Maybe (StoreLog 'ReadMode),
    blockSize :: Int,
-    trnSignAlg :: C.SignAlg,
-    serverPrivateKey :: C.PrivateKey 'C.RSA
+    serverPrivateKey :: C.PrivateKey 'C.RSA, -- TODO delete
+    serverPrivateKeyFile :: FilePath,
+    serverCertificateFile :: FilePath,
+    trnSignAlg :: C.SignAlg
  }

 data Env = Env
@@ -40,8 +43,9 @@ data Env = Env
    queueStore :: QueueStore,
    msgStore :: STMMsgStore,
    idsDrg :: TVar ChaChaDRG,
-    serverKeyPair :: C.KeyPair 'C.RSA,
-    storeLog :: Maybe (StoreLog 'WriteMode)
+    serverKeyPair :: C.KeyPair 'C.RSA, -- TODO delete
+    storeLog :: Maybe (StoreLog 'WriteMode),
+    serverCredential :: T.Credential
  }

 data Server = Server
@@ -93,9 +97,10 @@ newEnv config = do
  msgStore <- atomically newMsgStore
  idsDrg <- drgNew >>= newTVarIO
  s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
-  let pk = serverPrivateKey config
+  let pk = serverPrivateKey config -- TODO remove
      serverKeyPair = (C.publicKey pk, pk)
-  return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair, storeLog = s'}
+  serverCredential <- liftIO $ loadServerCredential (serverPrivateKeyFile config) (serverCertificateFile config)
+  return Env {config, server, queueStore, msgStore, idsDrg, serverKeyPair, storeLog = s', serverCredential}
  where
    restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)
    restoreQueues queueStore s = do
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -29,12 +30,13 @@ module Simplex.Messaging.Transport
    TProxy (..),
    ATransport (..),

-    -- * Transport over TCP
+    -- * Transport over TLS 1.3
    runTransportServer,
    runTransportClient,
+    loadServerCredential,

-    -- * TCP transport
-    TCP (..),
+    -- * TLS 1.3 Transport
+    TLS (..),

    -- * SMP encrypted transport
    THandle (..),
@@ -63,6 +65,8 @@ import Data.Bifunctor (first)
 import Data.ByteArray (xor)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as BL
+import Data.Default (def)
 import Data.Functor (($>))
 import Data.Maybe (fromMaybe)
 import Data.Set (Set)
@@ -74,11 +78,13 @@ import GHC.IO.Exception (IOErrorType (..))
 import GHC.IO.Handle.Internals (ioe_EOF)
 import Generic.Random (genericArbitraryU)
 import Network.Socket
+import qualified Network.TLS as T
+import qualified Network.TLS.Extra as TE
 import Network.Transport.Internal (decodeNum16, decodeNum32, encodeEnum16, encodeEnum32, encodeWord32)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (parse, parseAll, parseRead1, parseString)
 import Simplex.Messaging.Util (bshow, liftError)
-import System.IO
+import System.Exit (exitFailure)
 import System.IO.Error
 import Test.QuickCheck (Arbitrary (..))
 import UnliftIO.Concurrent
@@ -94,11 +100,11 @@ class Transport c where

  transportName :: TProxy c -> String

-  -- | Upgrade client socket to connection (used in the server)
-  getServerConnection :: Socket -> IO c
+  -- | Upgrade client TLS context to connection (used in the server)
+  getServerConnection :: TLS -> IO c

-  -- | Upgrade server socket to connection (used in the client)
-  getClientConnection :: Socket -> IO c
+  -- | Upgrade server TLS context to connection (used in the client)
+  getClientConnection :: TLS -> IO c

  -- | Close connection
  closeConnection :: c -> IO ()
@@ -120,18 +126,21 @@ data TProxy c = TProxy

 data ATransport = forall c. Transport c => ATransport (TProxy c)

-- * Transport over TCP
+-- * Transport over TLS 1.3

 -- | Run transport server (plain TCP or WebSockets) on passed TCP port and signal when server started and stopped via passed TMVar.
 --
 -- All accepted connections are passed to the passed function.
-runTransportServer :: (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> (c -> m ()) -> m ()
-runTransportServer started port server = do
+runTransportServer :: (Transport c, MonadUnliftIO m) => TMVar Bool -> ServiceName -> T.Credential -> (c -> m ()) -> m ()
+runTransportServer started port credential server = do
  clients <- newTVarIO S.empty
-  E.bracket (liftIO $ startTCPServer started port) (liftIO . closeServer clients) $ \sock -> forever $ do
-    c <- liftIO $ acceptConnection sock
-    tid <- forkFinally (server c) (const $ liftIO $ closeConnection c)
-    atomically . modifyTVar clients $ S.insert tid
+  E.bracket
+    (liftIO $ startTCPServer started port)
+    (liftIO . closeServer clients)
+    $ \sock -> forever $ do
+      c <- liftIO $ acceptConnection sock
+      tid <- forkFinally (server c) (const $ liftIO $ closeConnection c)
+      atomically . modifyTVar clients $ S.insert tid
  where
    closeServer :: TVar (Set ThreadId) -> Socket -> IO ()
    closeServer clients sock = do
@@ -139,7 +148,10 @@ runTransportServer started port server = do
      close sock
      void . atomically $ tryPutTMVar started False
    acceptConnection :: Transport c => Socket -> IO c
-    acceptConnection sock = accept sock >>= getServerConnection . fst
+    acceptConnection sock = do
+      (newSock, _) <- accept sock
+      let serverParams = mkServerParams credential
+      connectTLS "server" getServerConnection serverParams newSock

 startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
 startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
@@ -182,28 +194,106 @@ startTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
    open addr = do
      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
      connect sock $ addrAddress addr
-      getClientConnection sock
+      connectTLS "client" getClientConnection clientParams sock

-- * TCP transport
+-- TODO non lazy
+loadServerCredential :: FilePath -> FilePath -> IO T.Credential
+loadServerCredential privateKeyFile certificateFile =
+  T.credentialLoadX509 certificateFile privateKeyFile >>= \case
+    Right cert -> pure cert
+    Left _ -> putStrLn "invalid credential" >> exitFailure

-newtype TCP = TCP {tcpHandle :: Handle}
+-- * TLS 1.3 Transport

-instance Transport TCP where
-  transportName _ = "TCP"
-  getServerConnection = fmap TCP . getSocketHandle
-  getClientConnection = getServerConnection
-  closeConnection (TCP h) = hClose h `E.catch` \(_ :: E.SomeException) -> pure ()
-  cGet = B.hGet . tcpHandle
-  cPut = B.hPut . tcpHandle
-  getLn = fmap trimCR . B.hGetLine . tcpHandle
+data TLS = TLS {tlsContext :: T.Context, buffer :: TVar ByteString, getLock :: TMVar ()}

-getSocketHandle :: Socket -> IO Handle
-getSocketHandle conn = do
-  h <- socketToHandle conn ReadWriteMode
-  hSetBinaryMode h True
-  hSetNewlineMode h NewlineMode {inputNL = CRLF, outputNL = CRLF}
-  hSetBuffering h LineBuffering
-  return h
+connectTLS :: (T.TLSParams p) => String -> (TLS -> IO c) -> p -> Socket -> IO c
+connectTLS party getPartyConnection params sock =
+  E.bracketOnError (T.contextNew sock params) closeTLS $ \tlsContext -> do
+    T.handshake tlsContext
+    buffer <- newTVarIO ""
+    getLock <- newTMVarIO ()
+    getPartyConnection TLS {tlsContext, buffer, getLock}
+      `E.catch` \(e :: E.SomeException) -> putStrLn (party <> " exception: " <> show e) >> E.throwIO e
+
+closeTLS :: T.Context -> IO ()
+closeTLS ctx =
+  (T.bye ctx >> T.contextClose ctx) -- sometimes socket was closed before 'TLS.bye'
+    `E.catch` (\(_ :: E.SomeException) -> pure ()) -- so we catch the 'Broken pipe' error here
+
+mkServerParams :: T.Credential -> T.ServerParams
+mkServerParams credential =
+  def
+    { T.serverWantClientCert = False,
+      T.serverShared = def {T.sharedCredentials = T.Credentials [credential]},
+      T.serverHooks = def,
+      T.serverSupported = supportedParameters
+    }
+
+clientParams :: T.ClientParams
+clientParams =
+  (T.defaultParamsClient "localhost" "5223")
+    { T.clientShared = def,
+      T.clientHooks = def {T.onServerCertificate = \_ _ _ _ -> pure []},
+      T.clientSupported = supportedParameters
+    }
+
+supportedParameters :: T.Supported
+supportedParameters =
+  def
+    { T.supportedVersions = [T.TLS13],
+      T.supportedCiphers = [TE.cipher_TLS13_CHACHA20POLY1305_SHA256],
+      T.supportedHashSignatures = [(T.HashIntrinsic, T.SignatureEd448), (T.HashIntrinsic, T.SignatureEd25519)],
+      T.supportedSecureRenegotiation = False,
+      T.supportedGroups = [T.X448, T.X25519]
+    }
+
+instance Transport TLS where
+  transportName _ = "TLS 1.3"
+  getServerConnection = pure
+  getClientConnection = pure
+  closeConnection tls = closeTLS $ tlsContext tls
+
+  cGet :: TLS -> Int -> IO ByteString
+  cGet TLS {tlsContext, buffer, getLock} n =
+    E.bracket_
+      (atomically $ takeTMVar getLock)
+      (atomically $ putTMVar getLock ())
+      $ do
+        b <- readChunks =<< readTVarIO buffer
+        let (s, b') = B.splitAt n b
+        atomically $ writeTVar buffer b'
+        pure s
+    where
+      readChunks :: ByteString -> IO ByteString
+      readChunks b
+        | B.length b >= n = pure b
+        | otherwise = readChunks . (b <>) =<< T.recvData tlsContext `E.catch` handleEOF
+      handleEOF = \case
+        T.Error_EOF -> E.throwIO TEBadBlock
+        e -> E.throwIO e
+
+  cPut :: TLS -> ByteString -> IO ()
+  cPut tls = T.sendData (tlsContext tls) . BL.fromStrict
+
+  getLn :: TLS -> IO ByteString
+  getLn TLS {tlsContext, buffer, getLock} = do
+    E.bracket_
+      (atomically $ takeTMVar getLock)
+      (atomically $ putTMVar getLock ())
+      $ do
+        b <- readChunks =<< readTVarIO buffer
+        let (s, b') = B.break (== '\n') b
+        atomically $ writeTVar buffer (B.drop 1 b') -- drop '\n' we made a break at
+        pure $ trimCR s
+    where
+      readChunks :: ByteString -> IO ByteString
+      readChunks b
+        | B.elem '\n' b = pure b
+        | otherwise = readChunks . (b <>) =<< T.recvData tlsContext `E.catch` handleEOF
+      handleEOF = \case
+        T.Error_EOF -> E.throwIO TEBadBlock
+        e -> E.throwIO e

 -- | Trim trailing CR from ByteString.
 trimCR :: ByteString -> ByteString
--- a/src/Simplex/Messaging/Transport/WebSockets.hs
+++ b/src/Simplex/Messaging/Transport/WebSockets.hs
@@ -13,50 +13,50 @@ import Simplex.Messaging.Transport (TProxy, Transport (..), TransportError (..),

 data WS = WS {wsStream :: Stream, wsConnection :: Connection}

-websocketsOpts :: ConnectionOptions
-websocketsOpts =
-  defaultConnectionOptions
-    { connectionCompressionOptions = NoCompression,
-      connectionFramePayloadSizeLimit = SizeLimit 8192,
-      connectionMessageDataSizeLimit = SizeLimit 65536
-    }
+-- websocketsOpts :: ConnectionOptions
+-- websocketsOpts =
+--   defaultConnectionOptions
+--     { connectionCompressionOptions = NoCompression,
+--       connectionFramePayloadSizeLimit = SizeLimit 8192,
+--       connectionMessageDataSizeLimit = SizeLimit 65536
+--     }

-instance Transport WS where
-  transportName :: TProxy WS -> String
-  transportName _ = "WebSockets"
+-- instance Transport WS where
+--   transportName :: TProxy WS -> String
+--   transportName _ = "WebSockets"

-  getServerConnection :: Socket -> IO WS
-  getServerConnection sock = do
-    s <- S.makeSocketStream sock
-    WS s <$> acceptClientRequest s
-    where
-      acceptClientRequest :: Stream -> IO Connection
-      acceptClientRequest s = makePendingConnectionFromStream s websocketsOpts >>= acceptRequest
+--   getServerConnection :: Socket -> IO WS
+--   getServerConnection sock = do
+--     s <- S.makeSocketStream sock
+--     WS s <$> acceptClientRequest s
+--     where
+--       acceptClientRequest :: Stream -> IO Connection
+--       acceptClientRequest s = makePendingConnectionFromStream s websocketsOpts >>= acceptRequest

-  getClientConnection :: Socket -> IO WS
-  getClientConnection sock = do
-    s <- S.makeSocketStream sock
-    WS s <$> sendClientRequest s
-    where
-      sendClientRequest :: Stream -> IO Connection
-      sendClientRequest s = newClientConnection s "" "/" websocketsOpts []
+--   getClientConnection :: Socket -> IO WS
+--   getClientConnection sock = do
+--     s <- S.makeSocketStream sock
+--     WS s <$> sendClientRequest s
+--     where
+--       sendClientRequest :: Stream -> IO Connection
+--       sendClientRequest s = newClientConnection s "" "/" websocketsOpts []

-  closeConnection :: WS -> IO ()
-  closeConnection = S.close . wsStream
+--   closeConnection :: WS -> IO ()
+--   closeConnection = S.close . wsStream

-  cGet :: WS -> Int -> IO ByteString
-  cGet c n = do
-    s <- receiveData (wsConnection c)
-    if B.length s == n
-      then pure s
-      else E.throwIO TEBadBlock
+--   cGet :: WS -> Int -> IO ByteString
+--   cGet c n = do
+--     s <- receiveData (wsConnection c)
+--     if B.length s == n
+--       then pure s
+--       else E.throwIO TEBadBlock

-  cPut :: WS -> ByteString -> IO ()
-  cPut = sendBinaryData . wsConnection
+--   cPut :: WS -> ByteString -> IO ()
+--   cPut = sendBinaryData . wsConnection

-  getLn :: WS -> IO ByteString
-  getLn c = do
-    s <- trimCR <$> receiveData (wsConnection c)
-    if B.null s || B.last s /= '\n'
-      then E.throwIO TEBadBlock
-      else pure $ B.init s
+--   getLn :: WS -> IO ByteString
+--   getLn c = do
+--     s <- trimCR <$> receiveData (wsConnection c)
+--     if B.null s || B.last s /= '\n'
+--       then E.throwIO TEBadBlock
+--       else pure $ B.init s
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -162,10 +162,12 @@ cfg =
      smpCfg =
        smpDefaultConfig
          { qSize = 1,
-            defaultTransport = (testPort, transport @TCP),
+            defaultTransport = (testPort, transport @TLS),
            tcpTimeout = 500_000
          },
-      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50_000}
+      retryInterval = (retryInterval defaultAgentConfig) {initialInterval = 50_000},
+      agentPrivateKeyFile = "tests/fixtures/example.key",
+      agentCertificateFile = "tests/fixtures/example.crt"
    }

 withSmpAgentThreadOn_ :: (MonadUnliftIO m, MonadRandom m) => ATransport -> (ServiceName, ServiceName, String) -> m () -> (ThreadId -> m a) -> m a
@@ -190,7 +192,8 @@ testSMPAgentClientOn port' client = do
    line <- liftIO $ getLn h
    if line == "Welcome to SMP agent v" <> currentSMPVersionStr
      then client h
-      else error $ "wrong welcome message: " <> B.unpack line
+      else do
+        error $ "wrong welcome message: " <> B.unpack line

 testSMPAgentClient :: (Transport c, MonadUnliftIO m) => (c -> m a) -> m a
 testSMPAgentClient = testSMPAgentClientOn agentTestPort
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -95,7 +95,9 @@ cfg =
        \vqiBHoO3RNbqg+2rmTMfDuXreME3S955ZiPZm4Z+T8Hj52mPAoGAQm5QH/gLFtY5\
        \+znqU/0G8V6BKISCQMxbbmTQVcTgGySrP2gVd+e4MWvUttaZykhWqs8rpr7mgpIY\
        \hul7Swx0SHFN3WpXu8uj+B6MLpRcCbDHO65qU4kQLs+IaXXsuuTjMvJ5LwjkZVrQ\
-        \TmKzSAw7iVWwEUZR/PeiEKazqrpp9VU="
+        \TmKzSAw7iVWwEUZR/PeiEKazqrpp9VU=",
+      serverPrivateKeyFile = "tests/fixtures/example.key",
+      serverCertificateFile = "tests/fixtures/example.crt"
    }

 withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -3,7 +3,7 @@
 import AgentTests (agentTests)
 import ProtocolErrorTests
 import ServerTests
-import Simplex.Messaging.Transport (TCP, Transport (..))
+import Simplex.Messaging.Transport (TLS, Transport (..))
 import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
 import Test.Hspec
@@ -13,7 +13,7 @@ main = do
  createDirectoryIfMissing False "tests/tmp"
  hspec $ do
    describe "Protocol errors" protocolErrorTests
-    describe "SMP server via TCP" $ serverTests (transport @TCP)
-    describe "SMP server via WebSockets" $ serverTests (transport @WS)
-    describe "SMP client agent" $ agentTests (transport @TCP)
+    describe "SMP server via TLS 1.3" $ serverTests (transport @TLS)
+    -- describe "SMP server via WebSockets" $ serverTests (transport @WS)
+    describe "SMP client agent" $ agentTests (transport @TLS)
  removeDirectoryRecursive "tests/tmp"
--- a/tests/fixtures/example.crt
+++ b/tests/fixtures/example.crt
@@ -0,0 +1,9 @@
+-----BEGIN CERTIFICATE-----
+MIIBLzCBsAIUDS2s4hUHeT9gYpGcf7SJNnyReDUwBQYDK2VxMBQxEjAQBgNVBAMM
+CWxvY2FsaG9zdDAgFw0yMTEyMTQxMDM3NTFaGA80NzU5MTExMDEwMzc1MVowFDES
+MBAGA1UEAwwJbG9jYWxob3N0MEMwBQYDK2VxAzoAMb/HUcgN/sU2rm1YHoTMFVTu
+ptY7hKjDm8mRxUWXzvHS0S6vqZRfJuCBQms4MSlTv+z1LjzDevUAMAUGAytlcQNz
+AA2eyrpA0O2TzNCeVEs0Dp/uXTzQPWJHD8fN0DCwSJf7xIY01jNmcvx/IFYnGCd+
+uQ/7vm6kcUFNgKhVWY9e7xLjYqeBirHTQiTRrh+9mKDOwmsSOhnz3acYPgrJ2QUO
+zDtZa16ppKRA5ucLJ4AXaacOAA==
+-----END CERTIFICATE-----
--- a/tests/fixtures/example.key
+++ b/tests/fixtures/example.key
@@ -0,0 +1,4 @@
+-----BEGIN PRIVATE KEY-----
+MEcCAQAwBQYDK2VxBDsEOcj0BvnNHWg2dsOnww++p/PHxnl+KGWFXre57wXEredA
+j0xo78ZgadAeY0Y5mO4nfb8lk3CBz+ojGA==
+-----END PRIVATE KEY-----