From cb1fb6f7bfce6a1d2b3ef67d8d796352abc9d1c0 Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Wed, 13 Oct 2021 11:19:44 +0200 Subject: [PATCH] Reuse sandbox & JSON API across `daml ledger` tests (#11214) Speeds them up by more than 2x and reduces flakiness. I also added a higher timeout to the allocate party call since that seems to still be sometimes too slow if lots of things run in parallel. changelog_begin changelog_end --- .../test/DA/Daml/Helper/Test/Ledger.hs | 381 +++++++++--------- 1 file changed, 185 insertions(+), 196 deletions(-) diff --git a/daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Ledger.hs b/daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Ledger.hs index a5d95500d59..9711d42f413 100644 --- a/daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Ledger.hs +++ b/daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Ledger.hs @@ -35,210 +35,199 @@ main = do locateRunfiles (mainWorkspace "daml-assistant" "daml-helper" exe "daml-helper") testDar <- locateRunfiles (mainWorkspace "daml-assistant" "daml-helper" "test.dar") defaultMain $ + withSandbox defaultSandboxConf $ \getSandboxPort -> + withHttpJson getSandboxPort (defaultHttpJsonConf "Alice") $ \getHttpJson -> testGroup "daml ledger" - [ withSandbox defaultSandboxConf $ \getSandboxPort -> do - withHttpJson getSandboxPort (defaultHttpJsonConf "Alice") $ \getHttpJson -> - testGroup - "list-parties" - [ testCase "succeeds against HTTP JSON API" $ do - HttpJson {hjPort, hjTokenFile} <- getHttpJson - sandboxPort <- getSandboxPort - -- allocate parties via gRPC - callCommand $ - unwords - [ damlHelper - , "ledger" - , "allocate-party" - , "--host" - , "localhost" - , "--port" - , show sandboxPort - , "Bob" - ] - -- check for parties via json api - let ledgerOpts = - [ "--host=localhost" - , "--json-api" - , "--port" - , show hjPort - , "--access-token-file" - , hjTokenFile - ] - out <- readProcess damlHelper ("ledger" : "list-parties" : ledgerOpts) "" - ((show $ PartyDetails (Party "Bob") "Bob" True) `elem` lines out) @? - "Bob is not contained in list-parties output." - ] - , withSandbox defaultSandboxConf $ \getSandboxPort -> do - withHttpJson getSandboxPort (defaultHttpJsonConf "Alice") $ \getHttpJson -> - testGroup - "allocate-parties" - [ testCase "succeeds against HTTP JSON API" $ do - HttpJson {hjPort, hjTokenFile} <- getHttpJson - sandboxPort <- getSandboxPort - -- allocate parties via json api - callCommand $ - unwords - [ damlHelper - , "ledger" - , "allocate-parties" - , "--host=localhost" - , "--json-api" - , "--port" - , show hjPort - , "--access-token-file" - , hjTokenFile - , "Bob" - , "Charlie" - ] - -- check for parties via gRPC - let ledgerOpts = ["--host=localhost", "--port", show sandboxPort] - out <- readProcess damlHelper ("ledger" : "list-parties" : ledgerOpts) "" - ((show $ PartyDetails (Party "Bob") "Bob" True) `elem` lines out) @? - "Bob is not contained in list-parties output." - ((show $ PartyDetails (Party "Charlie") "Charlie" True) `elem` lines out) @? - "Charlie is not contained in list-parties output." - ] - , withSandbox defaultSandboxConf $ \getSandboxPort -> do - withHttpJson getSandboxPort (defaultHttpJsonConf "Alice") $ \getHttpJson -> - testGroup - "upload-dar" - [ testCase "succeeds against HTTP JSON API" $ do - HttpJson {hjPort, hjTokenFile} <- getHttpJson - sandboxPort <- getSandboxPort - testDarPkgId <- readDarMainPackageId testDar - -- upload-dar via json-api - callCommand $ - unwords - [ damlHelper - , "ledger" - , "upload-dar" - , "--host=localhost" - , "--json-api" - , "--port" - , show hjPort - , "--access-token-file" - , hjTokenFile - , testDar - ] - -- fetch dar via gRPC - withTempFile $ \tmp -> do - callCommand $ - unwords - [ damlHelper - , "ledger" - , "fetch-dar" - , "--host=localhost" - , "--port" - , show sandboxPort - , "--main-package-id" - , testDarPkgId - , "-o" - , tmp - ] - fetchedPkgId <- readDarMainPackageId tmp - fetchedPkgId == testDarPkgId @? "Fechted dar differs from uploaded dar." - ] - , withSandbox defaultSandboxConf $ \getSandboxPort -> do - withHttpJson getSandboxPort (defaultHttpJsonConf "Alice") $ \getHttpJson -> - testGroup - "fetch-dar" - [ testCase "succeeds against HTTP JSON API" $ do - HttpJson {hjPort, hjTokenFile} <- getHttpJson - sandboxPort <- getSandboxPort - testDarPkgId <- readDarMainPackageId testDar - -- upload-dar via gRPC - callCommand $ - unwords - [ damlHelper - , "ledger" - , "upload-dar" - , "--host=localhost" - , "--port" - , show sandboxPort - , testDar - ] - -- fetch dar via http json - withTempFile $ \tmp -> do - callCommand $ - unwords - [ damlHelper - , "ledger" - , "fetch-dar" - , "--json-api" - , "--host=localhost" - , "--port" - , show hjPort - , "--access-token-file" - , hjTokenFile - , "--main-package-id" - , testDarPkgId - , "-o" - , tmp - ] - fetchedPkgId <- readDarMainPackageId tmp - testDarPkgId == fetchedPkgId @? "Fechted dar differs from uploaded dar." - ] - , withSandbox defaultSandboxConf $ \getSandboxPort -> do - testGroup - "fetch-dar limited gRPC message size" - [ testCase "fails if the message size is too low" $ do - sandboxPort <- getSandboxPort - testDarPkgId <- readDarMainPackageId testDar - -- upload-dar via gRPC + [ testGroup "list-parties" + [ testCase "succeeds against HTTP JSON API" $ do + HttpJson {hjPort, hjTokenFile} <- getHttpJson + sandboxPort <- getSandboxPort + -- allocate parties via gRPC + callCommand $ + unwords + [ damlHelper + , "ledger" + , "allocate-party" + , "--host" + , "localhost" + , "--port" + , show sandboxPort + , "--timeout=120" + , "Bob" + ] + -- check for parties via json api + let ledgerOpts = + [ "--host=localhost" + , "--json-api" + , "--port" + , show hjPort + , "--access-token-file" + , hjTokenFile + ] + out <- readProcess damlHelper ("ledger" : "list-parties" : ledgerOpts) "" + ((show $ PartyDetails (Party "Bob") "Bob" True) `elem` lines out) @? + "Bob is not contained in list-parties output." + ] + , testGroup "allocate-parties" + [ testCase "succeeds against HTTP JSON API" $ do + HttpJson {hjPort, hjTokenFile} <- getHttpJson + sandboxPort <- getSandboxPort + -- allocate parties via json api + callCommand $ + unwords + [ damlHelper + , "ledger" + , "allocate-parties" + , "--host=localhost" + , "--json-api" + , "--port" + , show hjPort + , "--access-token-file" + , hjTokenFile + , "Bob" + , "Charlie" + ] + -- check for parties via gRPC + let ledgerOpts = ["--host=localhost", "--port", show sandboxPort] + out <- readProcess damlHelper ("ledger" : "list-parties" : ledgerOpts) "" + ((show $ PartyDetails (Party "Bob") "Bob" True) `elem` lines out) @? + "Bob is not contained in list-parties output." + ((show $ PartyDetails (Party "Charlie") "Charlie" True) `elem` lines out) @? + "Charlie is not contained in list-parties output." + ] + , testGroup "upload-dar" + [ testCase "succeeds against HTTP JSON API" $ do + HttpJson {hjPort, hjTokenFile} <- getHttpJson + sandboxPort <- getSandboxPort + testDarPkgId <- readDarMainPackageId testDar + -- upload-dar via json-api + callCommand $ + unwords + [ damlHelper + , "ledger" + , "upload-dar" + , "--host=localhost" + , "--json-api" + , "--port" + , show hjPort + , "--access-token-file" + , hjTokenFile + , testDar + ] + -- fetch dar via gRPC + withTempFile $ \tmp -> do callCommand $ unwords [ damlHelper , "ledger" - , "upload-dar" + , "fetch-dar" , "--host=localhost" , "--port" , show sandboxPort - , testDar + , "--main-package-id" + , testDarPkgId + , "-o" + , tmp ] - -- fetch dar via gRPC, but too small max-inbound-message-size - withTempFile $ \tmp -> do - (exitCode, _, _) <- - readCreateProcessWithExitCode - (shell $ - unwords - [ damlHelper - , "ledger" - , "fetch-dar" - , "--host=localhost" - , "--port" - , show sandboxPort - , "--main-package-id" - , testDarPkgId - , "-o" - , tmp - , "--max-inbound-message-size" - , "20" - ]) - "" - exitCode == - ExitFailure 1 @? - "fetch-dar did not fail with too small max-inbound-message-size flag" - (exitCode2, _, _) <- - readCreateProcessWithExitCode - (shell $ - unwords - [ damlHelper - , "ledger" - , "fetch-dar" - , "--host=localhost" - , "--port" - , show sandboxPort - , "--main-package-id" - , testDarPkgId - , "-o" - , tmp - , "--max-inbound-message-size" - , "2000000" - ]) - "" - exitCode2 == - ExitSuccess @? - "fetch-dar did fail with big enough max-inbound-message-size flag" - ] + fetchedPkgId <- readDarMainPackageId tmp + fetchedPkgId == testDarPkgId @? "Fechted dar differs from uploaded dar." + ] + , testGroup "fetch-dar" + [ testCase "succeeds against HTTP JSON API" $ do + HttpJson {hjPort, hjTokenFile} <- getHttpJson + sandboxPort <- getSandboxPort + testDarPkgId <- readDarMainPackageId testDar + -- upload-dar via gRPC + callCommand $ + unwords + [ damlHelper + , "ledger" + , "upload-dar" + , "--host=localhost" + , "--port" + , show sandboxPort + , testDar + ] + -- fetch dar via http json + withTempFile $ \tmp -> do + callCommand $ + unwords + [ damlHelper + , "ledger" + , "fetch-dar" + , "--json-api" + , "--host=localhost" + , "--port" + , show hjPort + , "--access-token-file" + , hjTokenFile + , "--main-package-id" + , testDarPkgId + , "-o" + , tmp + ] + fetchedPkgId <- readDarMainPackageId tmp + testDarPkgId == fetchedPkgId @? "Fechted dar differs from uploaded dar." + ] + , testGroup "fetch-dar limited gRPC message size" + [ testCase "fails if the message size is too low" $ do + sandboxPort <- getSandboxPort + testDarPkgId <- readDarMainPackageId testDar + -- upload-dar via gRPC + callCommand $ + unwords + [ damlHelper + , "ledger" + , "upload-dar" + , "--host=localhost" + , "--port" + , show sandboxPort + , testDar + ] + -- fetch dar via gRPC, but too small max-inbound-message-size + withTempFile $ \tmp -> do + (exitCode, _, _) <- + readCreateProcessWithExitCode + (shell $ + unwords + [ damlHelper + , "ledger" + , "fetch-dar" + , "--host=localhost" + , "--port" + , show sandboxPort + , "--main-package-id" + , testDarPkgId + , "-o" + , tmp + , "--max-inbound-message-size" + , "20" + ]) + "" + exitCode == + ExitFailure 1 @? + "fetch-dar did not fail with too small max-inbound-message-size flag" + (exitCode2, _, _) <- + readCreateProcessWithExitCode + (shell $ + unwords + [ damlHelper + , "ledger" + , "fetch-dar" + , "--host=localhost" + , "--port" + , show sandboxPort + , "--main-package-id" + , testDarPkgId + , "-o" + , tmp + , "--max-inbound-message-size" + , "2000000" + ]) + "" + exitCode2 == + ExitSuccess @? + "fetch-dar did fail with big enough max-inbound-message-size flag" + ] ]