Integrate create-daml-app into the assistant (#5152)

* Integrate create-daml-app into the assistant

fixes #4868

changelog_begin

- [DAML Assistant] Add a new ``daml create-daml-app`` command for creating a project based on
  `create-daml-app <https://github.com/digital-asset/create-daml-app>`_.

changelog_end

* Try random things hoping to fix windows

* Try random things hoping to fix things on macos

compiler/damlc/tests/BUILD.bazel

@@ -70,6 +70,7 @@ da_haskell_test(
         "//compiler/damlc/daml-opts:daml-opts-types",
         "//libs-haskell/bazel-runfiles",
         "//libs-haskell/da-hs-base",
+        "//libs-haskell/test-utils",
     ],
 )
 

compiler/damlc/tests/src/DamlcTest.hs

@@ -20,6 +20,7 @@ import qualified Data.ByteString.Lazy.Char8 as BSL (pack)
 import qualified Data.Text.Extended as T
 
 import DA.Bazel.Runfiles
+import DA.Test.Util
 import SdkVersion
 
 main :: IO ()
@@ -246,6 +247,3 @@ callProcessSilent cmd args = do
       hPutStrLn stderr $ unlines ["stdout:", out]
       hPutStrLn stderr $ unlines ["stderr: ", err]
       exitFailure
-
-assertInfixOf :: String -> String -> Assertion
-assertInfixOf needle haystack = assertBool ("Expected " <> show needle <> " in output but but got " <> show haystack) (needle `isInfixOf` haystack)

daml-assistant/daml-helper/BUILD.bazel

@@ -17,10 +17,12 @@ da_haskell_library(
         "base",
         "bytestring",
         "containers",
+        "conduit",
+        "conduit-extra",
         "directory",
         "extra",
         "filepath",
-        "http-client",
+        "http-conduit",
         "http-types",
         "jwt",
         "monad-loops",
@@ -66,7 +68,7 @@ package_app(
 
 da_haskell_test(
     name = "ledger-tls",
-    srcs = glob(["test/**/*.hs"]),
+    srcs = ["test/DA/Daml/Helper/Test/Tls.hs"],
     data = [
         "daml-helper",
         "//ledger/sandbox:sandbox-binary",
@@ -88,3 +90,28 @@ da_haskell_test(
         "//libs-haskell/test-utils",
     ],
 )
+
+# Misc tests for daml-helper that do not deserve their own test suite.
+da_haskell_test(
+    name = "tests",
+    srcs = ["test/DA/Daml/Helper/Test.hs"],
+    data = [
+        "daml-helper",
+    ],
+    hackage_deps = [
+        "base",
+        "directory",
+        "extra",
+        "filepath",
+        "process",
+        "tasty",
+        "tasty-hunit",
+    ],
+    main_function = "DA.Daml.Helper.Test.main",
+    visibility = ["//visibility:public"],
+    deps = [
+        "//libs-haskell/bazel-runfiles",
+        "//libs-haskell/da-hs-base",
+        "//libs-haskell/test-utils",
+    ],
+)

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

@@ -37,6 +37,9 @@ data Command
         , shutdownStdinClose :: Bool
         }
     | New { targetFolder :: FilePath, templateNameM :: Maybe String }
+    | CreateDamlApp { targetFolder :: FilePath }
+    -- ^ CreateDamlApp is sufficiently special that in addition to
+    -- `daml new foobar create-daml-app` we also make `daml create-daml-app foobar` work.
     | Init { targetFolderM :: Maybe FilePath }
     | ListTemplates
     | Start
@@ -65,6 +68,7 @@ commandParser :: Parser Command
 commandParser = subparser $ fold
     [ command "studio" (info (damlStudioCmd <**> helper) forwardOptions)
     , command "new" (info (newCmd <**> helper) idm)
+    , command "create-daml-app" (info (createDamlAppCmd <**> helper) idm)
     , command "init" (info (initCmd <**> helper) idm)
     , command "start" (info (startCmd <**> helper) idm)
     , command "deploy" (info (deployCmd <**> helper) deployCmdInfo)
@@ -106,6 +110,10 @@ commandParser = subparser $ fold
             <*> optional (argument str (metavar "TEMPLATE" <> help ("Name of the template used to create the project (default: " <> defaultProjectTemplate <> ")")))
         ]
 
+    createDamlAppCmd =
+        CreateDamlApp <$>
+        argument str (metavar "TARGET_PATH" <> help "Path where the new project should be located")
+
     initCmd = Init
         <$> optional (argument str (metavar "TARGET_PATH" <> help "Project folder to initialize."))
 
@@ -300,7 +308,10 @@ runCommand = \case
     RunJar {..} ->
         (if shutdownStdinClose then withCloseOnStdin else id) $
         runJar jarPath mbLogbackConfig remainingArguments
-    New {..} -> runNew targetFolder templateNameM [] []
+    New {..}
+        | templateNameM == Just "create-daml-app" -> runCreateDamlApp targetFolder
+        | otherwise -> runNew targetFolder templateNameM [] []
+    CreateDamlApp{..} -> runCreateDamlApp targetFolder
     Init {..} -> runInit targetFolderM
     ListTemplates -> runListTemplates
     Start {..} ->

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

@@ -1,9 +1,11 @@
 -- Copyright (c) 2020 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
+{-# LANGUAGE MultiWayIf #-}
 module DA.Daml.Helper.Run
     ( runDamlStudio
     , runInit
     , runNew
+    , runCreateDamlApp
     , runJar
     , runDaml2ts
     , runListTemplates
@@ -47,14 +49,20 @@ import Control.Concurrent
 import Control.Concurrent.Async
 import Control.Exception.Safe
 import Control.Monad
+import Control.Monad.IO.Class
 import Control.Monad.Extra hiding (fromMaybeM)
 import Control.Monad.Loops (untilJust)
+import Data.Conduit (runConduitRes, (.|))
+import Data.Conduit.Combinators (sinkHandle)
+import qualified Data.Conduit.Tar.Extra as Tar
+import qualified Data.Conduit.Zlib as Zlib
 import Data.Foldable
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe
 import qualified Data.Map.Strict as Map
 import Data.List.Extra
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSChar8
 import qualified Data.ByteString.Lazy.UTF8 as UTF8
 import DA.PortFile
 import qualified Data.Text as T
@@ -63,7 +71,7 @@ import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.IO as TL
 import qualified Data.Yaml as Y
 import qualified Data.Yaml.Pretty as Y
-import qualified Network.HTTP.Client as HTTP
+import qualified Network.HTTP.Simple as HTTP
 import qualified Network.HTTP.Types as HTTP
 import Network.Socket
 import System.FilePath
@@ -645,6 +653,49 @@ runNew targetFolder templateNameM pkgDeps dataDeps = do
         "Created a new project in \"" <> targetFolder <>
         "\" based on the template \"" <> templateName <> "\"."
 
+runCreateDamlApp :: FilePath -> IO ()
+runCreateDamlApp targetFolder = do
+    whenM (doesDirectoryExist targetFolder) $ do
+        hPutStr stderr $ unlines
+            [ "Directory " <> show targetFolder <> " already exists."
+            , "Please specify a new directory or delete the directory."
+            ]
+        exitFailure
+
+    sdkVersion <- getSdkVersion
+    request <- HTTP.parseRequest ("GET " <> url sdkVersion)
+    HTTP.withResponse request $ \response -> do
+        if | HTTP.getResponseStatus response == HTTP.notFound404 -> do
+                 -- We treat 404s specially to provide a better error message.
+                 hPutStrLn stderr $ unlines
+                     [ "create-daml-app is not available for SDK version " <> sdkVersion <> "."
+                     , "You need to use at least SDK version 1.0. If this is a new release,"
+                     , "try again in a few hours."
+                     ]
+                 exitFailure
+           | not (HTTP.statusIsSuccessful $ HTTP.getResponseStatus response) -> do
+                 hPutStrLn stderr $ unlines
+                     [ "Failed to download create-daml-app from " <> show (url sdkVersion) <> "."
+                     , "Verify that your network is working and that you can"
+                     , "access https://github.com/digital-asset/create-daml-app"
+                     ]
+                 hPrint stderr (HTTP.getResponseStatus response)
+                 runConduitRes (HTTP.getResponseBody response .| sinkHandle stderr )
+                 -- trailing newline
+                 BSChar8.hPutStrLn stderr ""
+                 exitFailure
+           | otherwise -> do
+                 -- Successful request so now extract it to the target folder.
+                 let extractError msg e = liftIO $ fail $
+                         "Failed to extract tarball: " <> T.unpack msg <> ": " <> T.unpack e
+                 runConduitRes $
+                     HTTP.getResponseBody response
+                     .| Zlib.ungzip
+                     .| Tar.untar (Tar.restoreFile extractError targetFolder)
+                 putStrLn $ "Created a new DAML app in " <> show targetFolder <> "."
+    where
+        url version = "https://github.com/digital-asset/create-daml-app/archive/v" <> version <> ".tar.gz"
+
 defaultProjectTemplate :: String
 defaultProjectTemplate = "skeleton"
 
@@ -1051,14 +1102,13 @@ waitForConnectionOnPort sleep port = do
 -- Between each connection request it calls `sleep`.
 waitForHttpServer :: IO () -> String -> HTTP.RequestHeaders -> IO ()
 waitForHttpServer sleep url headers = do
-    manager <- HTTP.newManager HTTP.defaultManagerSettings
     request <- HTTP.parseRequest $ "HEAD " <> url
-    request <- pure request { HTTP.requestHeaders = headers }
+    request <- pure (HTTP.setRequestHeaders headers request)
     untilJust $ do
-        r <- tryJust (\e -> guard (isIOException e || isHttpException e)) $ HTTP.httpNoBody request manager
+        r <- tryJust (\e -> guard (isIOException e || isHttpException e)) $ HTTP.httpNoBody request
         case r of
             Right resp
-                | HTTP.statusCode (HTTP.responseStatus resp) == 200 -> pure $ Just ()
+                | HTTP.statusCode (HTTP.getResponseStatus resp) == 200 -> pure $ Just ()
             _ -> sleep *> pure Nothing
     where isIOException e = isJust (fromException e :: Maybe IOException)
           isHttpException e = isJust (fromException e :: Maybe HTTP.HttpException)

daml-assistant/daml-helper/test/DA/Daml/Helper/Test.hs

@@ -0,0 +1,66 @@
+-- Copyright (c) 2020 The DAML Authors. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+module DA.Daml.Helper.Test (main) where
+
+import Control.Monad
+import DA.Bazel.Runfiles
+import DA.Test.Util
+import System.Directory
+import System.Environment.Blank
+import System.Exit
+import System.FilePath
+import System.Info
+import System.IO.Extra
+import System.Process
+import Test.Tasty
+import Test.Tasty.HUnit
+
+main :: IO ()
+main = do
+    setEnv "TASTY_NUM_THREADS" "1" True
+    when (os == "darwin") $ do
+        -- x509-system insists on trying to locate `security`
+        -- in PATH to find the root certificate store.
+        mbPath <- getEnv "PATH"
+        setEnv "PATH" (maybe "/usr/bin" ("/usr/bin:" <>) mbPath) True
+    damlHelper <- locateRunfiles (mainWorkspace </> "daml-assistant" </> "daml-helper" </> exe "daml-helper")
+    defaultMain $
+        testGroup "daml-helper"
+            [ createDamlAppTests damlHelper
+            ]
+
+createDamlAppTests :: FilePath -> TestTree
+createDamlAppTests damlHelper = testGroup "create-daml-app"
+    [ testCase "Succeeds with SDK 0.13.55" $ withTempDir $ \dir -> do
+          env <- getEnvironment
+          (exit, out, err) <- readCreateProcessWithExitCode
+              (proc damlHelper ["create-daml-app", dir </> "foobar"])
+                   { env = Just (("DAML_SDK_VERSION", "0.13.55") : env) }
+              ""
+          err @?= ""
+          assertInfixOf "Created" out
+          exit @?= ExitSuccess
+          assertBool "daml.yaml does not exist" =<<
+              doesFileExist (dir </> "foobar" </> "daml.yaml")
+    , testCase "Fails with SDK 0.0.1" $ withTempDir $ \dir -> do
+          -- Note that we do not test 0.0.0 since people
+          -- might be tempted to create that tag temporarily for
+          -- testing purposes.
+          env <- getEnvironment
+          (exit, out, err) <- readCreateProcessWithExitCode
+              (proc damlHelper ["create-daml-app", dir </> "foobar"])
+                   { env = Just (("DAML_SDK_VERSION", "0.0.1") : env) }
+              ""
+          assertInfixOf "not available for SDK version 0.0.1" err
+          out @?= ""
+          exit @?= ExitFailure 1
+    , testCase "Fails if directory already exists" $ withTempDir $ \dir -> do
+          createDirectory (dir </> "foobar")
+          (exit, out, err) <- readCreateProcessWithExitCode
+              (proc damlHelper ["create-daml-app", dir </> "foobar"])
+              ""
+          assertInfixOf "already exists" err
+          out @?= ""
+          exit @?= ExitFailure 1
+    ]

daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Tls.hs

@@ -5,7 +5,7 @@ module DA.Daml.Helper.Test.Tls (main) where
 
 import DA.Bazel.Runfiles
 import DA.Test.Sandbox
-import Data.List.Extra (isInfixOf)
+import DA.Test.Util
 import System.Environment.Blank
 import System.Exit
 import System.FilePath
@@ -75,7 +75,3 @@ main = do
                            assertInfixOf "no parties are known" out
                      ]
            ]
-
-assertInfixOf :: String -> String -> Assertion
-assertInfixOf needle haystack = assertBool ("Expected " <> show needle <> " in output but but got " <> show haystack) (needle `isInfixOf` haystack)
-

docs/source/tools/assistant.rst

@@ -7,6 +7,7 @@ DAML Assistant (``daml``)
 ``daml`` is a command-line tool that does a lot of useful things related to the SDK. Using ``daml``, you can:
 
 - Create new DAML projects: ``daml new <path to create project in>``
+- Create a new project based on `create-daml-app <https://github.com/digital-asset/create-daml-app>`_: ``daml create-daml-app <path to create project in>``
 - Initialize a DAML project: ``daml init``
 - Compile a DAML project: ``daml build``
 

libs-haskell/test-utils/BUILD.bazel

@@ -15,6 +15,7 @@ da_haskell_library(
         "filepath",
         "process",
         "tasty",
+        "tasty-hunit",
         "text",
     ],
     visibility = ["//visibility:public"],

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

@@ -4,10 +4,13 @@
 -- | Test utils
 module DA.Test.Util (
     standardizeQuotes,
-    standardizeEoL
+    standardizeEoL,
+    assertInfixOf
 ) where
 
+import Data.List.Extra (isInfixOf)
 import qualified Data.Text as T
+import Test.Tasty.HUnit
 
 standardizeQuotes :: T.Text -> T.Text
 standardizeQuotes msg = let
@@ -19,3 +22,6 @@ standardizeQuotes msg = let
 
 standardizeEoL :: T.Text -> T.Text
 standardizeEoL = T.replace (T.singleton '\r') T.empty
+
+assertInfixOf :: String -> String -> Assertion
+assertInfixOf needle haystack = assertBool ("Expected " <> show needle <> " in output but but got " <> show haystack) (needle `isInfixOf` haystack)

release/sdk-config.yaml.tmpl

@@ -10,6 +10,11 @@ commands:
   desc: "Create a new DAML project"
   args: ["new"]
   completion: true
+- name: create-daml-app
+  path: daml-helper/daml-helper
+  desc: "Create a new DAML project based on create-daml-app (experimental)"
+  args: ["create-daml-app"]
+  completion: true
 - name: init
   path: daml-helper/daml-helper
   desc: "Configure a folder as a DAML project"