Order requests from a tarball based on the sequence folder (#3979)

Fixes #3978 

This change is backwards compatible and works on the old style tarballs
which do not contain the `sequence` folder.

Author: goodlyrottenapple

booster/package.yaml

@@ -119,6 +119,7 @@ executables:
       - bz2
       - casing
       - clock
+      - containers
       - directory
       - extra
       - filepath

booster/tools/rpc-client/RpcClient.hs

@@ -31,6 +31,7 @@ import Data.ByteString.Lazy.Char8 qualified as BS
 import Data.Char (isDigit, toLower, toUpper)
 import Data.Int (Int64)
 import Data.List.Extra
+import Data.Map qualified as Map
 import Data.Maybe (isNothing, mapMaybe)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
@@ -515,14 +516,17 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
         withTempDir $ \tmp -> withLogLevel common.logLevel $ do
             -- unpack relevant tar files (rpc_* directories only)
             logInfo_ $ unwords ["unpacking json files from tarball", tarFile, "into", tmp]
-            jsonFiles <-
-                liftIO $ Tar.foldEntries (unpackIfRpc tmp) (pure []) throwAnyError checked
+            (jsonFiles, sequenceMap) <-
+                liftIO $ Tar.foldEntries (unpackIfRpc tmp) (pure mempty) throwAnyError checked
             logInfo_ $ "RPC data:" <> show jsonFiles
+            logInfo_ $ "Sequence data:" <> show sequenceMap
 
             -- we should not rely on the requests being returned in a sorted order and
             -- should therefore sort them explicitly
-            let requests = sort $ mapMaybe (stripSuffix "_request.json") jsonFiles
+            let requests = mapMaybe (stripSuffix "_request.json") $ sortBy (compareSequence sequenceMap) jsonFiles
                 successMsg = if compareDetails then "matches expected" else "has expected type"
+
+            logInfo_ $ "Requests to be executed:" <> show (map (<> "_request.json") requests)
             results <-
                 forM requests $ \r -> do
                     mbError <- runRequest skt tmp jsonFiles r
@@ -542,8 +546,19 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
     throwAnyError :: Either Tar.FormatError Tar.FileNameError -> IO a
     throwAnyError = either throwIO throwIO
 
+    compareSequence :: Ord a => Ord b => Map.Map a b -> a -> a -> Ordering
+    compareSequence seqMap a b = case (Map.lookup a seqMap, Map.lookup b seqMap) of
+        (Nothing, Nothing) -> compare a b
+        (Just{}, Nothing) -> LT
+        (Nothing, Just{}) -> GT
+        (Just a', Just b') -> compare a' b'
+
     -- unpack all */*.json files into dir and return their names
-    unpackIfRpc :: FilePath -> Tar.Entry -> IO [FilePath] -> IO [FilePath]
+    unpackIfRpc ::
+        FilePath ->
+        Tar.Entry ->
+        IO ([FilePath], Map.Map FilePath Int) ->
+        IO ([FilePath], Map.Map FilePath Int)
     unpackIfRpc tmpDir entry acc = do
         case splitFileName (Tar.entryPath entry) of
             -- unpack all directories "<something>" containing "*.json" files
@@ -562,8 +577,12 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
                     -- current tarballs do not have dir entries, create dir here
                     createDirectoryIfMissing True $ tmpDir </> dir
                     BS.writeFile (tmpDir </> newPath) bs
-                    (newPath :) <$> acc
-                | otherwise ->
+                    (first (newPath :)) <$> acc
+                | "sequence" `isInfixOf` dir
+                , Just (idx :: Int) <- readMaybe file
+                , Tar.NormalFile bs _size <- Tar.entryContent entry ->
+                    (second $ Map.insert (BS.unpack bs) idx) <$> acc
+                | otherwise -> do
                     -- skip anything else
                     acc