From f3523bbba965432fc654e589ffce57aea832183f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 2 Jan 2022 22:24:43 +0000
Subject: [PATCH] make KeyHash non-optional, verify KeyHash in SMP handshake,
 use StrEncoding class (#250)

* make KeyHash non-optional, StrEncoding class

* change server URI format in agent config, refactor with StrEncoding

* refactor Crypto using checkAlgorithm

* refactor parsing connection requests

* prepare to validate CA fingerprint sent in client handshake

* KeyHash check in handshake

* rename type to CliCommand

* server validates keyhash sent by the client

* validate -a option when parsing

* more of StrEncoding
---
 apps/smp-agent/Main.hs                      |   2 +-
 apps/smp-server/Main.hs                     | 165 ++++++-----
 migrations/20210101_initial.sql             |   2 +-
 simplexmq.cabal                             |   1 +
 src/Simplex/Messaging/Agent.hs              |   2 +-
 src/Simplex/Messaging/Agent/Client.hs       |   2 +-
 src/Simplex/Messaging/Agent/Env/SQLite.hs   |   2 +-
 src/Simplex/Messaging/Agent/Protocol.hs     | 262 +++++++----------
 src/Simplex/Messaging/Agent/Store/SQLite.hs |  15 +-
 src/Simplex/Messaging/Client.hs             |   3 +-
 src/Simplex/Messaging/Crypto.hs             | 295 +++++++-------------
 src/Simplex/Messaging/Crypto/Ratchet.hs     |   4 +-
 src/Simplex/Messaging/Encoding.hs           |  13 +
 src/Simplex/Messaging/Encoding/String.hs    |  85 ++++++
 src/Simplex/Messaging/Parsers.hs            |  23 +-
 src/Simplex/Messaging/Protocol.hs           |  36 ++-
 src/Simplex/Messaging/Server.hs             |  11 +-
 src/Simplex/Messaging/Server/Env/STM.hs     |   9 +-
 src/Simplex/Messaging/Server/StoreLog.hs    |  81 +++---
 src/Simplex/Messaging/Transport.hs          |  66 +++--
 src/Simplex/Messaging/Util.hs               |   2 +-
 src/Simplex/Messaging/Version.hs            |  10 +
 tests/AgentTests.hs                         |  21 +-
 tests/AgentTests/ConnectionRequestTests.hs  |  26 +-
 tests/SMPAgentClient.hs                     |   2 +-
 tests/SMPClient.hs                          |  19 +-
 tests/ServerTests.hs                        |   9 +-
 27 files changed, 577 insertions(+), 591 deletions(-)
 create mode 100644 src/Simplex/Messaging/Encoding/String.hs

diff --git a/apps/smp-agent/Main.hs b/apps/smp-agent/Main.hs
index 544a12701..b2bb22e9d 100644
--- a/apps/smp-agent/Main.hs
+++ b/apps/smp-agent/Main.hs
@@ -11,7 +11,7 @@ import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Transport (TLS, Transport (..))
 
 cfg :: AgentConfig
-cfg = defaultAgentConfig {smpServers = L.fromList ["localhost:5223#bU0K+bRg24xWW//lS0umO1Zdw/SXqpJNtm1/RrPLViE="]}
+cfg = defaultAgentConfig {smpServers = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"]}
 
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs
index 1cb595fca..bdade5f4a 100644
--- a/apps/smp-server/Main.hs
+++ b/apps/smp-server/Main.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -8,24 +9,27 @@
 module Main where
 
 import Control.Monad.Except
+import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Composition ((.:))
 import Data.Either (fromRight)
 import Data.Ini (Ini, lookupValue, readIniFile)
-import Data.List (dropWhileEnd)
 import qualified Data.Text as T
+import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (ServiceName)
 import Options.Applicative
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
-import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..), encodeFingerprint, loadFingerprint, simplexMQVersion)
+import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..), loadFingerprint, simplexMQVersion)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeDirectoryRecursive)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
-import System.IO (IOMode (..))
+import System.IO (IOMode (..), hGetLine, withFile)
 import System.Process (readCreateProcess, shell)
+import Text.Read (readMaybe)
 
 cfgDir :: FilePath
 cfgDir = "/etc/opt/simplex"
@@ -56,58 +60,53 @@ fingerprintFile = combine cfgDir "fingerprint"
 
 main :: IO ()
 main = do
-  getCliOptions >>= \opts -> case optCommand opts of
-    Init initOptions@InitOptions {pubkeyAlgorithm} -> do
-      -- TODO check during parsing
-      checkPubkeyAlgorithm pubkeyAlgorithm
+  getCliCommand >>= \case
+    Init opts ->
       doesFileExist iniFile >>= \case
-        True -> iniAlreadyExistsErr >> exitFailure
-        False -> initializeServer initOptions
-    Start -> do
+        True -> exitError $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `smp-server start`."
+        _ -> initializeServer opts
+    Start ->
       doesFileExist iniFile >>= \case
-        False -> iniDoesNotExistErr >> exitFailure
-        True -> readIniFile iniFile >>= either (\e -> putStrLn e >> exitFailure) (runServer . mkIniOptions)
+        True -> readIniFile iniFile >>= either exitError (runServer . mkIniOptions)
+        _ -> exitError $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `smp-server init`."
     Delete -> cleanup >> putStrLn "Deleted configuration and log files"
-  where
-    checkPubkeyAlgorithm alg
-      | alg == "ED448" || alg == "ED25519" = pure ()
-      | otherwise = putStrLn ("Unsupported public key algorithm " <> alg) >> exitFailure
-    iniAlreadyExistsErr = putStrLn $ "Error: server is already initialized (" <> iniFile <> " exists).\nRun `smp-server start`."
-    iniDoesNotExistErr = putStrLn $ "Error: server is not initialized (" <> iniFile <> " does not exist).\nRun `smp-server init`."
 
-newtype CliOptions = CliOptions {optCommand :: Command}
+exitError :: String -> IO ()
+exitError msg = putStrLn msg >> exitFailure
 
-data Command
+data CliCommand
   = Init InitOptions
   | Start
   | Delete
 
 data InitOptions = InitOptions
   { enableStoreLog :: Bool,
-    pubkeyAlgorithm :: String
+    signAlgorithm :: SignAlgorithm
   }
 
-getCliOptions :: IO CliOptions
-getCliOptions =
+data SignAlgorithm = ED448 | ED25519
+  deriving (Read, Show)
+
+getCliCommand :: IO CliCommand
+getCliCommand =
   customExecParser
     (prefs showHelpOnEmpty)
     ( info
-        (helper <*> versionOption <*> cliOptionsP)
+        (helper <*> versionOption <*> cliCommandP)
         (header version <> fullDesc)
     )
   where
     versionOption = infoOption version (long "version" <> short 'v' <> help "Show version")
 
-cliOptionsP :: Parser CliOptions
-cliOptionsP =
-  CliOptions
-    <$> hsubparser
-      ( command "init" (info initP (progDesc $ "Initialize server - creates " <> cfgDir <> " and " <> logDir <> " directories and configuration files"))
-          <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
-          <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
-      )
+cliCommandP :: Parser CliCommand
+cliCommandP =
+  hsubparser
+    ( command "init" (info initP (progDesc $ "Initialize server - creates " <> cfgDir <> " and " <> logDir <> " directories and configuration files"))
+        <> command "start" (info (pure Start) (progDesc $ "Start server (configuration: " <> iniFile <> ")"))
+        <> command "delete" (info (pure Delete) (progDesc "Delete configuration and log files"))
+    )
   where
-    initP :: Parser Command
+    initP :: Parser CliCommand
     initP =
       Init .: InitOptions
         <$> switch
@@ -115,34 +114,35 @@ cliOptionsP =
               <> short 'l'
               <> help "Enable store log for SMP queues persistence"
           )
-        <*> strOption
-          ( long "pubkey-algorithm"
+        <*> option
+          (maybeReader readMaybe)
+          ( long "sign-algorithm"
               <> short 'a'
-              <> help "Public key algorithm used for certificate generation: ED25519, ED448"
-              <> value "ED448"
+              <> help "Signature algorithm used for TLS certificates: ED25519, ED448"
+              <> value ED448
               <> showDefault
               <> metavar "ALG"
           )
 
 initializeServer :: InitOptions -> IO ()
-initializeServer InitOptions {enableStoreLog, pubkeyAlgorithm} = do
+initializeServer InitOptions {enableStoreLog, signAlgorithm} = do
   cleanup
   createDirectoryIfMissing True cfgDir
   createDirectoryIfMissing True logDir
   createX509
-  saveFingerprint
+  fp <- saveFingerprint
   createIni
   putStrLn $ "Server initialized, you can modify configuration in " <> iniFile <> ".\nRun `smp-server start` to start server."
-  printServiceInfo
+  printServiceInfo fp
   warnCAPrivateKeyFile
   where
     createX509 = do
       createOpensslConf
       -- CA certificate (identity/offline)
-      run $ "openssl genpkey -algorithm " <> pubkeyAlgorithm <> " -out " <> caKeyFile
+      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> caKeyFile
       run $ "openssl req -new -x509 -days 999999 -config " <> opensslCnfFile <> " -extensions v3_ca -key " <> caKeyFile <> " -out " <> caCrtFile
       -- server certificate (online)
-      run $ "openssl genpkey -algorithm " <> pubkeyAlgorithm <> " -out " <> serverKeyFile
+      run $ "openssl genpkey -algorithm " <> show signAlgorithm <> " -out " <> serverKeyFile
       run $ "openssl req -new -config " <> opensslCnfFile <> " -reqexts v3_req -key " <> serverKeyFile <> " -out " <> serverCsrFile
       run $ "openssl x509 -req -days 999999 -copy_extensions copy -in " <> serverCsrFile <> " -CA " <> caCrtFile <> " -CAkey " <> caKeyFile <> " -out " <> serverCrtFile
       where
@@ -168,8 +168,9 @@ initializeServer InitOptions {enableStoreLog, pubkeyAlgorithm} = do
             \extendedKeyUsage = serverAuth\n"
 
     saveFingerprint = do
-      fingerprint <- loadFingerprint caCrtFile
-      writeFile fingerprintFile $ (B.unpack . encodeFingerprint) fingerprint <> "\n"
+      Fingerprint fp <- loadFingerprint caCrtFile
+      withFile fingerprintFile WriteMode (`B.hPutStrLn` strEncode fp)
+      pure fp
 
     createIni = do
       writeFile iniFile $
@@ -207,45 +208,39 @@ mkIniOptions ini =
 
 runServer :: IniOptions -> IO ()
 runServer IniOptions {enableStoreLog, port, enableWebsockets} = do
-  checkSavedFingerprint
-  printServiceInfo
-  checkCAPrivateKeyFile
-  cfg <- setupServerConfig
+  fp <- checkSavedFingerprint
+  printServiceInfo fp
+  storeLog <- openStoreLog
+  let cfg = mkServerConfig storeLog
   printServerConfig cfg
   runSMPServer cfg
   where
     checkSavedFingerprint = do
       savedFingerprint <- loadSavedFingerprint
-      fingerprint <- loadFingerprint caCrtFile
-      when (savedFingerprint /= (B.unpack . encodeFingerprint) fingerprint) $
-        putStrLn "Stored fingerprint is invalid." >> exitFailure
+      Fingerprint fp <- loadFingerprint caCrtFile
+      when (B.pack savedFingerprint /= strEncode fp) $
+        exitError "Stored fingerprint is invalid."
+      pure fp
 
-    checkCAPrivateKeyFile =
-      doesFileExist caKeyFile >>= (`when` (alert >> warnCAPrivateKeyFile))
-      where
-        alert = putStrLn $ "WARNING: " <> caKeyFile <> " is present on the server!"
+    mkServerConfig storeLog =
+      ServerConfig
+        { transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets],
+          tbqSize = 16,
+          serverTbqSize = 128,
+          msgQueueQuota = 256,
+          queueIdBytes = 24,
+          msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
+          caCertificateFile = caCrtFile,
+          privateKeyFile = serverKeyFile,
+          certificateFile = serverCrtFile,
+          storeLog
+        }
 
-    setupServerConfig = do
-      storeLog <- openStoreLog
-      let transports = (port, transport @TLS) : [("80", transport @WS) | enableWebsockets]
-      pure
-        ServerConfig
-          { tbqSize = 16,
-            serverTbqSize = 128,
-            msgQueueQuota = 256,
-            queueIdBytes = 24,
-            msgIdBytes = 24, -- must be at least 24 bytes, it is used as 192-bit nonce for XSalsa20
-            caCertificateFile = caCrtFile,
-            privateKeyFile = serverKeyFile,
-            certificateFile = serverCrtFile,
-            transports,
-            storeLog
-          }
-      where
-        openStoreLog :: IO (Maybe (StoreLog 'ReadMode))
-        openStoreLog
-          | enableStoreLog = Just <$> openReadStoreLog storeLogFile
-          | otherwise = pure Nothing
+    openStoreLog :: IO (Maybe (StoreLog 'ReadMode))
+    openStoreLog =
+      if enableStoreLog
+        then Just <$> openReadStoreLog storeLogFile
+        else pure Nothing
 
     printServerConfig ServerConfig {storeLog, transports} = do
       putStrLn $ case storeLog of
@@ -261,11 +256,10 @@ cleanup = do
   where
     deleteDirIfExists path = doesDirectoryExist path >>= (`when` removeDirectoryRecursive path)
 
-printServiceInfo :: IO ()
-printServiceInfo = do
+printServiceInfo :: ByteString -> IO ()
+printServiceInfo fpStr = do
   putStrLn version
-  fingerprint <- loadSavedFingerprint
-  putStrLn $ "Fingerprint: " <> fingerprint
+  B.putStrLn $ "Fingerprint: " <> strEncode fpStr
 
 version :: String
 version = "SMP server v" <> simplexMQVersion
@@ -274,13 +268,12 @@ warnCAPrivateKeyFile :: IO ()
 warnCAPrivateKeyFile =
   putStrLn $
     "----------\n\
-    \We highly recommend to remove CA private key file from the server and keep it securely in place of your choosing.\n\
-    \In case server's TLS credential is compromised you will be able to regenerate it using this key,\n\
-    \thus keeping server's identity and allowing clients to keep established connections. Key location:\n"
+    \You should store CA private key securely and delete it from the server.\n\
+    \If server TLS credential is compromised this key can be used to sign a new one, \
+    \keeping the same server identity and established connections.\n\
+    \CA private key location:\n"
       <> caKeyFile
       <> "\n----------"
 
 loadSavedFingerprint :: IO String
-loadSavedFingerprint = do
-  fingerprint <- readFile fingerprintFile
-  pure $ dropWhileEnd (== '\n') fingerprint
+loadSavedFingerprint = withFile fingerprintFile ReadMode hGetLine
diff --git a/migrations/20210101_initial.sql b/migrations/20210101_initial.sql
index f4a4fe804..4cfa9ac95 100644
--- a/migrations/20210101_initial.sql
+++ b/migrations/20210101_initial.sql
@@ -1,7 +1,7 @@
 CREATE TABLE servers (
   host TEXT NOT NULL,
   port TEXT,
-  key_hash BLOB,
+  key_hash BLOB NOT NULL,
   PRIMARY KEY (host, port)
 ) WITHOUT ROWID;
 
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 52717be04..c91f87484 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -43,6 +43,7 @@ library
       Simplex.Messaging.Crypto
       Simplex.Messaging.Crypto.Ratchet
       Simplex.Messaging.Encoding
+      Simplex.Messaging.Encoding.String
       Simplex.Messaging.Parsers
       Simplex.Messaging.Protocol
       Simplex.Messaging.Server
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 1ac40b216..486efe247 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -691,7 +691,7 @@ newSndQueue_ ::
   SMPQueueUri ->
   ConnInfo ->
   m (SndQueue, SMPConfirmation)
-newSndQueue_ a (SMPQueueUri smpServer senderId rcvE2ePubDhKey) cInfo = do
+newSndQueue_ a (SMPQueueUri smpServer senderId clientVersion rcvE2ePubDhKey) cInfo = do
   (senderKey, sndPrivateKey) <- liftIO $ C.generateSignatureKeyPair a
   (e2ePubKey, e2ePrivKey) <- liftIO C.generateKeyPair'
   let sndQueue =
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index e7c9f80f2..8d6d82346 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -255,7 +255,7 @@ newRcvQueue_ a c srv = do
             sndId = Just sndId,
             status = New
           }
-  pure (rq, SMPQueueUri srv sndId e2eDhKey)
+  pure (rq, SMPQueueUri srv sndId SMP.smpClientVersion e2eDhKey)
 
 subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
 subscribeQueue c rq@RcvQueue {server, rcvPrivateKey, rcvId} connId = do
diff --git a/src/Simplex/Messaging/Agent/Env/SQLite.hs b/src/Simplex/Messaging/Agent/Env/SQLite.hs
index 52a008946..0efe49749 100644
--- a/src/Simplex/Messaging/Agent/Env/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Env/SQLite.hs
@@ -43,7 +43,7 @@ defaultAgentConfig :: AgentConfig
 defaultAgentConfig =
   AgentConfig
     { tcpPort = "5224",
-      smpServers = undefined,
+      smpServers = undefined, -- TODO move it elsewhere?
       cmdSignAlg = C.SignAlg C.SEd448,
       connIdBytes = 12,
       tbqSize = 16,
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 3f78d1cb9..f1ad4c705 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -41,6 +41,7 @@ module Simplex.Messaging.Agent.Protocol
     AHeader (..),
     AMessage (..),
     SMPServer (..),
+    SrvLoc (..),
     SMPQueueUri (..),
     ConnectionMode (..),
     SConnectionMode (..),
@@ -76,21 +77,12 @@ module Simplex.Messaging.Agent.Protocol
     clientToAgentMsg,
     serializeAgentMessage,
     serializeMsgIntegrity,
-    serializeSMPQueueUri,
-    serializeConnMode,
-    serializeConnMode',
     connMode,
     connMode',
-    serializeConnReq,
-    serializeConnReq',
     serializeAgentError,
     serializeSmpErrorType,
     commandP,
-    smpServerP,
-    smpQueueUriP,
     connModeT,
-    connReqP,
-    connReqP',
     msgIntegrityP,
     agentErrorTypeP,
     smpErrorTypeP,
@@ -105,7 +97,7 @@ module Simplex.Messaging.Agent.Protocol
   )
 where
 
-import Control.Applicative (optional, (<|>))
+import Control.Applicative ((<|>))
 import Control.Monad.IO.Class
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -113,13 +105,13 @@ import Data.ByteString.Base64
 import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
+import Data.Composition ((.:))
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Kind (Type)
 import Data.List (find)
 import qualified Data.List.NonEmpty as L
 import Data.Maybe (isJust)
-import Data.String (IsString (..))
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Data.Time.ISO8601
@@ -127,10 +119,10 @@ import Data.Type.Equality
 import Data.Typeable ()
 import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
-import Network.HTTP.Types (parseSimpleQuery, renderSimpleQuery)
-import Network.Socket (HostName, ServiceName)
+import Network.HTTP.Types (SimpleQuery, parseSimpleQuery, renderSimpleQuery)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Protocol
   ( ClientMessage (..),
@@ -138,11 +130,14 @@ import Simplex.Messaging.Protocol
     MsgBody,
     MsgId,
     PrivHeader (..),
+    SMPServer (..),
     SndPublicVerifyKey,
+    SrvLoc (..),
   )
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport (Transport (..), TransportError, serializeTransportError, transportErrorP)
 import Simplex.Messaging.Util
+import Simplex.Messaging.Version
 import Test.QuickCheck (Arbitrary (..))
 import Text.Read
 import UnliftIO.Exception (Exception)
@@ -198,15 +193,12 @@ data ACommand (p :: AParty) where
   END :: ACommand Agent
   DOWN :: ACommand Agent
   UP :: ACommand Agent
-  -- QST :: QueueDirection -> ACommand Client
-  -- STAT :: QueueDirection -> Maybe QueueStatus -> Maybe SubMode -> ACommand Agent
   SEND :: MsgBody -> ACommand Client
   MID :: AgentMsgId -> ACommand Agent
   SENT :: AgentMsgId -> ACommand Agent
   MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent
   MSG :: MsgMeta -> MsgBody -> ACommand Agent
   ACK :: AgentMsgId -> ACommand Client
-  -- RCVD :: AgentMsgId -> ACommand Agent
   OFF :: ACommand Client
   DEL :: ACommand Client
   OK :: ACommand Agent
@@ -232,7 +224,7 @@ instance TestEquality SConnectionMode where
   testEquality SCMContact SCMContact = Just Refl
   testEquality _ _ = Nothing
 
-data AConnectionMode = forall m. ACM (SConnectionMode m)
+data AConnectionMode = forall m. ConnectionModeI m => ACM (SConnectionMode m)
 
 instance Eq AConnectionMode where
   ACM m == ACM m' = isJust $ testEquality m m'
@@ -293,16 +285,14 @@ data AHeader = AHeader
     prevMsgHash :: MsgHash
   }
 
-serializeAHeader :: AHeader -> ByteString
-serializeAHeader AHeader {sndMsgId, prevMsgHash} =
-  bshow sndMsgId <> " " <> encode prevMsgHash <> "\n"
+instance StrEncoding AHeader where
+  strEncode AHeader {sndMsgId, prevMsgHash} =
+    bshow sndMsgId <> " " <> strEncode prevMsgHash <> "\n"
+  strP = AHeader <$> A.decimal <* A.space <*> (strP <|> pure "") <* A.endOfLine
 
 emptyAHeader :: ByteString
 emptyAHeader = "\n"
 
-aHeaderP :: Parser AHeader
-aHeaderP = AHeader <$> A.decimal <* A.space <*> (base64P <|> pure "") <* A.endOfLine
-
 emptyAHeaderP :: Parser ()
 emptyAHeaderP = A.endOfLine $> ()
 
@@ -326,9 +316,9 @@ agentToClientMsg = \case
   AgentConfirmation senderKey cInfo ->
     ClientMessage (PHConfirmation senderKey) $ emptyAHeader <> cInfo
   AgentInvitation cReq cInfo ->
-    ClientMessage PHEmpty $ emptyAHeader <> serializeConnReq' cReq <> "\n" <> cInfo
+    ClientMessage PHEmpty $ emptyAHeader <> strEncode cReq <> "\n" <> cInfo
   AgentMessage header aMsg ->
-    ClientMessage PHEmpty $ serializeAHeader header <> serializeAMessage aMsg
+    ClientMessage PHEmpty $ strEncode header <> strEncode aMsg
 
 clientToAgentMsg :: ClientMessage -> Either AgentErrorType AgentMessage
 clientToAgentMsg (ClientMessage header body) = parse parser (AGENT A_MESSAGE) body
@@ -336,121 +326,79 @@ clientToAgentMsg (ClientMessage header body) = parse parser (AGENT A_MESSAGE) bo
     parser = case header of
       PHConfirmation senderKey -> AgentConfirmation senderKey <$> (emptyAHeaderP *> A.takeByteString)
       PHEmpty -> invitationP <|> messageP
-    invitationP = AgentInvitation <$> (emptyAHeaderP *> connReqP' <* A.endOfLine) <*> A.takeByteString
-    messageP = AgentMessage <$> aHeaderP <*> aMessageP
+    invitationP = AgentInvitation <$> (emptyAHeaderP *> strP <* A.endOfLine) <*> A.takeByteString
+    messageP = AgentMessage <$> strP <*> strP
 
-aMessageP :: Parser AMessage
-aMessageP =
-  "HELLO" $> HELLO
-    <|> "REPLY " *> reply
-    <|> "MSG " *> a_msg
-  where
-    reply = REPLY <$> connReqP'
-    a_msg = A_MSG <$> A.takeByteString
+instance StrEncoding AMessage where
+  strP =
+    "HELLO" $> HELLO
+      <|> "REPLY " *> (REPLY <$> strP)
+      <|> "MSG " *> (A_MSG <$> A.takeByteString)
+  strEncode = \case
+    HELLO -> "HELLO"
+    REPLY cReq -> "REPLY " <> strEncode cReq
+    A_MSG body -> "MSG " <> body
 
--- | SMP server location parser.
-smpServerP :: Parser SMPServer
-smpServerP = SMPServer <$> server <*> optional port <*> kHash
-  where
-    server = B.unpack <$> A.takeWhile1 (A.notInClass ":#,; ")
-    port = A.char ':' *> (B.unpack <$> A.takeWhile1 A.isDigit)
-    kHash = Just . C.KeyHash <$> (A.char '#' *> base64P)
+instance StrEncoding SMPQueueUri where
+  strEncode SMPQueueUri {smpServer = srv, senderId = qId, smpVersionRange = vr, dhPublicKey = k} =
+    strEncode srv <> "/" <> U.encode qId <> "#" <> strEncode k
+  strP = do
+    smpServer <- strP <* A.char '/'
+    senderId <- strP <* A.char '#'
+    let smpVersionRange = SMP.smpClientVersion
+    dhPublicKey <- strP
+    pure SMPQueueUri {smpServer, senderId, smpVersionRange, dhPublicKey}
 
-serializeAMessage :: AMessage -> ByteString
-serializeAMessage = \case
-  HELLO -> "HELLO"
-  REPLY cReq -> "REPLY " <> serializeConnReq' cReq
-  A_MSG body -> "MSG " <> body
+newtype QueryStringParams = QSP SimpleQuery
 
--- | Serialize SMP queue information that is sent out-of-band.
-serializeSMPQueueUri :: SMPQueueUri -> ByteString
-serializeSMPQueueUri (SMPQueueUri srv qId dhKey) =
-  serializeServerUri srv <> "/" <> U.encode qId <> "#" <> C.serializePubKeyUri' dhKey
+instance StrEncoding QueryStringParams where
+  strEncode (QSP q) = renderSimpleQuery True q
+  strP = QSP . parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
 
--- | SMP queue information parser.
-smpQueueUriP :: Parser SMPQueueUri
-smpQueueUriP =
-  SMPQueueUri <$> smpServerUriP <* A.char '/' <*> base64UriP <* A.char '#' <*> C.strPubKeyUriP
+queryParam :: StrEncoding a => ByteString -> QueryStringParams -> Parser a
+queryParam name (QSP q) =
+  case find ((== name) . fst) q of
+    Just (_, p) -> either fail pure $ parseAll strP p
+    _ -> fail $ "no qs param " <> B.unpack name
 
-serializeConnReq :: AConnectionRequest -> ByteString
-serializeConnReq (ACR _ cr) = serializeConnReq' cr
+instance forall m. ConnectionModeI m => StrEncoding (ConnectionRequest m) where
+  strEncode = \case
+    CRInvitation crData -> serialize "invitation" crData
+    CRContact crData -> serialize "contact" crData
+    where
+      serialize crMode ConnReqData {crScheme, crSmpQueues, crEncryption = _} =
+        strEncode crScheme <> "/" <> crMode <> "#/" <> queryStr
+        where
+          queryStr = strEncode $ QSP [("smp", strEncode crSmpQueues), ("e2e", "")]
+  strP = do
+    ACR m cr <- strP
+    case testEquality m $ sConnectionMode @m of
+      Just Refl -> pure cr
+      _ -> fail "bad connection request mode"
 
-serializeConnReq' :: ConnectionRequest m -> ByteString
-serializeConnReq' = \case
-  CRInvitation crData -> serialize CMInvitation crData
-  CRContact crData -> serialize CMContact crData
-  where
-    serialize crMode ConnReqData {crScheme, crSmpQueues, crEncryption = _} =
-      sch <> "/" <> m <> "#/" <> queryStr
-      where
-        sch = case crScheme of
-          CRSSimplex -> "simplex:"
-          CRSAppServer host port -> B.pack $ "https://" <> host <> maybe "" (':' :) port
-        m = case crMode of
-          CMInvitation -> "invitation"
-          CMContact -> "contact"
-        queryStr = renderSimpleQuery True [("smp", queues), ("e2e", "")]
-        queues = B.intercalate "," . map serializeSMPQueueUri $ L.toList crSmpQueues
+instance StrEncoding AConnectionRequest where
+  strEncode (ACR _ cr) = strEncode cr
+  strP = do
+    crScheme <- strP
+    mkConnReq <- "/" *> mkConnReqP <* "#/?"
+    query <- strP
+    crSmpQueues <- queryParam "smp" query
+    let crEncryption = ConnectionEncryption
+    pure $ mkConnReq ConnReqData {crScheme, crSmpQueues, crEncryption}
+    where
+      mkConnReqP =
+        "invitation" $> ACR SCMInvitation . CRInvitation
+          <|> "contact" $> ACR SCMContact . CRContact
 
-connReqP' :: forall m. ConnectionModeI m => Parser (ConnectionRequest m)
-connReqP' = do
-  ACR m cr <- connReqP
-  case testEquality m $ sConnectionMode @m of
-    Just Refl -> pure cr
-    _ -> fail "bad connection request mode"
+instance StrEncoding ConnectionMode where
+  strEncode = \case
+    CMInvitation -> "INV"
+    CMContact -> "CON"
+  strP = "INV" $> CMInvitation <|> "CON" $> CMContact
 
-connReqP :: Parser AConnectionRequest
-connReqP = do
-  crScheme <- "simplex:" $> CRSSimplex <|> "https://" *> appServer
-  crMode <- "/" *> mode <* "#/?"
-  query <- parseSimpleQuery <$> A.takeTill (\c -> c == ' ' || c == '\n')
-  crSmpQueues <- paramP "smp" smpQueues query
-  let crEncryption = ConnectionEncryption
-      cReq = ConnReqData {crScheme, crSmpQueues, crEncryption}
-  pure $ case crMode of
-    CMInvitation -> ACR SCMInvitation $ CRInvitation cReq
-    CMContact -> ACR SCMContact $ CRContact cReq
-  where
-    appServer = CRSAppServer <$> host <*> optional port
-    host = B.unpack <$> A.takeTill (\c -> c == ':' || c == '/')
-    port = B.unpack <$> (A.char ':' *> A.takeTill (== '/'))
-    mode = "invitation" $> CMInvitation <|> "contact" $> CMContact
-    paramP param parser query =
-      let p = maybe (fail "") (pure . snd) $ find ((== param) . fst) query
-       in parseAll parser <$?> p
-    smpQueues =
-      maybe (fail "no SMP queues") pure . L.nonEmpty
-        =<< (smpQueue `A.sepBy1'` A.char ',')
-    smpQueue = parseAll smpQueueUriP <$?> A.takeTill (== ',')
-
--- | Serialize SMP server URI.
-serializeServerUri :: SMPServer -> ByteString
-serializeServerUri SMPServer {host, port, keyHash} = "smp://" <> kh <> B.pack host <> p
-  where
-    kh = maybe "" ((<> "@") . U.encode . C.unKeyHash) keyHash
-    p = B.pack $ maybe "" (':' :) port
-
-smpServerUriP :: Parser SMPServer
-smpServerUriP = do
-  _ <- "smp://"
-  keyHash <- C.KeyHash <$> (U.decode <$?> A.takeTill (== '@') <* A.char '@')
-  host <- B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
-  port <- optional $ B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit)
-  pure SMPServer {host, port, keyHash = Just keyHash}
-
-serializeConnMode :: AConnectionMode -> ByteString
-serializeConnMode (ACM cMode) = serializeConnMode' $ connMode cMode
-
-serializeConnMode' :: ConnectionMode -> ByteString
-serializeConnMode' = \case
-  CMInvitation -> "INV"
-  CMContact -> "CON"
-
-connModeP' :: Parser ConnectionMode
-connModeP' = "INV" $> CMInvitation <|> "CON" $> CMContact
-
-connModeP :: Parser AConnectionMode
-connModeP = connMode' <$> connModeP'
+instance StrEncoding AConnectionMode where
+  strEncode (ACM cMode) = strEncode $ connMode cMode
+  strP = connMode' <$> strP
 
 connModeT :: Text -> Maybe ConnectionMode
 connModeT = \case
@@ -458,17 +406,6 @@ connModeT = \case
   "CON" -> Just CMContact
   _ -> Nothing
 
--- | SMP server location and transport key digest (hash).
-data SMPServer = SMPServer
-  { host :: HostName,
-    port :: Maybe ServiceName,
-    keyHash :: Maybe C.KeyHash -- TODO make non optional
-  }
-  deriving (Eq, Ord, Show)
-
-instance IsString SMPServer where
-  fromString = parseString $ parseAll smpServerP
-
 -- | SMP agent connection alias.
 type ConnId = ByteString
 
@@ -482,6 +419,7 @@ type InvitationId = ByteString
 data SMPQueueUri = SMPQueueUri
   { smpServer :: SMPServer,
     senderId :: SMP.SenderId,
+    smpVersionRange :: VersionRange,
     dhPublicKey :: C.PublicKeyX25519
   }
   deriving (Eq, Show)
@@ -494,7 +432,7 @@ deriving instance Eq (ConnectionRequest m)
 
 deriving instance Show (ConnectionRequest m)
 
-data AConnectionRequest = forall m. ACR (SConnectionMode m) (ConnectionRequest m)
+data AConnectionRequest = forall m. ConnectionModeI m => ACR (SConnectionMode m) (ConnectionRequest m)
 
 instance Eq AConnectionRequest where
   ACR m cr == ACR m' cr' = case testEquality m m' of
@@ -510,17 +448,23 @@ data ConnReqData = ConnReqData
   }
   deriving (Eq, Show)
 
-data ConnReqScheme = CRSSimplex | CRSAppServer HostName (Maybe ServiceName)
+data ConnReqScheme = CRSSimplex | CRSAppServer SrvLoc
   deriving (Eq, Show)
 
+instance StrEncoding ConnReqScheme where
+  strEncode = \case
+    CRSSimplex -> "simplex:"
+    CRSAppServer srv -> "https://" <> strEncode srv
+  strP =
+    "simplex:" $> CRSSimplex
+      <|> "https://" *> (CRSAppServer <$> strP)
+
 -- TODO this is a stub for double ratchet E2E encryption parameters (2 public DH keys)
 data ConnectionEncryption = ConnectionEncryption
   deriving (Eq, Show)
 
 simplexChat :: ConnReqScheme
-simplexChat = CRSAppServer "simplex.chat" Nothing
-
-data QueueDirection = SND | RCV deriving (Show)
+simplexChat = CRSAppServer $ SrvLoc "simplex.chat" Nothing
 
 -- | SMP queue status.
 data QueueStatus
@@ -665,20 +609,20 @@ commandP =
     <|> "CON" $> ACmd SAgent CON
     <|> "OK" $> ACmd SAgent OK
   where
-    newCmd = ACmd SClient . NEW <$> connModeP
-    invResp = ACmd SAgent . INV <$> connReqP
-    joinCmd = ACmd SClient <$> (JOIN <$> connReqP <* A.space <*> A.takeByteString)
-    confMsg = ACmd SAgent <$> (CONF <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
-    letCmd = ACmd SClient <$> (LET <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
-    reqMsg = ACmd SAgent <$> (REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
-    acptCmd = ACmd SClient <$> (ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString)
+    newCmd = ACmd SClient . NEW <$> strP
+    invResp = ACmd SAgent . INV <$> strP
+    joinCmd = ACmd SClient .: JOIN <$> strP_ <*> A.takeByteString
+    confMsg = ACmd SAgent .: CONF <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString
+    letCmd = ACmd SClient .: LET <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString
+    reqMsg = ACmd SAgent .: REQ <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString
+    acptCmd = ACmd SClient .: ACPT <$> A.takeTill (== ' ') <* A.space <*> A.takeByteString
     rjctCmd = ACmd SClient . RJCT <$> A.takeByteString
     infoCmd = ACmd SAgent . INFO <$> A.takeByteString
     sendCmd = ACmd SClient . SEND <$> A.takeByteString
     msgIdResp = ACmd SAgent . MID <$> A.decimal
     sentResp = ACmd SAgent . SENT <$> A.decimal
-    msgErrResp = ACmd SAgent <$> (MERR <$> A.decimal <* A.space <*> agentErrorTypeP)
-    message = ACmd SAgent <$> (MSG <$> msgMetaP <* A.space <*> A.takeByteString)
+    msgErrResp = ACmd SAgent .: MERR <$> A.decimal <* A.space <*> agentErrorTypeP
+    message = ACmd SAgent .: MSG <$> msgMetaP <* A.space <*> A.takeByteString
     ackCmd = ACmd SClient . ACK <$> A.decimal
     msgMetaP = do
       integrity <- msgIntegrityP
@@ -705,9 +649,9 @@ parseCommand = parse commandP $ CMD SYNTAX
 -- | Serialize SMP agent command.
 serializeCommand :: ACommand p -> ByteString
 serializeCommand = \case
-  NEW cMode -> "NEW " <> serializeConnMode cMode
-  INV cReq -> "INV " <> serializeConnReq cReq
-  JOIN cReq cInfo -> B.unwords ["JOIN", serializeConnReq cReq, serializeBinary cInfo]
+  NEW cMode -> "NEW " <> strEncode cMode
+  INV cReq -> "INV " <> strEncode cReq
+  JOIN cReq cInfo -> B.unwords ["JOIN", strEncode cReq, serializeBinary cInfo]
   CONF confId cInfo -> B.unwords ["CONF", confId, serializeBinary cInfo]
   LET confId cInfo -> B.unwords ["LET", confId, serializeBinary cInfo]
   REQ invId cInfo -> B.unwords ["REQ", invId, serializeBinary cInfo]
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs
index f09521ea8..b31cc247e 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs
@@ -52,6 +52,7 @@ import Simplex.Messaging.Agent.Store
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration)
 import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldParser)
 import Simplex.Messaging.Protocol (MsgBody)
 import qualified Simplex.Messaging.Protocol as SMP
@@ -545,19 +546,19 @@ instance ToField MsgIntegrity where toField = toField . serializeMsgIntegrity
 
 instance FromField MsgIntegrity where fromField = blobFieldParser msgIntegrityP
 
-instance ToField SMPQueueUri where toField = toField . serializeSMPQueueUri
+instance ToField SMPQueueUri where toField = toField . strEncode
 
-instance FromField SMPQueueUri where fromField = blobFieldParser smpQueueUriP
+instance FromField SMPQueueUri where fromField = blobFieldParser strP
 
-instance ToField AConnectionRequest where toField = toField . serializeConnReq
+instance ToField AConnectionRequest where toField = toField . strEncode
 
-instance FromField AConnectionRequest where fromField = blobFieldParser connReqP
+instance FromField AConnectionRequest where fromField = blobFieldParser strP
 
-instance ToField (ConnectionRequest c) where toField = toField . serializeConnReq'
+instance ConnectionModeI c => ToField (ConnectionRequest c) where toField = toField . strEncode
 
-instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequest c) where fromField = blobFieldParser connReqP'
+instance (E.Typeable c, ConnectionModeI c) => FromField (ConnectionRequest c) where fromField = blobFieldParser strP
 
-instance ToField ConnectionMode where toField = toField . decodeLatin1 . serializeConnMode'
+instance ToField ConnectionMode where toField = toField . decodeLatin1 . strEncode
 
 instance FromField ConnectionMode where fromField = fromTextField_ connModeT
 
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 53028e4e7..46977aeeb 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -61,7 +61,6 @@ import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
 import Network.Socket (ServiceName)
 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 (..), THandle (..), TLS, TProxy, Transport (..), TransportError, clientHandshake, runTransportClient)
@@ -171,7 +170,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing} msgQ dis
 
     client :: forall c. Transport c => TProxy c -> SMPClient -> TMVar (Either SMPClientError (THandle c)) -> c -> IO ()
     client _ c thVar h =
-      runExceptT (clientHandshake h) >>= \case
+      runExceptT (clientHandshake h $ keyHash smpServer) >>= \case
         Left e -> atomically . putTMVar thVar . Left $ SMPTransportError e
         Right th@THandle {sessionId} -> do
           atomically $ do
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index aa82cbeb5..9231fba09 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -52,7 +52,6 @@ module Simplex.Messaging.Crypto
     DhSecret (..),
     DhSecretX25519,
     ADhSecret (..),
-    CryptoDhSecret (..),
     KeyHash (..),
     generateKeyPair,
     generateKeyPair',
@@ -61,15 +60,7 @@ module Simplex.Messaging.Crypto
     privateToX509,
 
     -- * key encoding/decoding
-    serializePubKey,
-    serializePubKey',
-    serializePubKeyUri,
-    serializePubKeyUri',
-    strPubKeyP,
-    strPubKeyUriP,
     encodePubKey,
-    encodePubKey',
-    binaryPubKeyP,
     encodePrivKey,
 
     -- * E2E hybrid encryption scheme
@@ -90,8 +81,7 @@ module Simplex.Messaging.Crypto
 
     -- * DH derivation
     dh',
-    dhSecret,
-    dhSecret',
+    dhSecretBytes',
 
     -- * AES256 AEAD-GCM scheme
     Key (..),
@@ -149,7 +139,6 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Base64 (decode, encode)
-import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Internal (c2w, w2c)
@@ -166,8 +155,8 @@ import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.TypeLits (ErrorMessage (..), TypeError)
 import Network.Transport.Internal (decodeWord16, encodeWord16)
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Parsers (base64P, base64UriP, blobFieldParser, parseAll, parseString)
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
 
 type E2EEncryptionVersion = Word16
 
@@ -210,6 +199,11 @@ instance AlgorithmI X25519 where sAlgorithm = SX25519
 
 instance AlgorithmI X448 where sAlgorithm = SX448
 
+checkAlgorithm :: forall t a a'. (AlgorithmI a, AlgorithmI a') => t a' -> Either String (t a)
+checkAlgorithm x = case testEquality (sAlgorithm @a) (sAlgorithm @a') of
+  Just Refl -> Right x
+  Nothing -> Left "bad algorithm"
+
 instance TestEquality SAlgorithm where
   testEquality SEd25519 SEd25519 = Just Refl
   testEquality SEd448 SEd448 = Just Refl
@@ -267,39 +261,6 @@ deriving instance Show APrivateKey
 
 type PrivateKeyX25519 = PrivateKey X25519
 
-class AlgorithmPrefix k where
-  algorithmPrefix :: k -> ByteString
-
-instance AlgorithmPrefix (SAlgorithm a) where
-  algorithmPrefix = \case
-    SEd25519 -> "ed25519"
-    SEd448 -> "ed448"
-    SX25519 -> "x25519"
-    SX448 -> "x448"
-
-instance AlgorithmI a => AlgorithmPrefix (PublicKey a) where
-  algorithmPrefix _ = algorithmPrefix $ sAlgorithm @a
-
-instance AlgorithmI a => AlgorithmPrefix (PrivateKey a) where
-  algorithmPrefix _ = algorithmPrefix $ sAlgorithm @a
-
-instance AlgorithmPrefix APublicKey where
-  algorithmPrefix (APublicKey a _) = algorithmPrefix a
-
-instance AlgorithmPrefix APrivateKey where
-  algorithmPrefix (APrivateKey a _) = algorithmPrefix a
-
-prefixAlgorithm :: ByteString -> Either String Alg
-prefixAlgorithm = \case
-  "ed25519" -> Right $ Alg SEd25519
-  "ed448" -> Right $ Alg SEd448
-  "x25519" -> Right $ Alg SX25519
-  "x448" -> Right $ Alg SX448
-  _ -> Left "unknown algorithm"
-
-algP :: Parser Alg
-algP = prefixAlgorithm <$?> A.takeTill (== ':')
-
 type family SignatureAlgorithm (a :: Algorithm) :: Constraint where
   SignatureAlgorithm Ed25519 = ()
   SignatureAlgorithm Ed448 = ()
@@ -387,44 +348,29 @@ dhAlgorithm = \case
   SX448 -> Just Dict
   _ -> Nothing
 
-class CryptoDhSecret s where
-  serializeDhSecret :: s -> ByteString
-  dhSecretBytes :: s -> ByteString
-  strDhSecretP :: Parser s
-  dhSecretP :: Parser s
+dhSecretBytes' :: DhSecret a -> ByteString
+dhSecretBytes' = \case
+  DhSecretX25519 s -> BA.convert s
+  DhSecretX448 s -> BA.convert s
+
+instance AlgorithmI a => StrEncoding (DhSecret a) where
+  strEncode = strEncode . dhSecretBytes'
+  strDecode = (\(ADhSecret _ s) -> checkAlgorithm s) <=< strDecode
+
+instance StrEncoding ADhSecret where
+  strEncode (ADhSecret _ s) = strEncode $ dhSecretBytes' s
+  strDecode = cryptoPassed . secret
+    where
+      secret bs
+        | B.length bs == x25519_size = ADhSecret SX25519 . DhSecretX25519 <$> X25519.dhSecret bs
+        | B.length bs == x448_size = ADhSecret SX448 . DhSecretX448 <$> X448.dhSecret bs
+        | otherwise = CE.CryptoFailed CE.CryptoError_SharedSecretSizeInvalid
+      cryptoPassed = \case
+        CE.CryptoPassed s -> Right s
+        CE.CryptoFailed e -> Left $ show e
 
 instance AlgorithmI a => IsString (DhSecret a) where
-  fromString = parseString $ dhSecret >=> dhSecret'
-
-instance CryptoDhSecret ADhSecret where
-  serializeDhSecret (ADhSecret _ s) = serializeDhSecret s
-  dhSecretBytes (ADhSecret _ s) = dhSecretBytes s
-  strDhSecretP = dhSecret <$?> base64P
-  dhSecretP = dhSecret <$?> A.takeByteString
-
-dhSecret :: ByteString -> Either String ADhSecret
-dhSecret = cryptoPassed . secret
-  where
-    secret bs
-      | B.length bs == x25519_size = ADhSecret SX25519 . DhSecretX25519 <$> X25519.dhSecret bs
-      | B.length bs == x448_size = ADhSecret SX448 . DhSecretX448 <$> X448.dhSecret bs
-      | otherwise = CE.CryptoFailed CE.CryptoError_SharedSecretSizeInvalid
-    cryptoPassed = \case
-      CE.CryptoPassed s -> Right s
-      CE.CryptoFailed e -> Left $ show e
-
-instance forall a. AlgorithmI a => CryptoDhSecret (DhSecret a) where
-  serializeDhSecret = encode . dhSecretBytes
-  dhSecretBytes = \case
-    DhSecretX25519 s -> BA.convert s
-    DhSecretX448 s -> BA.convert s
-  strDhSecretP = dhSecret' <$?> strDhSecretP
-  dhSecretP = dhSecret' <$?> dhSecretP
-
-dhSecret' :: forall a. AlgorithmI a => ADhSecret -> Either String (DhSecret a)
-dhSecret' (ADhSecret a s) = case testEquality a $ sAlgorithm @a of
-  Just Refl -> Right s
-  _ -> Left "bad DH secret algorithm"
+  fromString = parseString strDecode
 
 -- | Class for public key types
 class CryptoPublicKey k where
@@ -449,76 +395,48 @@ instance CryptoPublicKey APublicDhKey where
 
 instance AlgorithmI a => CryptoPublicKey (PublicKey a) where
   toPubKey = id
-  pubKey (APublicKey a k) = case testEquality a $ sAlgorithm @a of
-    Just Refl -> Right k
-    _ -> Left "bad key algorithm"
+  pubKey (APublicKey _ k) = checkAlgorithm k
 
 instance Encoding APublicVerifyKey where
-  smpEncode k = smpEncode $ encodePubKey k
-  smpP = parseAll binaryPubKeyP <$?> smpP
+  smpEncode = smpEncode . encodePubKey
+  {-# INLINE smpEncode #-}
+  smpDecode = decodePubKey
+  {-# INLINE smpDecode #-}
 
 instance Encoding APublicDhKey where
-  smpEncode k = smpEncode $ encodePubKey k
-  smpP = parseAll binaryPubKeyP <$?> smpP
+  smpEncode = smpEncode . encodePubKey
+  {-# INLINE smpEncode #-}
+  smpDecode = decodePubKey
+  {-# INLINE smpDecode #-}
 
 instance AlgorithmI a => Encoding (PublicKey a) where
-  smpEncode k = smpEncode $ encodePubKey' k
-  smpP = parseAll binaryPubKeyP <$?> smpP
+  smpEncode = smpEncode . encodePubKey
+  {-# INLINE smpEncode #-}
+  smpDecode = decodePubKey
+  {-# INLINE smpDecode #-}
 
--- | base64 X509 key encoding with algorithm prefix
-serializePubKey :: CryptoPublicKey k => k -> ByteString
-serializePubKey = toPubKey serializePubKey'
-{-# INLINE serializePubKey #-}
+instance StrEncoding APublicVerifyKey where
+  strEncode = strEncode . encodePubKey
+  {-# INLINE strEncode #-}
+  strDecode = decodePubKey
+  {-# INLINE strDecode #-}
 
--- | base64url X509 key encoding with algorithm prefix
-serializePubKeyUri :: CryptoPublicKey k => k -> ByteString
-serializePubKeyUri = toPubKey serializePubKeyUri'
-{-# INLINE serializePubKeyUri #-}
+instance StrEncoding APublicDhKey where
+  strEncode = strEncode . encodePubKey
+  {-# INLINE strEncode #-}
+  strDecode = decodePubKey
+  {-# INLINE strDecode #-}
 
-serializePubKey' :: AlgorithmI a => PublicKey a -> ByteString
-serializePubKey' k = algorithmPrefix k <> ":" <> encode (encodePubKey' k)
-
-serializePubKeyUri' :: AlgorithmI a => PublicKey a -> ByteString
-serializePubKeyUri' k = algorithmPrefix k <> ":" <> U.encode (encodePubKey' k)
-
--- | base64 X509 (with algorithm prefix) key parser
-strPubKeyP :: CryptoPublicKey k => Parser k
-strPubKeyP = pubKey <$?> aStrPubKeyP
-{-# INLINE strPubKeyP #-}
-
--- | base64url X509 (with algorithm prefix) key parser
-strPubKeyUriP :: CryptoPublicKey k => Parser k
-strPubKeyUriP = pubKey <$?> aStrPubKeyUriP
-{-# INLINE strPubKeyUriP #-}
-
-aStrPubKeyP :: Parser APublicKey
-aStrPubKeyP = strPublicKeyP_ base64P
-
-aStrPubKeyUriP :: Parser APublicKey
-aStrPubKeyUriP = strPublicKeyP_ base64UriP
-
-strPublicKeyP_ :: Parser ByteString -> Parser APublicKey
-strPublicKeyP_ b64P = do
-  Alg a <- algP <* A.char ':'
-  k@(APublicKey a' _) <- decodePubKey <$?> b64P
-  case testEquality a a' of
-    Just Refl -> pure k
-    _ -> fail $ "public key algorithm " <> show a <> " does not match prefix"
+instance AlgorithmI a => StrEncoding (PublicKey a) where
+  strEncode = strEncode . encodePubKey
+  {-# INLINE strEncode #-}
+  strDecode = decodePubKey
+  {-# INLINE strDecode #-}
 
 encodePubKey :: CryptoPublicKey pk => pk -> ByteString
-encodePubKey = toPubKey encodePubKey'
+encodePubKey = toPubKey $ encodeASNObj . publicToX509
 {-# INLINE encodePubKey #-}
 
-encodePubKey' :: PublicKey a -> ByteString
-encodePubKey' = encodeASNObj . publicToX509
-
-binaryPubKeyP :: CryptoPublicKey pk => Parser pk
-binaryPubKeyP = pubKey <$?> aBinaryPubKeyP
-{-# INLINE binaryPubKeyP #-}
-
-aBinaryPubKeyP :: Parser APublicKey
-aBinaryPubKeyP = decodePubKey <$?> A.takeByteString
-
 class CryptoPrivateKey pk where
   toPrivKey :: (forall a. AlgorithmI a => PrivateKey a -> b) -> pk -> b
   privKey :: APrivateKey -> Either String pk
@@ -541,27 +459,16 @@ instance CryptoPrivateKey APrivateDhKey where
 
 instance AlgorithmI a => CryptoPrivateKey (PrivateKey a) where
   toPrivKey = id
-  privKey (APrivateKey a k) = case testEquality a $ sAlgorithm @a of
-    Just Refl -> Right k
-    _ -> Left "bad key algorithm"
+  privKey (APrivateKey _ k) = checkAlgorithm k
 
 encodePrivKey :: CryptoPrivateKey pk => pk -> ByteString
-encodePrivKey = toPrivKey encodePrivKey'
-
-encodePrivKey' :: PrivateKey a -> ByteString
-encodePrivKey' = encodeASNObj . privateToX509
-
-binaryPrivKeyP :: CryptoPrivateKey pk => Parser pk
-binaryPrivKeyP = privKey <$?> aBinaryPrivKeyP
-
-aBinaryPrivKeyP :: Parser APrivateKey
-aBinaryPrivKeyP = decodePrivKey <$?> A.takeByteString
+encodePrivKey = toPrivKey $ encodeASNObj . privateToX509
 
 instance AlgorithmI a => IsString (PrivateKey a) where
-  fromString = parseString $ decode >=> decodePrivKey >=> privKey
+  fromString = parseString $ decode >=> decodePrivKey
 
 instance AlgorithmI a => IsString (PublicKey a) where
-  fromString = parseString $ decode >=> decodePubKey >=> pubKey
+  fromString = parseString $ decode >=> decodePubKey
 
 -- | Tuple of RSA 'PublicKey' and 'PrivateKey'.
 type KeyPair a = (PublicKey a, PrivateKey a)
@@ -608,25 +515,25 @@ instance ToField APrivateDhKey where toField = toField . encodePrivKey
 
 instance ToField APublicDhKey where toField = toField . encodePubKey
 
-instance ToField (PrivateKey a) where toField = toField . encodePrivKey'
+instance AlgorithmI a => ToField (PrivateKey a) where toField = toField . encodePrivKey
 
-instance ToField (PublicKey a) where toField = toField . encodePubKey'
+instance AlgorithmI a => ToField (PublicKey a) where toField = toField . encodePubKey
 
-instance AlgorithmI a => ToField (DhSecret a) where toField = toField . dhSecretBytes
+instance AlgorithmI a => ToField (DhSecret a) where toField = toField . dhSecretBytes'
 
-instance FromField APrivateSignKey where fromField = blobFieldParser binaryPrivKeyP
+instance FromField APrivateSignKey where fromField = blobFieldDecoder decodePrivKey
 
-instance FromField APublicVerifyKey where fromField = blobFieldParser binaryPubKeyP
+instance FromField APublicVerifyKey where fromField = blobFieldDecoder decodePubKey
 
-instance FromField APrivateDhKey where fromField = blobFieldParser binaryPrivKeyP
+instance FromField APrivateDhKey where fromField = blobFieldDecoder decodePrivKey
 
-instance FromField APublicDhKey where fromField = blobFieldParser binaryPubKeyP
+instance FromField APublicDhKey where fromField = blobFieldDecoder decodePubKey
 
-instance (Typeable a, AlgorithmI a) => FromField (PrivateKey a) where fromField = blobFieldParser binaryPrivKeyP
+instance (Typeable a, AlgorithmI a) => FromField (PrivateKey a) where fromField = blobFieldDecoder decodePrivKey
 
-instance (Typeable a, AlgorithmI a) => FromField (PublicKey a) where fromField = blobFieldParser binaryPubKeyP
+instance (Typeable a, AlgorithmI a) => FromField (PublicKey a) where fromField = blobFieldDecoder decodePubKey
 
-instance (Typeable a, AlgorithmI a) => FromField (DhSecret a) where fromField = blobFieldParser dhSecretP
+instance (Typeable a, AlgorithmI a) => FromField (DhSecret a) where fromField = blobFieldDecoder strDecode
 
 instance IsString (Maybe ASignature) where
   fromString = parseString $ decode >=> decodeSignature
@@ -679,10 +586,8 @@ instance AlgorithmI a => CryptoSignature (Signature a) where
     SignatureEd25519 s -> BA.convert s
     SignatureEd448 s -> BA.convert s
   decodeSignature s = do
-    ASignature a sig <- decodeSignature s
-    case testEquality a $ sAlgorithm @a of
-      Just Refl -> Right sig
-      _ -> Left "bad signature algorithm"
+    ASignature _ sig <- decodeSignature s
+    checkAlgorithm sig
 
 class SignatureSize s where signatureSize :: s -> Int
 
@@ -760,12 +665,20 @@ newtype IV = IV {unIV :: ByteString}
 -- Previously was used for server's public key hash in ad-hoc transport scheme, kept as is for compatibility.
 newtype KeyHash = KeyHash {unKeyHash :: ByteString} deriving (Eq, Ord, Show)
 
+instance Encoding KeyHash where
+  smpEncode = smpEncode . unKeyHash
+  smpP = KeyHash <$> smpP
+
+instance StrEncoding KeyHash where
+  strEncode = strEncode . unKeyHash
+  strP = KeyHash <$> strP
+
 instance IsString KeyHash where
-  fromString = parseString . parseAll $ KeyHash <$> base64P
+  fromString = parseString $ parseAll strP
 
-instance ToField KeyHash where toField = toField . encode . unKeyHash
+instance ToField KeyHash where toField = toField . strEncode
 
-instance FromField KeyHash where fromField = blobFieldParser $ KeyHash <$> base64P
+instance FromField KeyHash where fromField = blobFieldDecoder $ parseAll strP
 
 -- | SHA256 digest.
 sha256Hash :: ByteString -> ByteString
@@ -945,25 +858,29 @@ privateToX509 = \case
 encodeASNObj :: ASN1Object a => a -> ByteString
 encodeASNObj k = toStrict . encodeASN1 DER $ toASN1 k []
 
--- Decoding of binary X509 'PublicKey'.
-decodePubKey :: ByteString -> Either String APublicKey
-decodePubKey =
-  decodeKey >=> \case
-    (PubKeyEd25519 k, []) -> Right . APublicKey SEd25519 $ PublicKeyEd25519 k
-    (PubKeyEd448 k, []) -> Right . APublicKey SEd448 $ PublicKeyEd448 k
-    (PubKeyX25519 k, []) -> Right . APublicKey SX25519 $ PublicKeyX25519 k
-    (PubKeyX448 k, []) -> Right . APublicKey SX448 $ PublicKeyX448 k
-    r -> keyError r
+-- Decoding of binary X509 'CryptoPublicKey'.
+decodePubKey :: CryptoPublicKey k => ByteString -> Either String k
+decodePubKey = decodeKey >=> x509ToPublic >=> pubKey
 
 -- Decoding of binary PKCS8 'PrivateKey'.
-decodePrivKey :: ByteString -> Either String APrivateKey
-decodePrivKey =
-  decodeKey >=> \case
-    (PrivKeyEd25519 k, []) -> Right . APrivateKey SEd25519 . PrivateKeyEd25519 k $ Ed25519.toPublic k
-    (PrivKeyEd448 k, []) -> Right . APrivateKey SEd448 . PrivateKeyEd448 k $ Ed448.toPublic k
-    (PrivKeyX25519 k, []) -> Right . APrivateKey SX25519 $ PrivateKeyX25519 k
-    (PrivKeyX448 k, []) -> Right . APrivateKey SX448 $ PrivateKeyX448 k
-    r -> keyError r
+decodePrivKey :: CryptoPrivateKey k => ByteString -> Either String k
+decodePrivKey = decodeKey >=> x509ToPrivate >=> privKey
+
+x509ToPublic :: (PubKey, [ASN1]) -> Either String APublicKey
+x509ToPublic = \case
+  (PubKeyEd25519 k, []) -> Right . APublicKey SEd25519 $ PublicKeyEd25519 k
+  (PubKeyEd448 k, []) -> Right . APublicKey SEd448 $ PublicKeyEd448 k
+  (PubKeyX25519 k, []) -> Right . APublicKey SX25519 $ PublicKeyX25519 k
+  (PubKeyX448 k, []) -> Right . APublicKey SX448 $ PublicKeyX448 k
+  r -> keyError r
+
+x509ToPrivate :: (PrivKey, [ASN1]) -> Either String APrivateKey
+x509ToPrivate = \case
+  (PrivKeyEd25519 k, []) -> Right . APrivateKey SEd25519 . PrivateKeyEd25519 k $ Ed25519.toPublic k
+  (PrivKeyEd448 k, []) -> Right . APrivateKey SEd448 . PrivateKeyEd448 k $ Ed448.toPublic k
+  (PrivKeyX25519 k, []) -> Right . APrivateKey SX25519 $ PrivateKeyX25519 k
+  (PrivKeyX448 k, []) -> Right . APrivateKey SX448 $ PrivateKeyX448 k
+  r -> keyError r
 
 decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
 decodeKey = fromASN1 <=< first show . decodeASN1 DER . fromStrict
diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs
index fb14c668a..e88f4b102 100644
--- a/src/Simplex/Messaging/Crypto/Ratchet.hs
+++ b/src/Simplex/Messaging/Crypto/Ratchet.hs
@@ -355,13 +355,13 @@ rcDecrypt' rc@Ratchet {rcRcv, rcMKSkipped, rcAD} msg' = do
 
 initKdf :: (AlgorithmI a, DhAlgorithm a) => ByteString -> PublicKey a -> PrivateKey a -> (RatchetKey, Key, Key)
 initKdf salt k pk =
-  let dhOut = dhSecretBytes $ dh' k pk
+  let dhOut = dhSecretBytes' $ dh' k pk
       (sk, hk, nhk) = hkdf3 salt dhOut "SimpleXInitRatchet"
    in (RatchetKey sk, Key hk, Key nhk)
 
 rootKdf :: (AlgorithmI a, DhAlgorithm a) => RatchetKey -> PublicKey a -> PrivateKey a -> (RatchetKey, RatchetKey, Key)
 rootKdf (RatchetKey rk) k pk =
-  let dhOut = dhSecretBytes $ dh' k pk
+  let dhOut = dhSecretBytes' $ dh' k pk
       (rk', ck, nhk) = hkdf3 rk dhOut "SimpleXRootRatchet"
    in (RatchetKey rk', RatchetKey ck, Key nhk)
 
diff --git a/src/Simplex/Messaging/Encoding.hs b/src/Simplex/Messaging/Encoding.hs
index 65b77a4fe..b1164145e 100644
--- a/src/Simplex/Messaging/Encoding.hs
+++ b/src/Simplex/Messaging/Encoding.hs
@@ -18,10 +18,23 @@ import Data.Int (Int64)
 import Data.Time.Clock.System (SystemTime (..))
 import Data.Word (Word16, Word32)
 import Network.Transport.Internal (decodeWord16, decodeWord32, encodeWord16, encodeWord32)
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Util ((<$?>))
 
+-- | SMP protocol encoding
 class Encoding a where
+  {-# MINIMAL smpEncode, (smpDecode | smpP) #-}
+
+  -- | protocol encoding of type (default implementation uses protocol ByteString encoding)
   smpEncode :: a -> ByteString
+
+  -- | decoding of type (default implementation uses parser)
+  smpDecode :: ByteString -> Either String a
+  smpDecode = parseAll smpP
+
+  -- | protocol parser of type (default implementation parses protocol ByteString encoding)
   smpP :: Parser a
+  smpP = smpDecode <$?> smpP
 
 instance Encoding Char where
   smpEncode = B.singleton
diff --git a/src/Simplex/Messaging/Encoding/String.hs b/src/Simplex/Messaging/Encoding/String.hs
new file mode 100644
index 000000000..cecb81802
--- /dev/null
+++ b/src/Simplex/Messaging/Encoding/String.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Messaging.Encoding.String
+  ( StrEncoding (..),
+    Str (..),
+    strP_,
+  )
+where
+
+import Control.Applicative (optional)
+import Data.Attoparsec.ByteString.Char8 (Parser)
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.ByteString.Base64.URL as U
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Char (isAlphaNum)
+import qualified Data.List.NonEmpty as L
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Util ((<$?>))
+
+-- | Serializing human-readable and (where possible) URI-friendly strings for SMP and SMP agent protocols
+class StrEncoding a where
+  {-# MINIMAL strEncode, (strDecode | strP) #-}
+  strEncode :: a -> ByteString
+
+  -- Please note - if you only specify strDecode, it will use base64urlP as default parser before decoding the string
+  strDecode :: ByteString -> Either String a
+  strDecode = parseAll strP
+  strP :: Parser a
+  strP = strDecode <$?> base64urlP
+
+-- base64url encoding/decoding of ByteStrings - the parser only allows non-empty strings
+instance StrEncoding ByteString where
+  strEncode = U.encode
+  strP = base64urlP
+
+base64urlP :: Parser ByteString
+base64urlP = do
+  str <- A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')
+  pad <- A.takeWhile (== '=')
+  either fail pure $ U.decode (str <> pad)
+
+newtype Str = Str {unStr :: ByteString}
+
+instance StrEncoding Str where
+  strEncode = unStr
+  strP = Str <$> A.takeTill (== ' ') <* optional A.space
+
+instance StrEncoding a => StrEncoding (Maybe a) where
+  strEncode = maybe "" strEncode
+  strP = optional strP
+
+-- lists encode/parse as comma-separated strings
+instance StrEncoding a => StrEncoding [a] where
+  strEncode = B.intercalate "," . map strEncode
+  strP = listItem `A.sepBy'` A.char ','
+
+instance StrEncoding a => StrEncoding (L.NonEmpty a) where
+  strEncode = strEncode . L.toList
+  strP =
+    maybe (fail "empty list") pure . L.nonEmpty
+      =<< listItem `A.sepBy1'` A.char ','
+
+listItem :: StrEncoding a => Parser a
+listItem = strDecode <$?> A.takeTill (== ',')
+
+instance (StrEncoding a, StrEncoding b) => StrEncoding (a, b) where
+  strEncode (a, b) = B.unwords [strEncode a, strEncode b]
+  strP = (,) <$> strP_ <*> strP
+
+instance (StrEncoding a, StrEncoding b, StrEncoding c) => StrEncoding (a, b, c) where
+  strEncode (a, b, c) = B.unwords [strEncode a, strEncode b, strEncode c]
+  strP = (,,) <$> strP_ <*> strP_ <*> strP
+
+instance (StrEncoding a, StrEncoding b, StrEncoding c, StrEncoding d) => StrEncoding (a, b, c, d) where
+  strEncode (a, b, c, d) = B.unwords [strEncode a, strEncode b, strEncode c, strEncode d]
+  strP = (,,,) <$> strP_ <*> strP_ <*> strP_ <*> strP
+
+instance (StrEncoding a, StrEncoding b, StrEncoding c, StrEncoding d, StrEncoding e) => StrEncoding (a, b, c, d, e) where
+  strEncode (a, b, c, d, e) = B.unwords [strEncode a, strEncode b, strEncode c, strEncode d, strEncode e]
+  strP = (,,,,) <$> strP_ <*> strP_ <*> strP_ <*> strP_ <*> strP
+
+strP_ :: StrEncoding a => Parser a
+strP_ = strP <* A.space
diff --git a/src/Simplex/Messaging/Parsers.hs b/src/Simplex/Messaging/Parsers.hs
index d14419bf0..b73f0aff0 100644
--- a/src/Simplex/Messaging/Parsers.hs
+++ b/src/Simplex/Messaging/Parsers.hs
@@ -8,7 +8,6 @@ import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
 import Data.ByteString.Base64
-import qualified Data.ByteString.Base64.URL as U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isAlphaNum)
@@ -23,16 +22,7 @@ import Simplex.Messaging.Util ((<$?>))
 import Text.Read (readMaybe)
 
 base64P :: Parser ByteString
-base64P = decode <$?> base64StringP
-
-base64StringP :: Parser ByteString
-base64StringP = paddedBase64 rawBase64P
-
-base64UriP :: Parser ByteString
-base64UriP = U.decode <$?> base64UriStringP
-
-base64UriStringP :: Parser ByteString
-base64UriStringP = paddedBase64 rawBase64UriP
+base64P = decode <$?> paddedBase64 rawBase64P
 
 paddedBase64 :: Parser ByteString -> Parser ByteString
 paddedBase64 raw = (<>) <$> raw <*> pad
@@ -42,8 +32,8 @@ paddedBase64 raw = (<>) <$> raw <*> pad
 rawBase64P :: Parser ByteString
 rawBase64P = A.takeWhile1 (\c -> isAlphaNum c || c == '+' || c == '/')
 
-rawBase64UriP :: Parser ByteString
-rawBase64UriP = A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')
+-- rawBase64UriP :: Parser ByteString
+-- rawBase64UriP = A.takeWhile1 (\c -> isAlphaNum c || c == '-' || c == '_')
 
 tsISO8601P :: Parser UTCTime
 tsISO8601P = maybe (fail "timestamp") pure . parseISO8601 . B.unpack =<< A.takeTill wordEnd
@@ -79,9 +69,12 @@ parseString :: (ByteString -> Either String a) -> (String -> a)
 parseString p = either error id . p . B.pack
 
 blobFieldParser :: Typeable k => Parser k -> FieldParser k
-blobFieldParser p = \case
+blobFieldParser = blobFieldDecoder . parseAll
+
+blobFieldDecoder :: Typeable k => (ByteString -> Either String k) -> FieldParser k
+blobFieldDecoder dec = \case
   f@(Field (SQLBlob b) _) ->
-    case parseAll p b of
+    case dec b of
       Right k -> Ok k
       Left e -> returnError ConversionFailed f ("couldn't parse field: " ++ e)
   f -> returnError ConversionFailed f "expecting SQLBlob column type"
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index 862933489..bb76f226d 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -53,6 +53,8 @@ module Simplex.Messaging.Protocol
     PubHeader (..),
     ClientMessage (..),
     PrivHeader (..),
+    SMPServer (..),
+    SrvLoc (..),
     CorrId (..),
     QueueId,
     RecipientId,
@@ -98,8 +100,10 @@ import Data.Type.Equality
 import Data.Word (Word16)
 import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
+import Network.Socket (HostName, ServiceName)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers
 import Simplex.Messaging.Transport (THandle (..), Transport, TransportError (..), tGetBlock, tPutBlock)
 import Simplex.Messaging.Util ((<$?>))
@@ -330,7 +334,7 @@ instance Encoding PubHeader where
 
 instance Encoding EncMessage where
   smpEncode EncMessage {emHeader, emNonce, emBody} =
-    smpEncode emHeader <> smpEncode emNonce <> emBody
+    smpEncode (emHeader, emNonce, Tail emBody)
   smpP = do
     emHeader <- smpP
     emNonce <- smpP
@@ -357,6 +361,36 @@ instance Encoding ClientMessage where
   smpEncode (ClientMessage h msg) = smpEncode h <> msg
   smpP = ClientMessage <$> smpP <*> A.takeByteString
 
+-- | SMP server location and transport key digest (hash).
+data SMPServer = SMPServer
+  { host :: HostName,
+    port :: Maybe ServiceName,
+    keyHash :: C.KeyHash
+  }
+  deriving (Eq, Ord, Show)
+
+instance IsString SMPServer where
+  fromString = parseString strDecode
+
+instance StrEncoding SMPServer where
+  strEncode SMPServer {host, port, keyHash} =
+    "smp://" <> strEncode keyHash <> "@" <> strEncode (SrvLoc host port)
+  strP = do
+    _ <- "smp://"
+    keyHash <- strP <* A.char '@'
+    SrvLoc host port <- strP
+    pure SMPServer {host, port, keyHash}
+
+data SrvLoc = SrvLoc HostName (Maybe ServiceName)
+  deriving (Eq, Ord, Show)
+
+instance StrEncoding SrvLoc where
+  strEncode (SrvLoc host port) = B.pack $ host <> maybe "" (':' :) port
+  strP = SrvLoc <$> host <*> optional port
+    where
+      host = B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
+      port = B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit)
+
 -- | Transmission correlation ID.
 newtype CorrId = CorrId {bs :: ByteString} deriving (Eq, Ord, Show)
 
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 3647fdaa6..3ae73aa7f 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -117,11 +117,12 @@ runSMPServerBlocking started cfg@ServerConfig {transports} = do
             writeTBQueue (sndQ c) (CorrId "", qId, END)
           atomically . stateTVar (clientSubs c) $ \ss -> (M.lookup qId ss, M.delete qId ss)
 
-runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
-runClient _ h =
-  liftIO (runExceptT $ serverHandshake h) >>= \case
-    Right th -> runClientTransport th
-    Left _ -> pure ()
+    runClient :: (Transport c, MonadUnliftIO m, MonadReader Env m) => TProxy c -> c -> m ()
+    runClient _ h = do
+      kh <- asks serverIdentity
+      liftIO (runExceptT $ serverHandshake h kh) >>= \case
+        Right th -> runClientTransport th
+        Left _ -> pure ()
 
 runClientTransport :: (Transport c, MonadUnliftIO m, MonadReader Env m) => THandle c -> m ()
 runClientTransport th@THandle {sessionId} = do
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 49adf04fd..689096cac 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -11,15 +11,17 @@ import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.X509.Validation (Fingerprint (..))
 import Network.Socket (ServiceName)
 import qualified Network.TLS as T
 import Numeric.Natural
+import Simplex.Messaging.Crypto (KeyHash (..))
 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, loadTLSServerParams)
+import Simplex.Messaging.Transport (ATransport, loadFingerprint, loadTLSServerParams)
 import System.IO (IOMode (..))
 import UnliftIO.STM
 
@@ -40,6 +42,7 @@ data ServerConfig = ServerConfig
 data Env = Env
   { config :: ServerConfig,
     server :: Server,
+    serverIdentity :: KeyHash,
     queueStore :: QueueStore,
     msgStore :: STMMsgStore,
     idsDrg :: TVar ChaChaDRG,
@@ -100,7 +103,9 @@ newEnv config@ServerConfig {caCertificateFile, certificateFile, privateKeyFile}
   idsDrg <- drgNew >>= newTVarIO
   s' <- restoreQueues queueStore `mapM` storeLog (config :: ServerConfig)
   tlsServerParams <- liftIO $ loadTLSServerParams caCertificateFile certificateFile privateKeyFile
-  return Env {config, server, queueStore, msgStore, idsDrg, storeLog = s', tlsServerParams}
+  Fingerprint fp <- liftIO $ loadFingerprint caCertificateFile
+  let serverIdentity = KeyHash fp
+  return Env {config, server, serverIdentity, queueStore, msgStore, idsDrg, storeLog = s', tlsServerParams}
   where
     restoreQueues :: QueueStore -> StoreLog 'ReadMode -> m (StoreLog 'WriteMode)
     restoreQueues queueStore s = do
diff --git a/src/Simplex/Messaging/Server/StoreLog.hs b/src/Simplex/Messaging/Server/StoreLog.hs
index d2208e560..e0928c20e 100644
--- a/src/Simplex/Messaging/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Server/StoreLog.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Simplex.Messaging.Server.StoreLog
   ( StoreLog, -- constructors are not exported
@@ -22,10 +23,7 @@ where
 
 import Control.Applicative (optional, (<|>))
 import Control.Monad (unless)
-import Data.Attoparsec.ByteString.Char8 (Parser)
-import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first, second)
-import Data.ByteString.Base64 (encode)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -34,8 +32,7 @@ import Data.Functor (($>))
 import Data.List (foldl')
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Parsers (base64P, parseAll)
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore (QueueRec (..), QueueStatus (..))
 import Simplex.Messaging.Transport (trimCR)
@@ -54,44 +51,40 @@ data StoreLogRecord
   | AddNotifier QueueId NotifierId NtfPublicVerifyKey
   | DeleteQueue QueueId
 
-storeLogRecordP :: Parser StoreLogRecord
-storeLogRecordP =
-  "CREATE " *> createQueueP
-    <|> "SECURE " *> secureQueueP
-    <|> "NOTIFIER " *> addNotifierP
-    <|> "DELETE " *> (DeleteQueue <$> base64P)
-  where
-    createQueueP = CreateQueue <$> queueRecP
-    secureQueueP = SecureQueue <$> base64P <* A.space <*> C.strPubKeyP
-    addNotifierP =
-      AddNotifier <$> base64P <* A.space <*> base64P <* A.space <*> C.strPubKeyP
-    queueRecP = do
-      recipientId <- "rid=" *> base64P
-      recipientKey <- " rk=" *> C.strPubKeyP
-      rcvDhSecret <- " rdh=" *> C.strDhSecretP
-      senderId <- " sid=" *> base64P
-      senderKey <- " sk=" *> optional C.strPubKeyP
-      notifier <- optional $ (,) <$> (" nid=" *> base64P) <*> (" nk=" *> C.strPubKeyP)
-      pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier, status = QueueActive}
+instance StrEncoding QueueRec where
+  strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier} =
+    B.unwords
+      [ "rid=" <> strEncode recipientId,
+        "rk=" <> strEncode recipientKey,
+        "rdh=" <> strEncode rcvDhSecret,
+        "sid=" <> strEncode senderId,
+        "sk=" <> strEncode senderKey
+      ]
+      <> maybe "" notifierStr notifier
+    where
+      notifierStr (nId, nKey) = " nid=" <> strEncode nId <> " nk=" <> strEncode nKey
 
-serializeStoreLogRecord :: StoreLogRecord -> ByteString
-serializeStoreLogRecord = \case
-  CreateQueue q -> "CREATE " <> serializeQueue q
-  SecureQueue rId sKey -> "SECURE " <> encode rId <> " " <> C.serializePubKey sKey
-  AddNotifier rId nId nKey -> B.unwords ["NOTIFIER", encode rId, encode nId, C.serializePubKey nKey]
-  DeleteQueue rId -> "DELETE " <> encode rId
-  where
-    serializeQueue
-      QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier} =
-        B.unwords
-          [ "rid=" <> encode recipientId,
-            "rk=" <> C.serializePubKey recipientKey,
-            "rdh=" <> C.serializeDhSecret rcvDhSecret,
-            "sid=" <> encode senderId,
-            "sk=" <> maybe "" C.serializePubKey senderKey
-          ]
-          <> maybe "" serializeNotifier notifier
-    serializeNotifier (nId, nKey) = " nid=" <> encode nId <> " nk=" <> C.serializePubKey nKey
+  strP = do
+    recipientId <- "rid=" *> strP_
+    recipientKey <- "rk=" *> strP_
+    rcvDhSecret <- "rdh=" *> strP_
+    senderId <- "sid=" *> strP_
+    senderKey <- "sk=" *> strP
+    notifier <- optional $ (,) <$> (" nid=" *> strP_) <*> ("nk=" *> strP)
+    pure QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier, status = QueueActive}
+
+instance StrEncoding StoreLogRecord where
+  strEncode = \case
+    CreateQueue q -> strEncode (Str "CREATE", q)
+    SecureQueue rId sKey -> strEncode (Str "SECURE", rId, sKey)
+    AddNotifier rId nId nKey -> strEncode (Str "NOTIFIER", rId, nId, nKey)
+    DeleteQueue rId -> strEncode (Str "DELETE", rId)
+
+  strP =
+    "CREATE " *> (CreateQueue <$> strP)
+      <|> "SECURE " *> (SecureQueue <$> strP_ <*> strP)
+      <|> "NOTIFIER " *> (AddNotifier <$> strP_ <*> strP_ <*> strP)
+      <|> "DELETE " *> (DeleteQueue <$> strP)
 
 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = WriteStoreLog f <$> openFile f WriteMode
@@ -113,7 +106,7 @@ closeStoreLog = \case
 
 writeStoreLogRecord :: StoreLog 'WriteMode -> StoreLogRecord -> IO ()
 writeStoreLogRecord (WriteStoreLog _ h) r = do
-  B.hPutStrLn h $ serializeStoreLogRecord r
+  B.hPutStrLn h $ strEncode r
   hFlush h
 
 logCreateQueue :: StoreLog 'WriteMode -> QueueRec -> IO ()
@@ -151,7 +144,7 @@ readQueues (ReadStoreLog _ h) = LB.hGetContents h >>= returnResult . procStoreLo
     returnResult :: ([LogParsingError], Map RecipientId QueueRec) -> IO (Map RecipientId QueueRec)
     returnResult (errs, res) = mapM_ printError errs $> res
     parseLogRecord :: LB.ByteString -> Either LogParsingError StoreLogRecord
-    parseLogRecord = (\s -> first (,s) $ parseAll storeLogRecordP s) . trimCR . LB.toStrict
+    parseLogRecord = (\s -> first (,s) $ strDecode s) . trimCR . LB.toStrict
     procLogRecord :: Map RecipientId QueueRec -> StoreLogRecord -> Map RecipientId QueueRec
     procLogRecord m = \case
       CreateQueue q -> M.insert (recipientId q) q m
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index fc824c58d..a2f31710e 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -41,7 +41,6 @@ module Simplex.Messaging.Transport
     runTransportClient,
     loadTLSServerParams,
     loadFingerprint,
-    encodeFingerprint,
 
     -- * TLS 1.2 Transport
     TLS (..),
@@ -71,7 +70,6 @@ import qualified Crypto.Store.X509 as SX
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import Data.Bifunctor (first)
 import Data.Bitraversable (bimapM)
-import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as BL
@@ -82,6 +80,7 @@ import qualified Data.Set as S
 import Data.Word (Word16)
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
+import Data.X509.Validation (Fingerprint (..))
 import qualified Data.X509.Validation as XV
 import GHC.Generics (Generic)
 import GHC.IO.Exception (IOErrorType (..))
@@ -201,7 +200,7 @@ startTCPServer started port = withSocketsDo $ resolve >>= open >>= setStarted
     setStarted sock = atomically (tryPutTMVar started True) >> pure sock
 
 -- | Connect to passed TCP host:port and pass handle to the client.
-runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> Maybe C.KeyHash -> (c -> m a) -> m a
+runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> C.KeyHash -> (c -> m a) -> m a
 runTransportClient host port keyHash client = do
   let clientParams = mkTLSClientParams host port keyHash
   c <- liftIO $ startTCPClient host port clientParams
@@ -248,14 +247,11 @@ loadTLSServerParams caCertificateFile certificateFile privateKeyFile =
           T.serverSupported = supportedParameters
         }
 
-loadFingerprint :: FilePath -> IO XV.Fingerprint
+loadFingerprint :: FilePath -> IO Fingerprint
 loadFingerprint certificateFile = do
   (cert : _) <- SX.readSignedObject certificateFile
   pure $ XV.getFingerprint (cert :: X.SignedExact X.Certificate) X.HashSHA256
 
-encodeFingerprint :: XV.Fingerprint -> ByteString
-encodeFingerprint (XV.Fingerprint bs) = encode bs
-
 -- * TLS 1.2 Transport
 
 data TLS = TLS
@@ -294,7 +290,7 @@ 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
 
-mkTLSClientParams :: HostName -> ServiceName -> Maybe C.KeyHash -> T.ClientParams
+mkTLSClientParams :: HostName -> ServiceName -> C.KeyHash -> T.ClientParams
 mkTLSClientParams host port keyHash = do
   let p = B.pack port
   (T.defaultParamsClient host p)
@@ -303,16 +299,14 @@ mkTLSClientParams host port keyHash = do
       T.clientSupported = supportedParameters
     }
 
-validateCertificateChain :: Maybe C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
+validateCertificateChain :: C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
 validateCertificateChain _ _ _ (X.CertificateChain []) = pure [XV.EmptyChain]
 validateCertificateChain _ _ _ (X.CertificateChain [_]) = pure [XV.EmptyChain]
-validateCertificateChain keyHash host port cc@(X.CertificateChain sc@[_, caCert]) =
-  let fp = XV.getFingerprint caCert X.HashSHA256
-   in if maybe True (sameFingerprint fp) keyHash
-        then x509validate
-        else pure [XV.UnknownCA]
+validateCertificateChain (C.KeyHash kh) host port cc@(X.CertificateChain sc@[_, caCert]) =
+  if Fingerprint kh == XV.getFingerprint caCert X.HashSHA256
+    then x509validate
+    else pure [XV.UnknownCA]
   where
-    sameFingerprint (XV.Fingerprint s) (C.KeyHash s') = s == s'
     x509validate :: IO [XV.FailedReason]
     x509validate = XV.validate X.HashSHA256 hooks checks certStore cache serviceID cc
       where
@@ -402,14 +396,19 @@ data ServerHandshake = ServerHandshake
     sessionId :: ByteString
   }
 
-newtype ClientHandshake = ClientHandshake
+data ClientHandshake = ClientHandshake
   { -- | agreed SMP server protocol version
-    smpVersion :: Word16
+    smpVersion :: Word16,
+    -- | server identity - CA certificate fingerprint
+    keyHash :: C.KeyHash
   }
 
 instance Encoding ClientHandshake where
-  smpEncode ClientHandshake {smpVersion} = smpEncode smpVersion
-  smpP = ClientHandshake <$> smpP
+  smpEncode ClientHandshake {smpVersion, keyHash} = smpEncode (smpVersion, keyHash)
+  smpP = do
+    smpVersion <- smpP
+    keyHash <- smpP
+    pure ClientHandshake {smpVersion, keyHash}
 
 instance Encoding ServerHandshake where
   smpEncode ServerHandshake {smpVersionRange, sessionId} =
@@ -434,6 +433,8 @@ data HandshakeError
     PARSE
   | -- | incompatible peer version
     VERSION
+  | -- | incorrect server identity
+    IDENTITY
   deriving (Eq, Generic, Read, Show, Exception)
 
 instance Arbitrary TransportError where arbitrary = genericArbitraryU
@@ -472,29 +473,32 @@ tGetBlock THandle {connection = c} =
 -- | Server SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-serverHandshake :: forall c. Transport c => c -> ExceptT TransportError IO (THandle c)
-serverHandshake c = do
+serverHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
+serverHandshake c kh = do
   let th@THandle {sessionId} = tHandle c
   sendHandshake th $ ServerHandshake {sessionId, smpVersionRange = supportedSMPVersions}
-  ClientHandshake smpVersion <- getHandshake th
-  if smpVersion `isCompatible` supportedSMPVersions
-    then pure (th :: THandle c) {smpVersion}
-    else throwE $ TEHandshake VERSION
+  getHandshake th >>= \case
+    ClientHandshake {smpVersion, keyHash}
+      | keyHash /= kh ->
+        throwE $ TEHandshake IDENTITY
+      | smpVersion `isCompatible` supportedSMPVersions -> do
+        pure (th :: THandle c) {smpVersion}
+      | otherwise -> throwE $ TEHandshake VERSION
 
 -- | Client SMP transport handshake.
 --
 -- See https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#appendix-a
-clientHandshake :: forall c. Transport c => c -> ExceptT TransportError IO (THandle c)
-clientHandshake c = do
+clientHandshake :: forall c. Transport c => c -> C.KeyHash -> ExceptT TransportError IO (THandle c)
+clientHandshake c keyHash = do
   let th@THandle {sessionId} = tHandle c
   ServerHandshake {sessionId = sessId, smpVersionRange} <- getHandshake th
-  if sessionId == sessId
-    then case smpVersionRange `compatibleVersion` supportedSMPVersions of
+  if sessionId /= sessId
+    then throwE TEBadSession
+    else case smpVersionRange `compatibleVersion` supportedSMPVersions of
       Just smpVersion -> do
-        sendHandshake th $ ClientHandshake smpVersion
+        sendHandshake th $ ClientHandshake {smpVersion, keyHash}
         pure (th :: THandle c) {smpVersion}
       Nothing -> throwE $ TEHandshake VERSION
-    else throwE TEBadSession
 
 sendHandshake :: (Transport c, Encoding smp) => THandle c -> smp -> ExceptT TransportError IO ()
 sendHandshake th = ExceptT . tPutBlock th . smpEncode
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index 616101f19..b8194f1e3 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -40,7 +40,7 @@ infixl 4 <$$>, <$?>
 {-# INLINE (<$$>) #-}
 
 (<$?>) :: MonadFail m => (a -> Either String b) -> m a -> m b
-f <$?> m = m >>= either fail pure . f
+f <$?> m = either fail pure . f =<< m
 {-# INLINE (<$?>) #-}
 
 bshow :: Show a => a -> ByteString
diff --git a/src/Simplex/Messaging/Version.hs b/src/Simplex/Messaging/Version.hs
index 00a303590..829d65df1 100644
--- a/src/Simplex/Messaging/Version.hs
+++ b/src/Simplex/Messaging/Version.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 
 module Simplex.Messaging.Version
@@ -10,8 +11,11 @@ module Simplex.Messaging.Version
   )
 where
 
+import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Word (Word16)
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Util (bshow)
 
 pattern VersionRange :: Word16 -> Word16 -> VersionRange
 pattern VersionRange v1 v2 <- VRange v1 v2
@@ -41,6 +45,12 @@ instance Encoding VersionRange where
     maybe (fail "invalid version range") pure
       =<< versionRange <$> smpP <*> smpP
 
+instance StrEncoding VersionRange where
+  strEncode (VRange v1 v2) = bshow v1 <> "-" <> bshow v2
+  strP =
+    maybe (fail "invalid version range") pure
+      =<< versionRange <$> A.decimal <* A.char '-' <*> A.decimal
+
 compatibleVersion :: VersionRange -> VersionRange -> Maybe Word16
 compatibleVersion (VersionRange min1 max1) (VersionRange min2 max2)
   | min1 <= max2 && min2 <= max1 = Just $ min max1 max2
diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs
index 39e537940..45ec2498d 100644
--- a/tests/AgentTests.hs
+++ b/tests/AgentTests.hs
@@ -21,6 +21,7 @@ import SMPAgentClient
 import SMPClient (testPort, testPort2, testStoreLogFile, withSmpServer, withSmpServerStoreLogOn)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as A
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody)
 import Simplex.Messaging.Transport (ATransport (..), TProxy (..), Transport (..))
 import System.Directory (removeFile)
@@ -111,7 +112,7 @@ pattern Msg msgBody <- MSG MsgMeta {integrity = MsgOk} msgBody
 testDuplexConnection :: Transport c => TProxy c -> c -> c -> IO ()
 testDuplexConnection _ alice bob = do
   ("1", "bob", Right (INV cReq)) <- alice #: ("1", "bob", "NEW INV")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
   bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
   ("", "bob", Right (CONF confId "bob's connInfo")) <- (alice <#:)
   alice #: ("2", "bob", "LET " <> confId <> " 16\nalice's connInfo") #> ("2", "bob", OK)
@@ -143,7 +144,7 @@ testDuplexConnection _ alice bob = do
 testDuplexConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
 testDuplexConnRandomIds _ alice bob = do
   ("1", bobConn, Right (INV cReq)) <- alice #: ("1", "", "NEW INV")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
   ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo")
   ("", bobConn', Right (CONF confId "bob's connInfo")) <- (alice <#:)
   bobConn' `shouldBe` bobConn
@@ -176,7 +177,7 @@ testDuplexConnRandomIds _ alice bob = do
 testContactConnection :: Transport c => TProxy c -> c -> c -> c -> IO ()
 testContactConnection _ alice bob tom = do
   ("1", "alice_contact", Right (INV cReq)) <- alice #: ("1", "alice_contact", "NEW CON")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
 
   bob #: ("11", "alice", "JOIN " <> cReq' <> " 14\nbob's connInfo") #> ("11", "alice", OK)
   ("", "alice_contact", Right (REQ aInvId "bob's connInfo")) <- (alice <#:)
@@ -207,7 +208,7 @@ testContactConnection _ alice bob tom = do
 testContactConnRandomIds :: Transport c => TProxy c -> c -> c -> IO ()
 testContactConnRandomIds _ alice bob = do
   ("1", aliceContact, Right (INV cReq)) <- alice #: ("1", "", "NEW CON")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
 
   ("11", aliceConn, Right OK) <- bob #: ("11", "", "JOIN " <> cReq' <> " 14\nbob's connInfo")
   ("", aliceContact', Right (REQ aInvId "bob's connInfo")) <- (alice <#:)
@@ -230,7 +231,7 @@ testContactConnRandomIds _ alice bob = do
 testRejectContactRequest :: Transport c => TProxy c -> c -> c -> IO ()
 testRejectContactRequest _ alice bob = do
   ("1", "a_contact", Right (INV cReq)) <- alice #: ("1", "a_contact", "NEW CON")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
   bob #: ("11", "alice", "JOIN " <> cReq' <> " 10\nbob's info") #> ("11", "alice", OK)
   ("", "a_contact", Right (REQ aInvId "bob's info")) <- (alice <#:)
   -- RJCT must use correct contact connection
@@ -329,7 +330,7 @@ testMsgDeliveryAgentRestart t bob = do
 connect :: forall c. Transport c => (c, ByteString) -> (c, ByteString) -> IO ()
 connect (h1, name1) (h2, name2) = do
   ("c1", _, Right (INV cReq)) <- h1 #: ("c1", name2, "NEW INV")
-  let cReq' = serializeConnReq cReq
+  let cReq' = strEncode cReq
   h2 #: ("c2", name1, "JOIN " <> cReq' <> " 5\ninfo2") #> ("c2", name1, OK)
   ("", _, Right (CONF connId "info2")) <- (h1 <#:)
   h1 #: ("c3", name2, "LET " <> connId <> " 5\ninfo1") #> ("c3", name2, OK)
@@ -340,7 +341,7 @@ connect (h1, name1) (h2, name2) = do
 -- connect' :: forall c. Transport c => c -> c -> IO (ByteString, ByteString)
 -- connect' h1 h2 = do
 --   ("c1", conn2, Right (INV cReq)) <- h1 #: ("c1", "", "NEW INV")
---   let cReq' = serializeConnReq cReq
+--   let cReq' = strEncode cReq
 --   ("c2", conn1, Right OK) <- h2 #: ("c2", "", "JOIN " <> cReq' <> " 5\ninfo2")
 --   ("", _, Right (REQ connId "info2")) <- (h1 <#:)
 --   h1 #: ("c3", conn2, "ACPT " <> connId <> " 5\ninfo1") =#> \case ("c3", c, OK) -> c == conn2; _ -> False
@@ -349,11 +350,8 @@ connect (h1, name1) (h2, name2) = do
 --   h1 <# ("", conn2, CON)
 --   pure (conn1, conn2)
 
-samplePublicKey :: ByteString
-samplePublicKey = "rsa:MIIBoDANBgkqhkiG9w0BAQEFAAOCAY0AMIIBiAKCAQEAtn1NI2tPoOGSGfad0aUg0tJ0kG2nzrIPGLiz8wb3dQSJC9xkRHyzHhEE8Kmy2cM4q7rNZIlLcm4M7oXOTe7SC4x59bLQG9bteZPKqXu9wk41hNamV25PWQ4zIcIRmZKETVGbwN7jFMpH7wxLdI1zzMArAPKXCDCJ5ctWh4OWDI6OR6AcCtEj-toCI6N6pjxxn5VigJtwiKhxYpoUJSdNM60wVEDCSUrZYBAuDH8pOxPfP-Tm4sokaFDTIG3QJFzOjC-_9nW4MUjAOFll9PCp9kaEFHJ_YmOYKMWNOCCPvLS6lxA83i0UaardkNLNoFS5paWfTlroxRwOC2T6PwO2ywKBgDjtXcSED61zK1seocQMyGRINnlWdhceD669kIHju_f6kAayvYKW3_lbJNXCmyinAccBosO08_0sUxvtuniIo18kfYJE0UmP1ReCjhMP-O-yOmwZJini_QelJk_Pez8IIDDWnY1qYQsN_q7ocjakOYrpGG7mig6JMFpDJtD6istR"
-
 sampleDhKey :: ByteString
-sampleDhKey = "x25519:MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
+sampleDhKey = "MCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
 
 syntaxTests :: forall c. Transport c => TProxy c -> Spec
 syntaxTests t = do
@@ -378,7 +376,6 @@ syntaxTests t = do
             <> "%40localhost%3A5001%2F3456-w%3D%3D%23"
             <> urlEncode True sampleDhKey
             <> "&e2e="
-            <> urlEncode True samplePublicKey
             <> " 14\nbob's connInfo"
         )
           >#> ("311", "a", "ERR SMP AUTH")
diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs
index 821e88c5a..4b45b0d16 100644
--- a/tests/AgentTests/ConnectionRequestTests.hs
+++ b/tests/AgentTests/ConnectionRequestTests.hs
@@ -8,7 +8,8 @@ import Data.ByteString (ByteString)
 import Network.HTTP.Types (urlEncode)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (smpClientVersion)
 import Test.Hspec
 
 uri :: String
@@ -19,7 +20,7 @@ srv =
   SMPServer
     { host = "smp.simplex.im",
       port = Just "5223",
-      keyHash = Just (C.KeyHash "\215m\248\251")
+      keyHash = C.KeyHash "\215m\248\251"
     }
 
 queue :: SMPQueueUri
@@ -27,6 +28,7 @@ queue =
   SMPQueueUri
     { smpServer = srv,
       senderId = "\223\142z\251",
+      smpVersionRange = smpClientVersion,
       dhPublicKey = testDhKey
     }
 
@@ -34,19 +36,16 @@ testDhKey :: C.PublicKeyX25519
 testDhKey = "MCowBQYDK2VuAyEAjiswwI3O/NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o="
 
 testDhKeyStr :: ByteString
-testDhKeyStr = C.serializePubKeyUri' testDhKey
+testDhKeyStr = strEncode testDhKey
 
 testDhKeyStrUri :: ByteString
 testDhKeyStrUri = urlEncode True testDhKeyStr
 
-appServer :: ConnReqScheme
-appServer = CRSAppServer "simplex.chat" Nothing
-
 connectionRequest :: AConnectionRequest
 connectionRequest =
   ACR SCMInvitation . CRInvitation $
     ConnReqData
-      { crScheme = appServer,
+      { crScheme = simplexChat,
         crSmpQueues = [queue],
         crEncryption = ConnectionEncryption
       }
@@ -55,23 +54,22 @@ connectionRequestTests :: Spec
 connectionRequestTests =
   describe "connection request parsing / serializing" $ do
     it "should serialize SMP queue URIs" $ do
-      serializeSMPQueueUri queue {smpServer = srv {port = Nothing}}
+      strEncode queue {smpServer = srv {port = Nothing}}
         `shouldBe` "smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr
-      serializeSMPQueueUri queue
+      strEncode queue
         `shouldBe` "smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr
     it "should parse SMP queue URIs" $ do
-      parseAll smpQueueUriP ("smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr)
+      strDecode ("smp://1234-w==@smp.simplex.im/3456-w==#" <> testDhKeyStr)
         `shouldBe` Right queue {smpServer = srv {port = Nothing}}
-      parseAll smpQueueUriP ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr)
+      strDecode ("smp://1234-w==@smp.simplex.im:5223/3456-w==#" <> testDhKeyStr)
         `shouldBe` Right queue
     it "should serialize connection requests" $ do
-      serializeConnReq connectionRequest
+      strEncode connectionRequest
         `shouldBe` "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
         <> testDhKeyStrUri
         <> "&e2e="
     it "should parse connection requests" $ do
-      parseAll
-        connReqP
+      strDecode
         ( "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23"
             <> testDhKeyStrUri
             <> "&e2e="
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index 27abf0d15..a0003ce98 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -156,7 +156,7 @@ cfg :: AgentConfig
 cfg =
   defaultAgentConfig
     { tcpPort = agentTestPort,
-      smpServers = L.fromList ["localhost:5001#9VjLsOY5ZvB4hoglNdBzJFAUi/vP4GkZnJFahQOXV20="],
+      smpServers = L.fromList ["smp://9VjLsOY5ZvB4hoglNdBzJFAUi_vP4GkZnJFahQOXV20=@localhost:5001"],
       tbqSize = 1,
       dbFile = testDB,
       smpCfg =
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 07b7c9de5..d25df0411 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -36,11 +36,8 @@ testPort = "5001"
 testPort2 :: ServiceName
 testPort2 = "5002"
 
-testKeyHashStr :: ByteString
-testKeyHashStr = "9VjLsOY5ZvB4hoglNdBzJFAUi/vP4GkZnJFahQOXV20="
-
-testKeyHash :: Maybe C.KeyHash
-testKeyHash = Just "9VjLsOY5ZvB4hoglNdBzJFAUi/vP4GkZnJFahQOXV20="
+testKeyHash :: C.KeyHash
+testKeyHash = "9VjLsOY5ZvB4hoglNdBzJFAUi_vP4GkZnJFahQOXV20="
 
 testStoreLogFile :: FilePath
 testStoreLogFile = "tests/tmp/smp-server-store.log"
@@ -48,7 +45,7 @@ testStoreLogFile = "tests/tmp/smp-server-store.log"
 testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
   runTransportClient testHost testPort testKeyHash $ \h ->
-    liftIO (runExceptT $ clientHandshake h) >>= \case
+    liftIO (runExceptT $ clientHandshake h testKeyHash) >>= \case
       Right th -> client th
       Left e -> error $ show e
 
@@ -68,17 +65,17 @@ cfg =
     }
 
 withSmpServerStoreLogOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerStoreLogOn t port client = do
+withSmpServerStoreLogOn t port' client = do
   s <- liftIO $ openReadStoreLog testStoreLogFile
   serverBracket
-    (\started -> runSMPServerBlocking started cfg {transports = [(port, t)], storeLog = Just s})
+    (\started -> runSMPServerBlocking started cfg {transports = [(port', t)], storeLog = Just s})
     (pure ())
     client
 
 withSmpServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> (ThreadId -> m a) -> m a
-withSmpServerThreadOn t port =
+withSmpServerThreadOn t port' =
   serverBracket
-    (\started -> runSMPServerBlocking started cfg {transports = [(port, t)]})
+    (\started -> runSMPServerBlocking started cfg {transports = [(port', t)]})
     (pure ())
 
 serverBracket :: MonadUnliftIO m => (TMVar Bool -> m ()) -> m () -> (ThreadId -> m a) -> m a
@@ -95,7 +92,7 @@ serverBracket process afterProcess f = do
         _ -> pure ()
 
 withSmpServerOn :: (MonadUnliftIO m, MonadRandom m) => ATransport -> ServiceName -> m a -> m a
-withSmpServerOn t port = withSmpServerThreadOn t port . const
+withSmpServerOn t port' = withSmpServerThreadOn t port' . const
 
 withSmpServer :: (MonadUnliftIO m, MonadRandom m) => ATransport -> m a -> m a
 withSmpServer t = withSmpServerOn t testPort
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index d5923e2df..418c86a5e 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -19,6 +19,7 @@ import qualified Data.ByteString.Char8 as B
 import SMPClient
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Transport
 import System.Directory (removeFile)
@@ -214,13 +215,13 @@ testDuplex (ATransport t) =
       -- aSnd ID is passed to Bob out-of-band
 
       (bsPub, bsKey) <- C.generateSignatureKeyPair C.SEd448
-      Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, SEND $ "key " <> C.serializePubKey bsPub)
+      Resp "bcda" _ OK <- sendRecv bob ("", "bcda", aSnd, SEND $ "key " <> strEncode bsPub)
       -- "key ..." is ad-hoc, not a part of SMP protocol
 
       Resp "" _ (MSG mId1 _ msg1) <- tGet alice
       Resp "cdab" _ OK <- signSendRecv alice arKey ("cdab", aRcv, ACK)
       Right ["key", bobKey] <- pure $ B.words <$> aDec mId1 msg1
-      (bobKey, C.serializePubKey bsPub) #== "key received from Bob"
+      (bobKey, strEncode bsPub) #== "key received from Bob"
       Resp "dabc" _ OK <- signSendRecv alice arKey ("dabc", aRcv, KEY bsPub)
 
       (brPub, brKey) <- C.generateSignatureKeyPair C.SEd448
@@ -236,13 +237,13 @@ testDuplex (ATransport t) =
       (bId, encode bSnd) #== "reply queue ID received from Bob"
 
       (asPub, asKey) <- C.generateSignatureKeyPair C.SEd448
-      Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, SEND $ "key " <> C.serializePubKey asPub)
+      Resp "dabc" _ OK <- sendRecv alice ("", "dabc", bSnd, SEND $ "key " <> strEncode asPub)
       -- "key ..." is ad-hoc, not a part of  SMP protocol
 
       Resp "" _ (MSG mId3 _ msg3) <- tGet bob
       Resp "abcd" _ OK <- signSendRecv bob brKey ("abcd", bRcv, ACK)
       Right ["key", aliceKey] <- pure $ B.words <$> bDec mId3 msg3
-      (aliceKey, C.serializePubKey asPub) #== "key received from Alice"
+      (aliceKey, strEncode asPub) #== "key received from Alice"
       Resp "bcda" _ OK <- signSendRecv bob brKey ("bcda", bRcv, KEY asPub)
 
       Resp "cdab" _ OK <- signSendRecv bob bsKey ("cdab", aSnd, SEND "hi alice")