Removal of Sandbox Classic in Haskell code [DPP-1073]. (#14127)

* Removal of Sandbox Classic in Haskell code.

CHANGELOG_BEGIN
CHANGELOG_END

* Further sandbox-classic removals

* Upload dar files when withSandbox is used.

* fix formatting

* Moved upload of dars in createSandbox.

* Fixed test by passing the token before the token file is created.

* Added implicit party allocation argument for haskell tests.

* DPP-1073 Infer sandbox token from the shared secret.

* Different slicing of runLedgerUploadDar

Co-authored-by: Andreas Triantafyllos <andreas.triantafyllos@digitalasset.com>
Co-authored-by: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>

compiler/damlc/tests/BUILD.bazel

@@ -619,7 +619,7 @@ da_haskell_test(
         ":repl-test.dar",
         "//compiler/damlc",
         "//daml-script/daml:daml-script.dar",
-        "//ledger/sandbox-classic:sandbox-classic-binary",
+        "//ledger/sandbox-on-x:app",
         "//ledger/test-common/test-certificates",
     ],
     hackage_deps = [
@@ -662,7 +662,7 @@ da_haskell_test(
         "//compiler/damlc/stable-packages",
         "//compiler/repl-service/server:repl_service_jar",
         "//daml-script/daml:daml-script.dar",
-        "//ledger/sandbox-classic:sandbox-classic-binary",
+        "//ledger/sandbox-on-x:app",
     ],
     hackage_deps = [
         "async",
@@ -924,7 +924,7 @@ da_haskell_test(
     data = [
         ":pkg-manager-test.dar",
         "//compiler/damlc",
-        "//ledger/sandbox-classic:sandbox-classic-binary",
+        "//ledger/sandbox-on-x:app",
     ],
     hackage_deps = [
         "base",

daml-assistant/daml-helper/BUILD.bazel

@@ -97,7 +97,7 @@ da_haskell_test(
     srcs = ["test/DA/Daml/Helper/Test/Tls.hs"],
     data = [
         "daml-helper",
-        "//ledger/sandbox-classic:sandbox-classic-binary",
+        "//ledger/sandbox-on-x:app",
         "//ledger/test-common/test-certificates",
     ],
     hackage_deps = [
@@ -123,7 +123,7 @@ da_haskell_test(
     data = [
         "//compiler/damlc",
         "//daml-assistant/daml-helper",
-        "//ledger/sandbox-classic:sandbox-classic-binary",
+        "//ledger/sandbox-on-x:app",
     ],
     # TODO (MK) https://github.com/digital-asset/daml/issues/9768
     flaky = True,
@@ -165,7 +165,7 @@ da_haskell_test(
         "daml-helper",
         ":test.dar",
         "//ledger-service/http-json:http-json-binary",
-        "//ledger/sandbox-classic:sandbox-classic-binary",
+        "//ledger/sandbox-on-x:app",
     ],
     hackage_deps = [
         "base",
@@ -199,7 +199,7 @@ da_haskell_test(
         "daml-helper",
         ":test.dar",
         "//ledger-service/http-json:http-json-binary",
-        "//ledger/sandbox-classic:sandbox-classic-binary",
+        "//ledger/sandbox-on-x:app",
     ],
     hackage_deps = [
         "base",

daml-assistant/daml-helper/src/DA/Daml/Helper/Ledger.hs

@@ -8,6 +8,8 @@ module DA.Daml.Helper.Ledger (
     RemoteDalf(..),
     defaultLedgerFlags,
     sandboxLedgerFlags,
+    LedgerArgs(..),
+    defaultLedgerArgs,
     getDefaultArgs,
     LedgerApi(..),
     L.ClientSSLConfig(..),
@@ -18,6 +20,7 @@ module DA.Daml.Helper.Ledger (
     runLedgerListParties,
     runLedgerAllocateParties,
     runLedgerUploadDar,
+    runLedgerUploadDar',
     runLedgerFetchDar,
     runLedgerExport,
     runLedgerReset,
@@ -114,6 +117,17 @@ sandboxLedgerFlags port = (defaultLedgerFlags Grpc)
   , fPortM = Just port
   }
 
+defaultLedgerArgs :: LedgerApi -> LedgerArgs
+defaultLedgerArgs api = LedgerArgs
+  { api = api
+  , sslConfigM = Nothing
+  , timeout = 10
+  , port = 6865
+  , host = "localhost"
+  , tokM = Nothing
+  , grpcArgs = []
+  }
+
 data LedgerArgs = LedgerArgs
   { api :: LedgerApi
   , sslConfigM :: Maybe L.ClientSSLConfig
@@ -204,8 +218,12 @@ runLedgerAllocateParties flags partiesArg = do
 
 -- | Upload a DAR file to the ledger. (Defaults to project DAR)
 runLedgerUploadDar :: LedgerFlags -> Maybe FilePath -> IO ()
-runLedgerUploadDar flags darPathM = do
+runLedgerUploadDar flags mbDar = do
   args <- getDefaultArgs flags
+  runLedgerUploadDar' args mbDar
+
+runLedgerUploadDar' :: LedgerArgs -> Maybe FilePath -> IO ()
+runLedgerUploadDar' args darPathM  = do
   darPath <-
     flip fromMaybeM darPathM $ do
       doBuild
@@ -640,7 +658,7 @@ runLedgerMeteringReport :: LedgerFlags -> Day -> Maybe Day -> Maybe ApplicationI
 runLedgerMeteringReport flags fromIso toIso application compactOutput = do
     args <- getDefaultArgs flags
     report <- meteringReport args fromIso toIso application
-    let encodeFn = if compactOutput then encode else encodePretty  
+    let encodeFn = if compactOutput then encode else encodePretty
     let encoded = encodeFn report
     let bsc = BSL.toStrict encoded
     let output = BSC.unpack bsc

language-support/hs/bindings/BUILD.bazel

@@ -52,7 +52,7 @@ da_haskell_test(
     data = [
         ":for-tests.dar",
         ":for-upload.dar",
-        "//ledger/sandbox-classic:sandbox-classic-binary",
+        "//ledger/sandbox-on-x:app",
     ],
     # The tests throw flaky timeout errors. It looks like this comes
     # from a fundamental issue in the Haskell bindings: they eagerly pull

libs-haskell/test-utils/BUILD.bazel

@@ -31,6 +31,8 @@ da_haskell_library(
     ],
     visibility = ["//visibility:public"],
     deps = [
+        "//daml-assistant/daml-helper:daml-helper-lib",
+        "//language-support/hs/bindings:hs-ledger",
         "//libs-haskell/bazel-runfiles",
         "//libs-haskell/da-hs-base",
     ],

libs-haskell/test-utils/DA/Test/Sandbox.hs

@@ -16,11 +16,15 @@ module DA.Test.Sandbox
 
 import Control.Exception
 import DA.Bazel.Runfiles
+import DA.Daml.Helper.Ledger
+import Data.Foldable
+import qualified DA.Ledger as L
 import DA.PortFile
 import qualified Data.Aeson as Aeson
 import qualified Data.Map as Map
 import qualified Data.Text as T
 import qualified Data.Vector as Vector
+import qualified Data.Maybe as Maybe
 import System.FilePath
 import System.IO.Extra
 import System.Process
@@ -57,7 +61,7 @@ defaultSandboxConf = SandboxConfig
 
 getSandboxProc :: SandboxConfig -> FilePath -> IO CreateProcess
 getSandboxProc SandboxConfig{..} portFile = do
-    sandbox <- locateRunfiles (mainWorkspace </> "ledger" </> "sandbox-classic" </> exe "sandbox-classic-binary")
+    sandbox <- locateRunfiles (mainWorkspace </> "ledger" </> "sandbox-on-x" </> exe "app")
     tlsArgs <- if enableTls
         then do
             certDir <- locateRunfiles (mainWorkspace </> "ledger" </> "test-common" </> "test-certificates")
@@ -68,29 +72,33 @@ getSandboxProc SandboxConfig{..} portFile = do
                 ]
         else pure []
     pure $ proc sandbox $ concat
-        [ [ "--port=0", "--port-file", portFile ]
+        [ [ "--participant=participant-id=sandbox-participant,port=0,port-file=" <> portFile ]
         , tlsArgs
-        , [ timeArg ]
+        , Maybe.maybeToList timeArg
         , [ "--client-auth=" <> clientAuthArg auth | Just auth <- [mbClientAuth] ]
         , [ "--auth-jwt-hs256-unsafe=" <> secret | Just secret <- [mbSharedSecret] ]
-        , [ "--ledgerid=" <> ledgerId | Just ledgerId <- [mbLedgerId] ]
-        , dars
+        , [ "--ledger-id=" <> ledgerId | Just ledgerId <- [mbLedgerId] ]
+        , [ "--implicit-party-allocation=true" ]
         ]
   where timeArg = case timeMode of
-            WallClock -> "--wall-clock-time"
-            Static -> "--static-time"
+            WallClock -> Nothing
+            Static ->  Just "--static-time"
         clientAuthArg auth = case auth of
             None ->  "none"
             Optional -> "optional"
             Require -> "require"
 
 createSandbox :: FilePath -> Handle -> SandboxConfig -> IO SandboxResource
-createSandbox portFile sandboxOutput conf = do
+createSandbox portFile sandboxOutput conf@SandboxConfig{..} = do
     sandboxProc <- getSandboxProc conf portFile
     mask $ \unmask -> do
         ph@(_,_,_,ph') <- createProcess sandboxProc { std_out = UseHandle sandboxOutput }
         let waitForStart = do
                 port <- readPortFile ph' maxRetries portFile
+                forM_ dars $ \darPath -> do
+                    let args = (defaultLedgerArgs Grpc) { port = port, tokM = fmap (\s -> L.Token $ makeSignedJwt s []) mbSharedSecret }
+                    runLedgerUploadDar' args (Just darPath)
+
                 pure (SandboxResource ph port)
         unmask (waitForStart `onException` cleanupProcess ph)
 
@@ -103,7 +111,6 @@ withSandbox conf f =
                 createSandbox portFile stdout conf
         in withResource createSandbox' destroySandbox (f . fmap sandboxPort)
 
-
 data SandboxResource = SandboxResource
     { sandboxProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
     , sandboxPort :: Int