diff --git a/booster/package.yaml b/booster/package.yaml index c076b8038c..75512ee37a 100644 --- a/booster/package.yaml +++ b/booster/package.yaml @@ -119,6 +119,7 @@ executables: - bz2 - casing - clock + - containers - directory - extra - filepath diff --git a/booster/tools/rpc-client/RpcClient.hs b/booster/tools/rpc-client/RpcClient.hs index 69fc73a529..0824a9f94c 100644 --- a/booster/tools/rpc-client/RpcClient.hs +++ b/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 "" 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