From fc8eadf16444f2b15c35505907deeada60215b7f Mon Sep 17 00:00:00 2001 From: Gary Verhaegen Date: Mon, 6 Feb 2023 13:29:03 +0100 Subject: [PATCH] stop managing docs (#16226) The docs S3 bucket will now be entirely managed by the docs repo CI. --- azure-cron.yml | 20 ---- ci/cron/src/Docs.hs | 271 ------------------------------------------ ci/cron/src/Github.hs | 29 ----- ci/cron/src/Main.hs | 12 +- 4 files changed, 2 insertions(+), 330 deletions(-) delete mode 100644 ci/cron/src/Docs.hs diff --git a/azure-cron.yml b/azure-cron.yml index 432997c8c2..97f3668be8 100644 --- a/azure-cron.yml +++ b/azure-cron.yml @@ -30,26 +30,6 @@ trigger: none jobs: - template: ci/fix-bazel-cache.yml - - job: docs - timeoutInMinutes: 120 - pool: - name: 'ubuntu_20_04' - demands: assignment -equals default - steps: - - checkout: self - - bash: ci/dev-env-install.sh - displayName: 'Build/Install the Developer Environment' - - bash: | - set -euo pipefail - eval "$(dev-env/bin/dade assist)" - - bazel build //ci/cron:cron - ./bazel-bin/ci/cron/cron docs - env: - AWS_ACCESS_KEY_ID: $(AWS_ACCESS_KEY_ID) - AWS_SECRET_ACCESS_KEY: $(AWS_SECRET_ACCESS_KEY) - - template: ci/tell-slack-failed.yml - - job: docker_image timeoutInMinutes: 60 pool: diff --git a/ci/cron/src/Docs.hs b/ci/cron/src/Docs.hs deleted file mode 100644 index 4c991b21a8..0000000000 --- a/ci/cron/src/Docs.hs +++ /dev/null @@ -1,271 +0,0 @@ --- Copyright (c) 2023 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. --- SPDX-License-Identifier: Apache-2.0 - - --- | The docs cronjob runs through the following steps --- --- 1. Download the list of available releases from GH releases. --- 2. Download the list of available releases from S3 based on the contents of --- `/versions.json` and `/snapshots.json`. --- 3. For each version that is in GH but not in S3 run through those steps: --- 3.1. Check if the release has already been uploaded under `/$version/`. If so do nothing. --- We hit this for the split release process for 2.0 and newer. --- 3.2. If not, build it in the Daml repository and upload. --- We hit this for the non-split release process. --- 4. At this point, all releases have been uploaded. What remains to be done is --- updating the top-level release to the latest stable release that has --- been marked stable on GH. --- 5. Finally we update the versions.json and snapshots.json on S3 to match GH. --- --- This assumes that: --- --- 1. The assembly repo uploads a release to `/version/` but leaves --- moving it to the top-level to this cron job. --- 2. The assembly repo uploads to S3 before creating a GH release. -module Docs (docs, sdkDocOpts, damlOnSqlDocOpts) where - -import Control.Exception.Safe -import qualified Control.Monad as Control -import qualified Control.Monad.Extra -import qualified Data.Aeson as JSON -import qualified Data.Aeson.Key as JSON -import qualified Data.Aeson.KeyMap as JSON -import qualified Data.ByteString.Lazy.UTF8 as LBS -import Data.Either (isRight) -import qualified Data.Foldable -import Data.Function ((&)) -import qualified Data.List -import Data.Maybe (fromMaybe) -import qualified Data.Ord -import qualified Data.Set as Set -import qualified System.Directory.Extra as Directory -import qualified System.FilePath as FilePath -import qualified System.Environment -import qualified System.Exit as Exit -import System.FilePath.Posix (()) -import qualified System.IO.Extra as IO -import qualified System.Process as System - -import Github - -die :: String -> Int -> String -> String -> IO a -die cmd exit out err = - fail $ unlines ["Subprocess:", - cmd, - "failed with exit code " <> show exit <> "; output:", - "---", - out, - "---", - "err:", - "---", - err, - "---"] - -shell :: String -> IO String -shell cmd = System.readCreateProcess (System.shell cmd) "" - -proc :: [String] -> IO String -proc args = System.readCreateProcess (System.proc (head args) (tail args)) "" - -shell_ :: String -> IO () -shell_ cmd = do - Control.void $ shell cmd - -proc_ :: [String] -> IO () -proc_ args = Control.void $ do - print args - proc args - -shell_env_ :: [(String, String)] -> String -> IO () -shell_env_ env cmd = do - parent_env <- System.Environment.getEnvironment - Control.void $ System.readCreateProcess ((System.shell cmd) {System.env = Just (parent_env ++ env)}) "" - -robustly_download_nix_packages :: IO () -robustly_download_nix_packages = do - h (10 :: Integer) - where - cmd = "nix-build nix -A tools -A ci-cached --no-out-link" - h n = do - (exit, out, err) <- System.readCreateProcessWithExitCode (System.shell cmd) "" - case (exit, n) of - (Exit.ExitSuccess, _) -> return () - (Exit.ExitFailure exit, 0) -> die cmd exit out err - _ | "unexpected end-of-file" `Data.List.isInfixOf` err -> h (n - 1) - (Exit.ExitFailure exit, _) -> die cmd exit out err - -s3Path :: DocOptions -> FilePath -> String -s3Path DocOptions{s3Subdir} file = - "s3://docs-daml-com" fromMaybe "" s3Subdir file - --- We use a check for a file to check if the docs for a given version exist or not. --- This is technically slightly racy if the upload happens concurrently and we end up with a partial upload --- but the window seems small enough to make this acceptable. -doesVersionExist :: DocOptions -> Version -> IO Bool -doesVersionExist opts version = do - r <- tryIO $ IO.withTempFile $ \file -> proc_ ["aws", "s3", "cp", s3Path opts (show version fileToCheck opts), file] - pure (isRight r) - -build_and_push :: DocOptions -> FilePath -> [Version] -> IO () -build_and_push opts@DocOptions{build} temp versions = do - restore_sha $ do - Data.Foldable.for_ versions (\version -> do - putStrLn $ "Check if version " <> show version <> " exists ..." - exists <- doesVersionExist opts version - if exists - then putStrLn $ "Version " <> show version <> " already exists (split-release)" - else do - putStrLn $ "Building " <> show version <> "..." - build temp version - putStrLn $ "Pushing " <> show version <> " to S3 (as subfolder)..." - push version - putStrLn "Done.") - where - restore_sha io = - bracket (init <$> shell "git symbolic-ref --short HEAD 2>/dev/null || git rev-parse HEAD") - (\cur_sha -> proc_ ["git", "checkout", cur_sha]) - (const io) - push version = - proc_ ["aws", "s3", "cp", - temp show version, - s3Path opts (show version), - "--recursive", "--acl", "public-read"] - -fetch_if_missing :: DocOptions -> FilePath -> Version -> IO () -fetch_if_missing opts temp v = do - missing <- not <$> Directory.doesDirectoryExist (temp show v) - if missing then do - -- We hit this for all split releases as well as non-split releases that - -- have been built before being marked stable. - putStrLn $ "Downloading " <> show v <> "..." - proc_ ["aws", "s3", "cp", s3Path opts (show v), temp show v, "--recursive"] - putStrLn "Done." - else do - putStrLn $ show v <> " already present." - -update_s3 :: DocOptions -> FilePath -> Versions -> IO () -update_s3 opts temp vs = do - let displayed = dropdown vs - let hidden = Data.List.sortOn Data.Ord.Down $ Set.toList $ all_versions vs `Set.difference` Set.fromList displayed - -- The assistant depends on these three files, they are not just internal - -- to the docs process. - push (versions_json displayed) "versions.json" - push (versions_json hidden) "snapshots.json" - Control.Monad.Extra.whenJust (top vs) $ \latest -> push (show latest) "latest" - putStrLn "Done." - where - -- Not going through Aeson because it represents JSON objects as - -- unordered maps, and here order matters. - versions_json vs = vs - & map ((\s -> "\"" <> s <> "\": \"" <> s <> "\"") . show) - & Data.List.intercalate ", " - & \s -> "{" <> s <> "}" - push text name = do - writeFile (temp name) text - proc_ ["aws", "s3", "cp", temp name, s3Path opts name, "--acl", "public-read"] - -update_top_level :: DocOptions -> FilePath -> Version -> Maybe Version -> IO () -update_top_level opts temp new mayOld = do - new_files <- Set.fromList <$> files_under new - old_files <- case mayOld of - Nothing -> pure Set.empty - Just old -> Set.fromList <$> files_under old - let to_delete = Set.toList $ old_files `Set.difference` new_files - Control.when (not $ null to_delete) $ do - putStrLn $ "Deleting top-level files: " <> show to_delete - Data.Foldable.for_ to_delete (\f -> do - proc_ ["aws", "s3", "rm", s3Path opts f]) - putStrLn "Done." - putStrLn $ "Pushing " <> show new <> " to top-level..." - let root = s3Path opts "" <> "/" - proc_ ["aws", "s3", "cp", temp show new, root, "--recursive", "--acl", "public-read"] - putStrLn "Done." - where files_under folder = do - let root = temp show folder - full_paths <- Directory.listFilesRecursive root - return $ map (FilePath.makeRelative root) full_paths - -reset_cloudfront :: IO () -reset_cloudfront = do - putStrLn "Refreshing CloudFront cache..." - shell_ "aws cloudfront create-invalidation --distribution-id E1U753I56ERH55 --paths '/*'" - -fetch_s3_versions :: DocOptions -> IO Versions -fetch_s3_versions opts = do - -- On the first run, this will fail so treat it like an empty file. - dropdown <- fetch "versions.json" False `catchIO` (\_ -> pure []) - hidden <- fetch "snapshots.json" True `catchIO` (\_ -> pure []) - return $ versions $ dropdown <> hidden - where fetch file prerelease = do - temp <- shell "mktemp" - proc_ ["aws", "s3", "cp", s3Path opts file, temp] - s3_raw <- proc ["cat", temp] - let type_annotated_value :: Maybe JSON.Object - type_annotated_value = JSON.decode $ LBS.fromString s3_raw - case type_annotated_value of - Just s3_json -> return $ map (\s -> GitHubRelease prerelease (version $ JSON.toText s) []) $ JSON.keys s3_json - Nothing -> Exit.die "Failed to get versions from s3" - -data DocOptions = DocOptions - { s3Subdir :: Maybe FilePath - , includedVersion :: Version -> Bool - -- Exclusive minimum version bound for which we build docs - , build :: FilePath -> Version -> IO () - , fileToCheck :: FilePath - } - -sdkDocOpts :: DocOptions -sdkDocOpts = DocOptions - { s3Subdir = Nothing - -- versions prior to 0.13.10 cannot be built anymore and are not present in - -- the repo. - , includedVersion = \v -> v >= version "0.13.10" - , build = \temp version -> do - proc_ ["git", "checkout", "v" <> show version] - robustly_download_nix_packages - shell_env_ [("DAML_SDK_RELEASE_VERSION", show version)] "bazel build //docs:docs" - proc_ ["mkdir", "-p", temp show version] - proc_ ["tar", "xzf", "bazel-bin/docs/html.tar.gz", "--strip-components=1", "-C", temp show version] - , fileToCheck = "versions.json" - } - -damlOnSqlDocOpts :: DocOptions -damlOnSqlDocOpts = DocOptions - { s3Subdir = Just "daml-driver-for-postgresql" - , includedVersion = \v -> v > version "1.8.0-snapshot.20201201.5776.0.4b91f2a6" - && v <= version "2.0.0-snapshot.20220209.9212.0.b7fc9f57" - , build = \temp version -> do - proc_ ["git", "checkout", "v" <> show version] - robustly_download_nix_packages - shell_env_ [("DAML_SDK_RELEASE_VERSION", show version)] "bazel build //ledger/daml-on-sql:docs" - proc_ ["mkdir", "-p", temp show version] - proc_ ["tar", "xzf", "bazel-bin/ledger/daml-on-sql/html.tar.gz", "--strip-components=1", "-C", temp show version] - , fileToCheck = "index.html" - } - -docs :: DocOptions -> IO () -docs opts@DocOptions{includedVersion} = do - putStrLn "Checking for new version..." - gh_versions <- fetch_gh_versions includedVersion - s3_versions <- fetch_s3_versions opts - if s3_versions == gh_versions - then do - putStrLn "Versions match, nothing to do." - else do - -- We may have added versions. We need to build and push them. - let added = Set.toList $ all_versions gh_versions `Set.difference` all_versions s3_versions - -- post-2.0 versions are built and pushed by the docs.daml.com repo - let to_build = filter (version "2.0.0" >) added - IO.withTempDir $ \temp_dir -> do - putStrLn $ "Versions to build: " <> show added - build_and_push opts temp_dir to_build - -- If there is no version on GH, we don’t have to do anything. - Control.Monad.Extra.whenJust (top gh_versions) $ \gh_top -> - Control.when (Just gh_top /= top s3_versions) $ do - putStrLn $ "Updating top-level version from " <> (show $ top s3_versions) <> " to " <> (show $ top gh_versions) - fetch_if_missing opts temp_dir gh_top - Control.Monad.Extra.whenJust (top s3_versions) (fetch_if_missing opts temp_dir) - update_top_level opts temp_dir gh_top (top s3_versions) - putStrLn "Updating versions.json, snapshots.json, latest..." - update_s3 opts temp_dir gh_versions - reset_cloudfront diff --git a/ci/cron/src/Github.hs b/ci/cron/src/Github.hs index fa16bfdf8b..6db69ca6b9 100644 --- a/ci/cron/src/Github.hs +++ b/ci/cron/src/Github.hs @@ -4,13 +4,8 @@ module Github ( Asset(..) , GitHubRelease(..) - , Version(..) - , Versions(..) , add_github_contact_header - , version - , versions , fetch_gh_paginated - , fetch_gh_versions ) where import Data.Aeson @@ -19,18 +14,13 @@ import qualified Data.CaseInsensitive as CI import Data.Function ((&)) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HMS -import Data.List (sortOn) import qualified Data.List.Split as Split -import Data.Ord (Down(..)) import qualified Data.SemVer as SemVer -import Data.Set (Set) -import qualified Data.Set as Set import qualified Data.Text as Text import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.TLS as TLS import Network.HTTP.Types.Status (statusCode) import Network.URI -import Safe (headMay) import qualified System.Exit as Exit import qualified Text.Regex.TDFA as Regex @@ -56,25 +46,6 @@ instance Show Version where version :: Text.Text -> Version version t = Version $ (\case Left s -> (error s); Right v -> v) $ SemVer.fromText t -data Versions = Versions { top :: Maybe Version, all_versions :: Set Version, dropdown :: [Version] } - deriving Eq - -versions :: [GitHubRelease] -> Versions -versions vs = - let all_versions = Set.fromList $ map tag vs - dropdown = vs - & filter (not . prerelease) - & map tag - & filter (>= version "1.0.0") - & sortOn Down - top = headMay dropdown - in Versions {..} - -fetch_gh_versions :: (Version -> Bool) -> IO Versions -fetch_gh_versions pred = do - response <- fetch_gh_paginated "https://api.github.com/repos/digital-asset/daml/releases" - return $ versions $ filter (\v -> pred (tag v)) response - fetch_gh_paginated :: String -> IO [GitHubRelease] fetch_gh_paginated url = do (resp_0, headers) <- http_get url diff --git a/ci/cron/src/Main.hs b/ci/cron/src/Main.hs index a56cf2f9de..e7e13c29e0 100644 --- a/ci/cron/src/Main.hs +++ b/ci/cron/src/Main.hs @@ -5,25 +5,20 @@ module Main (main) where import qualified BazelCache import qualified CheckReleases -import qualified Docs import qualified Control.Monad as Control import qualified Options.Applicative as Opt import qualified System.IO.Extra as IO -data CliArgs = Docs - | Check { bash_lib :: String, +data CliArgs = Check { bash_lib :: String, max_releases :: Maybe Int } | BazelCache BazelCache.Opts parser :: Opt.ParserInfo CliArgs parser = info "This program is meant to be run by CI cron. You probably don't have sufficient access rights to run it locally." - (Opt.hsubparser (Opt.command "docs" docs - <> Opt.command "check" check + (Opt.hsubparser (Opt.command "check" check <> Opt.command "bazel-cache" bazelCache)) where info t p = Opt.info (p Opt.<**> Opt.helper) (Opt.progDesc t) - docs = info "Build & push latest docs, if needed." - (pure Docs) check = info "Check existing releases." (Check <$> Opt.strOption (Opt.long "bash-lib" <> Opt.metavar "PATH" @@ -63,9 +58,6 @@ main = do \h -> IO.hSetBuffering h IO.LineBuffering opts <- Opt.execParser parser case opts of - Docs -> do - Docs.docs Docs.sdkDocOpts - Docs.docs Docs.damlOnSqlDocOpts Check { bash_lib, max_releases } -> CheckReleases.check_releases bash_lib max_releases BazelCache opts -> BazelCache.run opts