Fix version caching (digital-asset#17581)

* Make at least one call API if there is no cache * document why we don't use /repos/{owner}/{repo}/releases/latest * Refactoring * Improve name - envLatestStableSdkVersion is only used in one location * `daml install latest` overrides update-check in daml-config.yaml * Improve comments for cacheAvailableSdkVersions * lint * Drop lookup for UpdateCheckNever https://dev.azure.com/digitalasset/daml/_build/results?buildId=151669&view=logs&jobId=870bb40c-6da0-5bff-67ed-547f10fa97f2&j=870bb40c-6da0-5bff-67ed-547f10fa97f2&t=fdc575a5-c2b4-5f52-8465-2c7aa3e12574 reports daml: Snapshot versions list from https://api.github.com/repos/digital-asset/daml/releases does not contain valid JSON context: Fetching list of available SDK versions details: Error in $: expected Array, but encountered Object I assume this is because the request returned some sort of failure
kgeonw · Oct 17, 2023 · a0fe6fe · a0fe6fe
1 parent 7ce588d
commit a0fe6fe
Show file tree

Hide file tree

Showing 7 changed files with 61 additions and 47 deletions.
diff --git a/daml-assistant/exe/DA/Daml/Assistant.hs b/daml-assistant/exe/DA/Daml/Assistant.hs
@@ -18,6 +18,7 @@ import DA.Daml.Assistant.Command
 import DA.Daml.Assistant.Version
 import DA.Daml.Assistant.Install
 import DA.Daml.Assistant.Util
+import DA.Daml.Assistant.Cache
 import System.Environment (getArgs, lookupEnv)
 import System.FilePath
 import System.Directory
@@ -100,8 +101,8 @@ commandWantsProjectPath cmd = LookForProjectPath $
 -- versions are out of date with the latest known release.
 versionChecks :: Env -> IO ()
 versionChecks Env{..} = do
-    envLatestStableSdkVersion <- envLatestStableSdkVersion
-    whenJust envLatestStableSdkVersion $ \latestVersion -> do
+    envFreshStableSdkVersionForCheck <- envFreshStableSdkVersionForCheck
+    whenJust envFreshStableSdkVersionForCheck $ \latestVersion -> do
         let isHead = maybe False isHeadVersion envSdkVersion
             projectSdkVersionIsOld = isJust envProjectPath && envSdkVersion < Just latestVersion
             assistantVersionIsOld = isJust envDamlAssistantSdkVersion &&
@@ -196,7 +197,7 @@ runCommand env@Env{..} = \case
               UseCache
                 { cachePath = envCachePath
                 , damlPath = envDamlPath
-                , forceReload = vForceRefresh
+                , overrideTimeout = if vForceRefresh then Just (CacheTimeout 1) else Nothing
                 }
         installedVersionsE <- tryAssistant $ getInstalledSdkVersions envDamlPath
         snapshotVersionsEUnfiltered <- tryAssistant $ fst <$> getAvailableSdkSnapshotVersions useCache

diff --git a/daml-assistant/src/DA/Daml/Assistant/Cache.hs b/daml-assistant/src/DA/Daml/Assistant/Cache.hs
@@ -51,7 +51,7 @@ versionsKey = "versions.txt"
 
 data UseCache
   = UseCache
-      { forceReload :: Bool
+      { overrideTimeout :: Maybe CacheTimeout
       , cachePath :: CachePath
       , damlPath :: DamlPath
       }
@@ -63,21 +63,25 @@ cacheAvailableSdkVersions
     -> IO [SdkVersion]
     -> IO ([SdkVersion], CacheAge)
 cacheAvailableSdkVersions DontUseCache getVersions = (, Fresh) <$> getVersions
-cacheAvailableSdkVersions UseCache { forceReload, cachePath, damlPath } getVersions = do
+cacheAvailableSdkVersions UseCache { overrideTimeout, cachePath, damlPath } getVersions = do
     damlConfigE <- tryConfig $ readDamlConfig damlPath
     let configUpdateCheckM = join $ eitherToMaybe (queryDamlConfig ["update-check"] =<< damlConfigE)
-        updateCheck | forceReload = UpdateCheckEvery (CacheTimeout 1)
-                    | Just updateCheck <- configUpdateCheckM = updateCheck
-                    | otherwise = UpdateCheckEvery (CacheTimeout 86400) -- One day, in seconds
-    case updateCheck of
-        UpdateCheckNever -> do
-            valueAgeM <- loadFromCacheWith cachePath versionsKey (CacheTimeout 0) deserializeVersions
-            pure $ fromMaybe ([], Stale) valueAgeM
-
-        UpdateCheckEvery timeout ->
-            cacheWith cachePath versionsKey timeout
-                serializeVersions deserializeVersions
-                getVersions
+        mbTimeout
+            -- A few different things can override the timeout behaviour in
+            -- daml-config.yaml, chiefly `daml install latest` and `daml version --force-reload yes`
+          | Just timeout <- overrideTimeout = Just timeout
+          | Just updateCheck <- configUpdateCheckM =
+              case updateCheck of
+                -- When UpdateCheckNever, still refresh the cache if it doesn't exist
+                UpdateCheckNever -> Nothing
+                UpdateCheckEvery timeout -> Just timeout
+          | otherwise = Just (CacheTimeout 86400)
+    case mbTimeout of
+      Nothing -> pure ([], Stale)
+      Just timeout ->
+        cacheWith cachePath versionsKey timeout
+            serializeVersions deserializeVersions
+            getVersions
 
 serializeVersions :: Serialize [SdkVersion]
 serializeVersions =

diff --git a/daml-assistant/src/DA/Daml/Assistant/Env.hs b/daml-assistant/src/DA/Daml/Assistant/Env.hs
@@ -39,7 +39,7 @@ getDamlEnv envDamlPath lookForProjectPath = do
     envProjectPath <- getProjectPath lookForProjectPath
     (envSdkVersion, envSdkPath) <- getSdk envDamlPath envProjectPath
     envCachePath <- getCachePath
-    envLatestStableSdkVersion <- getLatestStableSdkVersion (mkUseCache envCachePath envDamlPath)
+    envFreshStableSdkVersionForCheck <- getFreshStableSdkVersionForCheck (mkUseCache envCachePath envDamlPath)
     pure Env {..}
 
 envUseCache :: Env -> UseCache
@@ -48,7 +48,7 @@ envUseCache Env {..} =
 
 mkUseCache :: CachePath -> DamlPath -> UseCache
 mkUseCache cachePath damlPath =
-  UseCache { cachePath, damlPath, forceReload = False }
+  UseCache { cachePath, damlPath, overrideTimeout = Nothing }
 
 -- | (internal) Override function with environment variable
 -- if it is available.
@@ -83,11 +83,11 @@ overrideWithEnvVarMaybe envVar normalize parse calculate = do
 
 -- | Get the latest stable SDK version. Can be overriden with
 -- DAML_SDK_LATEST_VERSION environment variable.
-getLatestStableSdkVersion :: UseCache -> IO (IO (Maybe SdkVersion))
-getLatestStableSdkVersion useCache = do
+getFreshStableSdkVersionForCheck :: UseCache -> IO (IO (Maybe SdkVersion))
+getFreshStableSdkVersionForCheck useCache = do
   val <- getEnv sdkVersionLatestEnvVar
   case val of
-    Nothing -> pure (getLatestSdkVersion useCache)
+    Nothing -> pure (freshMaximumOfVersions (getAvailableReleaseVersions useCache))
     Just "" -> pure (pure Nothing)
     Just value -> do
       parsed <- requiredE
@@ -234,14 +234,14 @@ getSdk damlPath projectPathM =
 getDispatchEnv :: Env -> IO [(String, String)]
 getDispatchEnv Env{..} = do
     originalEnv <- getEnvironment
-    envLatestStableSdkVersion <- envLatestStableSdkVersion
+    envFreshStableSdkVersionForCheck <- envFreshStableSdkVersionForCheck
     pure $ filter ((`notElem` damlEnvVars) . fst) originalEnv
         ++ [ (damlPathEnvVar, unwrapDamlPath envDamlPath)
            , (damlCacheEnvVar, unwrapCachePath envCachePath)
            , (projectPathEnvVar, maybe "" unwrapProjectPath envProjectPath)
            , (sdkPathEnvVar, maybe "" unwrapSdkPath envSdkPath)
            , (sdkVersionEnvVar, maybe "" versionToString envSdkVersion)
-           , (sdkVersionLatestEnvVar, maybe "" versionToString envLatestStableSdkVersion)
+           , (sdkVersionLatestEnvVar, maybe "" versionToString envFreshStableSdkVersionForCheck)
            , (damlAssistantEnvVar, unwrapDamlAssistantPath envDamlAssistantPath)
            , (damlAssistantVersionEnvVar, maybe ""
                (versionToString . unwrapDamlAssistantSdkVersion)

diff --git a/daml-assistant/src/DA/Daml/Assistant/Install.hs b/daml-assistant/src/DA/Daml/Assistant/Install.hs
@@ -22,6 +22,7 @@ import qualified DA.Daml.Assistant.Install.Github as Github
 import DA.Daml.Assistant.Install.Path
 import DA.Daml.Assistant.Install.Completion
 import DA.Daml.Assistant.Version (getLatestSdkSnapshotVersion, getLatestReleaseVersion, UseCache (..))
+import DA.Daml.Assistant.Cache (CacheTimeout (..))
 import DA.Daml.Project.Consts
 import DA.Daml.Project.Config
 import Safe
@@ -420,8 +421,11 @@ versionInstall env@InstallEnv{..} version = withInstallLock env $ do
 latestInstall :: InstallEnv -> 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 getLatestSdkSnapshotVersion useCache
+        then tryAssistantM $ getLatestSdkSnapshotVersion useCache
         else pure Nothing
     let version = maybe version1 (max version1) version2M
     versionInstall env version

diff --git a/daml-assistant/src/DA/Daml/Assistant/Types.hs b/daml-assistant/src/DA/Daml/Assistant/Types.hs
@@ -58,7 +58,7 @@ data EnvF f = Env
     , envProjectPath   :: Maybe ProjectPath
     , envSdkPath       :: Maybe SdkPath
     , envSdkVersion    :: Maybe SdkVersion
-    , envLatestStableSdkVersion :: f (Maybe SdkVersion)
+    , envFreshStableSdkVersionForCheck :: f (Maybe SdkVersion)
     }
 
 deriving instance Eq (f (Maybe SdkVersion)) => Eq (EnvF f)
@@ -68,7 +68,7 @@ type Env = EnvF IO
 
 forceEnv :: Monad m => EnvF m -> m (EnvF Identity)
 forceEnv Env{..} = do
-  envLatestStableSdkVersion <- fmap Identity envLatestStableSdkVersion
+  envFreshStableSdkVersionForCheck <- fmap Identity envFreshStableSdkVersionForCheck
   pure Env{..}
 
 data BuiltinCommand

diff --git a/daml-assistant/src/DA/Daml/Assistant/Version.hs b/daml-assistant/src/DA/Daml/Assistant/Version.hs
@@ -9,7 +9,6 @@ module DA.Daml.Assistant.Version
     , getAssistantSdkVersion
     , getDefaultSdkVersion
     , getAvailableReleaseVersions
-    , getLatestSdkVersion
     , getAvailableSdkSnapshotVersions
     , getAvailableSdkSnapshotVersionsUncached
     , findAvailableSdkSnapshotVersion
@@ -18,6 +17,7 @@ module DA.Daml.Assistant.Version
     , isReleaseVersion
     , extractReleasesFromSnapshots
     , UseCache (..)
+    , freshMaximumOfVersions
     ) where
 
 import DA.Daml.Assistant.Types
@@ -205,6 +205,10 @@ searchSnapshotsUntil pred SnapshotsList { versions, next } = do
 -- | Get the list of available snapshot versions, until finding a version of
 -- interest. This will fetch https://api.github.com/repos/digital-asset/daml/releases
 -- and parse the obtained JSON.
+-- We do *not* use
+-- 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 :: IO SnapshotsList
 getAvailableSdkSnapshotVersionsUncached = do
   requestReleasesSnapshotsList "https://api.github.com/repos/digital-asset/daml/releases"
@@ -268,25 +272,26 @@ instance FromJSON ParsedSdkVersion where
         Left (InvalidVersion src msg) -> fail $ "Invalid version string `" <> unpack src <> "` for reason: " <> msg
         Right sdkVersion -> pure ParsedSdkVersion { unParsedSdkVersion = sdkVersion, isPrerelease }
 
+maximumOfNonEmptyVersions :: IO ([SdkVersion], CacheAge) -> IO SdkVersion
+maximumOfNonEmptyVersions getVersions = do
+    (versions, _cacheAge) <- getVersions
+    case maximumMay versions of
+      Nothing -> throwIO $ assistantError $ pack "Version list is empty."
+      Just m -> pure m
+
 -- | Get the latest released SDK version
-getLatestSdkVersion :: UseCache -> IO (Maybe SdkVersion)
-getLatestSdkVersion useCache = do
-    versionE <- tryAssistant (getAvailableReleaseVersions useCache)
-    pure $ do
-      (versions, _cacheAge) <- eitherToMaybe versionE
-      maximumMay versions
+freshMaximumOfVersions :: IO ([SdkVersion], CacheAge) -> IO (Maybe SdkVersion)
+freshMaximumOfVersions getVersions = do
+    (versions, cacheAge) <- getVersions
+    case cacheAge of
+      Stale -> pure Nothing
+      Fresh -> pure (maximumMay versions)
 
 -- | Get the latest snapshot SDK version.
-getLatestSdkSnapshotVersion :: UseCache -> IO (Maybe SdkVersion)
+getLatestSdkSnapshotVersion :: UseCache -> IO SdkVersion
 getLatestSdkSnapshotVersion useCache = do
-    versionE <- tryAssistant (getAvailableSdkSnapshotVersions useCache)
-    pure $ do
-      (versions, _cacheAge) <- eitherToMaybe versionE
-      maximumMay versions
+    maximumOfNonEmptyVersions (getAvailableSdkSnapshotVersions useCache)
 
 getLatestReleaseVersion :: UseCache -> IO SdkVersion
-getLatestReleaseVersion useCache = do
-    mbReleaseVersion <- getLatestSdkVersion useCache
-    case mbReleaseVersion of
-      Nothing -> throwIO $ assistantError (pack "Failed to get latest release version from github.com")
-      Just rv -> pure rv
+getLatestReleaseVersion useCache =
+    maximumOfNonEmptyVersions (getAvailableReleaseVersions useCache)
diff --git a/daml-assistant/test/DA/Daml/Assistant/Tests.hs b/daml-assistant/test/DA/Daml/Assistant/Tests.hs
@@ -292,7 +292,7 @@ testGetDispatchEnv = Tasty.testGroup "DA.Daml.Assistant.Env.getDispatchEnv"
                     , envDamlAssistantPath = DamlAssistantPath (base </> ".daml" </> "bin" </> "strange-daml")
                     , envDamlAssistantSdkVersion = Just $ DamlAssistantSdkVersion version
                     , envSdkVersion = Just version
-                    , envLatestStableSdkVersion = pure (Just version)
+                    , envFreshStableSdkVersionForCheck = pure (Just version)
                     , envSdkPath = Just $ SdkPath (base </> "sdk")
                     , envProjectPath = Just $ ProjectPath (base </> "proj")
                     }
@@ -309,7 +309,7 @@ testGetDispatchEnv = Tasty.testGroup "DA.Daml.Assistant.Env.getDispatchEnv"
                     , envDamlAssistantPath = DamlAssistantPath (base </> ".daml" </> "bin" </> "strange-daml")
                     , envDamlAssistantSdkVersion = Just $ DamlAssistantSdkVersion version
                     , envSdkVersion = Just version
-                    , envLatestStableSdkVersion = pure (Just version)
+                    , envFreshStableSdkVersionForCheck = pure (Just version)
                     , envSdkPath = Just $ SdkPath (base </> "sdk")
                     , envProjectPath = Just $ ProjectPath (base </> "proj")
                     }
@@ -327,7 +327,7 @@ testGetDispatchEnv = Tasty.testGroup "DA.Daml.Assistant.Env.getDispatchEnv"
                     , envDamlAssistantPath = DamlAssistantPath (base </> ".daml" </> "bin" </> "strange-daml")
                     , envDamlAssistantSdkVersion = Nothing
                     , envSdkVersion = Nothing
-                    , envLatestStableSdkVersion = pure Nothing
+                    , envFreshStableSdkVersionForCheck = pure Nothing
                     , envSdkPath = Nothing
                     , envProjectPath = Nothing
                     }