certificate validation on client side; check stored fingerprint on server start-up; non-optional fingerprint parsing (#234, closes #155)

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

apps/smp-server/Main.hs

@@ -9,19 +9,18 @@ module Main where
 
 import Control.Monad.Except
 import Control.Monad.Trans.Except
-import Data.ByteString.Base64 (encode)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (toLower)
 import Data.Ini (Ini, lookupValue, readIniFile)
+import Data.List (dropWhileEnd)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Network.Socket (ServiceName)
 import Options.Applicative
-import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Server (runSMPServer)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.StoreLog (StoreLog, openReadStoreLog, storeLogFilePath)
-import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..))
+import Simplex.Messaging.Transport (ATransport (..), TLS, Transport (..), encodeFingerprint, loadFingerprint)
 import Simplex.Messaging.Transport.WebSockets (WS)
 import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
 import System.Exit (exitFailure)
@@ -69,6 +68,9 @@ defaultPrivateKeyFile = combine cfgDir "server.key"
 defaultCertificateFile :: FilePath
 defaultCertificateFile = combine cfgDir "server.crt"
 
+fingerprintFile :: FilePath
+fingerprintFile = combine cfgDir "fingerprint"
+
 main :: IO ()
 main = do
   opts <- getServerOpts
@@ -78,12 +80,14 @@ main = do
       runExceptT (getConfig opts) >>= \case
         Right cfg -> do
           putStrLn "Error: server is already initialized. Start it with `smp-server start` command"
-          printConfig cfg
+          fingerprint <- loadSavedFingerprint
+          printConfig cfg fingerprint
           exitFailure
         Left _ -> do
           cfg <- initializeServer opts
           putStrLn "Server was initialized. Start it with `smp-server start` command"
-          printConfig cfg
+          fingerprint <- loadSavedFingerprint
+          printConfig cfg fingerprint
     ServerStart ->
       runExceptT (getConfig opts) >>= \case
         Right cfg -> runServer cfg
@@ -111,9 +115,9 @@ makeConfig IniOpts {serverPort, enableWebsockets, serverPrivateKeyFile, serverCe
   let transports = (serverPort, transport @TLS) : [("80", transport @WS) | enableWebsockets]
    in serverConfig {transports, storeLog, serverPrivateKeyFile, serverCertificateFile}
 
-printConfig :: ServerConfig -> IO ()
-printConfig ServerConfig {storeLog} = do
-  -- TODO print certificate hash
+printConfig :: ServerConfig -> String -> IO ()
+printConfig ServerConfig {storeLog} fingerprint = do
+  putStrLn $ "fingerprint: " <> fingerprint
   putStrLn $ case storeLog of
     Just s -> "store log: " <> storeLogFilePath s
     Nothing -> "store log disabled"
@@ -123,15 +127,25 @@ initializeServer opts = do
   createDirectoryIfMissing True cfgDir
   ini <- createIni opts
   createKeyAndCertificate ini opts
+  saveFingerprint $ serverCertificateFile (ini :: IniOpts)
   storeLog <- openStoreLog opts ini
   pure $ makeConfig ini storeLog
 
 runServer :: ServerConfig -> IO ()
 runServer cfg = do
-  printConfig cfg
+  savedFingerprint <- loadSavedFingerprint
+  checkSavedFingerprint savedFingerprint
+  printConfig cfg savedFingerprint
   forM_ (transports cfg) $ \(port, ATransport t) ->
     putStrLn $ "listening on port " <> port <> " (" <> transportName t <> ")"
   runSMPServer cfg
+  where
+    checkSavedFingerprint :: String -> IO ()
+    checkSavedFingerprint savedFingerprint = do
+      fingerprint <- loadFingerprint $ serverCertificateFile (cfg :: ServerConfig)
+      if savedFingerprint == (B.unpack . encodeFingerprint) fingerprint
+        then putStrLn "stored fingerprint is valid"
+        else putStrLn "stored fingerprint is invalid" >> exitFailure
 
 deleteServer :: IO ()
 deleteServer = do
@@ -142,10 +156,12 @@ deleteServer = do
       deleteIfExists storeLogFile
       deleteIfExists serverPrivateKeyFile
       deleteIfExists serverCertificateFile
+      deleteIfExists fingerprintFile
     Left _ -> do
       deleteIfExists defaultStoreLogFile
       deleteIfExists defaultPrivateKeyFile
       deleteIfExists defaultCertificateFile
+      deleteIfExists fingerprintFile
 
 data IniOpts = IniOpts
   { enableStoreLog :: Bool,
@@ -222,6 +238,16 @@ createKeyAndCertificate IniOpts {serverPrivateKeyFile, serverCertificateFile} Se
     csrPath :: String
     csrPath = combine cfgDir "localhost.csr"
 
+saveFingerprint :: FilePath -> IO ()
+saveFingerprint serverCertificateFile = do
+  fingerprint <- loadFingerprint serverCertificateFile
+  writeFile fingerprintFile $ (B.unpack . encodeFingerprint) fingerprint <> "\n"
+
+loadSavedFingerprint :: IO String
+loadSavedFingerprint = do
+  fingerpint <- readFile fingerprintFile
+  pure $ dropWhileEnd (== '\n') fingerpint
+
 fileExists :: FilePath -> ExceptT String IO ()
 fileExists path = do
   exists <- liftIO $ doesFileExist path
@@ -237,9 +263,6 @@ confirm msg = do
   ok <- getLine
   when (map toLower ok /= "y") exitFailure
 
-serverKeyHash :: C.PrivateKey 'C.RSA -> B.ByteString
-serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey
-
 openStoreLog :: ServerOpts -> IniOpts -> IO (Maybe (StoreLog 'ReadMode))
 openStoreLog ServerOpts {enableStoreLog = l} IniOpts {enableStoreLog = l', storeLogFile = f}
   | l || l' = do

package.yaml

@@ -35,6 +35,7 @@ dependencies:
   - constraints >= 0.12 && < 0.14
   - containers == 0.6.*
   - cryptonite >= 0.27 && < 0.30
+  - cryptostore == 0.2.*
   - data-default == 0.7.*
   - direct-sqlite == 2.3.*
   - directory == 1.3.*
@@ -61,6 +62,8 @@ dependencies:
   - unliftio-core == 0.2.*
   - websockets == 0.12.*
   - x509 == 1.7.*
+  - x509-store == 1.6.*
+  - x509-validation == 1.6.*
 
 library:
   source-dirs: src
@@ -70,7 +73,6 @@ executables:
     source-dirs: apps/smp-server
     main: Main.hs
     dependencies:
-      - cryptostore == 0.2.*
       - ini == 0.4.*
       - optparse-applicative >= 0.15 && < 0.17
       - process == 1.6.*

simplexmq.cabal

@@ -76,6 +76,7 @@ library
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
@@ -101,6 +102,8 @@ library
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
     , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
   default-language: Haskell2010
 
 executable smp-agent
@@ -124,6 +127,7 @@ executable smp-agent
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
@@ -150,6 +154,8 @@ executable smp-agent
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
     , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
   default-language: Haskell2010
 
 executable smp-server
@@ -203,6 +209,8 @@ executable smp-server
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
     , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
   default-language: Haskell2010
 
 test-suite smp-server-test
@@ -236,6 +244,7 @@ test-suite smp-server-test
     , constraints >=0.12 && <0.14
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , cryptostore ==0.2.*
     , data-default ==0.7.*
     , direct-sqlite ==2.3.*
     , directory ==1.3.*
@@ -265,4 +274,6 @@ test-suite smp-server-test
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
     , x509 ==1.7.*
+    , x509-store ==1.6.*
+    , x509-validation ==1.6.*
   default-language: Haskell2010

src/Simplex/Messaging/Agent/Protocol.hs

@@ -351,11 +351,11 @@ agentMessageP =
 
 -- | SMP server location parser.
 smpServerP :: Parser SMPServer
-smpServerP = SMPServer <$> server <*> optional port <*> optional kHash
+smpServerP = SMPServer <$> server <*> optional port <*> kHash
   where
     server = B.unpack <$> A.takeWhile1 (A.notInClass ":#,; ")
     port = A.char ':' *> (B.unpack <$> A.takeWhile1 A.isDigit)
-    kHash = C.KeyHash <$> (A.char '#' *> base64P)
+    kHash = Just . C.KeyHash <$> (A.char '#' *> base64P)
 
 serializeAgentMessage :: AMessage -> ByteString
 serializeAgentMessage = \case
@@ -443,10 +443,10 @@ serializeServerUri SMPServer {host, port, keyHash} = "smp://" <> kh <> B.pack ho
 smpServerUriP :: Parser SMPServer
 smpServerUriP = do
   _ <- "smp://"
-  keyHash <- optional $ C.KeyHash <$> (U.decode <$?> A.takeTill (== '@') <* A.char '@')
+  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}
+  pure SMPServer {host, port, keyHash = Just keyHash}
 
 serializeConnMode :: AConnectionMode -> ByteString
 serializeConnMode (ACM cMode) = serializeConnMode' $ connMode cMode
@@ -472,7 +472,7 @@ connModeT = \case
 data SMPServer = SMPServer
   { host :: HostName,
     port :: Maybe ServiceName,
-    keyHash :: Maybe C.KeyHash
+    keyHash :: Maybe C.KeyHash -- TODO make non optional
   }
   deriving (Eq, Ord, Show)
 

src/Simplex/Messaging/Client.hs

@@ -164,7 +164,7 @@ getSMPClient smpServer cfg@SMPClientConfig {qSize, tcpTimeout, smpPing, smpBlock
       thVar <- newEmptyTMVarIO
       action <-
         async $
-          runTransportClient (host smpServer) port' (client t c thVar)
+          runTransportClient (host smpServer) port' (keyHash smpServer) (client t c thVar)
             `finally` atomically (putTMVar thVar $ Left SMPNetworkError)
       bSize <- tcpTimeout `timeout` atomically (takeTMVar thVar)
       pure $ case bSize of

src/Simplex/Messaging/Crypto.hs

@@ -98,9 +98,6 @@ module Simplex.Messaging.Crypto
     cbDecrypt,
     cbNonce,
 
-    -- * Encoding of RSA keys
-    publicKeyHash,
-
     -- * SHA256 hash
     sha256Hash,
 
@@ -493,7 +490,7 @@ instance forall a. AlgorithmI a => CryptoKey (PublicKey a) where
     _ -> True
   serializeKey k = algorithmPrefix k <> ":" <> encode (encodeKey k)
   serializeKeyUri k = algorithmPrefix k <> ":" <> U.encode (encodeKey k)
-  encodeKey = encodeASNKey . publicToX509
+  encodeKey = encodeASNObj . publicToX509
   strKeyP = pubKey' <$?> strKeyP
   strKeyUriP = pubKey' <$?> strKeyUriP
   binaryKeyP = pubKey' <$?> binaryKeyP
@@ -552,7 +549,7 @@ instance AlgorithmI a => CryptoKey (PrivateKey a) where
     _ -> True
   serializeKey k = algorithmPrefix k <> ":" <> encode (encodeKey k)
   serializeKeyUri k = algorithmPrefix k <> ":" <> U.encode (encodeKey k)
-  encodeKey = encodeASNKey . privateToX509
+  encodeKey = encodeASNObj . privateToX509
   strKeyP = privKey' <$?> strKeyP
   strKeyUriP = privKey' <$?> strKeyUriP
   binaryKeyP = privKey' <$?> binaryKeyP
@@ -812,7 +809,9 @@ newtype Key = Key {unKey :: ByteString}
 -- | IV bytes newtype.
 newtype IV = IV {unIV :: ByteString}
 
--- | Key hash newtype.
+-- | Certificate fingerpint newtype.
+--
+-- 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 IsString KeyHash where
@@ -822,10 +821,6 @@ instance ToField KeyHash where toField = toField . encode . unKeyHash
 
 instance FromField KeyHash where fromField = blobFieldParser $ KeyHash <$> base64P
 
--- | Digest (hash) of binary X509 encoding of RSA public key.
-publicKeyHash :: PublicKey RSA -> KeyHash
-publicKeyHash = KeyHash . sha256Hash . encodeKey
-
 -- | SHA256 digest.
 sha256Hash :: ByteString -> ByteString
 sha256Hash = BA.convert . (hash :: ByteString -> Digest SHA256)
@@ -1075,8 +1070,8 @@ privateToX509 = \case
   PrivateKeyX25519 k -> PrivKeyX25519 k
   PrivateKeyX448 k -> PrivKeyX448 k
 
-encodeASNKey :: ASN1Object a => a -> ByteString
-encodeASNKey k = toStrict . encodeASN1 DER $ toASN1 k []
+encodeASNObj :: ASN1Object a => a -> ByteString
+encodeASNObj k = toStrict . encodeASN1 DER $ toASN1 k []
 
 -- Decoding of binary X509 'PublicKey'.
 decodePubKey :: ByteString -> Either String APublicKey

src/Simplex/Messaging/Transport.hs

@@ -35,11 +35,13 @@ module Simplex.Messaging.Transport
     runTransportServer,
     runTransportClient,
     loadTLSServerParams,
-    withTlsUnique,
+    loadFingerprint,
+    encodeFingerprint,
 
     -- * TLS 1.2 Transport
     TLS (..),
     closeTLS,
+    withTlsUnique,
 
     -- * SMP transport
     THandle (..),
@@ -61,6 +63,7 @@ import Control.Applicative ((<|>))
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Trans.Except (throwE)
+import qualified Crypto.Store.X509 as SX
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)
@@ -73,6 +76,9 @@ import Data.Functor (($>))
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.String
+import qualified Data.X509 as X
+import qualified Data.X509.CertificateStore as XS
+import qualified Data.X509.Validation as XV
 import GHC.Generics (Generic)
 import GHC.IO.Exception (IOErrorType (..))
 import GHC.IO.Handle.Internals (ioe_EOF)
@@ -80,6 +86,7 @@ import Generic.Random (genericArbitraryU)
 import Network.Socket
 import qualified Network.TLS as T
 import qualified Network.TLS.Extra as TE
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Parsers (parseAll, parseRead1, parseString)
 import Simplex.Messaging.Util (bshow)
 import System.Exit (exitFailure)
@@ -158,7 +165,7 @@ runTransportServer started port serverParams server = do
     acceptConnection :: Socket -> IO c
     acceptConnection sock = do
       (newSock, _) <- accept sock
-      ctx <- connectTLS "server" serverParams newSock
+      ctx <- connectTLS serverParams newSock
       getServerConnection ctx
 
 startTCPServer :: TMVar Bool -> ServiceName -> IO Socket
@@ -177,13 +184,14 @@ 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 -> (c -> m a) -> m a
-runTransportClient host port client = do
-  c <- liftIO $ startTCPClient host port
+runTransportClient :: Transport c => MonadUnliftIO m => HostName -> ServiceName -> Maybe 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
   client c `E.finally` liftIO (closeConnection c)
 
-startTCPClient :: forall c. Transport c => HostName -> ServiceName -> IO c
-startTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
+startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> IO c
+startTCPClient host port clientParams = withSocketsDo $ resolve >>= tryOpen err
   where
     err :: IOException
     err = mkIOError NoSuchThing "no address" Nothing Nothing
@@ -202,7 +210,7 @@ startTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
     open addr = do
       sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
       connect sock $ addrAddress addr
-      ctx <- connectTLS "client" clientParams sock
+      ctx <- connectTLS clientParams sock
       getClientConnection ctx
 
 loadTLSServerParams :: FilePath -> FilePath -> IO T.ServerParams
@@ -223,6 +231,14 @@ loadTLSServerParams certificateFile privateKeyFile =
           T.serverSupported = supportedParameters
         }
 
+loadFingerprint :: FilePath -> IO XV.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
@@ -233,11 +249,11 @@ data TLS = TLS
     getLock :: TMVar ()
   }
 
-connectTLS :: T.TLSParams p => String -> p -> Socket -> IO T.Context
-connectTLS party params sock =
+connectTLS :: T.TLSParams p => p -> Socket -> IO T.Context
+connectTLS params sock =
   E.bracketOnError (T.contextNew sock params) closeTLS $ \ctx -> do
     T.handshake ctx
-      `E.catch` \(e :: E.SomeException) -> putStrLn (party <> " exception: " <> show e) >> E.throwIO e
+      `E.catch` \(e :: E.SomeException) -> putStrLn ("exception: " <> show e) >> E.throwIO e
     pure ctx
 
 getTLS :: TransportPeer -> T.Context -> IO TLS
@@ -261,14 +277,34 @@ 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
 
-clientParams :: T.ClientParams
-clientParams =
-  (T.defaultParamsClient "localhost" "5223")
+mkTLSClientParams :: HostName -> ServiceName -> Maybe C.KeyHash -> T.ClientParams
+mkTLSClientParams host port keyHash = do
+  let p = B.pack port
+  (T.defaultParamsClient host p)
     { T.clientShared = def,
-      T.clientHooks = def {T.onServerCertificate = \_ _ _ _ -> pure []},
+      T.clientHooks = def {T.onServerCertificate = \_ _ _ -> validateCertificateChain keyHash host p},
       T.clientSupported = supportedParameters
     }
 
+validateCertificateChain :: Maybe C.KeyHash -> HostName -> ByteString -> X.CertificateChain -> IO [XV.FailedReason]
+validateCertificateChain _ _ _ (X.CertificateChain []) = pure [XV.EmptyChain]
+validateCertificateChain keyHash host port cc@(X.CertificateChain sc@[cert]) =
+  let fp = XV.getFingerprint cert X.HashSHA256
+   in if maybe True (sameFingerprint fp) keyHash
+        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
+        hooks = XV.defaultHooks
+        checks = XV.defaultChecks {XV.checkLeafV3 = False} -- TODO create v3 certificates? https://stackoverflow.com/a/18242720
+        certStore = XS.makeCertificateStore sc
+        cache = XV.exceptionValidationCache [] -- we manually check fingerprint only of the offline certificate (TODO 2 certificates)
+        serviceID = (host, port)
+validateCertificateChain _ _ _ (X.CertificateChain (_ : _)) = pure [XV.AuthorityTooDeep]
+
 supportedParameters :: T.Supported
 supportedParameters =
   def
@@ -333,7 +369,7 @@ trimCR :: ByteString -> ByteString
 trimCR "" = ""
 trimCR s = if B.last s == '\r' then B.init s else s
 
--- * SMP encrypted transport
+-- * SMP transport
 
 data SMPVersion = SMPVersion Int Int Int
   deriving (Eq, Ord)

tests/AgentTests.hs

@@ -365,8 +365,11 @@ syntaxTests t = do
     describe "valid" $ do
       -- TODO: ERROR no connection alias in the response (it does not generate it yet if not provided)
       -- TODO: add tests with defined connection alias
-      it "using same server as in invitation" $
-        ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2Flocalhost%3A5001%2F1234-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo") >#> ("311", "a", "ERR SMP AUTH")
+      xit "using same server as in invitation" $
+        -- URL encode key hash in ghci:
+        -- Network.HTTP.Types.urlEncode True $ B.pack "f80NoyPgNXR5n/fRVfmRTtkRps6/xDrQLmiuz9qFUJU="
+        ("311", "a", "JOIN https://simpex.chat/invitation#/?smp=smp%3A%2F%2FJ9wO8JGBQup6jPOs7BnNPutpKOe%2BLuFlaT10M7BK7JA%3D%40localhost%3A5001%2F3456-w%3D%3D%23&e2e=" <> urlEncode True samplePublicKey <> " 14\nbob's connInfo")
+          >#> ("311", "a", "ERR SMP AUTH")
     describe "invalid" $ do
       -- TODO: JOIN is not merged yet - to be added
       it "no parameters" $ ("321", "", "JOIN") >#> ("321", "", "ERR CMD SYNTAX")

tests/AgentTests/ConnectionRequestTests.hs

@@ -24,7 +24,7 @@ queue :: SMPQueueUri
 queue =
   SMPQueueUri
     { smpServer = srv,
-      senderId = "\215m\248\251"
+      senderId = "\223\142z\251"
     }
 
 appServer :: ConnReqScheme
@@ -43,26 +43,18 @@ connectionRequestTests :: Spec
 connectionRequestTests = do
   describe "connection request parsing / serializing" $ do
     it "should serialize SMP queue URIs" $ do
-      serializeSMPQueueUri queue {smpServer = srv {port = Nothing, keyHash = Nothing}}
-        `shouldBe` "smp://smp.simplex.im/1234-w==#"
-      serializeSMPQueueUri queue {smpServer = srv {keyHash = Nothing}}
-        `shouldBe` "smp://smp.simplex.im:5223/1234-w==#"
       serializeSMPQueueUri queue {smpServer = srv {port = Nothing}}
-        `shouldBe` "smp://1234-w==@smp.simplex.im/1234-w==#"
+        `shouldBe` "smp://1234-w==@smp.simplex.im/3456-w==#"
       serializeSMPQueueUri queue
-        `shouldBe` "smp://1234-w==@smp.simplex.im:5223/1234-w==#"
+        `shouldBe` "smp://1234-w==@smp.simplex.im:5223/3456-w==#"
     it "should parse SMP queue URIs" $ do
-      parseAll smpQueueUriP "smp://smp.simplex.im/1234-w==#"
-        `shouldBe` Right queue {smpServer = srv {port = Nothing, keyHash = Nothing}}
-      parseAll smpQueueUriP "smp://smp.simplex.im:5223/1234-w==#"
-        `shouldBe` Right queue {smpServer = srv {keyHash = Nothing}}
-      parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im/1234-w==#"
+      parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im/3456-w==#"
         `shouldBe` Right queue {smpServer = srv {port = Nothing}}
-      parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im:5223/1234-w==#"
+      parseAll smpQueueUriP "smp://1234-w==@smp.simplex.im:5223/3456-w==#"
         `shouldBe` Right queue
     it "should serialize connection requests" $ do
       serializeConnReq connectionRequest
-        `shouldBe` "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D"
+        `shouldBe` "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D"
     it "should parse connection requests" $ do
-      parseAll connReqP "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F1234-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D"
+      parseAll connReqP "https://simplex.chat/invitation#/?smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23&e2e=rsa%3AMBowDQYJKoZIhvcNAQEBBQADCQAwBgIBAAIBAA%3D%3D"
         `shouldBe` Right connectionRequest

tests/SMPAgentClient.hs

@@ -156,7 +156,7 @@ cfg :: AgentConfig
 cfg =
   defaultAgentConfig
     { tcpPort = agentTestPort,
-      smpServers = L.fromList ["localhost:5001#KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="],
+      smpServers = L.fromList ["localhost:5001#f80NoyPgNXR5n/fRVfmRTtkRps6/xDrQLmiuz9qFUJU="],
       tbqSize = 1,
       dbFile = testDB,
       smpCfg =
@@ -188,7 +188,7 @@ withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)
 
 testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a
 testSMPAgentClientOn port' client = do
-  runTransportClient agentTestHost port' $ \h -> do
+  runTransportClient agentTestHost port' testKeyHash $ \h -> do
     line <- liftIO $ getLn h
     if line == "Welcome to SMP agent v" <> currentSMPVersionStr
       then client h

tests/SMPClient.hs

@@ -38,20 +38,20 @@ testPort2 :: ServiceName
 testPort2 = "5002"
 
 testKeyHashStr :: ByteString
-testKeyHashStr = "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
+testKeyHashStr = "f80NoyPgNXR5n/fRVfmRTtkRps6/xDrQLmiuz9qFUJU="
 
 testBlockSize :: Int
 testBlockSize = 16 * 1024 -- TODO move to Protocol
 
 testKeyHash :: Maybe C.KeyHash
-testKeyHash = Just "KXNE1m2E1m0lm92WGKet9CL6+lO742Vy5G6nsrkvgs8="
+testKeyHash = Just "f80NoyPgNXR5n/fRVfmRTtkRps6/xDrQLmiuz9qFUJU="
 
 testStoreLogFile :: FilePath
 testStoreLogFile = "tests/tmp/smp-server-store.log"
 
 testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
 testSMPClient client =
-  runTransportClient testHost testPort $ \h ->
+  runTransportClient testHost testPort testKeyHash $ \h ->
     liftIO (runExceptT $ clientHandshake h testBlockSize) >>= \case
       Right th -> client th
       Left e -> error $ show e