Support split release artifactory, improve missing connection errors (#18271)

* Add resolution via artifactory, handle HTTP errors

* Replace origin with wrapErr in resolveReleaseVersionUnsafe

* Handle broken connections (e.g. no internet)

* drop comment, fix foldMap id to fold

* remove debugging writeFile calls

run-all-tests: true

* Rename partial field damlPath to damlPathUnsafe and add safe function

* support multiple possible installation locations

* update alternatives

* Wrap CouldNotResolveReleaseVersion into AssistantError in unsafe resolve
This commit is contained in:
dylant-da 2024-02-13 12:28:32 +00:00 committed by GitHub
parent b0006c84d6
commit 74a9d98a1f
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
10 changed files with 399 additions and 182 deletions

View File

@ -93,7 +93,8 @@ import DA.Daml.Project.Types
ProjectPath(..),
ProjectConfig,
unsafeResolveReleaseVersion)
import DA.Daml.Assistant.Version (resolveReleaseVersion)
import DA.Daml.Assistant.Version (resolveReleaseVersionUnsafe)
import DA.Daml.Assistant.Util (wrapErr)
import qualified DA.Daml.Compiler.Repl as Repl
import DA.Daml.Compiler.DocTest (docTest)
import DA.Daml.Desugar (desugar)
@ -921,7 +922,8 @@ installDepsAndInitPackageDb opts (InitPkgDb shouldInit) =
then do
damlPath <- getDamlPath
damlEnv <- getDamlEnv damlPath (LookForProjectPath False)
resolveReleaseVersion (envUseCache damlEnv) pSdkVersion
wrapErr "installing dependencies and initializing package database" $
resolveReleaseVersionUnsafe (envUseCache damlEnv) pSdkVersion
else pure (unsafeResolveReleaseVersion pSdkVersion)
installDependencies
(toNormalizedFilePath' projRoot)
@ -1613,7 +1615,8 @@ execDocTest opts scriptDar (ImportSource importSource) files =
then do
damlPath <- getDamlPath
damlEnv <- getDamlEnv damlPath (LookForProjectPath False)
resolveReleaseVersion (envUseCache damlEnv) SdkVersion.Class.unresolvedBuiltinSdkVersion
wrapErr "running doc test" $
resolveReleaseVersionUnsafe (envUseCache damlEnv) SdkVersion.Class.unresolvedBuiltinSdkVersion
else pure (unsafeResolveReleaseVersion SdkVersion.Class.unresolvedBuiltinSdkVersion)
installDependencies "." opts releaseVersion [scriptDar] []
createProjectPackageDb "." opts mempty

View File

@ -67,6 +67,7 @@ da_haskell_library(
"tls",
"typed-process",
"unix-compat",
"uri-encode",
"utf8-string",
"yaml",
] + (["Win32"] if is_windows else []),

View File

@ -200,7 +200,7 @@ runCommand env@Env{..} = \case
let useCache =
UseCache
{ cachePath = envCachePath
, damlPath = envDamlPath
, damlPathUnsafe = envDamlPath
, overrideTimeout = if vForceRefresh then Just (CacheTimeout 1) else Nothing
}
installedVersionsE <- tryAssistant $ getInstalledSdkVersions envDamlPath
@ -279,8 +279,8 @@ runCommand env@Env{..} = \case
install options envDamlPath (envUseCache env) envProjectPath envDamlAssistantSdkVersion
Builtin (Uninstall unresolvedVersion) -> do
version <- resolveReleaseVersion (envUseCache env) unresolvedVersion
uninstallVersion env version
versionOrErr <- resolveReleaseVersion (envUseCache env) unresolvedVersion
uninstallVersion env versionOrErr
Builtin (Exec cmd args) -> do
wrapErr "Running executable in daml environment." $ do

View File

@ -6,6 +6,7 @@ module DA.Daml.Assistant.Cache
( cacheAvailableSdkVersions
, CacheAge (..)
, UseCache (..)
, damlPath
, cacheWith
, loadFromCacheWith
, saveToCacheWith
@ -53,17 +54,21 @@ data UseCache
= UseCache
{ overrideTimeout :: Maybe CacheTimeout
, cachePath :: CachePath
, damlPath :: DamlPath
, damlPathUnsafe :: DamlPath
}
| DontUseCache
deriving (Show, Eq)
damlPath :: UseCache -> Maybe DamlPath
damlPath DontUseCache = Nothing
damlPath UseCache { damlPathUnsafe } = Just damlPathUnsafe
cacheAvailableSdkVersions
:: UseCache
-> (Maybe [ReleaseVersion] -> IO [ReleaseVersion])
-> IO ([ReleaseVersion], CacheAge)
cacheAvailableSdkVersions DontUseCache getVersions = (, Fresh) <$> getVersions Nothing
cacheAvailableSdkVersions UseCache { overrideTimeout, cachePath, damlPath } getVersions = do
cacheAvailableSdkVersions UseCache { overrideTimeout, cachePath, damlPathUnsafe = damlPath } getVersions = do
damlConfigE <- tryConfig $ readDamlConfig damlPath
let configUpdateCheckM = join $ eitherToMaybe (queryDamlConfig ["update-check"] =<< damlConfigE)
(neverRefresh, timeout)

View File

@ -50,7 +50,7 @@ envUseCache Env {..} =
mkUseCache :: CachePath -> DamlPath -> UseCache
mkUseCache cachePath damlPath =
UseCache { cachePath, damlPath, overrideTimeout = Nothing }
UseCache { cachePath, damlPathUnsafe = damlPath, overrideTimeout = Nothing }
-- | (internal) Override function with environment variable
-- if it is available.
@ -108,7 +108,7 @@ getFreshStableSdkVersionForCheck useCache = do
parsed <- requiredE
("Invalid value for environment variable " <> pack sdkVersionLatestEnvVar <> ".")
(parseVersion (pack value))
pure (Just <$> resolveReleaseVersion useCache parsed)
pure (Just <$> resolveReleaseVersionUnsafe useCache parsed)
-- | Determine the viability of running sdk commands in the environment.
-- Returns the first failing test's error message.
@ -152,7 +152,7 @@ getDamlAssistantPathDefault (DamlPath damlPath) =
getDamlAssistantSdkVersion :: UseCache -> IO (Maybe DamlAssistantSdkVersion)
getDamlAssistantSdkVersion useCache =
overrideWithEnvVarMaybeIO damlAssistantVersionEnvVar pure
(fmap (fmap DamlAssistantSdkVersion) . traverse (resolveReleaseVersion useCache) . parseVersion . pack)
(fmap (fmap DamlAssistantSdkVersion) . traverse (resolveReleaseVersionUnsafe useCache) . parseVersion . pack)
(fmap DamlAssistantSdkVersion <$> tryAssistantM (getAssistantSdkVersion useCache))
-- | Determine absolute path of daml home directory.
@ -223,14 +223,23 @@ getSdk :: UseCache
-> IO (Maybe ReleaseVersion, Maybe SdkPath)
getSdk useCache damlPath projectPathM =
wrapErr "Determining SDK version and path." $ do
releaseVersion <- overrideWithEnvVarMaybeIO sdkVersionEnvVar pure (traverse (resolveReleaseVersion useCache) . parseVersion . pack) $ firstJustM id
[ maybeM (pure Nothing)
(tryAssistantM . getReleaseVersionFromSdkPath useCache . SdkPath)
(getEnv sdkPathEnvVar)
, mapM (getSdkVersionFromProjectPath useCache) projectPathM
, tryAssistantM $ getDefaultSdkVersion damlPath
]
releaseVersion <-
let parseAndResolve =
traverse (resolveReleaseVersionUnsafe useCache) .
parseVersion .
pack
in
overrideWithEnvVarMaybeIO
sdkVersionEnvVar
pure
parseAndResolve $
firstJustM id
[ maybeM (pure Nothing)
(tryAssistantM . getReleaseVersionFromSdkPath useCache . SdkPath)
(getEnv sdkPathEnvVar)
, mapM (getSdkVersionFromProjectPath useCache) projectPathM
, tryAssistantM $ getDefaultSdkVersion damlPath
]
sdkPath <- overrideWithEnvVarMaybe @SomeException sdkPathEnvVar makeAbsolute (Right . SdkPath) $
useInstalledPath damlPath releaseVersion

View File

@ -22,7 +22,7 @@ import DA.Daml.Assistant.Util
import qualified DA.Daml.Assistant.Version as DAVersion
import DA.Daml.Assistant.Install.Path
import DA.Daml.Assistant.Install.Completion
import DA.Daml.Assistant.Version (getLatestSdkSnapshotVersion, getLatestReleaseVersion, UseCache (..), resolveSdkVersionToRelease)
import DA.Daml.Assistant.Version (getLatestSdkSnapshotVersion, getLatestReleaseVersion, UseCache (..), resolveSdkVersionToRelease, CouldNotResolveReleaseVersion(..))
import DA.Daml.Assistant.Cache (CacheTimeout (..))
import DA.Daml.Project.Consts
import DA.Daml.Project.Config
@ -52,6 +52,7 @@ import Options.Applicative.Extended (determineAuto)
import qualified Data.SemVer as V
import qualified Data.Text as T
import qualified Control.Exception
import qualified Data.List.NonEmpty as NonEmpty
-- unix specific
import System.PosixCompat.Types ( FileMode )
@ -371,19 +372,39 @@ httpInstall env@InstallEnv{targetVersionM = releaseVersion, ..} = do
!firstEEVersion =
let verStr = "1.12.0-snapshot.20210312.6498.0.707c86aa"
in either Control.Exception.throw id (unsafeParseOldReleaseVersion verStr)
downloadLocation :: DAVersion.InstallLocation -> IO ()
downloadLocation (DAVersion.HttpInstallLocation url headers) = do
request <- requiredAny "Failed to parse HTTPS request." $ parseRequest ("GET " <> unpack url)
withResponse (setRequestHeaders headers request) $ \response -> do
when (getResponseStatusCode response /= 200) $
throwIO . assistantErrorBecause ("Failed to download release from " <> url <> ".")
. pack . show $ getResponseStatus response
let totalSizeM = readMay . BS.UTF8.toString =<< headMay (getResponseHeader "Content-Length" response)
extractAndInstall (fmap Just env)
. maybe id (\s -> (.| observeProgress s)) totalSizeM
$ getResponseBody response
downloadLocation (DAVersion.HttpInstallLocations (location NonEmpty.:| alternatives)) = do
installationSucceeded <- go location alternatives
when (not installationSucceeded) $
throwIO $ assistantError "Could not download release from any of the following locations: "
where
go :: DAVersion.HttpInstallLocation -> [DAVersion.HttpInstallLocation] -> IO Bool
go location alternatives = do
location <- try (downloadHttpLocation location)
case location of
Left err@AssistantError {} -> do
hPutStrLn stderr $ displayException err
case alternatives of
[] -> pure False
(next:rest) -> go next rest
Right () -> pure True
downloadHttpLocation :: DAVersion.HttpInstallLocation -> IO ()
downloadHttpLocation (DAVersion.HttpInstallLocation url headers name) = do
hPutStrLn stderr $ "Trying to install version via HTTP from " <> T.unpack name
request <- requiredAny "Failed to parse HTTPS request." $ parseRequest ("GET " <> unpack url)
withResponse (setRequestHeaders headers request) $ \response -> do
when (getResponseStatusCode response /= 200) $
throwIO . assistantErrorBecause ("Failed to download release from " <> url <> ".")
. pack . show $ getResponseStatus response
let totalSizeM = readMay . BS.UTF8.toString =<< headMay (getResponseHeader "Content-Length" response)
extractAndInstall (fmap Just env)
. maybe id (\s -> (.| observeProgress s)) totalSizeM
$ getResponseBody response
downloadLocation (DAVersion.FileInstallLocation file) =
extractAndInstall (fmap Just env) (sourceFileBS file)
observeProgress :: MonadResource m =>
Int -> ConduitT BS.ByteString BS.ByteString m ()
observeProgress totalSize = do
@ -468,24 +489,26 @@ versionInstall env@InstallEnv{targetVersionM = version, ..} = withInstallLock en
-- | Install the latest version of the SDK.
latestInstall :: InstallEnvWithoutVersion -> IO ()
latestInstall env@InstallEnv{..} = do
version1 <- getLatestReleaseVersion useCache
-- override the cache if it's older than 1 day, even if daml-config.yaml says otherwise
{ overrideTimeout = Just (CacheTimeout 86400)
}
version2M <- if iSnapshots options
then tryAssistantM $ getLatestSdkSnapshotVersion useCache
else pure Nothing
let version = maybe version1 (max version1) version2M
versionInstall env { targetVersionM = version }
latestInstall env@InstallEnv{..} =
wrapErr "Installing latest daml version" $ do
version1 <- getLatestReleaseVersion useCache
-- override the cache if it's older than 1 day, even if daml-config.yaml says otherwise
{ overrideTimeout = Just (CacheTimeout 86400)
}
version2M <- if iSnapshots options
then tryAssistantM $ getLatestSdkSnapshotVersion useCache
else pure Nothing
let version = maybe version1 (max version1) version2M
versionInstall env { targetVersionM = version }
-- | Install the SDK version of the current project.
projectInstall :: InstallEnvWithoutVersion -> ProjectPath -> IO ()
projectInstall env projectPath = do
wrapErr "Installing daml version in project config (daml.yaml)" $ do
projectConfig <- readProjectConfig projectPath
unresolvedVersionM <- fromRightM throwIO $ releaseVersionFromProjectConfig projectConfig
unresolvedVersion <- required "SDK version missing from project config (daml.yaml)." unresolvedVersionM
version <- DAVersion.resolveReleaseVersion (useCache env) unresolvedVersion
version <- DAVersion.resolveReleaseVersionUnsafe (useCache env) unresolvedVersion
versionInstall env { targetVersionM = version }
-- | Determine whether the assistant should be installed.
@ -504,73 +527,77 @@ pattern RawInstallTarget_Latest = RawInstallTarget "latest"
-- | Run install command.
install :: InstallOptions -> DamlPath -> UseCache -> Maybe ProjectPath -> Maybe DamlAssistantSdkVersion -> IO ()
install options damlPath useCache projectPathM assistantVersion = do
when (unActivateInstall (iActivate options)) $
hPutStr stderr . unlines $
[ "WARNING: --activate is deprecated, use --install-assistant=yes instead."
, ""
]
missingAssistant <- not <$> doesFileExist (installedAssistantPath damlPath)
execPath <- getExecutablePath
damlConfigE <- tryConfig $ readDamlConfig damlPath
let installingFromOutside = not $
isPrefixOf (unwrapDamlPath damlPath </> "") execPath
targetVersionM = () -- determined later
output = putStrLn -- Output install messages to stdout.
artifactoryApiKeyM = DAVersion.queryArtifactoryApiKey =<< eitherToMaybe damlConfigE
env = InstallEnv {..}
warnAboutAnyInstallFlags command = do
when (unInstallWithInternalVersion (iInstallWithInternalVersion options)) $
hPutStrLn stderr $ unlines
[ "WARNING: You have supplied --install-with-internal-version=yes, but `" <> command <> "` does not take that option."
]
case unInstallWithCustomVersion (iInstallWithCustomVersion options) of
Just customVersion ->
hPutStrLn stderr $ unlines
[ "WARNING: You have supplied --install-with-custom-version=" <> customVersion <> ", but `" <> command <> "` does not take that option."
]
Nothing -> pure ()
case iTargetM options of
Nothing -> do
hPutStrLn stderr $ unlines
[ "ERROR: daml install requires a target."
install options damlPath useCache projectPathM assistantVersion =
wrapErr "Running daml install command" $ do
when (unActivateInstall (iActivate options)) $
hPutStr stderr . unlines $
[ "WARNING: --activate is deprecated, use --install-assistant=yes instead."
, ""
, "Available install targets:"
, " daml install latest Install the latest stable SDK version."
, " daml install project Install the project SDK version."
, " daml install VERSION Install a specific SDK version."
, " daml install PATH Install SDK from an SDK release tarball."
]
exitFailure
Just RawInstallTarget_Project -> do
projectPath <- required "'daml install project' must be run from within a project."
projectPathM
warnAboutAnyInstallFlags "daml install project"
projectInstall env projectPath
missingAssistant <- not <$> doesFileExist (installedAssistantPath damlPath)
execPath <- getExecutablePath
damlConfigE <- tryConfig $ readDamlConfig damlPath
let installingFromOutside = not $
isPrefixOf (unwrapDamlPath damlPath </> "") execPath
targetVersionM = () -- determined later
output = putStrLn -- Output install messages to stdout.
artifactoryApiKeyM = DAVersion.queryArtifactoryApiKey =<< eitherToMaybe damlConfigE
env = InstallEnv {..}
warnAboutAnyInstallFlags command = do
when (unInstallWithInternalVersion (iInstallWithInternalVersion options)) $
hPutStrLn stderr $ unlines
[ "WARNING: You have supplied --install-with-internal-version=yes, but `" <> command <> "` does not take that option."
]
case unInstallWithCustomVersion (iInstallWithCustomVersion options) of
Just customVersion ->
hPutStrLn stderr $ unlines
[ "WARNING: You have supplied --install-with-custom-version=" <> customVersion <> ", but `" <> command <> "` does not take that option."
]
Nothing -> pure ()
Just RawInstallTarget_Latest -> do
warnAboutAnyInstallFlags "daml install latest"
latestInstall env
case iTargetM options of
Nothing -> do
hPutStrLn stderr $ unlines
[ "ERROR: daml install requires a target."
, ""
, "Available install targets:"
, " daml install latest Install the latest stable SDK version."
, " daml install project Install the project SDK version."
, " daml install VERSION Install a specific SDK version."
, " daml install PATH Install SDK from an SDK release tarball."
]
exitFailure
Just (RawInstallTarget arg) | Right version <- parseVersion (pack arg) -> do
warnAboutAnyInstallFlags "daml install <version>"
releaseVersion <- DAVersion.resolveReleaseVersion useCache version
versionInstall env { targetVersionM = releaseVersion }
Just RawInstallTarget_Project -> do
projectPath <- required "'daml install project' must be run from within a project."
projectPathM
warnAboutAnyInstallFlags "daml install project"
projectInstall env projectPath
Just (RawInstallTarget arg) -> do
testD <- doesDirectoryExist arg
testF <- doesFileExist arg
if testD || testF then
pathInstall env arg
else
throwIO (assistantErrorBecause "Invalid install target. Expected version, path, 'project' or 'latest'." ("target = " <> pack arg))
Just RawInstallTarget_Latest -> do
warnAboutAnyInstallFlags "daml install latest"
latestInstall env
Just (RawInstallTarget arg) | Right version <- parseVersion (pack arg) -> do
warnAboutAnyInstallFlags "daml install <version>"
releaseVersion <- DAVersion.resolveReleaseVersionUnsafe useCache version
versionInstall env { targetVersionM = releaseVersion }
Just (RawInstallTarget arg) -> do
testD <- doesDirectoryExist arg
testF <- doesFileExist arg
if testD || testF then
pathInstall env arg
else
throwIO (assistantErrorBecause "Invalid install target. Expected version, path, 'project' or 'latest'." ("target = " <> pack arg))
-- | Uninstall a specific SDK version.
uninstallVersion :: Env -> ReleaseVersion -> IO ()
uninstallVersion Env{..} releaseVersion = wrapErr "Uninstalling SDK version." $ do
uninstallVersion :: Env -> Either CouldNotResolveReleaseVersion ReleaseVersion -> IO ()
uninstallVersion Env{} (Left (CouldNotResolveReleaseVersion _ unresolvedVersion)) =
wrapErr "Uninstalling SDK version." $
throwErr ("SDK version " <> unresolvedReleaseVersionToText unresolvedVersion <> " is not installed.")
uninstallVersion Env{..} (Right releaseVersion) = wrapErr "Uninstalling SDK version." $ do
let (SdkPath path) = defaultSdkPath envDamlPath releaseVersion
exists <- doesDirectoryExist path

View File

@ -22,26 +22,40 @@ throwErr msg = throwIO (assistantError msg)
-- | Handle synchronous exceptions by wrapping them in an AssistantError,
-- add context to any assistant errors that are missing context.
wrapErr :: Text -> IO a -> IO a
wrapErr ctx m = m `catches`
wrapErrG :: (Text -> SomeException -> AssistantError) -> Text -> IO a -> IO a
wrapErrG wrapSomeException ctx m = m `catches`
[ Handler $ throwIO @IO @ExitCode
, Handler $ \ExitCodeException{eceExitCode} -> exitWith eceExitCode
, Handler $ throwIO . addErrorContext
, Handler $ throwIO . wrapException
, Handler $ throwIO . wrapSomeException ctx
]
where
wrapException :: SomeException -> AssistantError
wrapException err =
AssistantError
{ errContext = Just ctx
, errMessage = Nothing
, errInternal = Just (pack (show err))
}
addErrorContext :: AssistantError -> AssistantError
addErrorContext err =
err { errContext = errContext err <|> Just ctx }
wrapErr :: Text -> IO a -> IO a
wrapErr = wrapErrG wrapSomeExceptionWithoutMsg
wrapSomeExceptionWithoutMsg :: Text -> SomeException -> AssistantError
wrapSomeExceptionWithoutMsg ctx err =
AssistantError
{ errContext = Just ctx
, errMessage = Nothing
, errInternal = Just (pack (show err))
}
wrapErrDisplay :: Text -> IO a -> IO a
wrapErrDisplay = wrapErrG wrapSomeExceptionWithMsg
wrapSomeExceptionWithMsg :: Text -> SomeException -> AssistantError
wrapSomeExceptionWithMsg ctx err =
AssistantError
{ errContext = Just ctx
, errMessage = Just (pack (displayException err))
, errInternal = Just (pack (show err))
}
-- | Catch a config error.
tryConfig :: IO t -> IO (Either ConfigError t)
tryConfig = try

View File

@ -20,6 +20,9 @@ module DA.Daml.Assistant.Version
, UseCache (..)
, freshMaximumOfVersions
, resolveReleaseVersion
, resolveReleaseVersionUnsafe
, CouldNotResolveSdkVersion(..)
, CouldNotResolveReleaseVersion(..)
, resolveSdkVersionToRelease
, githubVersionLocation
, artifactoryVersionLocation
@ -28,8 +31,12 @@ module DA.Daml.Assistant.Version
, ArtifactoryApiKey(..)
, alternateVersionLocation
, InstallLocation(..)
, HttpInstallLocation(..)
, resolveReleaseVersionFromArtifactory
) where
import Network.URI.Encode
import DA.Daml.Assistant.Types
import DA.Daml.Assistant.Util
import DA.Daml.Assistant.Cache
@ -37,6 +44,7 @@ import DA.Daml.Project.Config
import DA.Daml.Project.Consts hiding (getDamlPath, getProjectPath)
import System.Environment.Blank
import Control.Exception.Safe
import Control.Exception (mapException)
import Control.Monad.Extra
import Data.Maybe
import Data.Aeson (FromJSON(..), eitherDecodeStrict')
@ -48,6 +56,7 @@ import Network.HTTP.Simple
import Network.HTTP.Client
( Request(responseTimeout)
, responseTimeoutMicro
, setQueryString
)
import Data.ByteString (ByteString)
@ -56,6 +65,7 @@ import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.UTF8 as BSU
import qualified Data.SemVer as V
import Data.Function ((&))
import Data.Foldable (fold)
import Control.Lens (view)
import System.Directory (listDirectory, doesFileExist)
import System.FilePath ((</>))
@ -64,6 +74,7 @@ import Data.Either.Extra (eitherToMaybe)
import qualified Data.Map.Strict as M
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty)
import qualified System.Info
import GHC.Stack
@ -107,8 +118,15 @@ getSdkVersionFromProjectPath useCache projectPath =
requiredIO ("Failed to read SDK version from " <> pack projectConfigName) $ do
configE <- tryConfig $ readProjectConfig projectPath
case releaseVersionFromProjectConfig =<< configE of
Right (Just v) ->
resolveReleaseVersion useCache v
Right (Just v) -> do
resolvedVersionOrErr <- resolveReleaseVersion useCache v
case resolvedVersionOrErr of
Left resolveErr ->
throwIO $ assistantErrorDetails
("sdk-version field in " <> projectConfigName <> " is not a valid Daml version. Validating version from the internet failed.")
[("path", unwrapProjectPath projectPath </> projectConfigName)
,("internal", displayException resolveErr)]
Right version -> pure version
Left (ConfigFileInvalid _ raw) ->
throwIO $ assistantErrorDetails
(projectConfigName <> " is an invalid YAML file")
@ -213,9 +231,9 @@ getAvailableSdkSnapshotVersions useCache =
-- | Find the first occurence of a version on Github, without the cache. Keep in
-- mind that versions are not sorted.
findAvailableSdkSnapshotVersion :: DamlPath -> (ReleaseVersion -> Bool) -> IO (Maybe ReleaseVersion)
findAvailableSdkSnapshotVersion damlPath pred =
getAvailableSdkSnapshotVersionsUncached damlPath >>= searchSnapshotsUntil pred
findAvailableSdkSnapshotVersion :: Maybe DamlPath -> (ReleaseVersion -> Bool) -> IO (Maybe ReleaseVersion)
findAvailableSdkSnapshotVersion damlPathMb pred =
getAvailableSdkSnapshotVersionsUncached damlPathMb >>= searchSnapshotsUntil pred
data SnapshotsList = SnapshotsList
{ versions :: IO [ReleaseVersion]
@ -246,13 +264,17 @@ searchSnapshotsUntil pred SnapshotsList { versions, next } = do
-- https://docs.github.com/en/rest/releases/releases?apiVersion=2022-11-28#get-the-latest-release
-- because it sorts by time of upload, so a minor version bump like 2.5.15 may
-- supersede 2.7.2 if the minor release on 2.5.12 was released later
getAvailableSdkSnapshotVersionsUncached :: DamlPath -> IO SnapshotsList
getAvailableSdkSnapshotVersionsUncached damlPath = do
damlConfigE <- tryConfig (readDamlConfig damlPath)
let releasesEndpoint =
getAvailableSdkSnapshotVersionsUncached :: Maybe DamlPath -> IO SnapshotsList
getAvailableSdkSnapshotVersionsUncached damlPathMb = do
let defaultReleasesEndpoint = "https://api.github.com/repos/digital-asset/daml/releases"
releasesEndpoint <-
case damlPathMb of
Nothing -> pure defaultReleasesEndpoint
Just damlPath -> do
damlConfigE <- tryConfig (readDamlConfig damlPath)
case queryDamlConfig ["releases-endpoint"] =<< damlConfigE of
Right (Just url) -> url
_ -> "https://api.github.com/repos/digital-asset/daml/releases"
Right (Just url) -> pure url
_ -> pure defaultReleasesEndpoint
case parseRequest releasesEndpoint of
Just _ -> requestReleasesSnapshotsList releasesEndpoint
Nothing -> do
@ -357,46 +379,66 @@ getLatestReleaseVersion :: UseCache -> IO ReleaseVersion
getLatestReleaseVersion useCache =
maximumOfNonEmptyVersions (getAvailableReleaseVersions useCache)
data CouldNotResolveVersion
= CouldNotResolveReleaseVersion UnresolvedReleaseVersion
| CouldNotResolveSdkVersion SdkVersion
deriving (Show, Eq, Ord)
data CouldNotResolveReleaseVersion = CouldNotResolveReleaseVersion ResolveReleaseError UnresolvedReleaseVersion
deriving (Show, Eq)
instance Exception CouldNotResolveVersion where
displayException (CouldNotResolveReleaseVersion version) = "Could not resolve release version " <> T.unpack (V.toText (unwrapUnresolvedReleaseVersion version))
displayException (CouldNotResolveSdkVersion version) = "Could not resolve SDK version " <> T.unpack (V.toText (unwrapSdkVersion version)) <> " to a release version. Possible fix: `daml version --force-reload yes`?"
instance Exception CouldNotResolveReleaseVersion where
displayException (CouldNotResolveReleaseVersion githubReleaseError version) =
"Could not resolve release version " <> T.unpack (V.toText (unwrapUnresolvedReleaseVersion version)) <> " from the internet. Reason: " <> displayException githubReleaseError
resolveReleaseVersion :: HasCallStack => UseCache -> UnresolvedReleaseVersion -> IO ReleaseVersion
resolveReleaseVersion _ targetVersion | isHeadVersion targetVersion = pure headReleaseVersion
resolveReleaseVersion useCache targetVersion = do
mbResolved <- resolveReleaseVersionFromDamlPath (damlPath useCache) targetVersion
resolveReleaseVersion :: HasCallStack => UseCache -> UnresolvedReleaseVersion -> IO (Either CouldNotResolveReleaseVersion ReleaseVersion)
resolveReleaseVersion useCache unresolvedVersion = do
try (resolveReleaseVersionInternal useCache unresolvedVersion)
resolveReleaseVersionUnsafe :: HasCallStack => UseCache -> UnresolvedReleaseVersion -> IO ReleaseVersion
resolveReleaseVersionUnsafe useCache targetVersion = mapException handle $ resolveReleaseVersionInternal useCache targetVersion
where
handle :: CouldNotResolveReleaseVersion -> AssistantError
handle = wrapSomeExceptionWithMsg "Resolve SDK version from release version" . SomeException
resolveReleaseVersionInternal :: HasCallStack => UseCache -> UnresolvedReleaseVersion -> IO ReleaseVersion
resolveReleaseVersionInternal _ targetVersion | isHeadVersion targetVersion = pure headReleaseVersion
resolveReleaseVersionInternal useCache targetVersion = do
mbResolved <- traverse (\damlPath -> resolveReleaseVersionFromDamlPath damlPath targetVersion) (damlPath useCache)
case mbResolved of
Just resolved -> pure resolved
Nothing -> do
Just (Just resolved) -> pure resolved
_ -> do
let isTargetVersion version =
unwrapUnresolvedReleaseVersion targetVersion == releaseVersionFromReleaseVersion version
(releaseVersions, _) <- getAvailableSdkSnapshotVersions useCache
case filter isTargetVersion releaseVersions of
(x:_) -> pure x
[] -> do
releasedVersionE <- resolveReleaseVersionFromGithub targetVersion
case releasedVersionE of
Left _ ->
throwIO (CouldNotResolveReleaseVersion targetVersion)
Right releasedVersion -> do
_ <- cacheAvailableSdkVersions useCache (\pre -> pure (releasedVersion : fromMaybe [] pre))
pure releasedVersion
artifactoryReleasedVersionE <- resolveReleaseVersionFromArtifactory (damlPath useCache) targetVersion
case artifactoryReleasedVersionE of
Right (Just version) -> pure version
Left err -> throwIO (CouldNotResolveReleaseVersion err targetVersion)
Right Nothing -> do
githubReleasedVersionE <- resolveReleaseVersionFromGithub targetVersion
case githubReleasedVersionE of
Left githubReleaseError ->
throwIO (CouldNotResolveReleaseVersion githubReleaseError targetVersion)
Right releasedVersion -> do
_ <- cacheAvailableSdkVersions useCache (\pre -> pure (releasedVersion : fromMaybe [] pre))
pure releasedVersion
resolveSdkVersionToRelease :: UseCache -> SdkVersion -> IO (Either CouldNotResolveVersion ReleaseVersion)
data CouldNotResolveSdkVersion = CouldNotResolveSdkVersion SdkVersion
deriving (Show, Eq)
instance Exception CouldNotResolveSdkVersion where
displayException (CouldNotResolveSdkVersion version) =
"Could not resolve SDK version " <> T.unpack (V.toText (unwrapSdkVersion version)) <> " to a release version. Possible fix: `daml version --force-reload yes`?"
resolveSdkVersionToRelease :: UseCache -> SdkVersion -> IO (Either CouldNotResolveSdkVersion ReleaseVersion)
resolveSdkVersionToRelease _ targetVersion | isHeadVersion targetVersion = pure (Right headReleaseVersion)
resolveSdkVersionToRelease useCache targetVersion = do
resolved <- resolveSdkVersionFromDamlPath (damlPath useCache) targetVersion
resolved <- traverse (\damlPath -> resolveSdkVersionFromDamlPath damlPath targetVersion) (damlPath useCache)
case resolved of
Just resolved -> pure (Right resolved)
Nothing -> do
Just (Just resolved) -> pure (Right resolved)
_ -> do
let isTargetVersion version =
targetVersion == sdkVersionFromReleaseVersion version
(releaseVersions, _) <- getAvailableSdkSnapshotVersions useCache
(releaseVersions, _age) <- getAvailableSdkSnapshotVersions useCache
case filter isTargetVersion releaseVersions of
(x:_) -> pure $ Right x
[] -> pure $ Left $ CouldNotResolveSdkVersion targetVersion
@ -417,7 +459,7 @@ resolveSdkVersionFromDamlPath damlPath targetSdkVersion = do
-- | Subset of the github release response that we care about
data GithubReleaseResponseSubset = GithubReleaseResponseSubset
{ assetNames :: [T.Text] }
{ githubAssetNames :: [T.Text] }
instance FromJSON GithubReleaseResponseSubset where
-- Akin to `GithubReleaseResponseSubset . fmap name . assets` but lifted into a parser over json
@ -431,34 +473,108 @@ releaseResponseSubsetSdkVersion responseSubset =
withoutExt <- T.stripSuffix "-linux.tar.gz" name
T.stripPrefix "daml-sdk-" withoutExt
in
listToMaybe $ mapMaybe extractMatchingName (assetNames responseSubset)
listToMaybe $ mapMaybe extractMatchingName (githubAssetNames responseSubset)
data GithubReleaseError
data ResolveReleaseError
= FailedToFindLinuxSdkInRelease String
| Couldn'tParseSdkVersion String InvalidVersion
| Couldn'tParseJSON String
| Couldn'tConnect (Maybe Int) String
deriving (Show, Eq)
instance Exception GithubReleaseError where
instance Exception ResolveReleaseError where
displayException (FailedToFindLinuxSdkInRelease url) =
"Couldn't find Linux SDK in release at url: '" <> url <> "'"
displayException (Couldn'tParseSdkVersion url v) =
"Couldn't parse SDK in release at url '" <> url <> "': " <> displayException v
displayException (Couldn'tParseJSON url) =
"Couldn't parse JSON from the response from url '" <> url <> "'"
displayException (Couldn'tConnect statusCode url) =
let statusCodeDescription =
case statusCode of
Nothing -> ""
Just statusCode -> ", got HTTP status code `" <> show statusCode <> "`"
in
"Couldn't connect successfully to '" <> url <> "'" <> statusCodeDescription
-- | Since ~2.8.snapshot, the "enterprise version" (the version the user inputs) and the daml sdk version (the version of the daml repo) can differ
-- As such, we derive the latter via the github api `assets` endpoint, looking for a file matching the expected `daml-sdk-$VERSION-$OS.tar.gz`
resolveReleaseVersionFromGithub :: UnresolvedReleaseVersion -> IO (Either GithubReleaseError ReleaseVersion)
-- | Since ~2.8.snapshot, the "daml version" (the version the user inputs) and
-- the daml sdk version (the version of the daml repo) can differ
-- As such, we derive the latter via the github api `assets` endpoint, looking
-- for a file matching the expected `daml-sdk-$VERSION-$OS.tar.gz`
resolveReleaseVersionFromGithub :: UnresolvedReleaseVersion -> IO (Either ResolveReleaseError ReleaseVersion)
resolveReleaseVersionFromGithub unresolvedVersion = do
let tag = T.unpack (rawVersionToTextWithV (unwrapUnresolvedReleaseVersion unresolvedVersion))
url = "https://api.github.com/repos/digital-asset/daml/releases/tags/" <> tag
req <- parseRequest url
res <- httpJSON $ setRequestHeaders [("User-Agent", "request")] req
resOrErr <- try $ httpJSONEither $ setRequestHeaders [("User-Agent", "request")] req
pure $
case releaseResponseSubsetSdkVersion (getResponseBody res) of
Nothing -> Left (FailedToFindLinuxSdkInRelease url)
Just sdkVersionStr ->
case parseSdkVersion sdkVersionStr of
Left issue -> Left (Couldn'tParseSdkVersion url issue)
Right sdkVersion -> Right (mkReleaseVersion unresolvedVersion sdkVersion)
case resOrErr of
Right res -> case releaseResponseSubsetSdkVersion <$> getResponseBody res of
Right (Just sdkVersionStr) ->
case parseSdkVersion sdkVersionStr of
Left issue -> Left (Couldn'tParseSdkVersion url issue)
Right sdkVersion -> Right (mkReleaseVersion unresolvedVersion sdkVersion)
Right Nothing -> Left (FailedToFindLinuxSdkInRelease url)
Left _err
| getResponseStatusCode res == 200 -> Left (Couldn'tParseJSON url)
| getResponseStatusCode res == 404 -> Left (FailedToFindLinuxSdkInRelease url)
| otherwise -> Left (Couldn'tConnect (Just (getResponseStatusCode res)) url)
Left SomeException{} -> Left (Couldn'tConnect Nothing url)
-- | Subset of the artifactory release response that we care about
data ArtifactoryReleaseResponseSubset = ArtifactoryReleaseResponseSubset
{ artifactoryFiles :: [T.Text] }
deriving (Show, Eq, Ord)
instance FromJSON ArtifactoryReleaseResponseSubset where
-- Akin to `ArtifactoryReleaseResponseSubset . fmap name . assets` but lifted into a parser over json
parseJSON = withObject "ArtifactoryReleaseResponse" $ \v ->
ArtifactoryReleaseResponseSubset <$> explicitParseField (listParser parseJSON) v "files"
artifactoryReleaseResponseSubsetSdkVersion :: ArtifactoryReleaseResponseSubset -> Maybe T.Text
artifactoryReleaseResponseSubsetSdkVersion responseSubset =
let extractMatchingName :: T.Text -> Maybe T.Text
extractMatchingName path = do
let name = T.takeWhileEnd (/= '/') path
withoutExt <- T.stripSuffix "-linux-ee.tar.gz" name
T.stripPrefix "daml-sdk-" withoutExt
in
listToMaybe $ mapMaybe extractMatchingName (artifactoryFiles responseSubset)
resolveReleaseVersionFromArtifactory :: Maybe DamlPath -> UnresolvedReleaseVersion -> IO (Either ResolveReleaseError (Maybe ReleaseVersion))
resolveReleaseVersionFromArtifactory Nothing _ = pure (Right Nothing) -- Without a daml path, there is no artifactory key
resolveReleaseVersionFromArtifactory (Just damlPath) unresolvedVersion = do
damlConfig <- tryConfig $ readDamlConfig damlPath
case queryArtifactoryApiKey <$> damlConfig of
Right (Just apiKey) -> do
let url = "https://digitalasset.jfrog.io/artifactory/api/search/pattern"
searchParam = fold [ "external-files:daml-enterprise/*/", encodeTextToBS $ unresolvedReleaseVersionToText unresolvedVersion, "/*" ]
req <- parseRequest url
resOrErr <- try $ httpJSONEither $
setRequestHeaders
[ ("User-Agent", "request")
, ("X-JFrog-Art-Api", T.encodeUtf8 (unwrapArtifactoryApiKey apiKey))
] $
setQueryString
[ ("pattern", Just searchParam)
]
req
pure $
case resOrErr of
Right res ->
case artifactoryReleaseResponseSubsetSdkVersion <$> getResponseBody res of
Right (Just sdkVersionStr) ->
case parseSdkVersion sdkVersionStr of
Left issue -> Left (Couldn'tParseSdkVersion url issue)
Right sdkVersion -> Right (Just (mkReleaseVersion unresolvedVersion sdkVersion))
Right Nothing -> Left (FailedToFindLinuxSdkInRelease url)
Left _err
| getResponseStatusCode res == 200 -> Left (Couldn'tParseJSON url)
| getResponseStatusCode res == 404 -> Left (FailedToFindLinuxSdkInRelease url)
| otherwise -> Left (Couldn'tConnect (Just (getResponseStatusCode res)) url)
Left SomeException{} ->
Left (Couldn'tConnect Nothing url)
_ -> pure (Right Nothing)
-- | OS-specific part of the asset name.
osName :: Text
@ -478,26 +594,52 @@ queryArtifactoryApiKey damlConfig =
-- | Install location for particular version.
artifactoryVersionLocation :: ReleaseVersion -> ArtifactoryApiKey -> InstallLocation
artifactoryVersionLocation releaseVersion apiKey = HttpInstallLocation
{ ilUrl = T.concat
[ "https://digitalasset.jfrog.io/artifactory/sdk-ee/"
, sdkVersionToText (sdkVersionFromReleaseVersion releaseVersion)
, "/daml-sdk-"
, sdkVersionToText (sdkVersionFromReleaseVersion releaseVersion)
, "-"
, osName
, "-ee.tar.gz"
artifactoryVersionLocation releaseVersion apiKey =
let textShow = T.pack . show
majorVersion = view V.major (releaseVersionFromReleaseVersion releaseVersion)
minorVersion = view V.minor (releaseVersionFromReleaseVersion releaseVersion)
in
HttpInstallLocations $
HttpInstallLocation
{ hilUrl = T.concat
[ "https://digitalasset.jfrog.io/artifactory/external-files/daml-enterprise/"
, textShow majorVersion <> "." <> textShow minorVersion
, "/"
, versionToText releaseVersion
, "/daml-sdk-"
, sdkVersionToText (sdkVersionFromReleaseVersion releaseVersion)
, "-"
, osName
, "-ee.tar.gz"
]
, hilHeaders =
[("X-JFrog-Art-Api", T.encodeUtf8 (unwrapArtifactoryApiKey apiKey))]
, hilAlternativeName = "Artifactory `external-files` repo"
}
NonEmpty.:|
[ HttpInstallLocation
{ hilUrl = T.concat
[ "https://digitalasset.jfrog.io/artifactory/sdk-ee/"
, sdkVersionToText (sdkVersionFromReleaseVersion releaseVersion)
, "/daml-sdk-"
, sdkVersionToText (sdkVersionFromReleaseVersion releaseVersion)
, "-"
, osName
, "-ee.tar.gz"
]
, hilHeaders =
[("X-JFrog-Art-Api", T.encodeUtf8 (unwrapArtifactoryApiKey apiKey))]
, hilAlternativeName = "Artifactory `sdk-ee` repo (legacy)"
}
]
, ilHeaders =
[("X-JFrog-Art-Api", T.encodeUtf8 (unwrapArtifactoryApiKey apiKey))]
}
-- | Install location from Github for particular version.
githubVersionLocation :: ReleaseVersion -> InstallLocation
githubVersionLocation releaseVersion =
githubVersionLocation releaseVersion = HttpInstallLocations $ pure
HttpInstallLocation
{ ilUrl = renderVersionLocation releaseVersion "https://github.com/digital-asset/daml/releases/download"
, ilHeaders = []
{ hilUrl = renderVersionLocation releaseVersion "https://github.com/digital-asset/daml/releases/download"
, hilHeaders = []
, hilAlternativeName = "Github `daml` repo releases"
}
alternateVersionLocation :: ReleaseVersion -> Text -> IO (Either Text InstallLocation)
@ -509,7 +651,13 @@ alternateVersionLocation releaseVersion prefix = do
pure $ if exists
then Right (FileInstallLocation (T.unpack location))
else Left location
Just _ -> pure (Right (HttpInstallLocation location []))
Just _ ->
pure $ Right $ HttpInstallLocations $ pure
HttpInstallLocation
{ hilUrl = location
, hilHeaders = []
, hilAlternativeName = "Alternative install location from daml config `" <> prefix <> "`"
}
-- | Install location for particular version.
renderVersionLocation :: ReleaseVersion -> Text -> Text
@ -529,11 +677,17 @@ renderVersionLocation releaseVersion prefix =
-- required to access that URL. For example:
-- "https://github.com/digital-asset/daml/releases/download/v0.11.1/daml-sdk-0.11.1-macos.tar.gz"
data InstallLocation
= HttpInstallLocation
{ ilUrl :: Text
, ilHeaders :: RequestHeaders
= HttpInstallLocations
{ ilAlternatives :: NonEmpty HttpInstallLocation
}
| FileInstallLocation
{ ilPath :: FilePath
} deriving (Eq, Show)
}
deriving (Eq, Show)
data HttpInstallLocation = HttpInstallLocation
{ hilUrl :: Text
, hilHeaders :: RequestHeaders
, hilAlternativeName :: Text
}
deriving (Eq, Show)

View File

@ -42,6 +42,7 @@ import DA.Daml.Project.Types
import qualified DA.Daml.Project.Types as DATypes
import qualified DA.Daml.Assistant.Version as DAVersion
import qualified DA.Daml.Assistant.Env as DAEnv
import qualified DA.Daml.Assistant.Util as DAUtil
-- Version of the "@mojotech/json-type-validation" library we're using.
jtvVersion :: T.Text
@ -131,7 +132,7 @@ main = do
Left _ -> fail "Invalid SDK version"
Right v -> do
useCache <- DAEnv.mkUseCache <$> DAEnv.getCachePath <*> DAEnv.getDamlPath
DAVersion.resolveReleaseVersion useCache v
DAUtil.wrapErr "Getting SDK version for codegen" $ DAVersion.resolveReleaseVersionUnsafe useCache v
pkgs <- readPackages optInputDars
case mergePackageMap pkgs of
Left err -> fail . T.unpack $ err

View File

@ -87,6 +87,9 @@ sdkVersionToText = V.toText . unwrapSdkVersion
unresolvedReleaseVersionToString :: UnresolvedReleaseVersion -> String
unresolvedReleaseVersionToString = V.toString . unwrapUnresolvedReleaseVersion
unresolvedReleaseVersionToText :: UnresolvedReleaseVersion -> Text
unresolvedReleaseVersionToText = V.toText . unwrapUnresolvedReleaseVersion
class IsVersion a where
isHeadVersion :: a -> Bool