diff --git a/compiler/damlc/tests/BUILD.bazel b/compiler/damlc/tests/BUILD.bazel index 4e2525f2ed..1efd1e2da1 100644 --- a/compiler/damlc/tests/BUILD.bazel +++ b/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", ], ) diff --git a/compiler/damlc/tests/src/DamlcTest.hs b/compiler/damlc/tests/src/DamlcTest.hs index 7ed2d7d9cd..03d26da2d5 100644 --- a/compiler/damlc/tests/src/DamlcTest.hs +++ b/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) diff --git a/daml-assistant/daml-helper/BUILD.bazel b/daml-assistant/daml-helper/BUILD.bazel index ca289243cd..7b78a729ed 100644 --- a/daml-assistant/daml-helper/BUILD.bazel +++ b/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", + ], +) diff --git a/daml-assistant/daml-helper/src/DA/Daml/Helper/Main.hs b/daml-assistant/daml-helper/src/DA/Daml/Helper/Main.hs index 1725ea39cf..55b4f4bf23 100644 --- a/daml-assistant/daml-helper/src/DA/Daml/Helper/Main.hs +++ b/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 {..} -> diff --git a/daml-assistant/daml-helper/src/DA/Daml/Helper/Run.hs b/daml-assistant/daml-helper/src/DA/Daml/Helper/Run.hs index 96cc28b762..76fc60f165 100644 --- a/daml-assistant/daml-helper/src/DA/Daml/Helper/Run.hs +++ b/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) diff --git a/daml-assistant/daml-helper/test/DA/Daml/Helper/Test.hs b/daml-assistant/daml-helper/test/DA/Daml/Helper/Test.hs new file mode 100644 index 0000000000..c847582966 --- /dev/null +++ b/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 + ] diff --git a/daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Tls.hs b/daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Tls.hs index 530b84d94e..d4b8bc4b02 100644 --- a/daml-assistant/daml-helper/test/DA/Daml/Helper/Test/Tls.hs +++ b/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) - diff --git a/docs/source/tools/assistant.rst b/docs/source/tools/assistant.rst index 6d071f937b..4e25ac50b1 100644 --- a/docs/source/tools/assistant.rst +++ b/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 `` +- Create a new project based on `create-daml-app `_: ``daml create-daml-app `` - Initialize a DAML project: ``daml init`` - Compile a DAML project: ``daml build`` diff --git a/libs-haskell/test-utils/BUILD.bazel b/libs-haskell/test-utils/BUILD.bazel index 0a452035b0..54e98d6100 100644 --- a/libs-haskell/test-utils/BUILD.bazel +++ b/libs-haskell/test-utils/BUILD.bazel @@ -15,6 +15,7 @@ da_haskell_library( "filepath", "process", "tasty", + "tasty-hunit", "text", ], visibility = ["//visibility:public"], diff --git a/libs-haskell/test-utils/DA/Test/Util.hs b/libs-haskell/test-utils/DA/Test/Util.hs index 87264225f4..5e3469bb34 100644 --- a/libs-haskell/test-utils/DA/Test/Util.hs +++ b/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) diff --git a/release/sdk-config.yaml.tmpl b/release/sdk-config.yaml.tmpl index 4b4ebb50ab..893615d023 100644 --- a/release/sdk-config.yaml.tmpl +++ b/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"