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
2026-06-04 08:41:25 +00:00 · 2022-01-02 22:24:43 +00:00
parent 33bb38299b
commit f3523bbba9
27 changed files with 577 additions and 591 deletions
@@ -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}
@@ -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
@@ -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;

@@ -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
@@ -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 =
@@ -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
@@ -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,
@@ -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]
@@ -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

@@ -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
@@ -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
@@ -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)

@@ -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
@@ -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
@@ -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"
@@ -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)

@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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")
@@ -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="
@@ -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 =
@@ -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
@@ -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")