integration-tests: Allow generating tests results in ant xml format

changelog.d/5-internal/xml-reports

@@ -0,0 +1,9 @@
+All integration tests can generate XML reports.
+
+To generate the report in brig-integration, galley-integration,
+cargohold-integration, gundeck-integration, stern-integration and the new
+integration suite pass `--xml=<outfile>` to generate the XML file.
+
+For spar-integration and federator-integration pass `-f junit` and set
+`JUNIT_OUTPUT_DIRECTORY` and `JUNIT_SUITE_NAME` environment variables. The XML
+report will be generated at `$JUNIT_OUTPUT_DIRECTORY/junit.xml`.

integration/default.nix

@@ -42,6 +42,8 @@
 , proto-lens
 , random
 , raw-strings-qq
+, regex-base
+, regex-tdfa
 , retry
 , scientific
 , split
@@ -59,6 +61,7 @@
 , vector
 , websockets
 , wire-message-proto-lens
+, xml
 , yaml
 }:
 mkDerivation {
@@ -105,6 +108,8 @@ mkDerivation {
     proto-lens
     random
     raw-strings-qq
+    regex-base
+    regex-tdfa
     retry
     scientific
     split
@@ -122,6 +127,7 @@ mkDerivation {
     vector
     websockets
     wire-message-proto-lens
+    xml
     yaml
   ];
   license = lib.licenses.agpl3Only;

integration/integration.cabal

@@ -130,6 +130,7 @@ library
     Testlib.Run
     Testlib.RunServices
     Testlib.Types
+    Testlib.XML
 
   build-depends:
     , aeson
@@ -168,6 +169,8 @@ library
     , proto-lens
     , random
     , raw-strings-qq
+    , regex-base
+    , regex-tdfa
     , retry
     , scientific
     , split
@@ -185,4 +188,5 @@ library
     , vector
     , websockets
     , wire-message-proto-lens
+    , xml
     , yaml

integration/test/Testlib/Options.hs

@@ -9,6 +9,7 @@ data TestOptions = TestOptions
   { includeTests :: [String],
     excludeTests :: [String],
     listTests :: Bool,
+    xmlReport :: Maybe FilePath,
     configFile :: String
   }
 
@@ -32,6 +33,13 @@ parser =
           )
       )
     <*> switch (long "list" <> short 'l' <> help "Only list tests.")
+    <*> optional
+      ( strOption
+          ( long "xml"
+              <> metavar "FILE"
+              <> help "Generate XML report for the tests"
+          )
+      )
     <*> strOption
       ( long "config"
           <> short 'c'
@@ -53,12 +61,16 @@ getOptions :: IO TestOptions
 getOptions = do
   defaultsInclude <- maybe [] (splitOn ",") <$> lookupEnv "TEST_INCLUDE"
   defaultsExclude <- maybe [] (splitOn ",") <$> lookupEnv "TEST_EXCLUDE"
+  defaultsXMLReport <- lookupEnv "TEST_XML"
   opts <- execParser optInfo
   pure
     opts
       { includeTests = includeTests opts `orFromEnv` defaultsInclude,
-        excludeTests = excludeTests opts `orFromEnv` defaultsExclude
+        excludeTests = excludeTests opts `orFromEnv` defaultsExclude,
+        xmlReport = xmlReport opts `orFromEnv` defaultsXMLReport
       }
   where
-    orFromEnv [] fromEnv = fromEnv
-    orFromEnv patterns _ = patterns
+    orFromEnv fromArgs fromEnv =
+      if null fromArgs
+        then fromEnv
+        else fromArgs

integration/test/Testlib/Run.hs

@@ -24,22 +24,11 @@ import Testlib.JSON
 import Testlib.Options
 import Testlib.Printing
 import Testlib.Types
+import Testlib.XML
 import Text.Printf
 import UnliftIO.Async
 import Prelude
 
-data TestReport = TestReport
-  { count :: Int,
-    failures :: [String]
-  }
-  deriving (Eq, Show)
-
-instance Semigroup TestReport where
-  TestReport s1 f1 <> TestReport s2 f2 = TestReport (s1 + s2) (f1 <> f2)
-
-instance Monoid TestReport where
-  mempty = TestReport 0 mempty
-
 runTest :: GlobalEnv -> App a -> IO (Either String a)
 runTest ge action = lowerCodensity $ do
   env <- mkEnv ge
@@ -55,16 +44,18 @@ pluralise :: Int -> String -> String
 pluralise 1 x = x
 pluralise _ x = x <> "s"
 
-printReport :: TestReport -> IO ()
+printReport :: TestSuiteReport -> IO ()
 printReport report = do
-  unless (null report.failures) $ putStrLn $ "----------"
-  putStrLn $ show report.count <> " " <> pluralise report.count "test" <> " run."
-  unless (null report.failures) $ do
+  let numTests = length report.cases
+      failures = filter (\testCase -> testCase.result /= TestSuccess) report.cases
+      numFailures = length failures
+  when (numFailures > 0) $ putStrLn $ "----------"
+  putStrLn $ show numTests <> " " <> pluralise numTests "test" <> " run."
+  when (numFailures > 0) $ do
     putStrLn ""
-    let numFailures = length report.failures
     putStrLn $ colored red (show numFailures <> " failed " <> pluralise numFailures "test" <> ": ")
-    for_ report.failures $ \name ->
-      putStrLn $ " - " <> name
+    for_ failures $ \testCase ->
+      putStrLn $ " - " <> testCase.name
 
 testFilter :: TestOptions -> String -> Bool
 testFilter opts n = included n && not (excluded n)
@@ -105,7 +96,7 @@ main = do
                 qualifiedName = module0 <> "." <> name
              in (qualifiedName, summary, full, action)
 
-  if opts.listTests then doListTests tests else runTests tests cfg
+  if opts.listTests then doListTests tests else runTests tests opts.xmlReport cfg
 
 createGlobalEnv :: FilePath -> IO GlobalEnv
 createGlobalEnv cfg = do
@@ -123,8 +114,8 @@ createGlobalEnv cfg = do
           Just dir -> dir </> "galley" </> relPath
       pure genv0 {gRemovalKeyPath = path}
 
-runTests :: [(String, x, y, App ())] -> FilePath -> IO ()
-runTests tests cfg = do
+runTests :: [(String, x, y, App ())] -> Maybe FilePath -> FilePath -> IO ()
+runTests tests mXMLOutput cfg = do
   output <- newChan
   let displayOutput =
         readChan output >>= \case
@@ -149,14 +140,15 @@ runTests tests cfg = do
                 <> ") -----\n"
                 <> err
                 <> "\n"
-            pure (TestReport 1 [qname])
+            pure (TestSuiteReport [TestCaseReport qname (TestFailure err) tm])
           Right _ -> do
             writeOutput $ qname <> colored green " OK" <> " (" <> printTime tm <> ")" <> "\n"
-            pure (TestReport 1 [])
+            pure (TestSuiteReport [TestCaseReport qname TestSuccess tm])
     writeChan output Nothing
     wait displayThread
     printReport report
-    unless (null report.failures) $
+    mapM_ (saveXMLReport report) mXMLOutput
+    when (any (\testCase -> testCase.result /= TestSuccess) report.cases) $
       exitFailure
 
 doListTests :: [(String, String, String, x)] -> IO ()

integration/test/Testlib/Types.hs

@@ -26,6 +26,7 @@ import Data.Set qualified as Set
 import Data.String
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
+import Data.Time
 import Data.Word
 import GHC.Generics (Generic)
 import GHC.Records
@@ -440,3 +441,17 @@ data BackendName
 
 allServices :: [Service]
 allServices = [minBound .. maxBound]
+
+newtype TestSuiteReport = TestSuiteReport {cases :: [TestCaseReport]}
+  deriving (Eq, Show)
+  deriving newtype (Semigroup, Monoid)
+
+data TestCaseReport = TestCaseReport
+  { name :: String,
+    result :: TestResult,
+    time :: NominalDiffTime
+  }
+  deriving (Eq, Show)
+
+data TestResult = TestSuccess | TestFailure String
+  deriving (Eq, Show)

integration/test/Testlib/XML.hs

@@ -0,0 +1,60 @@
+module Testlib.XML where
+
+import Data.Array qualified as Array
+import Data.Fixed
+import Data.Time
+import Testlib.Types
+import Text.Regex.Base qualified as Regex
+import Text.Regex.TDFA.String qualified as Regex
+import Text.XML.Light
+import Prelude
+
+saveXMLReport :: TestSuiteReport -> FilePath -> IO ()
+saveXMLReport report output =
+  writeFile output $ showTopElement $ xmlReport report
+
+xmlReport :: TestSuiteReport -> Element
+xmlReport report =
+  unode
+    "testsuites"
+    ( Attr (unqual "name") "wire-server",
+      testSuiteElements
+    )
+  where
+    testSuiteElements =
+      unode
+        "testsuite"
+        ( attrs,
+          map encodeTestCase report.cases
+        )
+    attrs =
+      [ Attr (unqual "name") "integration",
+        Attr (unqual "tests") $ show $ length report.cases,
+        Attr (unqual "failures") $ show $ length $ filter (\testCase -> testCase.result /= TestSuccess) report.cases,
+        Attr (unqual "time") $ showFixed True $ nominalDiffTimeToSeconds $ sum $ map (.time) report.cases
+      ]
+
+encodeTestCase :: TestCaseReport -> Element
+encodeTestCase TestCaseReport {..} =
+  unode "testcase" (attrs, content)
+  where
+    attrs =
+      [ Attr (unqual "name") name,
+        Attr (unqual "time") (showFixed True (nominalDiffTimeToSeconds time))
+      ]
+    content = case result of
+      TestSuccess -> []
+      TestFailure msg -> [failure msg]
+    failure msg = unode "failure" (blank_cdata {cdData = dropConsoleFormatting msg})
+
+    -- Drops ANSI control characters which might be used to set colors.
+    -- Including these breaks XML, there is not much point encoding them.
+    dropConsoleFormatting input =
+      let regex = Regex.makeRegex "\x1b\\[[0-9;]*[mGKHF]" :: Regex.Regex
+          matches = Regex.matchAll regex input
+          dropMatch (offset, len) input' =
+            let (begining, rest) = splitAt offset input'
+                (_, end) = splitAt len rest
+             in begining <> end
+          matchTuples = map (Array.! 0) matches
+       in foldr dropMatch input matchTuples

nix/haskell-pins.nix

@@ -204,6 +204,22 @@ let
         sha256 = "sha256-htEIJY+LmIMACVZrflU60+X42/g14NxUyFM7VJs4E6w=";
       };
     };
+    # PR: https://github.com/ocharles/tasty-ant-xml/pull/32
+    tasty-ant-xml = {
+      src = fetchgit {
+        url = "https://github.com/akshaymankar/tasty-ant-xml";
+        rev = "34ff294d805e62e73678dccc0be9d3da13540fbe";
+        sha256 = "sha256-+rHcS+BwEFsXqPAHX/KZDIgv9zfk1dZl0LlZJ57Com4=";
+      };
+    };
+    # PR: https://github.com/freckle/hspec-junit-formatter/pull/24
+    hspec-junit-formatter = {
+      src = fetchgit {
+        url = "https://github.com/akshaymankar/hspec-junit-formatter";
+        rev = "acec31822cc4f90489d9940bad23b3fd6d1d7c75";
+        sha256 = "sha256-4xGW3KHQKbTL+6+Q/gzfaMBP+J0npUe7tP5ZCQCB5+s=";
+      };
+    };
   };
   hackagePins = {
     # Major re-write upstream, we should get rid of this dependency rather than

nix/manual-overrides.nix

@@ -27,6 +27,9 @@ hself: hsuper: {
   wai-middleware-prometheus = hlib.doJailbreak hsuper.wai-middleware-prometheus;
   wai-predicates = hlib.markUnbroken hsuper.wai-predicates;
 
+  # PR with fix: https://github.com/freckle/hspec-junit-formatter/pull/23
+  hspec-junit-formatter = hlib.markUnbroken (hlib.dontCheck hsuper.hspec-junit-formatter);
+
   # Some test seems to be broken
   hsaml2 = hlib.dontCheck hsuper.hsaml2;
   saml2-web-sso = hlib.dontCheck hsuper.saml2-web-sso;

services/brig/brig.cabal

@@ -595,6 +595,7 @@ executable brig-integration
     , spar
     , streaming-commons
     , tasty                  >=1.0
+    , tasty-ant-xml
     , tasty-cannon           >=0.3.4
     , tasty-hunit            >=0.2
     , temporary              >=1.2.1

services/brig/default.nix

@@ -122,6 +122,7 @@
 , streaming-commons
 , swagger2
 , tasty
+, tasty-ant-xml
 , tasty-cannon
 , tasty-hunit
 , tasty-quickcheck
@@ -354,6 +355,7 @@ mkDerivation {
     spar
     streaming-commons
     tasty
+    tasty-ant-xml
     tasty-cannon
     tasty-hunit
     temporary

services/brig/test/integration/Main.hs

@@ -64,6 +64,9 @@ import System.Environment (withArgs)
 import System.Logger qualified as Logger
 import Test.Tasty
 import Test.Tasty.HUnit
+import Test.Tasty.Ingredients
+import Test.Tasty.Runners
+import Test.Tasty.Runners.AntXML
 import Util
 import Util.Options
 import Util.Test
@@ -165,7 +168,7 @@ runTests iConf brigOpts otherArgs = do
       mlsApi = MLS.tests mg b brigOpts
       oauthAPI = API.OAuth.tests mg db b n brigOpts
 
-  withArgs otherArgs . defaultMain
+  withArgs otherArgs . defaultMainWithIngredients (listingTests : (composeReporters antXMLRunner consoleTestReporter) : defaultIngredients)
     $ testGroup
       "Brig API Integration"
     $ [ testCase "sitemap" $

services/cargohold/cargohold.cabal

@@ -289,6 +289,7 @@ executable cargohold-integration
     , servant-client
     , tagged                 >=0.8
     , tasty                  >=1.0
+    , tasty-ant-xml
     , tasty-hunit            >=0.9
     , text                   >=1.1
     , time                   >=1.5

services/cargohold/default.nix

@@ -50,6 +50,7 @@
 , servant-server
 , tagged
 , tasty
+, tasty-ant-xml
 , tasty-hunit
 , text
 , time
@@ -154,6 +155,7 @@ mkDerivation {
     servant-client
     tagged
     tasty
+    tasty-ant-xml
     tasty-hunit
     text
     time