Publish DAML on SQL Docs (#8191)

changelog_begin changelog_end
2024-09-19 16:57:40 +03:00 · 2020-12-08 13:49:37 +01:00 · 2020-12-08 13:49:37 +01:00 · 880d290285
commit 880d290285
parent 0ee2159218
2 changed files with 86 additions and 44 deletions
--- a/ci/cron/BUILD.bazel
+++ b/ci/cron/BUILD.bazel
@ -24,6 +24,7 @@ da_haskell_binary(
        "optparse-applicative",
        "process",
        "regex-tdfa",
+        "safe",
        "semver",
        "split",
        "text",
--- a/ci/cron/src/Main.hs
+++ b/ci/cron/src/Main.hs
@ -22,6 +22,7 @@ import qualified Data.Foldable
 import qualified Data.HashMap.Strict as H
 import qualified Data.List
 import qualified Data.List.Split as Split
+import Data.Maybe (fromMaybe)
 import qualified Data.Ord
 import qualified Data.SemVer
 import qualified Data.Set as Set
@ -31,6 +32,7 @@ import qualified Network.HTTP.Client.TLS as TLS
 import qualified Network.HTTP.Types.Status as Status
 import qualified Network.URI
 import qualified Options.Applicative as Opt
+import Safe (headMay)
 import qualified System.Directory as Directory
 import qualified System.Exit as Exit
 import qualified System.IO.Extra as IO
@ -96,12 +98,16 @@ http_get url = do
      _ -> Exit.die $ unlines ["GET \"" <> url <> "\" returned status code " <> show status <> ".",
                               show $ HTTP.responseBody response]

-build_and_push :: FilePath -> [Version] -> IO ()
-build_and_push temp versions = do
+s3Path :: DocOptions -> FilePath -> String
+s3Path DocOptions{s3Subdir} file =
+    "s3://docs-daml-com" </> fromMaybe "" s3Subdir </> file
+
+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 $ "Building " <> show version <> "..."
-            build version
+            build temp version
            putStrLn $ "Pushing " <> show version <> " to S3 (as subfolder)..."
            push version
            putStrLn "Done.")
@ -110,35 +116,32 @@ build_and_push temp versions = do
            Control.Exception.bracket (init <$> shell "git symbolic-ref --short HEAD 2>/dev/null || git rev-parse HEAD")
                                      (\cur_sha -> shell_ $ "git checkout " <> cur_sha)
                                      (const io)
-        build version = do
-            shell_ $ "git checkout v" <> show version
-            robustly_download_nix_packages
-            shell_ $ "DAML_SDK_RELEASE_VERSION=" <> show version <> " bazel build //docs:docs"
-            shell_ $ "mkdir -p  " <> temp </> show version
-            shell_ $ "tar xzf bazel-bin/docs/html.tar.gz --strip-components=1 -C" <> temp </> show version
        push version =
-            shell_ $ "aws s3 cp " <> (temp </> show version) </> " " <> "s3://docs-daml-com" </> show version </> " --recursive --acl public-read"
+            shell_ $ "aws s3 cp " <>
+              (temp </> show version) <> " " <>
+              s3Path opts (show version) <>
+              " --recursive --acl public-read"

-fetch_if_missing :: FilePath -> Version -> IO ()
-fetch_if_missing temp v = do
+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
        putStrLn $ "Downloading " <> show v <> "..."
-        shell_ $ "aws s3 cp s3://docs-daml-com" </> show v <> " " <> temp </> show v <> " --recursive"
+        shell_ $ "aws s3 cp " <> s3Path opts (show v) <> " " <> temp </> show v <> " --recursive"
        putStrLn "Done."
    else do
        putStrLn $ show v <> " already present."

-update_s3 :: FilePath -> Versions -> IO ()
-update_s3 temp vs = do
+update_s3 :: DocOptions -> FilePath -> Versions -> IO ()
+update_s3 opts temp vs = do
    putStrLn "Updating versions.json & hidden.json..."
    create_versions_json (dropdown vs) (temp </> "versions.json")
    let hidden = Data.List.sortOn Data.Ord.Down $ Set.toList $ all_versions vs `Set.difference` (Set.fromList $ dropdown vs)
    create_versions_json hidden (temp </> "hidden.json")
-    shell_ $ "aws s3 cp " <> temp </> "versions.json s3://docs-daml-com/versions.json --acl public-read"
-    shell_ $ "aws s3 cp " <> temp </> "hidden.json s3://docs-daml-com/hidden.json --acl public-read"
+    shell_ $ "aws s3 cp " <> temp </> "versions.json " <> s3Path opts "versions.json" <> " --acl public-read"
+    shell_ $ "aws s3 cp " <> temp </> "hidden.json " <> s3Path opts "hidden.json" <> " --acl public-read"
    -- FIXME: remove after running once (and updating the reading bit in this file)
-    shell_ $ "aws s3 cp " <> temp </> "hidden.json s3://docs-daml-com/snapshots.json --acl public-read"
+    shell_ $ "aws s3 cp " <> temp </> "hidden.json " <> s3Path opts "snapshots.json" <> " --acl public-read"
    putStrLn "Done."
    where
        create_versions_json versions file = do
@ -151,18 +154,21 @@ update_s3 temp vs = do
                                & \s -> "{" <> s <> "}"
            writeFile file versions_json

-update_top_level :: FilePath -> Version -> Version -> IO ()
-update_top_level temp new old = do
+update_top_level :: DocOptions -> FilePath -> Version -> Maybe Version -> IO ()
+update_top_level opts temp new mayOld = do
    new_files <- Set.fromList <$> Directory.listDirectory (temp </> show new)
-    old_files <- Set.fromList <$> Directory.listDirectory (temp </> show old)
+    old_files <- case mayOld of
+        Nothing -> pure Set.empty
+        Just old -> Set.fromList <$> Directory.listDirectory (temp </> show 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
-            shell_ $ "aws s3 rm s3://docs-daml-com" </> f <> " --recursive")
+            shell_ $ "aws s3 rm " <> s3Path opts f <> " --recursive")
        putStrLn "Done."
    putStrLn $ "Pushing " <> show new <> " to top-level..."
-    shell_ $ "aws s3 cp " <> temp </> show new </> " s3://docs-daml-com/ --recursive --acl public-read"
+    let path = s3Path opts "" <> "/"
+    shell_ $ "aws s3 cp " <> temp </> show new </> " " <> path <> " --recursive --acl public-read"
    putStrLn "Done."

 reset_cloudfront :: IO ()
@ -213,7 +219,7 @@ instance Show Version where
 version :: Text.Text -> Version
 version t = Version $ (\case Left s -> (error s); Right v -> v) $ Data.SemVer.fromText t

-data Versions = Versions { top :: Version, all_versions :: Set.Set Version, dropdown :: [Version] }
+data Versions = Versions { top :: Maybe Version, all_versions :: Set.Set Version, dropdown :: [Version] }
    deriving Eq

 versions :: [GitHubRelease] -> Versions
@ -224,25 +230,23 @@ versions vs =
                   & map tag
                   & filter (>= version "1.0.0")
                   & Data.List.sortOn Data.Ord.Down
-        top = head dropdown
+        top = headMay dropdown
    in Versions {..}

-fetch_gh_versions :: IO Versions
-fetch_gh_versions = do
+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"
-    -- versions prior to 0.13.10 cannot be built anymore and are not present in
-    -- the repo.
-    return $ versions $ filter (\v -> tag v >= version "0.13.10") response
+    return $ versions $ filter (\v -> pred (tag v)) response

-fetch_s3_versions :: IO Versions
-fetch_s3_versions = do
+fetch_s3_versions :: DocOptions -> IO Versions
+fetch_s3_versions opts = do
    dropdown <- fetch "versions.json" False
    -- TODO: read hidden.json after this has run once
    hidden <- fetch "snapshots.json" True
    return $ versions $ dropdown <> hidden
    where fetch file prerelease = do
              temp <- shell "mktemp"
-              shell_ $ "aws s3 cp s3://docs-daml-com/" <> file <> " " <> temp
+              shell_ $ "aws s3 cp " <> s3Path opts file <> " " <> temp
              s3_raw <- shell $ "cat " <> temp
              let type_annotated_value :: Maybe JSON.Object
                  type_annotated_value = JSON.decode $ LBS.fromString s3_raw
@ -250,11 +254,44 @@ fetch_s3_versions = do
                  Just s3_json -> return $ map (\s -> GitHubRelease prerelease (version s) []) $ H.keys s3_json
                  Nothing -> Exit.die "Failed to get versions from s3"

-docs :: IO ()
-docs = do
+data DocOptions = DocOptions
+  { s3Subdir :: Maybe FilePath
+  , includedVersion :: Version -> Bool
+    -- Exclusive minimum version bound for which we build docs
+  , build :: FilePath -> Version -> IO ()
+  }
+
+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
+        shell_ $ "git checkout v" <> show version
+        robustly_download_nix_packages
+        shell_ $ "DAML_SDK_RELEASE_VERSION=" <> show version <> " bazel build //docs:docs"
+        shell_ $ "mkdir -p  " <> temp </> show version
+        shell_ $ "tar xzf bazel-bin/docs/html.tar.gz --strip-components=1 -C" <> temp </> show version
+  }
+
+damlOnSqlDocOpts :: DocOptions
+damlOnSqlDocOpts = DocOptions
+  { s3Subdir = Just "daml-driver-for-postgresql"
+  , includedVersion = \v -> v > version "1.8.0-snapshot.20201201.5776.0.4b91f2a6"
+  , build = \temp version -> do
+        shell_ $ "git checkout v" <> show version
+        robustly_download_nix_packages
+        shell_ $ "DAML_SDK_RELEASE_VERSION=" <> show version <> " bazel build //ledger/daml-on-sql:docs"
+        shell_ $ "mkdir -p  " <> temp </> show version
+        shell_ $ "tar xzf bazel-bin/ledger/daml-on-sql/html.tar.gz --strip-components=1 -C" <> temp </> show version
+  }
+
+docs :: DocOptions -> IO ()
+docs opts@DocOptions{includedVersion} = do
    putStrLn "Checking for new version..."
-    gh_versions <- fetch_gh_versions
-    s3_versions <- fetch_s3_versions
+    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."
@ -263,14 +300,16 @@ docs = do
        let added = Set.toList $ all_versions gh_versions `Set.difference` all_versions s3_versions
        IO.withTempDir $ \temp_dir -> do
            putStrLn $ "Versions to build: " <> show added
-            build_and_push temp_dir added
-            Control.when (top gh_versions /= top s3_versions) $ do
+            build_and_push opts temp_dir added
+            -- 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 temp_dir (top gh_versions)
-                fetch_if_missing temp_dir (top s3_versions)
-                update_top_level temp_dir (top gh_versions) (top s3_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 & hidden.json"
-            update_s3 temp_dir gh_versions
+            update_s3 opts temp_dir gh_versions
        reset_cloudfront

 download_assets :: FilePath -> GitHubRelease -> IO ()
@ -414,5 +453,7 @@ main = do
        \h -> IO.hSetBuffering h IO.LineBuffering
    opts <- Opt.execParser parser
    case opts of
-      Docs -> docs
+      Docs -> do
+          docs sdkDocOpts
+          docs damlOnSqlDocOpts
      Check { bash_lib, gcp_credentials, max_releases } -> check_releases gcp_credentials bash_lib max_releases