From 8a80727fa59d862ea8c1e1e874145fa2fe565201 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sun, 11 Oct 2026 07:37:33 +0100 Subject: [PATCH 1/2] smp server: delayed AUTH responses (#1937) * smp server: delayed AUTH responses * plan * update * simplify * simplify * stat when sent without delay * update schema * round up response time to the nearest delay multiple --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> --- plans/2026-10-09-auth-error-delay.md | 52 +++++++++++++++ simplexmq.cabal | 1 - src/Simplex/Messaging/Server.hs | 41 ++++++++++-- src/Simplex/Messaging/Server/Env/STM.hs | 5 ++ src/Simplex/Messaging/Server/Main.hs | 1 + src/Simplex/Messaging/Server/Main/Init.hs | 4 +- src/Simplex/Messaging/Server/Prometheus.hs | 5 ++ .../QueueStore/Postgres/server_schema.sql | 2 - src/Simplex/Messaging/Server/Stats.hs | 8 +++ tests/SMPClient.hs | 1 + tests/SMPProxyTests.hs | 17 ++++- tests/ServerTests.hs | 66 +++++++++++++------ 12 files changed, 174 insertions(+), 29 deletions(-) create mode 100644 plans/2026-10-09-auth-error-delay.md diff --git a/plans/2026-10-09-auth-error-delay.md b/plans/2026-10-09-auth-error-delay.md new file mode 100644 index 000000000..5ac82c8e6 --- /dev/null +++ b/plans/2026-10-09-auth-error-delay.md @@ -0,0 +1,52 @@ +# Delayed AUTH error responses + +## Decisions + +- Responses that include `ERR AUTH` are sent at the next multiple of the delay after the start time. +- Delayed response sets: + + | Source | Responses sent together | Start time | + |---|---|---| + | `receive`, failed verification | verification and parsing errors of one received block | block receipt | + | `client`, command processing | responses and messages of one batch | batch read from `rcvQ` | + | `RFWD`, forwarded command | the `RRES` of that command | start of forwarded command processing | + +- A thread created by `forkClient` writes the responses to the send queue. +- Delay 0: the responses are written to the send queue directly. +- `authDelayExceeded`: incremented when processing took longer than the delay. + - Prometheus counter `simplex_smp_auth_delay_exceeded`. + - Not saved in the stats backup. + - Not in the daily stats log. +- Configuration: + + | Item | Value | + |---|---| + | INI section | `TRANSPORT` | + | INI key | `auth_error_delay_ms` | + | default | 50 | + | `ServerConfig` field | `authErrorDelay`, microseconds | + | test servers | 20 ms | + +- AUTH timing test: elapsed time of 5 requests, test servers' delay. +- Out of scope: NTF and XFTP servers. + +## Mechanics + +- `Server.hs`: + - `isAuthError`: response is `ERR AUTH`. + - `sendResponses`: responses with `ERR AUTH` to `sendAfterDelay`, others to the send queue. + - `sendAfterDelay`: writes responses to the send queue at the next multiple of the delay. + - `receive`: block receipt time from the `rcvActiveAt` reading. + - `client`: batch time. + - `processForwardedCommand`: start time. +- `Server/Env/STM.hs`: `authErrorDelay` field, `defaultAuthErrorDelayMs`. +- `Server/Stats.hs`: `authDelayExceeded` in `ServerStats` and `ServerStatsData`. +- `Server/Prometheus.hs`: `simplex_smp_auth_delay_exceeded`. +- `Server/Main.hs`: INI value. +- `Server/Main/Init.hs`: INI template line. +- `simplexmq.cabal`: `timeit` removed from the test suite. +- `tests/SMPClient.hs`: `authErrorDelay = 20000`. +- `tests/ServerTests.hs`: + - delayed AUTH for wrong key, absent queue, absent link and suspended queue; immediate `SOK`. + - AUTH timing test measures elapsed time. +- `tests/SMPProxyTests.hs`: delayed AUTH to forwarded `SEND` and `LGET`. diff --git a/simplexmq.cabal b/simplexmq.cabal index 0153db450..11384f5ae 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -640,7 +640,6 @@ test-suite simplexmq-test , stm , text , time - , timeit ==2.0.* , tls >=1.9.0 && <1.10 , transformers , unliftio diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 600c9d287..e2cef6f50 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -1145,14 +1145,16 @@ cancelSub s = case subThread s of type VerifiedTransmissionOrError s = Either (Transmission BrokerMsg) (VerifiedTransmission s) receive :: forall c s. (Transport c, MsgStoreClass s) => THandleSMP c 'TServer -> s -> Client s -> M s () -receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, sndQ, rcvActiveAt} = do +receive h@THandle {params = THandleParams {thAuth, sessionId}} ms c@Client {rcvQ, rcvActiveAt} = do labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive" sa <- asks serverActive stats <- asks serverStats + authDelay <- asks $ authErrorDelay . config liftIO $ forever $ do ts <- tGetServer h unlessM (readTVarIO sa) $ throwIO $ userError "server stopped" - atomically . (writeTVar rcvActiveAt $!) =<< getSystemTime + receivedAt <- getSystemTime + atomically $ writeTVar rcvActiveAt $! receivedAt let (es, ts') = partitionEithers $ L.toList ts errs = map (second ERR) es errs' <- case ts' of @@ -1168,7 +1170,7 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, mapM_ (atomically . writeTBQueue rcvQ) $ L.nonEmpty cmds pure $ errs ++ errs' [] -> pure errs - mapM_ (atomically . writeTBQueue sndQ . (,[])) $ L.nonEmpty errs' + mapM_ (sendResponses c stats authDelay receivedAt . (,[])) $ L.nonEmpty errs' where sameParty :: SParty p -> SignedTransmission Cmd -> Bool sameParty p (_, _, (_, _, Cmd p' _)) = isJust $ testEquality p p' @@ -1191,6 +1193,27 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, GET -> incStat $ msgGetAuth stats _ -> pure () +isAuthError :: Transmission BrokerMsg -> Bool +isAuthError (_, _, r) = case r of + ERR AUTH -> True + _ -> False + +sendResponses :: Client s -> ServerStats -> Int64 -> SystemTime -> (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]) -> IO () +sendResponses c@Client {sndQ} stats authDelay since rs@(ts, _) + | any isAuthError ts = sendAfterDelay c stats authDelay since rs + | otherwise = atomically $ writeTBQueue sndQ rs + +sendAfterDelay :: Client s -> ServerStats -> Int64 -> SystemTime -> (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]) -> IO () +sendAfterDelay c@Client {sndQ, clientTHParams = THandleParams {sessionId}} stats delay since rs + | delay > 0 = do + elapsed <- subtract (microseconds since) . microseconds <$> getSystemTime + when (elapsed >= delay) $ incStat $ authDelayExceeded stats + forkClient c (B.unpack $ "client $" <> encode sessionId <> " auth") $ threadDelay' (delay - elapsed `mod` delay) >> write + | otherwise = write + where + write = atomically $ writeTBQueue sndQ rs + microseconds (MkSystemTime s ns) = s * 1000000 + fromIntegral (ns `div` 1000) + send :: Transport c => MVar (THandleSMP c 'TServer) -> Client s -> IO () send th c@Client {sndQ, msgQ, clientTHParams = THandleParams {sessionId}} = do labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send" @@ -1374,15 +1397,18 @@ client ms clnt@Client {clientId, rcvQ, sndQ, msgQ, clientTHParams = thParams'@THandleParams {sessionId}, procThreads} = do labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands" + stats <- asks serverStats + authDelay <- asks $ authErrorDelay . config let clntServiceId = (\THClientService {serviceId} -> serviceId) <$> (peerClientService =<< thAuth thParams') process batchSubs t acc@(rs, msgs) = (maybe acc (\(!r, !msg_) -> (r : rs, maybe msgs (: msgs) msg_))) <$> processCommand clntServiceId batchSubs t forever $ do batch <- atomically (readTBQueue rcvQ) + processedAt <- liftIO getSystemTime batchSubs <- prepareBatchSubs clntServiceId batch foldrM (process batchSubs) ([], []) batch - >>= \(rs_, msgs) -> mapM_ (atomically . writeTBQueue sndQ . (,msgs)) (L.nonEmpty rs_) + >>= \(rs_, msgs) -> mapM_ (liftIO . sendResponses clnt stats authDelay processedAt . (,msgs)) (L.nonEmpty rs_) where prepareBatchSubs :: Maybe ServiceId -> @@ -2119,6 +2145,7 @@ client processForwardedCommand :: EncFwdTransmission -> M s (Maybe BrokerMsg) processForwardedCommand (EncFwdTransmission s) = fmap (either (Just . ERR) id) . runExceptT $ do + startedAt <- liftIO getSystemTime THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams') sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret' proxyNonce <- liftEitherWith (const CRYPTO) $ C.cbNonce $ bs corrId @@ -2162,7 +2189,11 @@ client _ -> Just . maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing (Right (M.empty, M.empty, M.empty)) t'') stats <- asks serverStats incStat $ pMsgFwdsRecv stats - traverse encodeResp r_ + traverse encodeResp r_ >>= \case + Just rres | any isAuthError r_ -> do + authDelay <- asks $ authErrorDelay . config + Nothing <$ liftIO (sendAfterDelay clnt stats authDelay startedAt ([(corrId, NoEntity, rres)], [])) + rres_ -> pure rres_ where rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmissionOrError ErrorType Cmd -> M s (VerifiedTransmissionOrError s) rejectOrVerify clntThAuth = \case diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index ca59f75f6..2c1843e51 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -68,6 +68,7 @@ module Simplex.Messaging.Server.Env.STM defaultInactiveClientExpiration, defaultProxyClientConcurrency, defaultNameResolverConcurrency, + defaultAuthErrorDelayMs, defaultMaxJournalMsgCount, defaultMaxJournalStateLines, defaultIdleQueueInterval, @@ -187,6 +188,7 @@ data ServerConfig s = ServerConfig ntfDeliveryInterval :: Int, -- | interval between sending pending END events to unsubscribed clients, seconds pendingENDInterval :: Int, + authErrorDelay :: Int64, smpCredentials :: ServerCredentials, httpCredentials :: Maybe ServerCredentials, -- | SMP client-server protocol version range @@ -255,6 +257,9 @@ defaultProxyClientConcurrency = 32 defaultNameResolverConcurrency :: Int defaultNameResolverConcurrency = 1000 +defaultAuthErrorDelayMs :: Int64 +defaultAuthErrorDelayMs = 50 + journalMsgStoreDepth :: Int journalMsgStoreDepth = 5 diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 138a25fc0..4a3c909ed 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -580,6 +580,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath = prometheusMetricsFile = combine logPath "smp-server-metrics.txt", pendingENDInterval = 15000000, -- 15 seconds ntfDeliveryInterval = 1500000, -- 1.5 second + authErrorDelay = 1000 * readIniDefault defaultAuthErrorDelayMs "TRANSPORT" "auth_error_delay_ms" ini, smpServerVRange = supportedServerSMPRelayVRange, transportConfig = mkTransportServerConfig diff --git a/src/Simplex/Messaging/Server/Main/Init.hs b/src/Simplex/Messaging/Server/Main/Init.hs index 89df1ad93..b82061ca3 100644 --- a/src/Simplex/Messaging/Server/Main/Init.hs +++ b/src/Simplex/Messaging/Server/Main/Init.hs @@ -130,7 +130,9 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds = <> ("host = " <> T.pack host <> "\n") <> ("port = " <> defaultServerPorts <> "\n") <> "log_tls_errors = off\n\n\ - \# Use `websockets = 443` to run websockets server in addition to plain TLS.\n\ + \# Minimum time to respond with AUTH error, milliseconds.\n" + <> ("# auth_error_delay_ms = " <> tshow defaultAuthErrorDelayMs <> "\n\n") + <> "# Use `websockets = 443` to run websockets server in addition to plain TLS.\n\ \# This option is deprecated and should be used for testing only.\n\ \# , port 443 should be specified in port above\n\ \websockets = off\n" diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs index 85d2624fd..864a2014f 100644 --- a/src/Simplex/Messaging/Server/Prometheus.hs +++ b/src/Simplex/Messaging/Server/Prometheus.hs @@ -126,6 +126,7 @@ prometheusMetrics sm rtm ts = _ntfServices, _rcvServicesSubMsg, _rcvServicesSubDuplicate, + _authDelayExceeded, _qCount, _msgCount, _ntfCount, @@ -192,6 +193,10 @@ prometheusMetrics sm rtm ts = \# HELP simplex_smp_queues_notify_monthly Monthly active queues with notifications.\n\ \# TYPE simplex_smp_queues_notify_monthly gauge\n\ \simplex_smp_queues_notify_monthly " <> mstr (monthCount psNtf) <> "\n# monthCountNtf\n\ + \\n\ + \# HELP simplex_smp_auth_delay_exceeded Responses with AUTH errors sent without delay, as processing took longer than the delay.\n\ + \# TYPE simplex_smp_auth_delay_exceeded counter\n\ + \simplex_smp_auth_delay_exceeded " <> mshow _authDelayExceeded <> "\n# authDelayExceeded\n\ \\n" subscriptions = "# Subscriptions\n\ diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql b/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql index c39b82990..fcaaf7257 100644 --- a/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql +++ b/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql @@ -1,6 +1,5 @@ - SET statement_timeout = 0; SET lock_timeout = 0; SET idle_in_transaction_session_timeout = 0; @@ -555,4 +554,3 @@ ALTER TABLE ONLY smp_server.msg_queues - diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs index 11a7de666..c1c599822 100644 --- a/src/Simplex/Messaging/Server/Stats.hs +++ b/src/Simplex/Messaging/Server/Stats.hs @@ -128,6 +128,7 @@ data ServerStats = ServerStats ntfServices :: ServiceStats, rcvServicesSubMsg :: IORef Int, rcvServicesSubDuplicate :: IORef Int, + authDelayExceeded :: IORef Int, qCount :: IORef Int, msgCount :: IORef Int, ntfCount :: IORef Int, @@ -190,6 +191,7 @@ data ServerStatsData = ServerStatsData _rcvServices :: ServiceStatsData, _rcvServicesSubMsg :: Int, _rcvServicesSubDuplicate :: Int, + _authDelayExceeded :: Int, _qCount :: Int, _msgCount :: Int, _ntfCount :: Int, @@ -254,6 +256,7 @@ newServerStats ts = do ntfServices <- newServiceStats rcvServicesSubMsg <- newIORef 0 rcvServicesSubDuplicate <- newIORef 0 + authDelayExceeded <- newIORef 0 qCount <- newIORef 0 msgCount <- newIORef 0 ntfCount <- newIORef 0 @@ -315,6 +318,7 @@ newServerStats ts = do ntfServices, rcvServicesSubMsg, rcvServicesSubDuplicate, + authDelayExceeded, qCount, msgCount, ntfCount, @@ -378,6 +382,7 @@ getServerStatsData s = do _ntfServices <- getServiceStatsData $ ntfServices s _rcvServicesSubMsg <- readIORef $ rcvServicesSubMsg s _rcvServicesSubDuplicate <- readIORef $ rcvServicesSubDuplicate s + _authDelayExceeded <- readIORef $ authDelayExceeded s _qCount <- readIORef $ qCount s _msgCount <- readIORef $ msgCount s _ntfCount <- readIORef $ ntfCount s @@ -439,6 +444,7 @@ getServerStatsData s = do _ntfServices, _rcvServicesSubMsg, _rcvServicesSubDuplicate, + _authDelayExceeded, _qCount, _msgCount, _ntfCount, @@ -503,6 +509,7 @@ setServerStats s d = do setServiceStats (ntfServices s) $! _ntfServices d writeIORef (rcvServicesSubMsg s) $! _rcvServicesSubMsg d writeIORef (rcvServicesSubDuplicate s) $! _rcvServicesSubDuplicate d + writeIORef (authDelayExceeded s) $! _authDelayExceeded d writeIORef (qCount s) $! _qCount d writeIORef (msgCount s) $! _msgCount d writeIORef (ntfCount s) $! _ntfCount d @@ -705,6 +712,7 @@ instance StrEncoding ServerStatsData where _ntfServices, _rcvServicesSubMsg = 0, _rcvServicesSubDuplicate = 0, + _authDelayExceeded = 0, _qCount, _msgCount = 0, _ntfCount = 0, diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index f1d5af1db..2db4a9819 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -263,6 +263,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg -> prometheusMetricsFile = testPrometheusMetricsFile, pendingENDInterval = 500000, ntfDeliveryInterval = 200000, + authErrorDelay = 20000, smpCredentials = ServerCredentials { caCertificateFile = Just "tests/fixtures/ca.crt", diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 134093acc..62bb4a85e 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -26,7 +26,7 @@ import qualified Data.List.NonEmpty as L import Data.Time.Clock (getCurrentTime) import SMPAgentClient import SMPClient -import ServerTests (decryptMsgV3, sendRecv) +import ServerTests (decryptMsgV3, responseTime, sendRecv) import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage) import qualified Simplex.Messaging.Agent as A import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..)) @@ -77,6 +77,8 @@ smpProxyTests = do testChangedFwdVersion it "proxy rejects forwarded correlation ID that is not 24 bytes" $ \_ -> testFwdCorrIdSize + it "relay delays AUTH errors to forwarded commands" $ \_ -> + testForwardedAuthErrorDelay describe "deliver message via SMP proxy" $ do let srv1 = SMPServer testHost testPort testKeyHash srv2 = SMPServer testHost2 testPort2 testKeyHash @@ -490,6 +492,19 @@ testFwdCorrIdSize = (_, _, reply) <- sendRecv th (Nothing, corrId, SMP.EntityId sessId, SMP.PFWD currentClientSMPRelayVersion cmdPubKey (SMP.EncTransmission "")) reply `shouldBe` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX) +testForwardedAuthErrorDelay :: IO () +testForwardedAuthErrorDelay = + withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ -> + withSmpServerConfigOn (transport @TLS) (updateCfg cfgJ2 $ \cfg_ -> cfg_ {authErrorDelay = 500000}) testPort2 $ \_ -> do + g <- C.newRandom + ts <- getCurrentTime + pc <- either (fail . show) pure =<< getProtocolClient g NRMInteractive (1, testSMPServer, Nothing) defaultSMPClientConfig [] Nothing ts (\_ -> pure ()) + sess <- runExceptT' $ connectSMPProxiedRelay pc NRMInteractive testSMPServer2 Nothing + (sendTime, Left (PCEProtocolError SMP.AUTH)) <- responseTime $ runExceptT $ proxySMPMessage pc NRMInteractive sess Nothing (SMP.EntityId "1234") noMsgFlags "hello" + (getLinkTime, Left (PCEProtocolError SMP.AUTH)) <- responseTime $ runExceptT $ proxyGetSMPQueueLink pc NRMInteractive sess (SMP.EntityId "1234") + sendTime `shouldSatisfy` (>= 0.5) + getLinkTime `shouldSatisfy` (>= 0.5) + -- Shared "phase 2" of the reconnection tests: start a healthy relay, confirm it is reachable -- directly (PING, not via the proxy) so a proxy failure can only mean the proxy didn't reconnect, -- let any stored connection error expire, then require the proxy to establish the session (PKEY). diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 6165dfb46..89ac46144 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -36,6 +36,7 @@ import Data.List.NonEmpty (NonEmpty) import Data.List (isPrefixOf) import Data.Maybe (catMaybes) import Data.String (IsString (..)) +import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime) import Text.Read (readMaybe) import Data.Type.Equality import qualified Data.X509.Validation as XV @@ -58,7 +59,6 @@ import Simplex.Messaging.Transport.Credentials import Simplex.Messaging.Util (whenM) import System.Directory (doesDirectoryExist, doesFileExist, removeDirectoryRecursive, removeFile) import System.IO (IOMode (..), withFile) -import System.TimeIt (timeItT) import System.Timeout import Test.HUnit import Test.Hspec hiding (fit, it) @@ -97,6 +97,7 @@ serverTests = do describe "Restore messages (old / v2)" testRestoreExpireMessages describe "Save prometheus metrics" testPrometheusMetrics describe "Timing of AUTH error" testTiming + describe "Delay of AUTH error" testAuthErrorDelay describe "Message notifications" $ do testMessageNotifications testMessageServiceNotifications @@ -1274,21 +1275,21 @@ testTiming = smpTest2Cfg (cfgMS msType) supportedServerSMPRelayVRange t $ \rh sh -> testSameTiming rh sh tst msType where - testName :: (C.AuthAlg, C.AuthAlg, Int) -> String - testName (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, _) = unwords ["queue key:", show goodKeyAlg, "/ used key:", show badKeyAlg] - timingTests :: [(C.AuthAlg, C.AuthAlg, Int)] + testName :: (C.AuthAlg, C.AuthAlg) -> String + testName (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg) = unwords ["queue key:", show goodKeyAlg, "/ used key:", show badKeyAlg] + timingTests :: [(C.AuthAlg, C.AuthAlg)] timingTests = - [ (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd25519, 200), -- correct key type - -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd448, 150), - -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SX25519, 200), - (C.AuthAlg C.SEd448, C.AuthAlg C.SEd25519, 200), - (C.AuthAlg C.SEd448, C.AuthAlg C.SEd448, 150), -- correct key type - (C.AuthAlg C.SEd448, C.AuthAlg C.SX25519, 200), - (C.AuthAlg C.SX25519, C.AuthAlg C.SEd25519, 200), - (C.AuthAlg C.SX25519, C.AuthAlg C.SEd448, 150), - (C.AuthAlg C.SX25519, C.AuthAlg C.SX25519, 200) -- correct key type + [ (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd25519), -- correct key type + -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd448), + -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SX25519), + (C.AuthAlg C.SEd448, C.AuthAlg C.SEd25519), + (C.AuthAlg C.SEd448, C.AuthAlg C.SEd448), -- correct key type + (C.AuthAlg C.SEd448, C.AuthAlg C.SX25519), + (C.AuthAlg C.SX25519, C.AuthAlg C.SEd25519), + (C.AuthAlg C.SX25519, C.AuthAlg C.SEd448), + (C.AuthAlg C.SX25519, C.AuthAlg C.SX25519) -- correct key type ] - timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const + timeRepeat = fmap fst . responseTime . replicateM_ 5 similarTime t1 t2 msType | t1 <= t2 = abs (1 - t1 / t2) < diff | otherwise = similarTime t2 t1 msType @@ -1297,8 +1298,8 @@ testTiming = diff = case msType of ASType SQSPostgres _ -> 0.45 _ -> 0.3 - testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg, Int) -> AStoreType -> Expectation - testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) msType = do + testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg) -> AStoreType -> Expectation + testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg) msType = do g <- C.newRandom (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g @@ -1325,16 +1326,16 @@ testTiming = runTimingTest :: PartyI p => THandleSMP c 'TClient -> C.APrivateAuthKey -> EntityId -> Command p -> IO () runTimingTest h badKey qId cmd = do threadDelay 100000 - _ <- timeRepeat n $ do + _ <- timeRepeat $ do -- "warm up" the server Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd) return () threadDelay 100000 - timeWrongKey <- timeRepeat n $ do + timeWrongKey <- timeRepeat $ do Resp "cdabcdabcdabcdabcdabcdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdabcdabcdabcdabcdabcdab", qId, cmd) return () threadDelay 100000 - timeNoQueue <- timeRepeat n $ do + timeNoQueue <- timeRepeat $ do Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd) return () let ok = similarTime timeNoQueue timeWrongKey msType @@ -1347,6 +1348,33 @@ testTiming = ] ok `shouldBe` True +testAuthErrorDelay :: SpecWith (ASrvTransport, AStoreType) +testAuthErrorDelay = + it "should send AUTH errors after the delay and other responses without it" $ \(ATransport t, msType) -> + smpTest2Cfg (updateCfg (cfgMS msType) $ \cfg' -> cfg' {authErrorDelay = 500000}) supportedClientSMPRelayVRange t $ \rh sh -> do + g <- C.newRandom + (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g + Resp "1" NoEntity (Ids rId sId _) <- signSendRecv rh rKey ("1", NoEntity, New rPub dhPub) + (_, badKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (wrongKeyTime, Resp "2" _ (ERR AUTH)) <- responseTime $ signSendRecv rh badKey ("2", rId, SUB) + (noQueueTime, Resp "3" _ (ERR AUTH)) <- responseTime $ signSendRecv rh badKey ("3", EntityId "1234", SUB) + (noLinkTime, Resp "4" _ (ERR AUTH)) <- responseTime $ sendRecv sh ("", "4", EntityId "1234", LGET) + (subTime, Resp "5" _ (SOK Nothing)) <- responseTime $ signSendRecv rh rKey ("5", rId, SUB) + Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, OFF) + (suspendedTime, Resp "7" _ (ERR AUTH)) <- responseTime $ sendRecv sh ("", "7", sId, _SEND "hello") + wrongKeyTime `shouldSatisfy` (>= 0.5) + noQueueTime `shouldSatisfy` (>= 0.5) + suspendedTime `shouldSatisfy` (>= 0.5) + noLinkTime `shouldSatisfy` (>= 0.5) + subTime `shouldSatisfy` (< 0.5) + +responseTime :: IO a -> IO (NominalDiffTime, a) +responseTime action = do + t <- getCurrentTime + r <- action + (,r) . (`diffUTCTime` t) <$> getCurrentTime + testMessageNotifications :: SpecWith (ASrvTransport, AStoreType) testMessageNotifications = it "should create simplex connection, subscribe notifier and deliver notifications" $ \(ATransport t, msType) -> do From 3db4029bb9c218f82739c9c67064a3c61db642ea Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sun, 11 Oct 2026 11:52:24 +0100 Subject: [PATCH 2/2] ci: build cache (#1938) * ci: build cache * update build job * rename steps, cache all builds, patch timestamps for ghc 8.10.7 * refactor, save O0 caches in master and stable builds * update build to include toolchain fingerprint * do not save cache on exact match * remove caching docker from prs --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> --- .github/workflows/build.yml | 174 ++++++++++++++++++++++++++++---- scripts/ci/prune-old-builds.sh | 9 ++ scripts/ci/source-timestamps.sh | 27 +++++ tests/Util.hs | 2 +- 4 files changed, 192 insertions(+), 20 deletions(-) create mode 100755 scripts/ci/prune-old-builds.sh create mode 100755 scripts/ci/source-timestamps.sh diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 6d445b8b1..a6a3283c5 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -66,8 +66,19 @@ jobs: build: name: "ubuntu-${{ matrix.os }}-${{ matrix.arch }}, GHC: ${{ matrix.ghc }}" needs: maybe-release + permissions: + contents: write + packages: write env: apps: "smp-server xftp-server ntf-server xftp" + opt: ${{ github.event_name == 'pull_request' && 'O0' || 'O2' }} + ghc_options: ${{ github.event_name == 'pull_request' && '--ghc-options=-O0' || '' }} + release: ${{ startsWith(github.ref, 'refs/tags/v') }} + postgres_dist: ${{ startsWith(github.ref, 'refs/tags/v') && 'dist-newstyle' || 'dist-postgres' }} + branch: ${{ github.base_ref || github.ref_name }} + cache_o0: ${{ github.event_name == 'push' && (github.ref == 'refs/heads/master' || github.ref == 'refs/heads/stable') }} + image_cache: ghcr.io/simplex-chat/simplexmq-build-cache:${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }} + source_hashes: dist-newstyle/sources.sha256 runs-on: ${{ matrix.runner }} services: postgres: @@ -146,6 +157,18 @@ jobs: sudo apt update sudo apt -y install postgresql-client-15 + - name: Log in to GitHub Container Registry + if: matrix.should_run == true && env.release != 'true' + shell: bash + env: + GHCR_TOKEN: ${{ secrets.GITHUB_TOKEN }} + run: echo "$GHCR_TOKEN" | docker login ghcr.io -u "${{ github.actor }}" --password-stdin + + - name: Compute image cache week + id: week + if: matrix.should_run == true && env.release != 'true' + run: echo "week=$(date -u +%G-W%V)" >> "$GITHUB_OUTPUT" + - name: Build and cache Docker image if: matrix.should_run == true uses: simplex-chat/docker-build-push-action@v6 @@ -157,20 +180,14 @@ jobs: build-args: | TAG=${{ matrix.os }} GHC=${{ matrix.ghc }} - - - name: Cache dependencies - if: matrix.should_run == true - uses: actions/cache@v4 - with: - path: | - ~/.cabal/store - dist-newstyle - key: ubuntu-${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }} + cache-from: ${{ env.release != 'true' && format('type=registry,ref={0}-{1}', env.image_cache, steps.week.outputs.week) || '' }} + cache-to: ${{ github.event_name == 'push' && github.ref == 'refs/heads/master' && format('type=registry,ref={0}-{1},mode=max,ignore-error=true', env.image_cache, steps.week.outputs.week) || '' }} - name: Start container if: matrix.should_run == true shell: bash run: | + mkdir -p ~/.cabal docker run -t -d \ --device /dev/fuse \ --cap-add SYS_ADMIN \ @@ -181,21 +198,66 @@ jobs: -v ${{ github.workspace }}:/project \ build/${{ matrix.os }}:latest + - name: Compute cache key prefixes + id: keys + if: matrix.should_run == true && env.release != 'true' + run: | + toolchain=$(docker exec builder dpkg-query -W -f '${db:Status-Status} ${binary:Package} ${Version}\n' 'binutils*' 'cpp*' 'gcc*' '*-dev' | grep '^installed ' | sha256sum | cut -c1-16) + target=${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-$toolchain + echo "deps=deps-$target" >> "$GITHUB_OUTPUT" + echo "dist=dist-$target" >> "$GITHUB_OUTPUT" + + - name: Restore dependencies from cache + id: restore-deps + if: matrix.should_run == true && env.release != 'true' + uses: actions/cache/restore@v4 + with: + path: ~/.cabal/store + key: ${{ steps.keys.outputs.deps }}-${{ env.branch }}-${{ github.sha }} + restore-keys: | + ${{ steps.keys.outputs.deps }}-${{ env.branch }}- + ${{ steps.keys.outputs.deps }}- + + - name: Warn if dependencies not in cache + if: matrix.should_run == true && env.release != 'true' && steps.restore-deps.outputs.cache-matched-key == '' + run: echo "::warning title=Cache miss::${{ steps.keys.outputs.deps }}-${{ env.branch }}" + + - name: Restore build directories from cache + id: restore-build + if: matrix.should_run == true && env.release != 'true' + uses: actions/cache/restore@v4 + with: + path: | + dist-newstyle + dist-postgres + key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }} + restore-keys: | + ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}- + ${{ steps.keys.outputs.dist }}-${{ env.opt }}- + + - name: Warn if build directories not in cache + if: matrix.should_run == true && env.release != 'true' && steps.restore-build.outputs.cache-matched-key == '' + run: echo "::warning title=Cache miss::${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}" + + - name: Set old timestamps on unchanged sources (GHC 8.10.7) + if: matrix.ghc == '8.10.7' && steps.restore-build.outputs.cache-matched-key != '' && hashFiles(env.source_hashes) != '' + run: scripts/ci/source-timestamps.sh restore ${{ env.source_hashes }} + - name: Build smp-server, xftp-server (postgresql) and tests if: matrix.should_run == true shell: docker exec -t builder sh -eu {0} run: | - chmod -fR 777 ~/.cabal ./dist-newstyle || :; git config --global --add safe.directory '*' - cabal clean + chmod -fR 777 ~/.cabal ./dist-newstyle ./dist-postgres || :; git config --global --add safe.directory '*' + scripts/ci/prune-old-builds.sh dist-newstyle dist-postgres cabal update - cabal build --jobs=$(nproc) --enable-tests -fserver_postgres + cabal build --builddir=${{ env.postgres_dist }} --jobs=$(nproc) --enable-tests -fserver_postgres ${{ env.ghc_options }} mkdir -p /out - for i in smp-server xftp-server simplexmq-test; do - bin=$(find /project/dist-newstyle -name "$i" -type f -executable) + for i in smp-server xftp-server ntf-server simplexmq-test; do + bin=$(find /project/${{ env.postgres_dist }} -name "$i" -type f -executable) chmod +x "$bin" - mv "$bin" /out/ + cp "$bin" /out/ done - strip /out/smp-server /out/xftp-server + strip /out/smp-server /out/xftp-server /out/ntf-server - name: Copy simplexmq-test from container if: matrix.should_run == true @@ -228,16 +290,17 @@ jobs: cat hashes.output >> "$GITHUB_OUTPUT" - name: Build everything else (standard) + id: build-standard if: matrix.should_run == true shell: docker exec -t builder sh -eu {0} run: | - cabal build --jobs=$(nproc) + cabal build --jobs=$(nproc) ${{ env.ghc_options }} mkdir -p /out - for i in ${{ env.apps }}; do + for i in smp-server xftp-server xftp; do bin=$(find /project/dist-newstyle -name "$i" -type f -executable) strip "$bin" chmod +x "$bin" - mv "$bin" /out/ + cp "$bin" /out/ done - name: Copy binaries from container and prepare them @@ -282,6 +345,33 @@ jobs: env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + - name: Record source hashes (GHC 8.10.7) + if: matrix.should_run == true && matrix.ghc == '8.10.7' + shell: docker exec -t builder sh -eu {0} + run: scripts/ci/source-timestamps.sh record ${{ env.source_hashes }} + + - name: Compute dependency cache key + id: hash-deps + if: matrix.should_run == true && env.release != 'true' + shell: bash + run: echo "hash=$(ls ~/.cabal/store/ghc-*/ | sha256sum | cut -c1-16)" >> "$GITHUB_OUTPUT" + + - name: Save dependencies to cache + if: matrix.should_run == true && env.release != 'true' && steps.restore-deps.outputs.cache-matched-key != format('{0}-{1}-{2}', steps.keys.outputs.deps, env.branch, steps.hash-deps.outputs.hash) + uses: actions/cache/save@v4 + with: + path: ~/.cabal/store + key: ${{ steps.keys.outputs.deps }}-${{ env.branch }}-${{ steps.hash-deps.outputs.hash }} + + - name: Save build directories to cache + if: matrix.should_run == true && env.release != 'true' && steps.restore-build.outputs.cache-hit != 'true' + uses: actions/cache/save@v4 + with: + path: | + dist-newstyle + dist-postgres + key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }} + - name: Test if: matrix.should_run == true && matrix.arch == 'x86-64' timeout-minutes: 120 @@ -306,6 +396,52 @@ jobs: exit 1 fi + - name: Remove -O2 build directories + id: remove-o2 + if: env.cache_o0 == 'true' && !cancelled() && steps.build-standard.outcome == 'success' + shell: docker exec -t builder sh -eu {0} + run: rm -rf dist-newstyle dist-postgres + + - name: Restore -O0 build directories from cache + id: restore-build-o0 + if: ${{ !cancelled() && steps.remove-o2.outcome == 'success' }} + uses: actions/cache/restore@v4 + with: + path: | + dist-newstyle + dist-postgres + key: ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-${{ github.sha }} + restore-keys: | + ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}- + ${{ steps.keys.outputs.dist }}-O0- + + - name: Set old timestamps on unchanged sources for -O0 build (GHC 8.10.7) + if: ${{ !cancelled() && matrix.ghc == '8.10.7' && steps.restore-build-o0.outputs.cache-matched-key != '' && hashFiles(env.source_hashes) != '' }} + run: scripts/ci/source-timestamps.sh restore ${{ env.source_hashes }} + + - name: Build at -O0 for pull request caches + id: build-o0 + if: ${{ !cancelled() && steps.remove-o2.outcome == 'success' }} + shell: docker exec -t builder sh -eu {0} + run: | + scripts/ci/prune-old-builds.sh dist-newstyle dist-postgres + cabal build --builddir=dist-postgres --jobs=$(nproc) --enable-tests -fserver_postgres --ghc-options=-O0 + cabal build --jobs=$(nproc) --ghc-options=-O0 + + - name: Record source hashes for -O0 build (GHC 8.10.7) + if: ${{ !cancelled() && matrix.ghc == '8.10.7' && steps.build-o0.outcome == 'success' }} + shell: docker exec -t builder sh -eu {0} + run: scripts/ci/source-timestamps.sh record ${{ env.source_hashes }} + + - name: Save -O0 build directories to cache + if: ${{ !cancelled() && steps.build-o0.outcome == 'success' && steps.restore-build-o0.outputs.cache-hit != 'true' }} + uses: actions/cache/save@v4 + with: + path: | + dist-newstyle + dist-postgres + key: ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-${{ github.sha }} + # ============================= # Resolver test job # ============================= diff --git a/scripts/ci/prune-old-builds.sh b/scripts/ci/prune-old-builds.sh new file mode 100755 index 000000000..c122ed338 --- /dev/null +++ b/scripts/ci/prune-old-builds.sh @@ -0,0 +1,9 @@ +#!/bin/sh +set -eu + +version=$(awk '/^version:/ {print $2}' simplexmq.cabal) +for dir in "$@"; do + if [ -d "$dir/build" ]; then + find "$dir/build" -mindepth 3 -maxdepth 3 -type d -name 'simplexmq-*' ! -name "simplexmq-$version" -exec rm -rf {} + + fi +done diff --git a/scripts/ci/source-timestamps.sh b/scripts/ci/source-timestamps.sh new file mode 100755 index 000000000..e8bc8b1ce --- /dev/null +++ b/scripts/ci/source-timestamps.sh @@ -0,0 +1,27 @@ +#!/bin/sh +set -eu + +command=$1 +hashes=$2 + +sources() { + git ls-files -z '*.hs' '*.hsc' +} + +case "$command" in + record) + sources | xargs -0 sha256sum > "$hashes" + ;; + restore) + sources | xargs -0 touch + while read -r hash file; do + if [ -f "$file" ] && [ "$(sha256sum "$file" | cut -d' ' -f1)" = "$hash" ]; then + touch -d 2000-01-01 "$file" + fi + done < "$hashes" + ;; + *) + echo "usage: $0 record|restore " >&2 + exit 1 + ;; +esac diff --git a/tests/Util.hs b/tests/Util.hs index 9a4049d68..eaa670f06 100644 --- a/tests/Util.hs +++ b/tests/Util.hs @@ -56,7 +56,7 @@ instance Example a => Example (TestWrapper a) where ci <- envCI runTest `E.catches` [E.Handler (onTestFailure ci), E.Handler (onTestException ci)] where - tt = 120 + tt = 300 runTest = timeout (tt * 1000000) (evaluateExample action params hooks state) `finally` callCommand "sync" >>= \case Just r -> pure r