From e2cd37051313ed95f993180135437bda1253bb1f Mon Sep 17 00:00:00 2001 From: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> Date: Wed, 22 Dec 2021 23:24:58 +0400 Subject: [PATCH] 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 | 47 +++++++++++---- package.yaml | 4 +- simplexmq.cabal | 11 ++++ src/Simplex/Messaging/Agent/Protocol.hs | 10 ++-- src/Simplex/Messaging/Client.hs | 2 +- src/Simplex/Messaging/Crypto.hs | 19 +++--- src/Simplex/Messaging/Transport.hs | 68 +++++++++++++++++----- tests/AgentTests.hs | 7 ++- tests/AgentTests/ConnectionRequestTests.hs | 22 +++---- tests/SMPAgentClient.hs | 4 +- tests/SMPClient.hs | 6 +- 11 files changed, 131 insertions(+), 69 deletions(-) diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs index 22bea02a0..310369973 100644 --- a/apps/smp-server/Main.hs +++ b/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 diff --git a/package.yaml b/package.yaml index 0da0db01f..ef50b5b27 100644 --- a/package.yaml +++ b/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.* diff --git a/simplexmq.cabal b/simplexmq.cabal index 750dc50a4..e3f7f7acd 100644 --- a/simplexmq.cabal +++ b/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 diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 7faef0f34..3ca65be9d 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/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) diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs index e01a7baaa..db0ffefcc 100644 --- a/src/Simplex/Messaging/Client.hs +++ b/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 diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index b451103ab..57e5a0bb1 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/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 diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index c7ded0a36..4cc61063e 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/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) diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index c9aab3a85..39fe8b056 100644 --- a/tests/AgentTests.hs +++ b/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") diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs index 53a7c58e5..49c6c9661 100644 --- a/tests/AgentTests/ConnectionRequestTests.hs +++ b/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 diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs index 95170790b..9918e3adb 100644 --- a/tests/SMPAgentClient.hs +++ b/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 diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index 454d62819..77eec9a9a 100644 --- a/tests/SMPClient.hs +++ b/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