diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 79ca5d700a..aa7786631c 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/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 0000000000..192f74df71 --- /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 8f13eb96c7..8de120c7a2 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 @@ -50,6 +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 import System.FilePath import Testlib.JSON import Testlib.Printing @@ -400,24 +402,37 @@ 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 +printFailureDetails :: Env -> AssertionFailure -> IO String +printFailureDetails env (AssertionFailure stack mbResponse ctx msg) = do s <- prettierCallStack stack + ct <- renderCurlTrace env.curlTrace 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 <- renderCurlTrace env.curlTrace pure . unlines $ colored yellow "app failure:" : colored red msg : "\n" : [s] + <> ct + +renderCurlTrace :: IORef [String] -> IO [String] +renderCurlTrace trace = do + 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 $ (Just "1" ==) <$> lookupEnv "WIRE_INTEGRATION_TEST_VERBOSITY" prettyContext :: String -> String prettyContext ctx = do @@ -426,12 +441,14 @@ prettyContext ctx = do colored blue ctx ] -printExceptionDetails :: SomeException -> IO String -printExceptionDetails e = do +printExceptionDetails :: Env -> SomeException -> IO String +printExceptionDetails env e = do + ct <- renderCurlTrace env.curlTrace 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 1a65d7f5ea..addf929ef3 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 9ce4f542ad..643ff624f1 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -18,6 +18,7 @@ module Testlib.HTTP where import qualified Control.Exception as E +import Control.Monad.Extra (whenM) import Control.Monad.Reader import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson @@ -27,6 +28,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 +233,17 @@ 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 + whenM isTestVerbose do + 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 0566cc00f2..b32b9a78eb 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 74ac08535c..9f1d10c13b 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -36,6 +36,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 +50,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 +273,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 @@ -374,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", @@ -401,11 +404,29 @@ 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 ''" + + dataBinary :: String -> String + dataBinary "" = "" + 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 + -- only using it in our own integration tests, right? shellEscape :: String -> String shellEscape s = "'" ++ concatMap escape s ++ "'" where diff --git a/postgres-schema.sql b/postgres-schema.sql index e6d915bae7..070828aa35 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); --