digital-asset/daml
1
1
Fork 0
mirror of https://github.com/digital-asset/daml.git synced 2024-09-17 15:57:21 +03:00
Code Issues Projects Releases Wiki Activity

Make daml version display installed SDK versions like da list. (#1114)

Browse Source 
* Separate version logic out of DAML.Assistant.Env.

* Refactoring some of the exception handling.

* Update daml version command.

* Uncommit linting atrocity.
This commit is contained in:
A. F. Mota 2019-05-14 08:46:55 +02:00 committed by GitHub
parent a244579470
commit 838b81d3da
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 183 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
daml-assistant/BUILD.bazel
View File

@ -81,6 +81,7 @@ da_haskell_binary(
"filepath",
"process",
"safe-exceptions",
"text",
],
main_function = "DAML.Assistant.main",
src_strip_prefix = "exe",

73
daml-assistant/exe/DAML/Assistant.hs
View File

@ -11,6 +11,7 @@ import DAML.Project.Config
import DAML.Assistant.Types
import DAML.Assistant.Env
import DAML.Assistant.Command
import DAML.Assistant.Version
import DAML.Assistant.Install
import DAML.Assistant.Util
import System.FilePath
@ -21,6 +22,9 @@ import System.Exit
import System.IO
import Control.Exception.Safe
import Data.Maybe
import Data.List.Extra
import Data.Either.Extra
import qualified Data.Text as T
import Control.Monad.Extra
-- | Run the assistant and exit.
@ -42,25 +46,23 @@ main = displayErrors $ do
-- Project SDK version is outdated.
when (not isHead && projectSdkVersionIsOld) $ do
hPutStrLn stderr . unlines $
hPutStr stderr . unlines $
[ "WARNING: Using an outdated version of the DAML SDK in project."
, ""
, "Please set the sdk-version in the project config daml.yaml"
, "to the latest stable version " <> versionToString latestVersion
<> " like this:"
, ""
, "sdk-version: " <> versionToString latestVersion
, " sdk-version: " <> versionToString latestVersion
, ""
]
-- DAML assistant is outdated.
when (not isHead && not projectSdkVersionIsOld && assistantVersionIsOld) $ do
hPutStrLn stderr . unlines $
hPutStr stderr . unlines $
[ "WARNING: Using an outdated version of the DAML assistant."
, ""
, "Please upgrade to the latest stable version by running:"
, ""
, "daml install latest --activate --force"
, " daml install latest --activate --force"
, ""
]
@ -69,15 +71,56 @@ main = displayErrors $ do
case userCommand of
Builtin Version -> do
putStr . unlines $
[ "SDK version: "
<> maybe "unknown" versionToString envSdkVersion
, "Latest stable release: "
<> maybe "unknown" versionToString envLatestStableSdkVersion
, "Assistant version: "
<> maybe "unknown" (versionToString . unwrapDamlAssistantSdkVersion)
envDamlAssistantSdkVersion
]
installedVersionsE <- tryAssistant $ getInstalledSdkVersions envDamlPath
defaultVersionM <- tryAssistantM $ getDefaultSdkVersion envDamlPath
let asstVersion = unwrapDamlAssistantSdkVersion <$> envDamlAssistantSdkVersion
envVersions = catMaybes
[ envSdkVersion
, envLatestStableSdkVersion
, asstVersion
]
isInstalled =
case installedVersionsE of
Left _ -> const True
Right vs -> (`elem` vs)
versionAttrs v = catMaybes
[ "active"
<$ guard (Just v == envSdkVersion)
, "default"
<$ guard (Just v == defaultVersionM)
, "assistant"
<$ guard (Just v == asstVersion)
, "latest release"
<$ guard (Just v == envLatestStableSdkVersion)
, "not installed"
<$ guard (not (isInstalled v))
]
-- | Workaround for Data.SemVer old unfixed bug (see https://github.com/brendanhay/semver/pull/6)
-- TODO: move away from Data.SemVer...
versionCompare v1 v2 =
if v1 == v2
then EQ
else compare v1 v2
versions = nubSortBy versionCompare (envVersions ++ fromRight [] installedVersionsE)
versionTable = [ (versionToText v, versionAttrs v) | v <- versions ]
versionWidth = maximum (1 : map (T.length . fst) versionTable)
versionLines =
[ T.concat
[ " "
, v
, T.replicate (versionWidth - T.length v) " "
, if null attrs
then ""
else " (" <> T.intercalate ", " attrs <> ")"
]
| (v,attrs) <- versionTable ]
putStr . unpack $ T.unlines ("DAML SDK versions:" : versionLines)
Builtin (Install options) -> wrapErr "Installing the SDK." $ do
install options envDamlPath envProjectPath

3
daml-assistant/src/DAML/Assistant/Cache.hs
View File

@ -8,6 +8,7 @@ module DAML.Assistant.Cache
) where
import DAML.Assistant.Types
import DAML.Assistant.Util
import DAML.Project.Config
import Control.Exception.Safe
import Control.Monad.Extra
@ -40,7 +41,7 @@ cacheLatestSdkVersion
-> IO (Maybe SdkVersion)
-> IO (Maybe SdkVersion)
cacheLatestSdkVersion damlPath getVersion = do
damlConfigE <- try $ readDamlConfig damlPath
damlConfigE <- tryConfig $ readDamlConfig damlPath
let updateCheckM = join $ eitherToMaybe (queryDamlConfig ["update-check"] =<< damlConfigE)
defaultUpdateCheck = UpdateCheckEvery (CacheTimeout 86400)
case fromMaybe defaultUpdateCheck updateCheckM of

79
daml-assistant/src/DAML/Assistant/Env.hs
View File

@ -21,7 +21,7 @@ module DAML.Assistant.Env
import DAML.Assistant.Types
import DAML.Assistant.Util
import DAML.Assistant.Cache
import DAML.Assistant.Version
import DAML.Assistant.Install
import DAML.Project.Config
import DAML.Project.Consts hiding (getDamlPath, getProjectPath)
@ -34,7 +34,6 @@ import Control.Monad.Extra
import Control.Exception.Safe
import Data.Maybe
import Data.Either.Extra
import Safe
-- | Get a minimal environment in which to run daml install.
getMinimalDamlEnv :: IO Env
@ -88,26 +87,12 @@ overrideWithEnvVarMaybe envVar parse calculate = do
("Invalid value for environment variable " <> pack envVar <> ".")
(parse value)
-- | Get the latest stable SDK version. Can be overriden with
-- DAML_SDK_LATEST_VERSION environment variable.
getLatestStableSdkVersion :: DamlPath -> IO (Maybe SdkVersion)
getLatestStableSdkVersion damlPath =
overrideWithEnvVarMaybe sdkVersionLatestEnvVar (parseVersion . pack) $
getLatestStableSdkVersionDefault damlPath
-- | Get the latest stable SDK version. Designed to return Nothing if
-- anything fails (e.g. machine is offline). The result is cached in
-- $DAML_HOME/cache/latest-sdk-version.txt and only polled once a day.
getLatestStableSdkVersionDefault :: DamlPath -> IO (Maybe SdkVersion)
getLatestStableSdkVersionDefault damlPath =
cacheLatestSdkVersion damlPath $ do
versionE :: Either AssistantError SdkVersion
<- try getLatestVersion
pure (eitherToMaybe versionE)
getLatestSdkVersionCached damlPath
-- | Determine the viability of running sdk commands in the environment.
-- Returns the first failing test's error message.
@ -154,22 +139,7 @@ getDamlAssistantSdkVersion :: IO (Maybe DamlAssistantSdkVersion)
getDamlAssistantSdkVersion =
overrideWithEnvVarMaybe damlAssistantVersionEnvVar
(fmap DamlAssistantSdkVersion . parseVersion . pack)
getDamlAssistantSdkVersionDefault
-- | Determine SDK version of running daml assistant.
getDamlAssistantSdkVersionDefault :: IO (Maybe DamlAssistantSdkVersion)
getDamlAssistantSdkVersionDefault = fmap DamlAssistantSdkVersion <$> do
exePath <- getExecutablePath
sdkPathM <- fmap SdkPath <$> findM hasSdkConfig (ascendants exePath)
case sdkPathM of
Nothing -> pure Nothing
Just sdkPath -> do
sdkConfigE <- try $ readSdkConfig sdkPath
pure $ eitherToMaybe (sdkVersionFromSdkConfig =<< sdkConfigE)
where
hasSdkConfig :: FilePath -> IO Bool
hasSdkConfig p = doesFileExist (p </> sdkConfigName)
(fmap DamlAssistantSdkVersion <$> tryAssistantM getAssistantSdkVersion)
-- | Determine absolute path of daml home directory.
--
@ -213,7 +183,6 @@ getProjectPath = wrapErr "Detecting daml project." $ do
hasProjectConfig :: FilePath -> IO Bool
hasProjectConfig p = doesFileExist (p </> projectConfigName)
-- | Calculate the current SDK version and path.
--
-- These can be overriden by the environment variables DAML_SDK_VERSION
@ -227,13 +196,13 @@ getSdk damlPath damlAsstSdkVersionM projectPathM =
wrapErr "Determining SDK version and path." $ do
sdkVersion <- overrideWithEnvVarMaybe sdkVersionEnvVar (parseVersion . pack) $ firstJustM id
[ fromConfig "SDK" (getEnv sdkPathEnvVar)
(readSdkConfig . SdkPath)
(fmap Just . sdkVersionFromSdkConfig)
, fromConfig "project" (pure projectPathM)
readProjectConfig
sdkVersionFromProjectConfig
, getLatestInstalledSdkVersion damlPath
[ maybeM (pure Nothing)
(tryAssistantM . getSdkVersionFromSdkPath . SdkPath)
(getEnv sdkPathEnvVar)
, maybe (pure Nothing)
(tryAssistantM . getSdkVersionFromProjectPath)
projectPathM
, tryAssistantM $ getDefaultSdkVersion damlPath
]
sdkPath <- overrideWithEnvVarMaybe @SomeException sdkPathEnvVar (Right . SdkPath) $ firstJustM id
@ -244,18 +213,6 @@ getSdk damlPath damlAsstSdkVersionM projectPathM =
return (sdkVersion, sdkPath)
where
fromConfig :: Text
-> IO (Maybe path)
-> (path -> IO config)
-> (config -> Either ConfigError (Maybe SdkVersion))
-> IO (Maybe SdkVersion)
fromConfig name lookupPath readConfig parseVersion =
wrapErr ("Determining SDK version from " <> name <> " config.") $ do
pathM <- lookupPath
fmap join . forM pathM $ \path -> do
config <- readConfig path
fromRightM throwIO (parseVersion config)
useInstalledPath :: DamlPath -> Maybe SdkVersion -> IO (Maybe SdkPath)
useInstalledPath _ Nothing = pure Nothing
useInstalledPath damlPath (Just sdkVersion) = do
@ -263,19 +220,6 @@ getSdk damlPath damlAsstSdkVersionM projectPathM =
test <- doesDirectoryExist (unwrapSdkPath sdkPath)
pure (guard test >> Just sdkPath)
-- | Determine the latest installed version of the SDK.
getLatestInstalledSdkVersion :: DamlPath -> IO (Maybe SdkVersion)
getLatestInstalledSdkVersion (DamlPath path) = do
let dpath = path </> "sdk"
wrapErr "Determining latest installed sdk version." $ do
dirlistE <- tryIO $ listDirectory dpath
case dirlistE of
Left _ -> pure Nothing
Right dirlist -> do
subdirs <- filterM (doesDirectoryExist . (dpath </>)) dirlist
let versions = mapMaybe (eitherToMaybe . parseVersion . pack) subdirs
pure $ maximumMay (filter isStableVersion versions)
-- | Calculate the environment for dispatched commands (i.e. the environment
-- with updated DAML_HOME, DAML_PROJECT, DAML_SDK, etc).
getDispatchEnv :: Env -> IO [(String, String)]
@ -293,7 +237,6 @@ getDispatchEnv Env{..} = do
envDamlAssistantSdkVersion)
]
-- | Auto-installs requested version if it is missing and updates daml-assistant
-- if it is the latest stable version.
autoInstall
@ -302,7 +245,7 @@ autoInstall
-> Maybe SdkVersion
-> IO (Maybe SdkPath)
autoInstall damlPath damlAsstSdkVersionM sdkVersionM = do
damlConfigE <- try $ readDamlConfig damlPath
damlConfigE <- tryConfig $ readDamlConfig damlPath
let doAutoInstallE = queryDamlConfigRequired ["auto-install"] =<< damlConfigE
doAutoInstall = fromRight True doAutoInstallE
whenMaybe (doAutoInstall && isJust sdkVersionM) $ do

16
daml-assistant/src/DAML/Assistant/Util.hs
View File

@ -5,7 +5,6 @@ module DAML.Assistant.Util
( module DAML.Assistant.Util
, ascendants
, fromRightM
, fromMaybeM
) where
import DAML.Assistant.Types
@ -13,7 +12,8 @@ import DAML.Project.Util
import System.Exit
import Control.Exception.Safe
import Control.Applicative
import Control.Monad.Extra hiding (fromMaybeM)
import Control.Monad.Extra
import Data.Either.Extra
-- | Throw an assistant error.
throwErr :: Text -> IO a
@ -40,6 +40,18 @@ wrapErr ctx m = m `catches`
addErrorContext err =
err { errContext = errContext err <|> Just ctx }
-- | Catch a config error.
tryConfig :: IO t -> IO (Either ConfigError t)
tryConfig = try
-- | Catch an assistant error.
tryAssistant :: IO t -> IO (Either AssistantError t)
tryAssistant = try
-- | Catch an assistant error and ignore the error case.
tryAssistantM :: IO t -> IO (Maybe t)
tryAssistantM m = eitherToMaybe <$> tryAssistant m
-- | Throw an assistant error if the passed value is Nothing.
-- Otherwise return the underlying value.

96
daml-assistant/src/DAML/Assistant/Version.hs Normal file
View File

@ -0,0 +1,96 @@
-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE OverloadedStrings #-}
module DAML.Assistant.Version
( getInstalledSdkVersions
, getLatestSdkVersionCached
, getSdkVersionFromSdkPath
, getSdkVersionFromProjectPath
, getAssistantSdkVersion
, getDefaultSdkVersion
) where
import DAML.Assistant.Types
import DAML.Assistant.Util
import DAML.Assistant.Cache
import DAML.Assistant.Install
import DAML.Project.Config
import DAML.Project.Consts hiding (getDamlPath, getProjectPath)
import System.Directory
import System.FilePath
import System.Environment.Blank
import Control.Monad.Extra
import Data.Maybe
import Data.Either.Extra
import Safe
-- | Get the latest released SDK version. Designed to return Nothing if
-- anything fails (e.g. machine is offline). The result is cached in
-- $DAML_HOME/cache/latest-sdk-version.txt and only polled once a day.
getLatestSdkVersionCached :: DamlPath -> IO (Maybe SdkVersion)
getLatestSdkVersionCached damlPath =
cacheLatestSdkVersion damlPath $ do
tryAssistantM getLatestVersion
-- | Determine SDK version of running daml assistant. Fails with an
-- AssistantError exception if the version cannot be determined.
getAssistantSdkVersion :: IO SdkVersion
getAssistantSdkVersion = do
exePath <- requiredIO "Failed to determine executable path of assistant."
getExecutablePath
sdkPath <- required "Failed to determine SDK path of assistant." =<<
findM hasSdkConfig (ascendants exePath)
getSdkVersionFromSdkPath (SdkPath sdkPath)
where
hasSdkConfig :: FilePath -> IO Bool
hasSdkConfig p = doesFileExist (p </> sdkConfigName)
-- | Determine SDK version from an SDK directory. Fails with an
-- AssistantError exception if the version cannot be determined.
getSdkVersionFromSdkPath :: SdkPath -> IO SdkVersion
getSdkVersionFromSdkPath sdkPath = do
config <- requiredIO "Failed to read SDK config." $
readSdkConfig sdkPath
requiredE "Failed to parse SDK version from SDK config." $
sdkVersionFromSdkConfig config
-- | Determine SDK version from project root. Fails with an
-- AssistantError exception if the version cannot be determined.
getSdkVersionFromProjectPath :: ProjectPath -> IO SdkVersion
getSdkVersionFromProjectPath projectPath = do
config <- requiredIO "Failed to read project config." $
readProjectConfig projectPath
versionM <- requiredE "Failed to parse SDK version from project config." $
sdkVersionFromProjectConfig config
required "SDK version missing from project config." versionM
-- | Get the list of installed SDK versions. Returned list is
-- in no particular order. Fails with an AssistantError exception
-- if this list cannot be obtained.
getInstalledSdkVersions :: DamlPath -> IO [SdkVersion]
getInstalledSdkVersions (DamlPath path) = do
let sdkdir = path </> "sdk"
subdirs <- requiredIO "Failed to list installed SDKs." $ do
dirlist <- listDirectory sdkdir
filterM (\p -> doesDirectoryExist (sdkdir </> p)) dirlist
pure (mapMaybe (eitherToMaybe . parseVersion . pack) subdirs)
-- | Get the default SDK version for commands run outside of a
-- project. This is defined as the latest installed version
-- without a release tag (e.g. this will prefer version 0.12.17
-- over version 0.12.18-nightly even though the latter came later).
--
-- Raises an AssistantError exception if the version cannot be
-- obtained, either because we cannot determine the installed
-- versions or it is empty.
getDefaultSdkVersion :: DamlPath -> IO SdkVersion
getDefaultSdkVersion damlPath = do
installedVersions <- getInstalledSdkVersions damlPath
required "There are no installed SDK versions." $
maximumMay (filter isStableVersion installedVersions)

2
daml-assistant/test/DAML/Assistant/Tests.hs
View File

@ -76,7 +76,7 @@ main = do
assertError :: Text -> Text -> IO a -> IO ()
assertError ctxPattern msgPattern action = do
result <- try action
result <- tryAssistant action
case result of
Left AssistantError{..} -> do
Tasty.assertBool ("Error context pattern does not match error. Expected: " <> show ctxPattern <> ". Got: " <> show errContext <> ".") (ctxPattern `T.isInfixOf` fromMaybe "" errContext)