Skip to content

Commit cddf0cc

Browse files
committed
Merge remote-tracking branch 'origin/master' into release
2 parents 385c29d + c71e5da commit cddf0cc

File tree

2 files changed

+26
-6
lines changed

2 files changed

+26
-6
lines changed

booster/package.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -119,6 +119,7 @@ executables:
119119
- bz2
120120
- casing
121121
- clock
122+
- containers
122123
- directory
123124
- extra
124125
- filepath

booster/tools/rpc-client/RpcClient.hs

Lines changed: 25 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import Data.ByteString.Lazy.Char8 qualified as BS
3131
import Data.Char (isDigit, toLower, toUpper)
3232
import Data.Int (Int64)
3333
import Data.List.Extra
34+
import Data.Map qualified as Map
3435
import Data.Maybe (isNothing, mapMaybe)
3536
import Data.Text qualified as Text
3637
import Data.Text.IO qualified as Text
@@ -515,14 +516,17 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
515516
withTempDir $ \tmp -> withLogLevel common.logLevel $ do
516517
-- unpack relevant tar files (rpc_* directories only)
517518
logInfo_ $ unwords ["unpacking json files from tarball", tarFile, "into", tmp]
518-
jsonFiles <-
519-
liftIO $ Tar.foldEntries (unpackIfRpc tmp) (pure []) throwAnyError checked
519+
(jsonFiles, sequenceMap) <-
520+
liftIO $ Tar.foldEntries (unpackIfRpc tmp) (pure mempty) throwAnyError checked
520521
logInfo_ $ "RPC data:" <> show jsonFiles
522+
logInfo_ $ "Sequence data:" <> show sequenceMap
521523

522524
-- we should not rely on the requests being returned in a sorted order and
523525
-- should therefore sort them explicitly
524-
let requests = sort $ mapMaybe (stripSuffix "_request.json") jsonFiles
526+
let requests = mapMaybe (stripSuffix "_request.json") $ sortBy (compareSequence sequenceMap) jsonFiles
525527
successMsg = if compareDetails then "matches expected" else "has expected type"
528+
529+
logInfo_ $ "Requests to be executed:" <> show (map (<> "_request.json") requests)
526530
results <-
527531
forM requests $ \r -> do
528532
mbError <- runRequest skt tmp jsonFiles r
@@ -542,8 +546,19 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
542546
throwAnyError :: Either Tar.FormatError Tar.FileNameError -> IO a
543547
throwAnyError = either throwIO throwIO
544548

549+
compareSequence :: Ord a => Ord b => Map.Map a b -> a -> a -> Ordering
550+
compareSequence seqMap a b = case (Map.lookup a seqMap, Map.lookup b seqMap) of
551+
(Nothing, Nothing) -> compare a b
552+
(Just{}, Nothing) -> LT
553+
(Nothing, Just{}) -> GT
554+
(Just a', Just b') -> compare a' b'
555+
545556
-- unpack all */*.json files into dir and return their names
546-
unpackIfRpc :: FilePath -> Tar.Entry -> IO [FilePath] -> IO [FilePath]
557+
unpackIfRpc ::
558+
FilePath ->
559+
Tar.Entry ->
560+
IO ([FilePath], Map.Map FilePath Int) ->
561+
IO ([FilePath], Map.Map FilePath Int)
547562
unpackIfRpc tmpDir entry acc = do
548563
case splitFileName (Tar.entryPath entry) of
549564
-- unpack all directories "<something>" containing "*.json" files
@@ -562,8 +577,12 @@ runTarball common (Just sock) tarFile keepGoing runOnly compareDetails = do
562577
-- current tarballs do not have dir entries, create dir here
563578
createDirectoryIfMissing True $ tmpDir </> dir
564579
BS.writeFile (tmpDir </> newPath) bs
565-
(newPath :) <$> acc
566-
| otherwise ->
580+
(first (newPath :)) <$> acc
581+
| "sequence" `isInfixOf` dir
582+
, Just (idx :: Int) <- readMaybe file
583+
, Tar.NormalFile bs _size <- Tar.entryContent entry ->
584+
(second $ Map.insert (BS.unpack bs) idx) <$> acc
585+
| otherwise -> do
567586
-- skip anything else
568587
acc
569588

0 commit comments

Comments
 (0)