From 1a9d5153dbc7077932fec8ef7aee71d2e6062e90 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 19 Feb 2026 17:31:05 +0100 Subject: [PATCH 01/19] Add curl to integration test failure reports. --- ...d-curl-to-integration-test-failure-reports | 1 + integration/test/Testlib/Assertions.hs | 21 +++++++++----- integration/test/Testlib/Env.hs | 4 ++- integration/test/Testlib/HTTP.hs | 22 +++++++-------- integration/test/Testlib/Run.hs | 6 ++-- integration/test/Testlib/Types.hs | 28 +++++++++++++++---- 6 files changed, 54 insertions(+), 28 deletions(-) create mode 100644 changelog.d/5-internal/WPB-22549-add-curl-to-integration-test-failure-reports diff --git a/changelog.d/5-internal/WPB-22549-add-curl-to-integration-test-failure-reports b/changelog.d/5-internal/WPB-22549-add-curl-to-integration-test-failure-reports new file mode 100644 index 00000000000..192f74df717 --- /dev/null +++ b/changelog.d/5-internal/WPB-22549-add-curl-to-integration-test-failure-reports @@ -0,0 +1 @@ +Add curl to integration test failure reports. diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 8f13eb96c75..7e3555e47da 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -40,6 +40,7 @@ import qualified Data.ByteString.Lazy as BS import Data.Char import Data.Foldable import Data.Hex +import Data.IORef (readIORef) import Data.List import qualified Data.Map as Map import Data.Maybe @@ -400,24 +401,28 @@ super `shouldNotContain` sub = do when (sub `isInfixOf` super) $ do assertFailure $ "String or List:\n" <> show super <> "\nDoes contain:\n" <> show sub -printFailureDetails :: AssertionFailure -> IO String -printFailureDetails (AssertionFailure stack mbResponse ctx msg) = do - s <- prettierCallStack stack +printFailureDetails :: Env -> AssertionFailure -> IO String +printFailureDetails env (AssertionFailure stack mbResponse ctx msg) = do + s <- liftIO $ prettierCallStack stack + ct <- readIORef env.curlTrace -- TODO: if $VERBOSE != 1 (or something), this should just be "crank up verbosity if you want to have a shell script reproducing this." pure . unlines $ colored yellow "assertion failure:" : colored red msg : "\n" <> s : toList (fmap prettyResponse mbResponse) <> toList (fmap prettyContext ctx) + <> ct -printAppFailureDetails :: AppFailure -> IO String -printAppFailureDetails (AppFailure msg stack) = do +printAppFailureDetails :: Env -> AppFailure -> IO String +printAppFailureDetails env (AppFailure msg stack) = do s <- prettierCallStack stack + ct <- readIORef env.curlTrace -- TODO: if $VERBOSE != 1 (or something), this should just be "crank up verbosity if you want to have a shell script reproducing this." pure . unlines $ colored yellow "app failure:" : colored red msg : "\n" : [s] + <> ct prettyContext :: String -> String prettyContext ctx = do @@ -426,12 +431,14 @@ prettyContext ctx = do colored blue ctx ] -printExceptionDetails :: SomeException -> IO String -printExceptionDetails e = do +printExceptionDetails :: Env -> SomeException -> IO String +printExceptionDetails env e = do + ct <- readIORef env.curlTrace -- TODO: if $VERBOSE != 1 (or something), this should just be "crank up verbosity if you want to have a shell script reproducing this." pure . unlines $ [ colored yellow "exception:", colored red (displayException e) ] + <> ct prettierCallStack :: CallStack -> IO String prettierCallStack cstack = do diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index 1a65d7f5ea1..addf929ef31 100644 --- a/integration/test/Testlib/Env.hs +++ b/integration/test/Testlib/Env.hs @@ -169,6 +169,7 @@ mkEnv currentTestName ge = do liftIO $ do pks <- newIORef (zip [1 ..] somePrekeys) lpks <- newIORef someLastPrekeys + curlTrace <- newIORef [] pure Env { serviceMap = gServiceMap ge, @@ -201,7 +202,8 @@ mkEnv currentTestName ge = do dnsMockServerConfig = ge.gDNSMockServerConfig, cellsEventQueue = ge.gCellsEventQueue, cellsEventWatchersLock = ge.gCellsEventWatchersLock, - cellsEventWatchers = ge.gCellsEventWatchers + cellsEventWatchers = ge.gCellsEventWatchers, + curlTrace } allCiphersuites :: [Ciphersuite] diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index 9ce4f542ada..875766ab472 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -27,6 +27,7 @@ import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L import qualified Data.CaseInsensitive as CI import Data.Function +import Data.IORef import Data.List import Data.List.Split (splitOn) import qualified Data.Map as Map @@ -231,19 +232,16 @@ zHost = addHeader "Z-Host" submit :: String -> HTTP.Request -> App Response submit method req0 = do - let req = req0 {HTTP.method = T.encodeUtf8 (T.pack method)} - -- uncomment this for more debugging noise: - -- liftIO $ putStrLn $ requestToCurl req + let request = req0 {HTTP.method = T.encodeUtf8 (T.pack method)} manager <- asks (.manager) - res <- liftIO $ HTTP.httpLbs req manager - pure $ - Response - { json = Aeson.decode (HTTP.responseBody res), - body = L.toStrict (HTTP.responseBody res), - status = HTTP.statusCode (HTTP.responseStatus res), - headers = HTTP.responseHeaders res, - request = req - } + response <- liftIO $ HTTP.httpLbs request manager + let json = Aeson.decode (HTTP.responseBody response) + body = L.toStrict (HTTP.responseBody response) + status = HTTP.statusCode (HTTP.responseStatus response) + headers = HTTP.responseHeaders response + curl <- asks (.curlTrace) + _ <- liftIO $ modifyIORef' curl (<> [requestToCurl request, "# ==> " <> show (status, body, headers), ""]) + pure Response {..} locationHeaderHost :: Response -> String locationHeaderHost resp = diff --git a/integration/test/Testlib/Run.hs b/integration/test/Testlib/Run.hs index 0566cc00f22..b32b9a78eb6 100644 --- a/integration/test/Testlib/Run.hs +++ b/integration/test/Testlib/Run.hs @@ -68,11 +68,11 @@ runTest testName ge action = lowerCodensity $ do -- This ensures things like UserInterrupt are properly handled. E.throw e, E.Handler -- AssertionFailure - (fmap Left . printFailureDetails), + (fmap Left . printFailureDetails env), E.Handler -- AppFailure - (fmap Left . printAppFailureDetails), + (fmap Left . printAppFailureDetails env), E.Handler - (fmap Left . printExceptionDetails) + (fmap Left . printExceptionDetails env) ] pluralise :: Int -> String -> String diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 74ac08535c3..fd045a49370 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2025 Wire Swiss GmbH @@ -36,6 +39,7 @@ import Data.Aeson import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L import qualified Data.CaseInsensitive as CI @@ -49,6 +53,7 @@ import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import Data.String +import Data.String.Conversions (cs) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Time @@ -271,7 +276,8 @@ data Env = Env dnsMockServerConfig :: DNSMockServerConfig, cellsEventQueue :: String, cellsEventWatchersLock :: MVar (), - cellsEventWatchers :: IORef (Map String QueueWatcher) + cellsEventWatchers :: IORef (Map String QueueWatcher), + curlTrace :: IORef [String] } data Response = Response @@ -401,11 +407,23 @@ requestToCurl req = defaultPort = if HTTP.secure req then 443 else 80 body' = case HTTP.requestBody req of - HTTP.RequestBodyLBS lbs -> if lbs == mempty then "" else "--data-binary " ++ shellEscape (C8.unpack $ L.toStrict lbs) - HTTP.RequestBodyBS bs -> if bs == mempty then "" else "--data-binary " ++ shellEscape (C8.unpack bs) - HTTP.RequestBodyBuilder _ _ -> "--data-binary ''" - _ -> "" + HTTP.RequestBodyLBS lbs -> dataBinary (C8.unpack $ L.toStrict lbs) + HTTP.RequestBodyBS bs -> dataBinary (C8.unpack bs) + _ -> + -- this won't work + "--data-binary ' String + dataBinary "" = "" + dataBinary raw = "--data-binary \"$(" <> customEncoded <> "| base64 -d)\"" + where + customEncoded = case Aeson.decode @Aeson.Value (cs raw) of + Just _val -> shellEscape raw + Nothing -> cs $ Base64.encode $ cs raw + -- this is probably used wrong, and there are still come escape + -- issues to be solved. but it should be safe as long as we're + -- only using it in our own integration tests, right? shellEscape :: String -> String shellEscape s = "'" ++ concatMap escape s ++ "'" where From 6faf8cf6a8c2a2be3b29ffdfc0cda9beaad4c71a Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 26 Feb 2026 17:20:29 +0100 Subject: [PATCH 02/19] Make curl traces hide behind posix verbosity switch. --- integration/test/Testlib/Assertions.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 7e3555e47da..ac33a425a0a 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -40,7 +40,6 @@ import qualified Data.ByteString.Lazy as BS import Data.Char import Data.Foldable import Data.Hex -import Data.IORef (readIORef) import Data.List import qualified Data.Map as Map import Data.Maybe @@ -49,9 +48,11 @@ import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding.Error as Text import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL +import GHC.IORef import GHC.Stack as Stack import qualified Network.HTTP.Client as HTTP import System.FilePath +import System.Posix.Env (getEnvironment) import Testlib.JSON import Testlib.Printing import Testlib.Types @@ -404,7 +405,7 @@ super `shouldNotContain` sub = do printFailureDetails :: Env -> AssertionFailure -> IO String printFailureDetails env (AssertionFailure stack mbResponse ctx msg) = do s <- liftIO $ prettierCallStack stack - ct <- readIORef env.curlTrace -- TODO: if $VERBOSE != 1 (or something), this should just be "crank up verbosity if you want to have a shell script reproducing this." + ct <- renderCurlTrace env.curlTrace pure . unlines $ colored yellow "assertion failure:" : colored red msg @@ -416,7 +417,7 @@ printFailureDetails env (AssertionFailure stack mbResponse ctx msg) = do printAppFailureDetails :: Env -> AppFailure -> IO String printAppFailureDetails env (AppFailure msg stack) = do s <- prettierCallStack stack - ct <- readIORef env.curlTrace -- TODO: if $VERBOSE != 1 (or something), this should just be "crank up verbosity if you want to have a shell script reproducing this." + ct <- renderCurlTrace env.curlTrace pure . unlines $ colored yellow "app failure:" : colored red msg @@ -424,6 +425,13 @@ printAppFailureDetails env (AppFailure msg stack) = do : [s] <> ct +renderCurlTrace :: IORef [String] -> IO [String] +renderCurlTrace trace = do + verbosity <- getEnvironment >>= maybe (pure "") pure . lookup "WIRE_INTEGRATION_TEST_VERBOSITY" + if verbosity == "1" + then ("HTTP trace in curl pseudo-syntax:" :) <$> readIORef trace + else pure ["Set WIRE_INTEGRATION_TEST_VERBOSITY=1 if you want to see complete trace of the HTTP traffic in curl pseudo-syntax."] + prettyContext :: String -> String prettyContext ctx = do unlines @@ -433,7 +441,7 @@ prettyContext ctx = do printExceptionDetails :: Env -> SomeException -> IO String printExceptionDetails env e = do - ct <- readIORef env.curlTrace -- TODO: if $VERBOSE != 1 (or something), this should just be "crank up verbosity if you want to have a shell script reproducing this." + ct <- renderCurlTrace env.curlTrace pure . unlines $ [ colored yellow "exception:", colored red (displayException e) From f50c2b0c09dcfa7b9adf8111cea1981adc541000 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 27 Feb 2026 13:50:29 +0100 Subject: [PATCH 03/19] make sanitize-pr --- cassandra-schema.cql | 1 + integration/test/Testlib/Types.hs | 2 +- postgres-schema.sql | 63 ++++++++++++++++++------------- 3 files changed, 38 insertions(+), 28 deletions(-) diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 79ca5d700ab..aa7786631cb 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -1639,6 +1639,7 @@ CREATE TABLE galley_test.conversation ( epoch bigint, group_conv_type int, group_id blob, + history_depth bigint, message_timer bigint, name text, parent_conv uuid, diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index fd045a49370..a38783bbe4d 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass #-} + {-# LANGUAGE DeriveGeneric #-} -- This file is part of the Wire Server implementation. diff --git a/postgres-schema.sql b/postgres-schema.sql index e6d915bae79..070828aa351 100644 --- a/postgres-schema.sql +++ b/postgres-schema.sql @@ -9,8 +9,8 @@ \restrict 79bbfb4630959c48307653a5cd3d83f2582b3c2210f75f10d79e3ebf0015620 --- Dumped from database version 17.6 --- Dumped by pg_dump version 17.6 +-- Dumped from database version 17.7 +-- Dumped by pg_dump version 17.7 SET statement_timeout = 0; SET lock_timeout = 0; @@ -40,6 +40,20 @@ ALTER SCHEMA public OWNER TO "wire-server"; COMMENT ON SCHEMA public IS ''; +-- +-- Name: recurrence_frequency; Type: TYPE; Schema: public; Owner: wire-server +-- + +CREATE TYPE public.recurrence_frequency AS ENUM ( + 'daily', + 'weekly', + 'monthly', + 'yearly' +); + + +ALTER TYPE public.recurrence_frequency OWNER TO "wire-server"; + SET default_tablespace = ''; SET default_table_access_method = heap; @@ -96,7 +110,8 @@ CREATE TABLE public.conversation ( receipt_mode integer, team uuid, type integer NOT NULL, - parent_conv uuid + parent_conv uuid, + history_depth bigint ); @@ -177,33 +192,27 @@ CREATE TABLE public.local_conversation_remote_member ( ALTER TABLE public.local_conversation_remote_member OWNER TO "wire-server"; --- --- Name: meetings; Type: ENUM; Schema: public; Owner: wire-server --- - -CREATE TYPE recurrence_frequency AS ENUM ('daily', 'weekly', 'monthly', 'yearly'); - - -ALTER TABLE public.recurrence_frequency OWNER TO "wire-server"; - -- -- Name: meetings; Type: TABLE; Schema: public; Owner: wire-server -- CREATE TABLE public.meetings ( - id uuid NOT NULL DEFAULT gen_random_uuid(), + id uuid DEFAULT gen_random_uuid() NOT NULL, title text NOT NULL, creator uuid NOT NULL, - start_time timestamptz NOT NULL, - end_time timestamptz NOT NULL, - recurrence_frequency recurrence_frequency, + start_time timestamp with time zone NOT NULL, + end_time timestamp with time zone NOT NULL, + recurrence_frequency public.recurrence_frequency, recurrence_interval integer, - recurrence_until timestamptz, + recurrence_until timestamp with time zone, conversation_id uuid NOT NULL, - invited_emails text[] DEFAULT '{}'::text[], - trial boolean DEFAULT false, - created_at timestamp with time zone DEFAULT now(), - updated_at timestamp with time zone DEFAULT now() + invited_emails text[] DEFAULT '{}'::text[] NOT NULL, + trial boolean DEFAULT false NOT NULL, + created_at timestamp with time zone DEFAULT now() NOT NULL, + updated_at timestamp with time zone DEFAULT now() NOT NULL, + CONSTRAINT meetings_title_length CHECK ((length(title) <= 256)), + CONSTRAINT meetings_title_not_empty CHECK ((length(TRIM(BOTH FROM title)) > 0)), + CONSTRAINT meetings_valid_time_range CHECK ((end_time > start_time)) ); @@ -385,19 +394,19 @@ ALTER TABLE ONLY public.conversation -- --- Name: meetings meetings_pkey; Type: CONSTRAINT; Schema: public; Owner: wire-server +-- Name: local_conversation_remote_member local_conversation_remote_member_pkey; Type: CONSTRAINT; Schema: public; Owner: wire-server -- -ALTER TABLE ONLY public.meetings - ADD CONSTRAINT meetings_pkey PRIMARY KEY (id); +ALTER TABLE ONLY public.local_conversation_remote_member + ADD CONSTRAINT local_conversation_remote_member_pkey PRIMARY KEY (conv, user_remote_domain, user_remote_id); -- --- Name: local_conversation_remote_member local_conversation_remote_member_pkey; Type: CONSTRAINT; Schema: public; Owner: wire-server +-- Name: meetings meetings_pkey; Type: CONSTRAINT; Schema: public; Owner: wire-server -- -ALTER TABLE ONLY public.local_conversation_remote_member - ADD CONSTRAINT local_conversation_remote_member_pkey PRIMARY KEY (conv, user_remote_domain, user_remote_id); +ALTER TABLE ONLY public.meetings + ADD CONSTRAINT meetings_pkey PRIMARY KEY (id); -- From b80891081cbc9288bb0ecae0b92d969e74d527e2 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 27 Feb 2026 13:59:45 +0100 Subject: [PATCH 04/19] Fixup --- integration/test/Testlib/Assertions.hs | 2 +- integration/test/Testlib/Types.hs | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index ac33a425a0a..9d41164d4ec 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -404,7 +404,7 @@ super `shouldNotContain` sub = do printFailureDetails :: Env -> AssertionFailure -> IO String printFailureDetails env (AssertionFailure stack mbResponse ctx msg) = do - s <- liftIO $ prettierCallStack stack + s <- prettierCallStack stack ct <- renderCurlTrace env.curlTrace pure . unlines $ colored yellow "assertion failure:" diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index a38783bbe4d..051e73a220c 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -1,4 +1,3 @@ - {-# LANGUAGE DeriveGeneric #-} -- This file is part of the Wire Server implementation. @@ -411,7 +410,7 @@ requestToCurl req = HTTP.RequestBodyBS bs -> dataBinary (C8.unpack bs) _ -> -- this won't work - "--data-binary ''" dataBinary :: String -> String dataBinary "" = "" From 3e9a6cb4240c69c39e7cb3568b8feef6311a6421 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 12:07:19 +0100 Subject: [PATCH 05/19] Remove redundant language ext. Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- integration/test/Testlib/Types.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 051e73a220c..bc931abb3f1 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2025 Wire Swiss GmbH From a43dec95dfef1e52ee5e0509798a4f11adb690c0 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 12:10:04 +0100 Subject: [PATCH 06/19] Fix typo. Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- integration/test/Testlib/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index bc931abb3f1..75c1846046a 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -418,7 +418,7 @@ requestToCurl req = Just _val -> shellEscape raw Nothing -> cs $ Base64.encode $ cs raw - -- this is probably used wrong, and there are still come escape + -- this is probably used wrong, and there are still some escape -- issues to be solved. but it should be safe as long as we're -- only using it in our own integration tests, right? shellEscape :: String -> String From f16b4ecfd14819575e981407f808d3fd33b21d0a Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 12:11:01 +0100 Subject: [PATCH 07/19] Fix odd import. Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- integration/test/Testlib/Assertions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 9d41164d4ec..0200096d77f 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -48,7 +48,7 @@ import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding.Error as Text import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -import GHC.IORef +import Data.IORef import GHC.Stack as Stack import qualified Network.HTTP.Client as HTTP import System.FilePath From 7cf881dedbf575b34821964b92eaf54c209c6730 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 12:17:36 +0100 Subject: [PATCH 08/19] Fix curl command renderer. Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- integration/test/Testlib/Types.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 75c1846046a..977d9e14438 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -412,11 +412,17 @@ requestToCurl req = dataBinary :: String -> String dataBinary "" = "" - dataBinary raw = "--data-binary \"$(" <> customEncoded <> "| base64 -d)\"" - where - customEncoded = case Aeson.decode @Aeson.Value (cs raw) of - Just _val -> shellEscape raw - Nothing -> cs $ Base64.encode $ cs raw + dataBinary raw = + case Aeson.decode @Aeson.Value (cs raw) of + -- For JSON bodies, pass the payload directly, properly shell-escaped. + Just _val -> + "--data-binary " <> shellEscape raw + -- For non-JSON (potentially binary) bodies, use a base64 literal + -- and decode it at runtime via a valid command substitution. + Nothing -> + let b64 :: String + b64 = cs (Base64.encode (cs raw)) + in "--data-binary \"$(printf %s " <> shellEscape b64 <> " | base64 -d)\"" -- this is probably used wrong, and there are still some escape -- issues to be solved. but it should be safe as long as we're From 71a23c974836643d30720f2be2648f626bedaba6 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 12:24:20 +0100 Subject: [PATCH 09/19] hlint. --- integration/test/Testlib/Assertions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 0200096d77f..8b2b23e7df6 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -40,6 +40,7 @@ import qualified Data.ByteString.Lazy as BS import Data.Char import Data.Foldable import Data.Hex +import Data.IORef import Data.List import qualified Data.Map as Map import Data.Maybe @@ -48,7 +49,6 @@ import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding.Error as Text import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -import Data.IORef import GHC.Stack as Stack import qualified Network.HTTP.Client as HTTP import System.FilePath From 9e661ac32d4c09b5191342980b2ee512f5dbcb60 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 12:24:27 +0100 Subject: [PATCH 10/19] Fix trivial typo. --- integration/test/Testlib/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 977d9e14438..9f1d10c13bd 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -377,7 +377,7 @@ data MLSConv = MLSConv requestToCurl :: HTTP.Request -> String requestToCurl req = - unwords $ -- FUTUREWORK: amke this multi-line, but so thhhaaaatttt iiiitttt ddddoooesn't go wrong. + unwords $ -- FUTUREWORK: make this multi-line, but so thhhaaaatttt iiiitttt ddddoooesn't go wrong. Prelude.filter (not . Prelude.null) [ "curl", From 4bf30862dcfb69ab10b72e445968dae849a88e74 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 12:24:42 +0100 Subject: [PATCH 11/19] Only keep track of curl traces if verbosity=1. --- integration/test/Testlib/HTTP.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index 875766ab472..a4f3e2658e8 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -18,6 +18,8 @@ module Testlib.HTTP where import qualified Control.Exception as E +import Control.Monad (when) +import Control.Monad.Extra (void) import Control.Monad.Reader import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson @@ -44,6 +46,7 @@ import Network.HTTP.Types (hContentLength, hLocation) import qualified Network.HTTP.Types as HTTP import Network.HTTP.Types.URI (parseQuery) import Network.URI (URI (..), URIAuth (..), parseURI) +import System.Environment import Testlib.Assertions import Testlib.Env import Testlib.JSON @@ -239,8 +242,10 @@ submit method req0 = do body = L.toStrict (HTTP.responseBody response) status = HTTP.statusCode (HTTP.responseStatus response) headers = HTTP.responseHeaders response - curl <- asks (.curlTrace) - _ <- liftIO $ modifyIORef' curl (<> [requestToCurl request, "# ==> " <> show (status, body, headers), ""]) + verbosity <- liftIO $ getEnvironment >>= maybe (pure "") pure . lookup "WIRE_INTEGRATION_TEST_VERBOSITY" + when (verbosity == "1") do + curl <- asks (.curlTrace) + void $ liftIO $ modifyIORef' curl (<> [requestToCurl request, "# ==> " <> show (status, body, headers), ""]) pure Response {..} locationHeaderHost :: Response -> String From 0345da6db4679a21ad0f9c177619223ea0cbf13a Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 17:08:14 +0100 Subject: [PATCH 12/19] Sanitize imports. Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- integration/test/Testlib/HTTP.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index a4f3e2658e8..837c5a84137 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -242,7 +242,7 @@ submit method req0 = do body = L.toStrict (HTTP.responseBody response) status = HTTP.statusCode (HTTP.responseStatus response) headers = HTTP.responseHeaders response - verbosity <- liftIO $ getEnvironment >>= maybe (pure "") pure . lookup "WIRE_INTEGRATION_TEST_VERBOSITY" + verbosity <- liftIO $ fmap (maybe "" id) (lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY") when (verbosity == "1") do curl <- asks (.curlTrace) void $ liftIO $ modifyIORef' curl (<> [requestToCurl request, "# ==> " <> show (status, body, headers), ""]) From c6ce5ab2cfbf0442b5da32c72899e07e2354749a Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 17:09:03 +0100 Subject: [PATCH 13/19] Remove redundant `void`. Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- integration/test/Testlib/HTTP.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index 837c5a84137..ecee17f57e6 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -245,7 +245,7 @@ submit method req0 = do verbosity <- liftIO $ fmap (maybe "" id) (lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY") when (verbosity == "1") do curl <- asks (.curlTrace) - void $ liftIO $ modifyIORef' curl (<> [requestToCurl request, "# ==> " <> show (status, body, headers), ""]) + liftIO $ modifyIORef' curl (<> [requestToCurl request, "# ==> " <> show (status, body, headers), ""]) pure Response {..} locationHeaderHost :: Response -> String From 53f1a545c07acf524ad87ea01ef3c70231af66f2 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 17:11:40 +0100 Subject: [PATCH 14/19] Sanitize imports. --- integration/test/Testlib/Assertions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 8b2b23e7df6..522f1a95cd4 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -51,8 +51,8 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import GHC.Stack as Stack import qualified Network.HTTP.Client as HTTP +import System.Environment (getEnvironment) import System.FilePath -import System.Posix.Env (getEnvironment) import Testlib.JSON import Testlib.Printing import Testlib.Types From 3d993b59d041b3900d0213d975a8585876486e33 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 2 Mar 2026 17:25:59 +0100 Subject: [PATCH 15/19] Sanitize imports. --- integration/test/Testlib/HTTP.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index ecee17f57e6..eb188fdbd5a 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -19,7 +19,6 @@ module Testlib.HTTP where import qualified Control.Exception as E import Control.Monad (when) -import Control.Monad.Extra (void) import Control.Monad.Reader import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson From 6f5a72c2d76bb8a6d87d98a00c5ca50013793512 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Tue, 3 Mar 2026 09:08:34 +0100 Subject: [PATCH 16/19] make sanitize-pr. --- integration/test/Testlib/HTTP.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index eb188fdbd5a..002048e9a5d 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -241,7 +241,7 @@ submit method req0 = do body = L.toStrict (HTTP.responseBody response) status = HTTP.statusCode (HTTP.responseStatus response) headers = HTTP.responseHeaders response - verbosity <- liftIO $ fmap (maybe "" id) (lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY") + verbosity <- liftIO $ fmap (fromMaybe "") (lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY") when (verbosity == "1") do curl <- asks (.curlTrace) liftIO $ modifyIORef' curl (<> [requestToCurl request, "# ==> " <> show (status, body, headers), ""]) From d778e9cfa38805898e6f0c269b7ef25c8f7c6e50 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 4 Mar 2026 10:29:14 +0100 Subject: [PATCH 17/19] Feedback from human hlinters :) Co-authored-by: Gautier DI FOLCO --- integration/test/Testlib/Assertions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 522f1a95cd4..4cab4c337d0 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -427,7 +427,7 @@ printAppFailureDetails env (AppFailure msg stack) = do renderCurlTrace :: IORef [String] -> IO [String] renderCurlTrace trace = do - verbosity <- getEnvironment >>= maybe (pure "") pure . lookup "WIRE_INTEGRATION_TEST_VERBOSITY" + verbosity <- fromMaybe "" <$> lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY" if verbosity == "1" then ("HTTP trace in curl pseudo-syntax:" :) <$> readIORef trace else pure ["Set WIRE_INTEGRATION_TEST_VERBOSITY=1 if you want to see complete trace of the HTTP traffic in curl pseudo-syntax."] From 831036077997a100b14f9cfc7b14f323f9df0622 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 4 Mar 2026 11:15:19 +0100 Subject: [PATCH 18/19] Cosmetics: hide away from magic POSIX variable in one place only. --- integration/test/Testlib/Assertions.hs | 12 +++++++----- integration/test/Testlib/HTTP.hs | 6 ++---- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 4cab4c337d0..fa27314886a 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -51,7 +51,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import GHC.Stack as Stack import qualified Network.HTTP.Client as HTTP -import System.Environment (getEnvironment) +import System.Environment import System.FilePath import Testlib.JSON import Testlib.Printing @@ -427,10 +427,12 @@ printAppFailureDetails env (AppFailure msg stack) = do renderCurlTrace :: IORef [String] -> IO [String] renderCurlTrace trace = do - verbosity <- fromMaybe "" <$> lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY" - if verbosity == "1" - then ("HTTP trace in curl pseudo-syntax:" :) <$> readIORef trace - else pure ["Set WIRE_INTEGRATION_TEST_VERBOSITY=1 if you want to see complete trace of the HTTP traffic in curl pseudo-syntax."] + isTestVerbose >>= \case + True -> ("HTTP trace in curl pseudo-syntax:" :) <$> readIORef trace + False -> pure ["Set WIRE_INTEGRATION_TEST_VERBOSITY=1 if you want to see complete trace of the HTTP traffic in curl pseudo-syntax."] + +isTestVerbose :: (MonadIO m) => m Bool +isTestVerbose = liftIO $ maybe False (== "1") <$> lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY" prettyContext :: String -> String prettyContext ctx = do diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index 002048e9a5d..643ff624f12 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -18,7 +18,7 @@ module Testlib.HTTP where import qualified Control.Exception as E -import Control.Monad (when) +import Control.Monad.Extra (whenM) import Control.Monad.Reader import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson @@ -45,7 +45,6 @@ import Network.HTTP.Types (hContentLength, hLocation) import qualified Network.HTTP.Types as HTTP import Network.HTTP.Types.URI (parseQuery) import Network.URI (URI (..), URIAuth (..), parseURI) -import System.Environment import Testlib.Assertions import Testlib.Env import Testlib.JSON @@ -241,8 +240,7 @@ submit method req0 = do body = L.toStrict (HTTP.responseBody response) status = HTTP.statusCode (HTTP.responseStatus response) headers = HTTP.responseHeaders response - verbosity <- liftIO $ fmap (fromMaybe "") (lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY") - when (verbosity == "1") do + whenM isTestVerbose do curl <- asks (.curlTrace) liftIO $ modifyIORef' curl (<> [requestToCurl request, "# ==> " <> show (status, body, headers), ""]) pure Response {..} From 8ecb44787867f0302e3ab9efcfa22c16a3a04800 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 4 Mar 2026 13:31:18 +0100 Subject: [PATCH 19/19] make sanitize-pr. --- integration/test/Testlib/Assertions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index fa27314886a..8de120c7a2c 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -432,7 +432,7 @@ renderCurlTrace trace = do False -> pure ["Set WIRE_INTEGRATION_TEST_VERBOSITY=1 if you want to see complete trace of the HTTP traffic in curl pseudo-syntax."] isTestVerbose :: (MonadIO m) => m Bool -isTestVerbose = liftIO $ maybe False (== "1") <$> lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY" +isTestVerbose = liftIO $ (Just "1" ==) <$> lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY" prettyContext :: String -> String prettyContext ctx = do