├── .github └── workflows │ ├── ci.yml │ └── release.yml ├── README.md ├── bb.edn ├── brew ├── garden-cask.template ├── garden-formula.template ├── update-cask.sh └── update-formula.sh ├── build.sh ├── deps.edn ├── flake.lock ├── flake.nix ├── nix └── garden.nix ├── resources ├── .gitkeep ├── VERSION └── default-template-coords.edn ├── src └── nextjournal │ ├── edit_distance.clj │ ├── garden_cli.clj │ ├── start_command.clj │ └── template.clj └── standalone-build.sh /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: 6 | - main 7 | 8 | # Allows you to run this workflow manually from the Actions tab 9 | workflow_dispatch: 10 | 11 | jobs: 12 | build-cli: 13 | runs-on: ubuntu-latest 14 | steps: 15 | - name: Checkout 16 | uses: actions/checkout@v3 17 | with: 18 | # fetch all history to get the commits required for tagging releases 19 | fetch-depth: 0 20 | # use a PAT instead of GITHUB_TOKEN to push the tags to trigger the release worflow when pushing tags 21 | # https://stackoverflow.com/questions/75348291/how-to-trigger-github-actions-workflow-whenever-a-new-tag-was-pushed 22 | token: ${{secrets.CLASSIC_REPO_TOKEN}} 23 | 24 | - name: Install babashka 25 | run: | 26 | bash < <(curl -s https://raw.githubusercontent.com/babashka/babashka/master/install) 27 | 28 | - name: Build standalone cli 29 | run: | 30 | ./standalone-build.sh target 31 | 32 | - name: Build bb dependent launcher 33 | id: portable-build 34 | run: | 35 | ./build.sh target 36 | echo "sha256=$(cat target/garden.tar.gz.sha256)" >> $GITHUB_OUTPUT 37 | 38 | - name: Upload build 39 | uses: actions/upload-artifact@v3 40 | with: 41 | path: target/* 42 | 43 | - name: Tag releases 44 | # find all commits since last version tag that touch resources/VERSION and tag them with a version based on the contents of resources/VERSION 45 | run: | 46 | lastTaggedRelease=$(git describe --match="v*" --tags --abbrev=0 || git rev-list --max-parents=0 HEAD) 47 | commits=$(git log --format=%H "$lastTaggedRelease.." resources/VERSION) 48 | [ -z $commits ] || echo $commits | while read commit; do 49 | version="$(git show "$commit:resources/VERSION")" 50 | git tag "v$version" "$commit" 51 | done 52 | git push --tags 53 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | name: Release 2 | 3 | on: 4 | push: 5 | tags: 6 | - v* 7 | 8 | jobs: 9 | build-cli: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - name: Checkout 13 | uses: actions/checkout@v3 14 | 15 | - name: Install babashka 16 | run: | 17 | bash < <(curl -s https://raw.githubusercontent.com/babashka/babashka/master/install) 18 | 19 | - name: Build standalone cli 20 | run: | 21 | ./standalone-build.sh target 22 | 23 | - name: Build bb dependent launcher 24 | id: portable-build 25 | run: | 26 | ./build.sh target 27 | echo "sha256=" >> $GITHUB_OUTPUT 28 | 29 | - name: Create release 30 | uses: softprops/action-gh-release@v1 31 | with: 32 | files: target/* 33 | 34 | - name: Update brew formula 35 | run: | 36 | ./brew/update-formula.sh ${{secrets.CLASSIC_REPO_TOKEN}} 37 | 38 | # - name: Update brew cask 39 | # run: | 40 | # ./brew/update-cask.sh ${{secrets.CLASSIC_REPO_TOKEN}} 41 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # application.garden CLI 2 | 3 | A command line interface for [application.garden](https://application.garden). Installation and usage are covered in the [documentation](https://docs.apps.garden/#installing-the-cli). 4 | -------------------------------------------------------------------------------- /bb.edn: -------------------------------------------------------------------------------- 1 | {:min-bb-version "1.3.189" 2 | :paths ["src" "resources"] 3 | :deps {nextjournal/garden-cli {:local/root "."}} 4 | :bbin/bin {garden {:main-opts ["-f" "src/nextjournal/garden_cli.clj"]}}} 5 | -------------------------------------------------------------------------------- /brew/garden-cask.template: -------------------------------------------------------------------------------- 1 | cask "garden" do 2 | arch arm: "aarch64", intel: "amd64" 3 | version "${VERSION}" 4 | sha256 arm: "${SHA256_AARCH64}", 5 | intel: "${SHA256_AMD64}" 6 | url "https://github.com/nextjournal/garden-cli/releases/download/v#{version}/garden-macos-#{arch}.tar.gz", 7 | verified: "https://github.com/nextjournal/garden-cli" 8 | name "application.garden command line interface" 9 | name "garden" 10 | desc "CLI for application.garden" 11 | homepage "https://application.garden" 12 | binary "garden" 13 | end 14 | -------------------------------------------------------------------------------- /brew/garden-formula.template: -------------------------------------------------------------------------------- 1 | class Garden < Formula 2 | desc "CLI for application.garden" 3 | homepage "application.garden" 4 | version "${VERSION}" 5 | 6 | if OS.linux? 7 | if Hardware::CPU.arm? 8 | url "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-linux-aarch64-static.tar.gz" 9 | sha256 "${LINUX_ARM_SHA}" 10 | else 11 | url "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-linux-amd64-static.tar.gz" 12 | sha256 "${LINUX_AMD_SHA}" 13 | end 14 | else 15 | if Hardware::CPU.arm? 16 | url "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-macos-aarch64.tar.gz" 17 | sha256 "${MACOS_ARM_SHA}" 18 | else 19 | url "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-macos-amd64.tar.gz" 20 | sha256 "${MACOS_AMD_SHA}" 21 | end 22 | end 23 | 24 | def install 25 | bin.install "garden" 26 | end 27 | 28 | test do 29 | system "#{bin}/garden", "version" 30 | end 31 | end 32 | -------------------------------------------------------------------------------- /brew/update-cask.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | set -ex 3 | PAT="$1" 4 | template="$(readlink -f "$(dirname "$0")/garden-cask.template")" 5 | VERSION="$(cat "$(readlink -f "$(dirname "$0")/../resources/VERSION")")" 6 | SHA256_AARCH64="$(curl -L "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-macos-aarch64.tar.gz.sha256")" 7 | SHA256_AMD64="$(curl -L "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-macos-amd64.tar.gz.sha256")" 8 | if [ -z "$VERSION" ]; then 9 | echo "No version found in $(readlink -f "$(dirname "$0")/../resources/VERSION")" 10 | exit 1 11 | fi 12 | if [ -z "$SHA256_AARCH64" ]; then 13 | echo "No version found in $(readlink -f "$(dirname "$0")/../target/garden-macos-aarch64.tar.gz.sha256")" 14 | echo "Run standalone-build.sh first." 15 | exit 1 16 | fi 17 | if [ -z "$SHA256_AARCH64" ]; then 18 | echo "No version found in $(readlink -f "$(dirname "$0")/../target/garden-macos-aarch64.tar.gz.sha256")" 19 | echo "Run standalone-build.sh first." 20 | exit 1 21 | fi 22 | cd "$(mktemp -d)" 23 | git clone "https://x-access-token:${PAT}@github.com/nextjournal/homebrew-brew" 24 | cd homebrew-brew 25 | mkdir -p Casks 26 | cp "$template" Casks/garden.rb 27 | sed -i "s/\${VERSION}/${VERSION}/g" Casks/garden.rb 28 | sed -i "s/\${SHA256_AARCH64}/${SHA256_AARCH64}/g" Casks/garden.rb 29 | sed -i "s/\${SHA256_AMD64}/${SHA256_AMD64}/g" Casks/garden.rb 30 | git config user.name "Update" 31 | git config user.email "nextjournal@users.noreply.github.com" 32 | git add Casks/garden.rb 33 | git commit -m "Update garden CLI cask" 34 | git push 35 | -------------------------------------------------------------------------------- /brew/update-formula.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | set -ex 3 | PAT="$1" 4 | template="$(readlink -f "$(dirname "$0")/garden-formula.template")" 5 | VERSION="$(cat "$(readlink -f "$(dirname "$0")/../resources/VERSION")")" 6 | LINUX_ARM_SHA="$(curl -L "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-linux-amd64-static.tar.gz.sha256")" 7 | LINUX_AMD_SHA="$(curl -L "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-linux-amd64-static.tar.gz.sha256")" 8 | MACOS_ARM_SHA="$(curl -L "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-macos-aarch64.tar.gz.sha256")" 9 | MACOS_AMD_SHA="$(curl -L "https://github.com/nextjournal/garden-cli/releases/download/v${VERSION}/garden-macos-amd64.tar.gz.sha256")" 10 | cd "$(mktemp -d)" 11 | git clone "https://x-access-token:${PAT}@github.com/nextjournal/homebrew-brew" 12 | cd homebrew-brew 13 | cp "$template" garden.rb 14 | sed -i "s/\${VERSION}/${VERSION}/g" garden.rb 15 | sed -i "s/\${LINUX_ARM_SHA}/${LINUX_ARM_SHA}/g" garden.rb 16 | sed -i "s/\${LINUX_AMD_SHA}/${LINUX_AMD_SHA}/g" garden.rb 17 | sed -i "s/\${MACOS_ARM_SHA}/${MACOS_ARM_SHA}/g" garden.rb 18 | sed -i "s/\${MACOS_AMD_SHA}/${MACOS_AMD_SHA}/g" garden.rb 19 | git config user.name "Update" 20 | git config user.email "nextjournal@users.noreply.github.com" 21 | git add garden.rb 22 | git commit -m "Update garden CLI" 23 | git push 24 | -------------------------------------------------------------------------------- /build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -ex 3 | if [ -z "$1" ]; then 4 | echo "Usage: $(basename "$0") " 5 | exit 1 6 | fi 7 | workdir="$(pwd)" 8 | clidir="$(dirname "$0")" 9 | target_dir="$(readlink -f "$1")" 10 | cd "$clidir" 11 | rev="$(git rev-parse HEAD)" 12 | shortRev="$(git rev-parse --short HEAD)" 13 | mkdir -p "$target_dir" 14 | tmpdir="$(mktemp -d)" 15 | cd "$tmpdir" 16 | echo "#!/bin/sh 17 | exec bb -Sdeps '{:deps {io.github.nextjournal/garden-cli {:git/sha \"${rev}\"}}}' -Dnextjournal.garden.rev=${shortRev} -m nextjournal.garden-cli \$@" > garden 18 | chmod +x garden 19 | tar caf "$target_dir/garden.tar.gz" garden 20 | sha256sum "$target_dir/garden.tar.gz" | cut -d " " -f 1 > "$target_dir/garden.tar.gz.sha256" 21 | cd "$workdir" 22 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src" "resources"] 2 | :deps {io.github.babashka/nrepl-client {:git/sha "c83b15906d224b67a67951343b05623c4c00cdcf"} 3 | io.github.seancorfield/deps-new {:git/tag "v0.6.0" 4 | :git/sha "64e79d1"}}} 5 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "nixpkgs": { 4 | "locked": { 5 | "lastModified": 1711532879, 6 | "narHash": "sha256-VUvOxVoxBokiZETZdZU97MnJpeKa19KqSOPlC84QB9Y=", 7 | "owner": "nixos", 8 | "repo": "nixpkgs", 9 | "rev": "2230a20f2b5a14f2db3d7f13a2dc3c22517e790b", 10 | "type": "github" 11 | }, 12 | "original": { 13 | "id": "nixpkgs", 14 | "ref": "nixpkgs-unstable", 15 | "type": "indirect" 16 | } 17 | }, 18 | "root": { 19 | "inputs": { 20 | "nixpkgs": "nixpkgs" 21 | } 22 | } 23 | }, 24 | "root": "root", 25 | "version": 7 26 | } 27 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "CLI for application.garden"; 3 | inputs.nixpkgs.url = "nixpkgs/nixpkgs-unstable"; 4 | outputs = { 5 | self, 6 | nixpkgs, 7 | ... 8 | }: let 9 | supportedSystems = [ 10 | "x86_64-linux" 11 | "aarch64-linux" 12 | "x86_64-darwin" 13 | "aarch64-darwin" 14 | ]; 15 | forAllSystems = nixpkgs.lib.genAttrs supportedSystems; 16 | in { 17 | packages = forAllSystems ( 18 | system: let 19 | pkgs = import nixpkgs { 20 | inherit system; 21 | overlays = [self.overlays.default]; 22 | }; 23 | in { 24 | inherit (pkgs) garden; 25 | default = pkgs.garden; 26 | } 27 | ); 28 | apps = forAllSystems ( 29 | system: { 30 | garden = { 31 | type = "app"; 32 | program = "${self.packages.${system}.garden}/bin/garden"; 33 | }; 34 | } 35 | ); 36 | overlays.default = final: prev: { 37 | garden = final.callPackage ./nix/garden.nix {rev = self.shortRev or "undefined";}; 38 | }; 39 | }; 40 | } 41 | -------------------------------------------------------------------------------- /nix/garden.nix: -------------------------------------------------------------------------------- 1 | { 2 | rev, 3 | writeShellScriptBin, 4 | babashka, 5 | ... 6 | }: 7 | writeShellScriptBin "garden" 8 | '' 9 | exec ${babashka}/bin/bb -Sforce --config ${../bb.edn} --deps-root ${../.} -Dnextjournal.garden.rev=${rev} -m nextjournal.garden-cli -- $@ 10 | '' 11 | -------------------------------------------------------------------------------- /resources/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nextjournal/garden-cli/8cbd0a719c7d0999dee93cb1e9e5387cb5e9ab1a/resources/.gitkeep -------------------------------------------------------------------------------- /resources/VERSION: -------------------------------------------------------------------------------- 1 | 0.1.15 2 | -------------------------------------------------------------------------------- /resources/default-template-coords.edn: -------------------------------------------------------------------------------- 1 | {io.github.nextjournal/garden-template 2 | {:git/url "https://github.com/nextjournal/garden-template", 3 | :git/sha "8a1d13adabbf4b348f3210205fe67ee477abd481"}} 4 | -------------------------------------------------------------------------------- /src/nextjournal/edit_distance.clj: -------------------------------------------------------------------------------- 1 | (ns nextjournal.edit-distance) 2 | 3 | (defn edit-distance [a b] 4 | (let [alen (count a) 5 | blen (count b) 6 | [longlen shortlen a b] (if (> alen blen) 7 | [alen blen a b] 8 | [blen alen b a]) 9 | [a' & a-rest] a 10 | [b' & b-rest] b] 11 | (if (zero? shortlen) 12 | longlen 13 | (if (= a' b') 14 | (edit-distance a-rest b-rest) 15 | (+ 1 (min (edit-distance a-rest b-rest) 16 | (edit-distance a-rest b))))))) 17 | 18 | (def max-edit-distance 3) 19 | (def max-candidates 3) 20 | 21 | (defn candidates [input available-cmds] 22 | (->> available-cmds 23 | (map (fn [c] {:dist (edit-distance c input) 24 | :cmd c})) 25 | (filter (fn [{:keys [dist]}] (<= dist max-edit-distance))) 26 | (sort-by :dist) 27 | (map :cmd) 28 | (take max-candidates))) 29 | -------------------------------------------------------------------------------- /src/nextjournal/garden_cli.clj: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bb 2 | ;; -*- mode: clojure -*- 3 | ;; launch nrepl from project `bb --config /bb.edn nrepl-server ` 4 | (ns nextjournal.garden-cli 5 | (:refer-clojure :exclude [pr-str]) 6 | (:require [babashka.cli :as cli] 7 | [babashka.fs :as fs] 8 | [babashka.process :as p :refer [shell sh]] 9 | [babashka.http-client :as http] 10 | [clojure.core :as core] 11 | [clojure.string :as str] 12 | [clojure.edn :as edn] 13 | [clojure.pprint :as pp] 14 | [cheshire.core :as json] 15 | [clojure.java.io :as io] 16 | [babashka.nrepl-client :as nrepl] 17 | [nextjournal.edit-distance :as edit-distance] 18 | [nextjournal.start-command :as start-command] 19 | [nextjournal.template :as template])) 20 | 21 | (def version (let [semver (try (str/trim (slurp (io/resource "VERSION"))) 22 | (catch Exception _ nil)) 23 | gitrev (try (let [{:keys [exit out]} (sh ["git" "rev-parse" "--short" "HEAD"] {:dir (str (fs/parent *file*)) 24 | :out :string})] 25 | (when (zero? exit) 26 | (str/trim out)) 27 | (System/getProperty "nextjournal.garden.rev")) 28 | (catch Exception _ nil)) 29 | version (str "v" semver (when gitrev (str "-" gitrev)))] 30 | version)) 31 | 32 | (defn print-version [_] 33 | (println version)) 34 | 35 | (declare help) 36 | 37 | (defn garden-project? [] (fs/exists? "garden.edn")) 38 | 39 | (defn pr-str [& xs] 40 | (binding [*print-namespace-maps* false] 41 | (apply core/pr-str xs))) 42 | 43 | (defn print-error [s] 44 | (binding [*out* *err*] 45 | (println s)) 46 | {:exit-code 1}) 47 | 48 | (def ^:dynamic *debug* false) 49 | 50 | (defn print-debug [& s] 51 | (when *debug* 52 | (binding [*out* *err*] 53 | (apply println s)))) 54 | 55 | (defn read-config [] 56 | (try 57 | (edn/read-string (slurp "garden.edn")) 58 | (catch Throwable _ {}))) 59 | #_(read-config) 60 | 61 | (def arboretum-ssh-host 62 | (or (System/getenv "ARBORETUM_SSH_DEST") 63 | (:ssh-server (read-config)) 64 | "arboretum@ssh.application.garden")) 65 | 66 | (defn git-remote-url [project] (str "ssh://" arboretum-ssh-host "/" project ".git")) 67 | 68 | (defn ssh-args 69 | ([] (ssh-args nil nil)) 70 | ([command] (ssh-args command nil)) 71 | ([command body] 72 | (let [[host port] (clojure.string/split arboretum-ssh-host #":")] 73 | (concat (when port ["-p" port]) 74 | (cond-> ["-n" "-o" "StrictHostKeyChecking=accept-new" "-o" "ControlMaster=no" "-o" "ControlPath=none" host] 75 | command (conj command) 76 | body (conj (pr-str body))))))) 77 | 78 | (defn update-config! [f & args] (spit "garden.edn" (str (pr-str (apply f (read-config) args)) "\n"))) 79 | #_(update-config! assoc :v "1.2.1") 80 | 81 | (defn call-api [{:as body :keys [as]}] 82 | (let [cmd (concat ["ssh"] (ssh-args "api" (assoc body :version version)))] 83 | (print-debug (str/join " " cmd)) 84 | (cond-> (apply shell {:out (if (= :stream as) :inherit :string)} cmd) 85 | (not= :stream as) 86 | (-> :out edn/read-string)))) 87 | 88 | #_(call-api {:command "create"}) 89 | #_(call-api {:command "create" :project "hello"}) 90 | #_(call-api {:command "info" :project "toboga"}) 91 | #_(call-api {:command "list"}) 92 | 93 | (defn reset [] 94 | (fs/delete-if-exists "garden.edn")) 95 | 96 | (defn project-dir [] 97 | (fs/cwd)) 98 | 99 | (defn git-repo? [target-dir] 100 | (try (= 0 (:exit (sh ["git" "status"] {:dir target-dir}))) 101 | (catch Exception _ false))) 102 | 103 | (defn path-from-git-root-parent [] 104 | (not-empty (str/trim (str (:out (sh "git rev-parse --show-prefix")))))) 105 | 106 | #_(path-from-git-root-parent) 107 | 108 | (defn empty-git-repo? [target-dir] 109 | (pos? (:exit (sh ["git" "rev-parse" "HEAD"] {:dir target-dir})))) 110 | 111 | (defn setup-git-remote! [remote-url] 112 | (sh "git remote rm garden") 113 | (sh "git remote add garden" remote-url)) 114 | #_(setup-git-remote! "git@github.com:zampino/foo") 115 | 116 | (defn init [{:keys [opts]}] 117 | (let [target-dir (str (fs/cwd))] 118 | (when-not (git-repo? target-dir) 119 | (println "Initializing git repo.") 120 | (sh ["git" "init"] {:dir target-dir})) 121 | (let [project-name (or (-> opts :project) 122 | (when-not (:force opts) (:project (read-config))))] 123 | (when (:force opts) (reset)) 124 | (if (garden-project?) 125 | (print-error (format "There is already an existing application.garden project (%s) in this repository. Use --force to overwrite." 126 | (:project (read-config)))) 127 | 128 | ;; we might have cloned a repo tracking `garden.edn`: we validate the project name against the server anyway 129 | (let [{:keys [ok message id name]} (call-api (cond-> {:command "create"} 130 | project-name (assoc :project project-name)))] 131 | (if ok 132 | (do 133 | (println message) 134 | (update-config! assoc :project name) 135 | (when (empty? (remove #{".git" "garden.edn" ".garden"} (map fs/file-name (fs/list-dir (project-dir))))) 136 | (template/create (-> opts 137 | (assoc :name name) 138 | (dissoc :force :quiet :output-format))) 139 | (sh ["git" "add" "."]) 140 | (sh ["git" "commit" "-m" "init"])) 141 | (when-not (-> opts :project) 142 | (println "You can rename your project at any time via `garden rename `.")) 143 | (if (empty-git-repo? target-dir) 144 | (println (str "First create a commit, then run `garden deploy` to deploy your project.")) 145 | (println (str " Run `garden deploy` to deploy your project."))) 146 | (setup-git-remote! (git-remote-url id))) 147 | 148 | (print-error message))))))) 149 | 150 | (defn wait-for 151 | ([f] (wait-for f 10)) 152 | ([f timeout-seconds] 153 | (loop [time-left timeout-seconds] 154 | (let [sleep-seconds 1] 155 | (Thread/sleep (* sleep-seconds 1000)) 156 | (if (f) 157 | {:success true} 158 | (if (>= time-left 0) 159 | (recur (- time-left sleep-seconds)) 160 | {:error :timeout})))))) 161 | 162 | (defn run [{:keys [opts]}] 163 | (println "Starting application locally...") 164 | (let [http-port 7777 165 | url (str "http://localhost:" http-port) 166 | nrepl-port 6666 167 | storage-dir (fs/absolutize ".garden/storage") 168 | timeout-seconds (* 5 60) 169 | garden-alias (try (edn/read-string (slurp "deps.edn")) (catch Exception _ (print-error "Malformed deps.edn"))) 170 | app-process (promise) 171 | start-command (start-command/start-command (assoc opts :garden-alias garden-alias)) 172 | old-port (try (slurp ".nrepl-port") (catch java.io.FileNotFoundException _ nil))] 173 | (-> (Runtime/getRuntime) 174 | (.addShutdownHook (Thread. (fn [] 175 | (p/destroy-tree @app-process) 176 | (if old-port 177 | (spit ".nrepl-port" old-port) 178 | (fs/delete-if-exists ".nrepl-port")))))) 179 | (doto (Thread. (fn [] (if (:success (wait-for #(try (<= 200 180 | (:status (http/head url {:client (http/client {:follow-redirects :never})})) 181 | 399) 182 | (catch Throwable _ false)) timeout-seconds)) 183 | (println "Application ready on" url) 184 | (do 185 | (print-error (format "Application did not start after %ss." timeout-seconds)) 186 | (print-error (format "Make sure your app binds to 0.0.0.0:%s and reponds with a 200 status code to HEAD requests to `/`." http-port)) 187 | (System/exit 1))))) 188 | .start) 189 | (fs/create-dirs storage-dir) 190 | (spit ".nrepl-port" nrepl-port) 191 | (let [extra-env {"GARDEN_PROJECT_NAME" (:project opts) 192 | "GARDEN_NREPL_PORT" nrepl-port 193 | "GARDEN_STORAGE" storage-dir 194 | "GARDEN_EMAIL_ADDRESS" "just-a-placeholder@example.com" 195 | "GARDEN_URL" url} 196 | p (p/process start-command 197 | {:extra-env extra-env 198 | :out :inherit 199 | :err :inherit})] 200 | (print-debug (str/join " " (concat (for [[k v] extra-env] (str k "=" v)) start-command))) 201 | (deliver app-process p) 202 | (p/check p)))) 203 | 204 | (defn deploy [{:keys [opts]}] 205 | (let [{:keys [git-ref force]} opts 206 | {:keys [out exit]} (sh "git rev-parse" git-ref)] 207 | (if (pos? exit) 208 | (print-error (if (= git-ref "HEAD") 209 | "You need to commit before you can deploy." 210 | (format "`%s` is not a valid git ref." git-ref))) 211 | (let [sha (str/trim out) 212 | branch (-> (sh "git symbolic-ref --short HEAD") :out str/trim) 213 | remote (-> (sh "git" "config" (str "branch." branch ".remote")) :out str/trim) 214 | remote-url (-> (sh "git" "remote" "get-url" remote) :out str/trim) 215 | {:keys [ok name status message id git-rev]} (call-api (assoc opts :command "create"))] 216 | (if ok 217 | (let [_ (when (= :new ok) (println (str "Created project '" name "'."))) 218 | _ (println "Pushing code to garden...") 219 | {:keys [out err exit]} (sh "git push --force" (git-remote-url id) (str git-ref ":___garden_deploy___"))] 220 | (if-not (zero? exit) 221 | (println (str "Cannot push to garden\n" out "\n" err "\n")) 222 | ;; this guesses 223 | (let [working-dir (path-from-git-root-parent)] 224 | (when-not working-dir 225 | (sh "git update-ref refs/remotes/garden/main" sha)) 226 | (when (= sha git-rev) 227 | (println "Project code is up-to-date...")) 228 | (if (and (not force) 229 | (= sha git-rev) 230 | (= "running" status)) 231 | (println "Project is Running. Use `--force` to deploy the same version again.") 232 | (call-api (-> opts 233 | (assoc :command "deploy" :commit sha :as :stream) 234 | (cond-> 235 | working-dir 236 | (assoc :working-dir working-dir) 237 | 238 | (seq remote-url) 239 | (assoc :remote-url remote-url)))))))) 240 | (print-error message)))))) 241 | 242 | (defn sftp [{:keys [opts]}] 243 | (let [{:keys [id]} (call-api (merge {:command "info"} opts)) 244 | [host port] (clojure.string/split arboretum-ssh-host #":")] 245 | (shell (concat ["sftp" (str "-o SetEnv=SFTP_PROJECT=" id)] 246 | (when port ["-P" port]) 247 | [host])))) 248 | 249 | (defn rename [{:keys [opts]}] 250 | (if-not (garden-project?) 251 | (println "`rename` may only be called from inside a garden project.") 252 | (let [{:keys [ok message project]} (call-api (merge {:command "rename"} opts))] 253 | (if ok 254 | (do (update-config! assoc :project project) 255 | (println message)) 256 | (print-error message))))) 257 | 258 | (def cols [:name :status :git-rev :url :deployed-at :deployed-by :owner :groups]) 259 | 260 | (defn info [{:keys [opts]}] 261 | (let [{:as m :keys [ok message]} (call-api (assoc opts :command "info"))] 262 | (if ok 263 | (do (println (cli/format-table {:rows (map (juxt name (comp str m)) cols) 264 | :indent 0})) 265 | m) 266 | (println message)))) 267 | 268 | (defn mb [long] (try (quot long (* 1024 1024)) (catch Throwable _ nil))) 269 | (defn gb [long] (try (quot long (* 1024 1024 1024)) (catch Throwable _ nil))) 270 | (defn perc [x y] (try (float (/ (* 100 x) y)) (catch Throwable _ nil))) 271 | 272 | (defn list-projects [_] 273 | (let [{:as resp :keys [ok message projects running-projects-limit running-projects-count storage-quota-used storage-quota-max]} 274 | (call-api {:command "list-projects"})] 275 | (if ok 276 | (if (seq projects) 277 | (do (pp/print-table (map (comp symbol name) (remove #{:owner :groups} cols)) 278 | (map #(update-keys % (comp symbol name)) projects)) 279 | (println) 280 | (when (and running-projects-count running-projects-limit) 281 | (println (format "Running projects limit: %s/%s" running-projects-count running-projects-limit))) 282 | (when (and storage-quota-max storage-quota-used) 283 | (println (format "Used storage quota: %dMB/%dGB (%.1f%%)" 284 | (mb storage-quota-used) 285 | (gb storage-quota-max) 286 | (perc storage-quota-used storage-quota-max)))) 287 | (dissoc resp :ok :message)) 288 | (do (print-error "No projects, use 'garden init' to create one!") 289 | {:exit-code 0})) 290 | (println message)))) 291 | 292 | (defn stats [{:keys [opts]}] 293 | (call-api (assoc opts :command "stats" :as :stream))) 294 | 295 | (defn logs [{:keys [opts]}] 296 | (call-api (assoc opts :command "logs" :as :stream))) 297 | 298 | (defn restart [{:keys [opts]}] 299 | (let [working-dir (path-from-git-root-parent)] 300 | (call-api (-> opts 301 | (assoc :command "restart" :as :stream) 302 | (cond-> working-dir 303 | (assoc :working-dir working-dir)))))) 304 | 305 | (defn stop [m] 306 | (let [{:keys [ok message]} (call-api (merge {:command "stop"} (:opts m)))] 307 | (when-not ok (println message)))) 308 | 309 | (defn publish [{:as m :keys [opts]}] 310 | (let [{:keys [project domain remove]} opts] 311 | (if remove 312 | (let [{:as result :keys [message]} (call-api {:command "unpublish" :project project :domain domain})] 313 | (println message) 314 | result) 315 | (let [{:keys [ok message ip txt-record]} (call-api {:command "get-domain-verification-info" :project project :domain domain})] 316 | (if ok 317 | (do 318 | (println (str "Please configure DNS for '" domain "' with the following A record:")) 319 | (println ip) 320 | (println "and the following TXT record:") 321 | (println txt-record) 322 | (println "After you have added the records, press enter.") 323 | (read-line) 324 | (println "Checking configuration...") 325 | (Thread/sleep 1000) ;wait a bit more for DNS changes 326 | (let [{:keys [ok message]} (call-api {:command "publish" 327 | :project project 328 | :domain domain})] 329 | (if ok 330 | (do 331 | (restart m) 332 | (println (str "Done. Your project is available at https://" domain))) 333 | (print-error message)))) 334 | (print-error message)))))) 335 | 336 | (defn delete [{:keys [opts]}] 337 | (let [{:keys [ok message name]} (call-api (assoc opts :command "info")) 338 | guard (fn [project-name] 339 | (println (str "Deleting a project will stop your current application and remove your data permanently. This cannot be undone!\n" 340 | "If you delete a project, its name will be available to anyone else again.\n" 341 | (format "If you want to delete project %s, confirm by typing the project's name and pressing 'Enter':" project-name))) 342 | (= project-name (read-line)))] 343 | (if-not ok 344 | (println message) 345 | (do 346 | (println (str "Deleting '" name "'")) 347 | (if (or (:force opts) (guard name)) 348 | (let [{:keys [ok message]} (call-api (assoc opts :command "delete"))] 349 | (if ok 350 | (println message) 351 | (print-error message))) 352 | (print-error "This is not the project-name. Not deleting your project.")))))) 353 | 354 | (defn free-port 355 | "Finds an free, unprivileged port. 356 | 357 | The port is free at the time of calling this function, but might be used afterwards. Beware of race conditions." 358 | [] 359 | (let [s (doto (java.net.Socket.) 360 | (.bind (java.net.InetSocketAddress. "localhost" 0))) 361 | p (.getLocalPort s)] 362 | (.close s) 363 | p)) 364 | 365 | (defn repl-up? [port] 366 | (try (= {:vals ["1"]} 367 | (nrepl/eval-expr {:host "127.0.0.1" 368 | :port port 369 | :expr "1"})) 370 | (catch Exception _ 371 | false))) 372 | 373 | (defn connect-repl [port] 374 | (shell "clojure" "-Sdeps" "{:deps {reply/reply {:mvn/version \"0.5.1\"}}}" "-M" "-m" "reply.main" "--attach" port)) 375 | 376 | (defn repl [{:keys [opts]}] 377 | (let [{:keys [repl-port]} (call-api (merge {:command "info"} opts)) 378 | {:keys [port eval headless]} opts 379 | port (or port (free-port)) 380 | old-port (try (slurp ".nrepl-port") (catch java.io.FileNotFoundException _ nil)) 381 | tunnel (atom nil)] 382 | (try 383 | (reset! tunnel (p/process (concat ["ssh" "-N" "-L" (str port ":localhost:" repl-port)] 384 | (ssh-args) 385 | ["tunnel"]))) 386 | (if (= :timeout (:error (wait-for (partial repl-up? port)))) 387 | (print-error (str/join "\n" ["It seems there is no nREPL server listening in your application." 388 | "Check https://docs.apps.garden#nrepl-support for information."])) 389 | (if eval 390 | (println (first (:vals (nrepl/eval-expr {:host "127.0.0.1" 391 | :port port 392 | :expr eval})))) 393 | (do (println (str "Forwarded port " port " to remote nREPL.")) 394 | (spit ".nrepl-port" port) 395 | (if headless 396 | (do (println "Use ^-C to quit.") @(promise)) 397 | (connect-repl port))))) 398 | (catch Throwable _ 399 | (if old-port 400 | (spit ".nrepl-port" old-port) 401 | (fs/delete-if-exists ".nrepl-port")) 402 | (p/destroy @tunnel) 403 | (println "Tunnel closed"))))) 404 | 405 | 406 | (defn add-secret [{:keys [opts]}] 407 | (if (and (not (:force opts)) 408 | (some #{(:secret-name opts)} 409 | (:secrets (call-api (assoc opts :command "list-secrets"))))) 410 | (print-error (format "A secret with the same name already exist. Use `garden secrets add %s --force` to overwrite it." 411 | (:secret-name opts))) 412 | (let [{:keys [ok message]} 413 | (call-api (assoc opts :command "add-secret" 414 | :secret-value (do 415 | (println "Type your secret and press Enter:") 416 | (or 417 | (when-some [c (System/console)] 418 | (String. (.readPassword c))) 419 | (read-line)))))] 420 | (if ok 421 | (println message) 422 | (print-error message))))) 423 | 424 | (defn remove-secret [{:keys [opts]}] 425 | (let [{:keys [ok message]} (call-api (assoc opts :command "remove-secret"))] 426 | (if ok 427 | (println message) 428 | (print-error message)))) 429 | 430 | (defn list-secrets [{:keys [opts]}] 431 | (let [{:keys [ok secrets message]} (call-api (assoc opts :command "list-secrets"))] 432 | (if ok 433 | (do (doseq [s secrets] (println s)) secrets) 434 | (print-error message)))) 435 | 436 | ;; ## Groups 437 | 438 | (defn create-group [{:keys [opts]}] 439 | (let [{:as ret :keys [ok message]} (call-api (assoc opts :command "create-group"))] 440 | (if ok 441 | (do (println message) ret) 442 | (print-error message)))) 443 | 444 | (defn list-groups [{:keys [opts]}] 445 | (let [{:as ret :keys [ok message groups]} (call-api (assoc opts :command "list-groups"))] 446 | (if ok 447 | (do (doseq [g groups] (println g)) ret) 448 | (print-error message)))) 449 | 450 | (defn add-group-member [{:keys [opts]}] 451 | (let [{:as ret :keys [ok message]} (call-api (assoc opts :command "add-group-member"))] 452 | (if ok 453 | (do (println message) ret) 454 | (print-error message)))) 455 | 456 | (defn remove-group-member [{:keys [opts]}] 457 | (let [{:as ret :keys [ok message]} (call-api (assoc opts :command "remove-group-member"))] 458 | (if ok 459 | (do (println message) ret) 460 | (print-error message)))) 461 | 462 | (defn list-group-members [{:keys [opts]}] 463 | (let [{:as ret :keys [ok message members]} (call-api (assoc opts :command "list-group-members"))] 464 | (if ok 465 | (do (doseq [m members] (println m)) ret) 466 | (print-error message)))) 467 | 468 | (defn add-project-to-group [{:keys [opts]}] 469 | (let [{:as ret :keys [ok message]} (call-api (assoc opts :command "add-project-to-group"))] 470 | (if ok 471 | (do (println message) ret) 472 | (print-error message)))) 473 | 474 | (defn remove-project-from-group [{:keys [opts]}] 475 | (let [{:as ret :keys [ok message]} (call-api (assoc opts :command "remove-project-from-group"))] 476 | (if ok 477 | (do (println message) ret) 478 | (print-error message)))) 479 | 480 | (defn list-group-projects [{:keys [opts]}] 481 | (let [{:as ret :keys [ok message projects]} (call-api (assoc opts :command "list-group-projects"))] 482 | (if ok 483 | (do (doseq [p projects] (println p)) ret) 484 | (print-error message)))) 485 | 486 | (defn delete-group [{:keys [opts]}] 487 | (let [{:keys [force group-handle]} opts 488 | continue? (or force 489 | (do (println (format "Are you sure you want to delete the group %s?" group-handle)) 490 | (println "To delete, please type the group-handle and press 'Enter':") 491 | (= group-handle (read-line))))] 492 | (when continue? 493 | (let [{:as ret :keys [ok message]} (call-api (assoc opts :command "delete-group"))] 494 | (if ok 495 | (do (println message) ret) 496 | (print-error message)))))) 497 | 498 | (def default-spec 499 | {:quiet {:coerce :boolean 500 | :alias :q 501 | :desc "Do not print output"} 502 | :output-format (let [valid-formats #{:edn :json}] 503 | {:ref "" 504 | :coerce :keyword 505 | :validate valid-formats 506 | :desc (str "Print result in a machine readable format. One of: " (str/join ", " (map name valid-formats)))})}) 507 | 508 | (def project-spec 509 | {:project {:ref "" 510 | :require true 511 | :message "Command '%s' needs either a --project option or has to be run inside an application.garden project." 512 | :desc "The name used to identify the project remotely, when not passed garden will infer it from the local `garden.edn`." 513 | :default-desc "`:project` from `garden.edn`"}}) 514 | 515 | (def secrets-spec 516 | {:secret-name {:ref "" 517 | :require true 518 | :desc "The secret name" 519 | :coerce :string 520 | :validate {:pred #(re-matches #"[a-zA-Z_]+" %) 521 | :ex-msg (constantly "secret names must only contain alphanumeric characters or underscores")}}}) 522 | 523 | (def cmd-tree 524 | {"stop" 525 | {:fn stop, 526 | :spec (merge default-spec project-spec), 527 | :help "Stop a project in your garden"}, 528 | "run" 529 | {:fn run, 530 | :spec (merge default-spec project-spec), 531 | :help "Run a project locally"}, 532 | "deploy" 533 | {:fn deploy, 534 | :help "Deploy a project to application.garden", 535 | :spec 536 | (-> 537 | (merge default-spec project-spec) 538 | (dissoc :output-format) 539 | (assoc-in 540 | [:project :desc] 541 | "The project to be deployed. A new project will be created if it does not exist yet") 542 | (assoc 543 | :git-ref 544 | {:ref "", 545 | :default "HEAD", 546 | :desc "The git branch, commit, tag, etc. to be deployed"} 547 | :force 548 | {:alias :f 549 | :coerce :boolean, 550 | :desc "Force a deployment, even when the code has not changed since the last deploy"} 551 | :deploy-strategy 552 | {:ref "", 553 | :coerce :keyword, 554 | :default :zero-downtime, 555 | :validate #{:restart :zero-downtime}, 556 | :desc 557 | "How to deploy a new version: stop old instance before starting new instance (restart), stop old instance after new instance is ready (zero-downtime)"}))}, 558 | "rename" 559 | {:fn rename, 560 | :args->opts [:new-project-name], 561 | :spec 562 | (-> 563 | (merge default-spec project-spec) 564 | (assoc 565 | :new-project-name 566 | {:ref "", :require true, :desc "New project name"}) 567 | (assoc-in [:project :desc] "Old project name")), 568 | :help "Rename a project"}, 569 | "list" 570 | {:fn list-projects, 571 | :spec default-spec, 572 | :help "List your projects and their status"}, 573 | "repl" 574 | {:fn repl , 575 | :help "Open a REPL connected to the deployed project", 576 | :spec 577 | (assoc 578 | (merge default-spec project-spec) 579 | :headless 580 | {:coerce :boolean 581 | :require false, 582 | :desc "Do not start an interactive REPL session. Only tunnel nREPL connection."} 583 | :eval 584 | {:alias :e 585 | :ref "", 586 | :coerce :string 587 | :require false, 588 | :desc "An expression to evaluate in the context of the remote app"} 589 | :port 590 | {:ref "", 591 | :require false, 592 | :desc "The local TCP port to tunnel to the remote nREPL port"})}, 593 | "delete" 594 | {:fn delete, 595 | :args->opts [:project] 596 | :spec 597 | (assoc 598 | (merge default-spec project-spec) 599 | :force 600 | {:alias :f 601 | :coerce :boolean, 602 | :desc "Do not ask for confirmation"}), 603 | :help 604 | "Stop the project and remove all project data from your garden (!)"}, 605 | "info" 606 | {:fn info, 607 | :spec (merge default-spec project-spec) , 608 | :help "Show information about a project"}, 609 | "stats" 610 | {:fn stats 611 | :spec (merge default-spec project-spec) , 612 | :help "Show a project's traffic statistics"}, 613 | "logs" 614 | {:fn logs 615 | :spec {:lines {:alias :n 616 | :ref "" 617 | :coerce :long 618 | :validate (complement neg?) 619 | :desc "Number of log lines to show"} 620 | :line-format 621 | (let [valid-formats #{:text :raw :edn :json}] 622 | {:alias :f 623 | :ref "" 624 | :coerce :keyword 625 | :default :text 626 | :validate valid-formats 627 | :desc (str "Output format of logs. One of: " (str/join ", " (map name valid-formats)))})} 628 | :help "Show a project's log on stdout"}, 629 | "publish" 630 | {:args->opts [:domain], 631 | :fn publish, 632 | :spec 633 | (assoc 634 | (merge default-spec project-spec) 635 | :domain 636 | {:ref "", :require true, :desc "The domain"} 637 | :remove 638 | {:alias :rm :desc "Removes access to project via . Projects will still be reachable at the default URL."}), 639 | :help "Publish your project to a custom domain"}, 640 | "restart" 641 | {:fn restart, 642 | :spec (merge default-spec project-spec) , 643 | :help "Restart a project in your garden"}, 644 | "init" 645 | {:fn init, 646 | :spec 647 | (-> 648 | (merge default-spec project-spec) 649 | (update :project dissoc :require) 650 | (assoc-in [:project :desc] "The name of the project to be created, when left blank garden will create a random name for you. You can rename your project at any time later.") 651 | (assoc 652 | :force 653 | {:alias :f, 654 | :coerce :boolean, 655 | :desc "Ignore an existing `garden.edn` and re-initialize the project with a new name"} 656 | :template 657 | {:coerce :string 658 | :desc "A template name (deps-new compatible) for initializing a project. See https://docs.apps.garden#project-templates for more info or https://github.com/topics/application-garden-template for a list of available templates." 659 | :default "io.github.nextjournal/garden-template"})), 660 | :help 661 | "Initialize an application.garden project in the local directory"}, 662 | "version" {:fn #'print-version, :help "Print garden cli version"}, 663 | "help" {:fn #'help, :help "Show help for a command"}, 664 | "secrets" 665 | {:help "Manage secrets", 666 | "add" 667 | {:fn add-secret, 668 | :args->opts [:secret-name], 669 | :help "Add a secret to a project", 670 | :spec 671 | (assoc 672 | (merge default-spec project-spec secrets-spec) 673 | :force 674 | {:coerce :boolean, 675 | :desc "Overwrite an existing secret"})}, 676 | "remove" 677 | {:fn remove-secret, 678 | :args->opts [:secret-name], 679 | :help "Remove a secret from a project", 680 | :spec (merge default-spec project-spec secrets-spec)}, 681 | "list" 682 | {:fn list-secrets, 683 | :spec (merge default-spec project-spec) , 684 | :help "List all secrets for a project"}}, 685 | "groups" 686 | {:help "Manage groups", 687 | "list" {:fn list-groups, :help "List the groups you are part of"}, 688 | "create" 689 | {:fn create-group, 690 | :help "Create a group", 691 | :args->opts [:group-handle] 692 | :spec 693 | {:group-handle 694 | {:ref "", 695 | :desc "Unique identifier for a group", 696 | :require true}}}, 697 | "add-member" 698 | {:fn add-group-member, 699 | :help "Add a member to a group" 700 | :args->opts [:group-handle], 701 | :spec 702 | (assoc 703 | default-spec 704 | :person-nickname 705 | {:ref "", 706 | :desc "The person to be added to the group", 707 | :require true} 708 | :group-handle 709 | {:ref "", 710 | :require true, 711 | :desc "The group to add a member to"})}, 712 | "remove-member" 713 | {:fn remove-group-member, 714 | :help "Remove a member from a group" 715 | :args->opts [:group-handle], 716 | :spec 717 | (assoc 718 | default-spec 719 | :person-nickname 720 | {:ref "", 721 | :desc "The person to be removed from the group", 722 | :require true} 723 | :group-handle 724 | {:ref "", 725 | :require true, 726 | :desc "The group to remove a member from"})} 727 | "list-members" 728 | {:fn list-group-members, 729 | :help "List members in a group" 730 | :args->opts [:group-handle], 731 | :spec 732 | (assoc 733 | default-spec 734 | :group-handle 735 | {:ref "", 736 | :require true, 737 | :desc "The group to list the members for"})}, 738 | "add-project" 739 | {:fn add-project-to-group, 740 | :help "Add a project to a group" 741 | :args->opts [:group-handle], 742 | :spec 743 | (-> 744 | (merge default-spec project-spec) 745 | (assoc-in [:project :desc] "The project to be added to the group") 746 | (assoc 747 | :group-handle 748 | {:ref "", 749 | :require true, 750 | :desc "The group to add a project to"}))}, 751 | "remove-project" 752 | {:fn remove-project-from-group, 753 | :help "Remove a project from a group" 754 | :args->opts [:group-handle], 755 | :spec 756 | (-> 757 | (merge default-spec project-spec) 758 | (assoc-in 759 | [:project :desc] 760 | "The project to be removed from the group") 761 | (assoc 762 | :group-handle 763 | {:ref "", 764 | :require true, 765 | :desc "The group to remove a project from"}))} 766 | "list-projects" 767 | {:fn list-group-projects, 768 | :help "List projects in a group" 769 | :args->opts [:group-handle], 770 | :spec 771 | (assoc 772 | default-spec 773 | :group-handle 774 | {:ref "", 775 | :require true, 776 | :desc "The group to list the projects for"})} 777 | "delete" 778 | {:fn delete-group, 779 | :help "Delete a group" 780 | :args->opts [:group-handle], 781 | :spec (assoc 782 | default-spec 783 | :group-handle 784 | {:ref "", 785 | :require true, 786 | :desc "The group to delete"} 787 | :force 788 | {:alias :f, 789 | :coerce :boolean, 790 | :desc "Do not ask for confirmation"})}}, 791 | "sftp" 792 | {:fn sftp, 793 | :spec project-spec, 794 | :help "Spawn a SFTP session to your project's persistent storage"}}) 795 | 796 | (defn keyword-map [m] 797 | (select-keys m (filter keyword? (keys m)))) 798 | 799 | (defn ->option [k] (str "--" (name k))) 800 | 801 | (defonce !errors (atom [])) 802 | (defn error-fn [{:as m :keys [cause]}] 803 | (swap! !errors conj 804 | (case cause 805 | :require (format "Missing option: %s" (->option (:option m))) 806 | :validate (format "Invalid value for option %s" (->option (:option m))) 807 | :coerce (format "Invalid value for option %s" (->option (:option m))) 808 | :restrict (format "Invalid option %s" (->option (:option m))) 809 | nil "Error"))) 810 | 811 | (defn deep-merge [a b] 812 | (reduce (fn [acc k] (update acc k (fn [v] 813 | (if (map? v) 814 | (deep-merge v (b k)) 815 | (b k))))) 816 | a (keys b))) 817 | 818 | (defn has-parse-opts? [m] 819 | (some #{:spec :coerce :require :restrict :validate :args->opts :exec-args} (keys m))) 820 | 821 | (defn is-option? [s] 822 | (some-> s (str/starts-with? "-"))) 823 | 824 | (defn dispatch-tree' [tree args opts] 825 | (loop [cmds [] all-opts {} args args cmd-info tree] 826 | (let [m (keyword-map cmd-info) 827 | should-parse-args? (or (has-parse-opts? m) 828 | (is-option? (first args))) 829 | parse-opts (deep-merge opts m) 830 | {:keys [args opts]} (if should-parse-args? 831 | (cli/parse-args args parse-opts) 832 | {:args args 833 | :opts {}}) 834 | [arg & rest] args] 835 | (if-let [subcmd-info (get cmd-info arg)] 836 | (recur (conj cmds arg) (merge all-opts opts) rest subcmd-info) 837 | (if (:fn cmd-info) 838 | {:cmd-info cmd-info 839 | :dispatch cmds 840 | :opts (merge all-opts opts) 841 | :args args} 842 | (if arg 843 | {:error :no-match 844 | :dispatch cmds 845 | :wrong-input arg 846 | :available-commands (sort (filter string? (keys cmd-info)))} 847 | {:error :input-exhausted 848 | :dispatch cmds 849 | :available-commands (sort (filter string? (keys cmd-info)))})))))) 850 | 851 | (defn dispatch' [cmd-tree args opts] 852 | (dispatch-tree' cmd-tree args opts)) 853 | 854 | (comment 855 | (= :input-exhausted (:error (dispatch' cmd-tree [] {}))) 856 | (= :no-match (:error (dispatch' cmd-tree ["foo"] {}))) 857 | (dispatch' cmd-tree ["help" "list"] {})) 858 | 859 | (defn indent 860 | "indent a multiline string by spaces" 861 | [indent lines] 862 | (->> (str/split-lines lines) 863 | (map (fn [line] (str (apply str (repeat indent " ")) line))) 864 | (str/join "\n"))) 865 | 866 | (defn signature [cmd-tree cmds] 867 | (when (seq cmds) 868 | (when-let [{:as _cmd-info :keys [args->opts]} (get-in cmd-tree cmds)] 869 | (str/join " " (concat cmds (map #(str "<" (name %) ">") args->opts)))))) 870 | 871 | (defn help-text [cmd-tree cmds] 872 | (:help (get-in cmd-tree cmds))) 873 | 874 | (defn options-text [cmd-tree cmds] 875 | (let [s (cli/format-opts (assoc (get-in cmd-tree cmds) :indent 0))] 876 | (when-not (str/blank? s) 877 | s))) 878 | 879 | (defn subcommand-help-text [cmd-tree cmds] 880 | (let [subcommands (sort (filter string? (keys (get-in cmd-tree cmds))))] 881 | (when (seq subcommands) 882 | (cli/format-table 883 | {:rows (mapv (fn [c] (let [subcommand (concat cmds [c])] 884 | [(str/join " " subcommand) (help-text cmd-tree subcommand)])) 885 | subcommands) 886 | :indent 0})))) 887 | 888 | (defn print-command-help [cmd-tree command] 889 | (when-let [s (signature cmd-tree command)] 890 | (println s "\t" (help-text cmd-tree command)))) 891 | 892 | (defn print-command-options [cmd-tree command] 893 | (when-let [s (options-text cmd-tree command)] 894 | (println) 895 | (println "Options:") 896 | (println (indent 2 s)))) 897 | 898 | (defn print-available-commands [cmd-tree command] 899 | (when-let [s (subcommand-help-text cmd-tree command)] 900 | (println (indent 2 s)))) 901 | 902 | (defn help [{:as _m :keys [args]}] 903 | (cond (nil? args) (do 904 | (println) 905 | (println "Available commands (run `garden help ` for more details):") 906 | (println) 907 | (print-available-commands cmd-tree [])) 908 | (get-in cmd-tree args) (do 909 | (print-command-help cmd-tree args) 910 | (print-command-options cmd-tree args) 911 | (print-available-commands cmd-tree args)) 912 | :else (do 913 | (println) 914 | (println "Unknown command. Available commands (use --help for detailed help on a command):") 915 | (println) 916 | (print-available-commands cmd-tree [])))) 917 | 918 | (defn dispatch [cmd-tree args {:as opts :keys [middleware]}] 919 | (let [{:as res :keys [error _cmd-info dispatch wrong-input available-commands]} (dispatch' cmd-tree args opts)] 920 | (if error 921 | (case error 922 | :input-exhausted (print-error (str "Available commands (use --help for detailed help on a command):\n\n" (subcommand-help-text cmd-tree dispatch))) 923 | :no-match (print-error (let [candidates (edit-distance/candidates wrong-input available-commands)] 924 | (if (seq candidates) 925 | (str "Unknown command. Did you mean one of:\n" 926 | (indent 2 (str/join "\n" (map 927 | #(str/join " " (concat ["garden"] dispatch [%])) 928 | candidates)))) 929 | (str "Unknown command. Available commands:\n\n" (subcommand-help-text cmd-tree dispatch)))))) 930 | (let [res (reduce (fn [r m] (m r)) res middleware)] 931 | ((get-in res [:cmd-info :fn]) res))))) 932 | 933 | (defn wrap-with-help [{:as res :keys [dispatch]}] 934 | (update-in res [:cmd-info :fn] (fn [f] (fn [{:as m :keys [opts]}] 935 | (if (:help opts) 936 | (do 937 | (reset! !errors []) 938 | (help {:args dispatch})) 939 | (f m)))))) 940 | 941 | (defn dev-null-print-writer [] 942 | (java.io.PrintWriter. "/dev/null")) 943 | 944 | (defn wrap-with-quiet [res] 945 | (update-in res [:cmd-info :fn] 946 | (fn [f] 947 | (fn [{:as m :keys [opts]}] 948 | (if (:quiet opts) 949 | (binding [*out* (dev-null-print-writer) 950 | *err* (dev-null-print-writer)] 951 | (f m)) 952 | (f m)))))) 953 | 954 | (defn wrap-with-output-format [res] 955 | (update-in res [:cmd-info :fn] 956 | (fn [f] 957 | (fn [{:as m :keys [opts]}] 958 | (if-let [output-format (:output-format opts)] 959 | (let [result (f (assoc-in m [:opts :quiet] true))] 960 | (case output-format 961 | :edn (prn result) 962 | :json (println (json/encode result)))) 963 | (f m)))))) 964 | 965 | (defn wrap-with-error-reporting [res] 966 | (update-in res [:cmd-info :fn] 967 | (fn [f] 968 | (fn [m] 969 | (if-let [errors (seq @!errors)] 970 | (do 971 | (doseq [error errors] 972 | (print-error error)) 973 | (print-error "") 974 | (print-error "Use --help for detailed help on a command") 975 | {:exit-code 1}) 976 | (f m)))))) 977 | 978 | (defn wrap-with-exit-code [res] 979 | (update-in res [:cmd-info :fn] 980 | (fn [f] 981 | (fn [m] 982 | (let [{:as result :keys [exit-code]} (f m)] 983 | (if exit-code 984 | (System/exit exit-code) 985 | result)))))) 986 | 987 | (defn wrap-with-debug [res] 988 | (update-in res [:cmd-info :fn] 989 | (fn [f] 990 | (fn [{:as m :keys [opts]}] 991 | (if (:debug opts) 992 | (binding [*debug* true] 993 | (f m)) 994 | (f m)))))) 995 | 996 | (defn migrate-config-file! [] 997 | (when (fs/exists? ".garden.edn") 998 | (spit "garden.edn" 999 | (pr-str (:nextjournal/garden (edn/read-string (slurp ".garden.edn"))))) 1000 | (fs/delete ".garden.edn")) 1001 | (when-some [pid (:project/id (read-config))] 1002 | (when (uuid? pid) 1003 | (try 1004 | (let [{:keys [name id]} (call-api {:command "info" :project pid})] 1005 | (assert (and name id)) 1006 | (update-config! #(-> % (assoc :project name) (dissoc :project/id)))) 1007 | (catch Throwable _ 1008 | (println (str "There were issues migrating to new project spec. Please run `garden init --force --project " pid "`."))))))) 1009 | 1010 | (defmacro with-exception-reporting [& body] 1011 | `(try 1012 | ~@body 1013 | (catch clojure.lang.ExceptionInfo e# 1014 | (when (try (parse-boolean (System/getenv "DEBUG")) (catch Exception _# false)) 1015 | (throw e#)) 1016 | (binding [*out* *err*] 1017 | (println (ex-message e#)) 1018 | (System/exit 1))))) 1019 | 1020 | (defn -main [& _] 1021 | (with-exception-reporting 1022 | (migrate-config-file!) 1023 | (dispatch cmd-tree *command-line-args* {:middleware [wrap-with-debug 1024 | wrap-with-error-reporting 1025 | wrap-with-help 1026 | wrap-with-quiet 1027 | wrap-with-exit-code 1028 | wrap-with-output-format] 1029 | :exec-args (read-config) 1030 | :error-fn error-fn}))) 1031 | 1032 | (when (= *file* (System/getProperty "babashka.file")) 1033 | (-main)) 1034 | -------------------------------------------------------------------------------- /src/nextjournal/start_command.clj: -------------------------------------------------------------------------------- 1 | (ns nextjournal.start-command 2 | (:require [clojure.string :as str])) 3 | 4 | (def garden-nrepl-sha "d64532bf7c16565b0dfc825bc27eafdb453c1a61") 5 | 6 | (defn fetch-deps-command [{:as opts 7 | :keys [garden-alias sdeps]}] 8 | (filterv some? 9 | ["clojure" 10 | "-P" 11 | "-Srepro" 12 | "-Sdeps" (pr-str (merge sdeps {:deps {'io.github.nextjournal/garden-nrepl {:git/sha garden-nrepl-sha}}})) 13 | "-J-Dclojure.main.report=stdout" 14 | (when-some [extra-aliases (get garden-alias :nextjournal.garden/aliases)] 15 | (when-not (every? keyword? extra-aliases) (throw (ex-info "`:nextjournal.garden/aliases` must be a vector of keywords" opts))) 16 | (str "-A" (str/join extra-aliases))) 17 | "-A:nextjournal/garden"])) 18 | 19 | (defn start-command [{:as opts 20 | :keys [skip-inject-nrepl garden-alias sdeps] 21 | :or {sdeps {}}}] 22 | (let [sdeps (cond-> sdeps 23 | (not skip-inject-nrepl) (merge {:deps {'io.github.nextjournal/garden-nrepl {:git/sha garden-nrepl-sha}} 24 | :aliases {:nextjournal/garden-nrepl {:exec-fn 'nextjournal.garden-nrepl/start!}}}))] 25 | (filterv some? 26 | ["clojure" 27 | "-Srepro" 28 | "-Sdeps" (pr-str sdeps) 29 | "-J-Dclojure.main.report=stdout" 30 | (when-some [extra-aliases (get garden-alias :nextjournal.garden/aliases)] 31 | (when-not (every? keyword? extra-aliases) (throw (ex-info "`:nextjournal.garden/aliases` must be a vector of keywords" opts))) 32 | (str "-A" (str/join extra-aliases))) 33 | (if (not skip-inject-nrepl) 34 | "-X:nextjournal/garden:nextjournal/garden-nrepl" 35 | "-X:nextjournal/garden") 36 | ":host" "\"0.0.0.0\"" ":port" "7777"]))) 37 | -------------------------------------------------------------------------------- /src/nextjournal/template.clj: -------------------------------------------------------------------------------- 1 | (ns nextjournal.template 2 | (:require [babashka.http-client :as http] 3 | [cheshire.core :as cheshire] 4 | [clojure.edn :as edn] 5 | [clojure.set :as set] 6 | [clojure.string :as str] 7 | [clojure.java.io :as io])) 8 | 9 | ;; Workaround for pmap + require which doesn't work well in bb - 2023-02-04 10 | 11 | (def ^:private lock (Object.)) 12 | 13 | (defn- serialized-require 14 | [& args] 15 | (locking lock 16 | (apply require args))) 17 | 18 | (defn req-resolve 19 | [sym] 20 | (if (qualified-symbol? sym) 21 | (or (resolve sym) 22 | (do (-> sym namespace symbol serialized-require) 23 | (resolve sym))) 24 | (throw (IllegalArgumentException. (str "Not a qualified symbol: " sym))))) 25 | 26 | ;; End workaround 27 | 28 | ;; adapted from babashka.neil.git 29 | 30 | (def github-user (or (System/getenv "NEIL_GITHUB_USER") 31 | (System/getenv "BABASHKA_NEIL_DEV_GITHUB_USER"))) 32 | (def github-token (or (System/getenv "NEIL_GITHUB_TOKEN") 33 | (System/getenv "BABASHKA_NEIL_DEV_GITHUB_TOKEN"))) 34 | 35 | (defn curl-get-json [url] 36 | (let [response (http/get url (merge {:throw false} 37 | (when (and github-user github-token) 38 | {:basic-auth [github-user github-token]}))) 39 | parsed-body (-> response :body (cheshire/parse-string true))] 40 | (if (and (= 403 (:status response)) 41 | (str/includes? url "api.github") 42 | (str/includes? (:message parsed-body) "rate limit")) 43 | (throw (ex-info "You've hit the GitHub rate-limit (60 reqs/hr). 44 | You can set the environment variables NEIL_GITHUB_USER to your GitHub user 45 | and NEIL_GITHUB_TOKEN to a GitHub API Token to increase the limit." {:error :github-rate-limit})) 46 | parsed-body))) 47 | 48 | (defn default-branch [lib] 49 | (get (curl-get-json (format "https://api.github.com/repos/%s/%s" 50 | (namespace lib) (name lib))) 51 | :default_branch)) 52 | 53 | (defn clean-github-lib [lib] 54 | (-> lib 55 | (str/replace "com.github." "") 56 | (str/replace "io.github." "") 57 | (symbol))) 58 | 59 | (defn latest-github-sha [lib] 60 | (try (let [lib (clean-github-lib lib) 61 | branch (default-branch lib)] 62 | (get (curl-get-json (format "https://api.github.com/repos/%s/%s/commits/%s" 63 | (namespace lib) (name lib) branch)) 64 | :sha)) 65 | (catch clojure.lang.ExceptionInfo e 66 | (println (ex-message e))))) 67 | 68 | (defn list-github-tags [lib] 69 | (let [lib (clean-github-lib lib)] 70 | (curl-get-json (format "https://api.github.com/repos/%s/%s/tags" 71 | (namespace lib) (name lib))))) 72 | 73 | (defn latest-github-tag [lib] 74 | (-> (list-github-tags lib) 75 | first)) 76 | 77 | (defn find-github-tag [lib tag] 78 | (->> (list-github-tags lib) 79 | (filter #(= (:name %) tag)) 80 | first)) 81 | 82 | (defn- github-repo-http-url [lib] 83 | (str "https://github.com/" (clean-github-lib lib))) 84 | 85 | (def github-repo-ssh-regex #"^git@github.com:([^/]+)/([^\.]+)\.git$") 86 | (def github-repo-http-regex #"^https://github.com/([^/]+)/([^\.]+)(\.git)?$") 87 | 88 | (defn- parse-git-url [git-url] 89 | (let [[[_ gh-user repo-name]] (or (re-seq github-repo-ssh-regex git-url) 90 | (re-seq github-repo-http-regex git-url))] 91 | (if (and gh-user repo-name) 92 | {:gh-user gh-user :repo-name repo-name} 93 | (throw (ex-info "Failed to parse :git/url" {:git/url git-url}))))) 94 | 95 | (defn- git-url->lib-sym [git-url] 96 | (when-let [{:keys [gh-user repo-name]} (parse-git-url git-url)] 97 | (symbol (str "io.github." gh-user) repo-name))) 98 | 99 | (def lib-opts->template-deps-fn 100 | "A map to define valid CLI options for deps-new template deps. 101 | 102 | - Each key is a sequence of valid combinations of CLI opts. 103 | - Each value is a function which returns a tools.deps lib map." 104 | {[#{:local/root}] 105 | (fn [lib-sym lib-opts] 106 | {lib-sym (select-keys lib-opts [:local/root])}) 107 | 108 | [#{} #{:git/url}] 109 | (fn [lib-sym lib-opts] 110 | (let [url (or (:git/url lib-opts) (github-repo-http-url lib-sym)) 111 | tag (latest-github-tag (git-url->lib-sym url))] 112 | (if tag 113 | {lib-sym {:git/url url :git/tag (:name tag) :git/sha (-> tag :commit :sha)}} 114 | (let [sha (latest-github-sha (git-url->lib-sym url))] 115 | {lib-sym {:git/url url :git/sha sha}})))) 116 | 117 | [#{:git/tag} #{:git/url :git/tag}] 118 | (fn [lib-sym lib-opts] 119 | (let [url (or (:git/url lib-opts) (github-repo-http-url lib-sym)) 120 | tag (:git/tag lib-opts) 121 | {:keys [commit]} (find-github-tag (git-url->lib-sym url) tag)] 122 | {lib-sym {:git/url url :git/tag tag :git/sha (:sha commit)}})) 123 | 124 | [#{:git/sha} #{:git/url :git/sha}] 125 | (fn [lib-sym lib-opts] 126 | (let [url (or (:git/url lib-opts) (github-repo-http-url lib-sym)) 127 | sha (:git/sha lib-opts)] 128 | {lib-sym {:git/url url :git/sha sha}})) 129 | 130 | [#{:latest-sha} #{:git/url :latest-sha}] 131 | (fn [lib-sym lib-opts] 132 | (let [url (or (:git/url lib-opts) (github-repo-http-url lib-sym)) 133 | sha (latest-github-sha (git-url->lib-sym url))] 134 | {lib-sym {:git/url url :git/sha sha}})) 135 | 136 | [#{:git/url :git/tag :git/sha}] 137 | (fn [lib-sym lib-opts] 138 | {lib-sym (select-keys lib-opts [:git/url :git/tag :git/sha])})}) 139 | 140 | (def valid-lib-opts 141 | "The set of all valid combinations of deps-new template deps opts." 142 | (into #{} cat (keys lib-opts->template-deps-fn))) 143 | 144 | (defn- deps-new-cli-opts->lib-opts 145 | "Returns parsed deps-new template deps opts from raw CLI opts." 146 | [cli-opts] 147 | (-> cli-opts 148 | (set/rename-keys {:sha :git/sha}) 149 | (select-keys (into #{} cat valid-lib-opts)))) 150 | 151 | (defn- invalid-lib-opts-error [provided-lib-opts] 152 | (ex-info (str "Provided invalid combination of CLI options for deps-new " 153 | "template deps.") 154 | {:provided-opts (set (keys provided-lib-opts)) 155 | :valid-combinations valid-lib-opts})) 156 | 157 | (defn- find-template-deps-fn 158 | "Returns a template-deps-fn given lib-opts parsed from raw CLI opts." 159 | [lib-opts] 160 | (some (fn [[k v]] (and (contains? (set k) (set (keys lib-opts))) v)) 161 | lib-opts->template-deps-fn)) 162 | 163 | (defn- template-deps 164 | "Returns a tools.deps lib map for the given CLI opts." 165 | [template cli-opts] 166 | (let [lib-opts (deps-new-cli-opts->lib-opts cli-opts) 167 | lib-sym (edn/read-string template) 168 | template-deps-fn (find-template-deps-fn lib-opts)] 169 | (if-not template-deps-fn 170 | (throw (invalid-lib-opts-error lib-opts)) 171 | (template-deps-fn lib-sym lib-opts)))) 172 | 173 | (def bb? (System/getProperty "babashka.version")) 174 | 175 | (def create-opts-deny-list 176 | [:git/sha :git/url :latest-sha :local/root :sha]) 177 | 178 | (defn- cli-opts->create-opts 179 | "Returns options for org.corfield.new/create based on the cli-opts." 180 | [cli-opts] 181 | (apply dissoc cli-opts create-opts-deny-list)) 182 | 183 | (defn default-template [] 184 | (edn/read-string (slurp (io/resource "default-template-coords.edn")))) 185 | 186 | (defn- deps-new-plan 187 | "Returns a plan for calling org.corfield.new/create. 188 | 189 | :template-deps - These deps will be added with babashka.deps/add-deps before 190 | calling the create function. 191 | 192 | :create-opts - This map contains the options that will be passed to the 193 | create function." 194 | [cli-opts] 195 | (let [create-opts (cli-opts->create-opts cli-opts) 196 | tpl-deps (try (template-deps (:template create-opts) cli-opts) 197 | (catch Exception e 198 | (if (= {:error :github-rate-limit} (ex-data e)) 199 | (binding [*out* *err*] 200 | (println (ex-message e)) 201 | (println "Using default template:") 202 | (prn (default-template)) 203 | (default-template)) 204 | (throw e))))] 205 | {:template-deps tpl-deps 206 | :create-opts create-opts})) 207 | 208 | (defn- deps-new-set-classpath 209 | "Sets the java.class.path property. 210 | 211 | This is required by org.corfield.new/create. In Clojure it's set by default, 212 | but in Babashka it must be set explicitly." 213 | [] 214 | (let [classpath ((req-resolve 'babashka.classpath/get-classpath))] 215 | (System/setProperty "java.class.path" classpath))) 216 | 217 | (defn- deps-new-add-template-deps 218 | "Adds template deps at runtime." 219 | [template-deps] 220 | ((req-resolve 'babashka.deps/add-deps) {:deps template-deps})) 221 | 222 | (defn run-deps-new [opts] 223 | (let [plan (deps-new-plan opts) 224 | {:keys [template-deps create-opts]} plan] 225 | (deps-new-add-template-deps template-deps) 226 | (when bb? (deps-new-set-classpath)) 227 | ((req-resolve 'org.corfield.new/create) create-opts))) 228 | 229 | (defn create [opts] 230 | (run-deps-new (merge {:target-dir "." 231 | :overwrite true} 232 | opts))) 233 | -------------------------------------------------------------------------------- /standalone-build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -ex 3 | if [ -z "$1" ]; then 4 | echo "Usage: $(basename "$0") " 5 | exit 1 6 | fi 7 | workdir="$(pwd)" 8 | clidir="$(dirname "$0")" 9 | targetdir="$(readlink -f "$1")" 10 | mkdir -p "$targetdir" 11 | cd "$clidir" 12 | bb_version="$(bb -o "(:min-bb-version (clojure.edn/read-string (slurp \"bb.edn\")))")" 13 | bb uberjar cli.jar -m nextjournal.garden-cli 14 | tmpdir="$(mktemp -d)" 15 | mv cli.jar "$tmpdir" 16 | cd "$tmpdir" 17 | for arch in macos-aarch64 macos-amd64 linux-aarch64-static linux-amd64-static; do 18 | echo "Building for ${arch}" 19 | curl -o bb.tar.gz -sL "https://github.com/babashka/babashka/releases/download/v${bb_version}/babashka-${bb_version}-${arch}.tar.gz" 20 | tar xzf bb.tar.gz 21 | cat ./bb cli.jar > garden 22 | chmod +x garden 23 | tar caf "$targetdir/garden-${arch}.tar.gz" garden 24 | sha256sum "$targetdir/garden-${arch}.tar.gz" | cut -d " " -f 1 > "$targetdir/garden-${arch}.tar.gz.sha256" 25 | done 26 | cd "$workdir" 27 | --------------------------------------------------------------------------------