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
This commit is contained in:
Moritz Kiefer 2021-10-13 11:19:44 +02:00 committed by GitHub
parent f4ca876756
commit cb1fb6f7bf
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -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"
]
]