├── app ├── examples │ ├── caches │ │ ├── .gitignore │ │ └── build.clj │ ├── clj-build │ │ ├── .gitignore │ │ ├── tests.edn │ │ ├── src │ │ │ └── com │ │ │ │ └── monkeyci │ │ │ │ └── examples │ │ │ │ └── clj_build.clj │ │ ├── deps.edn │ │ ├── test │ │ │ └── com │ │ │ │ └── monkeyci │ │ │ │ └── examples │ │ │ │ └── clj_build_test.clj │ │ └── .monkeyci │ │ │ └── build.clj │ ├── artifacts │ │ ├── .gitignore │ │ └── build.clj │ ├── .gitignore │ ├── kaniko │ │ ├── Dockerfile │ │ └── .monkeyci │ │ │ └── build.clj │ ├── invalid-script │ │ └── build.clj │ ├── yaml │ │ └── build.yaml │ ├── failing │ │ └── build.clj │ ├── regex │ │ └── build.clj │ ├── build-params │ │ └── build.clj │ ├── basic-clj │ │ └── build.clj │ ├── single-job │ │ └── build.clj │ ├── extra-deps │ │ └── build.clj │ ├── many-parallel-jobs │ │ └── build.clj │ ├── basic-script │ │ └── build.clj │ ├── container-script │ │ └── build.clj │ ├── parallel-jobs │ │ └── build.clj │ ├── many-sequential-jobs │ │ └── build.clj │ └── conditional-jobs │ │ └── build.clj ├── tests.edn ├── src │ └── monkey │ │ └── ci │ │ ├── runners │ │ ├── k8s.clj │ │ └── interceptors.clj │ │ ├── spec │ │ ├── job_context.clj │ │ ├── build_api.clj │ │ ├── extensions.clj │ │ ├── context.clj │ │ ├── gen.clj │ │ ├── api_server.clj │ │ ├── containers.clj │ │ ├── runner.clj │ │ ├── script.clj │ │ └── sidecar.clj │ │ ├── version.clj │ │ ├── build │ │ ├── container.clj │ │ └── v2.clj │ │ ├── metrics │ │ ├── common.clj │ │ └── otlp.clj │ │ ├── web │ │ ├── response.clj │ │ ├── api │ │ │ ├── crypto.clj │ │ │ ├── repo.clj │ │ │ └── ssh_keys.clj │ │ └── http.clj │ │ ├── local │ │ └── common.clj │ │ ├── sid.clj │ │ ├── entities │ │ ├── mailing.clj │ │ ├── ssh_key.clj │ │ ├── join_request.clj │ │ ├── credit_subs.clj │ │ ├── types.clj │ │ ├── invoice.clj │ │ ├── token.clj │ │ ├── webhook.clj │ │ └── credit_cons.clj │ │ ├── reporting.clj │ │ ├── storage │ │ ├── sql │ │ │ ├── common.clj │ │ │ ├── email_registration.clj │ │ │ ├── user_token.clj │ │ │ ├── org_token.clj │ │ │ └── webhook.clj │ │ └── cached.clj │ │ ├── dispatcher │ │ ├── spec.clj │ │ ├── state.clj │ │ ├── main.clj │ │ └── http.clj │ │ ├── internal.clj │ │ ├── agent │ │ ├── container.clj │ │ └── main.clj │ │ ├── pem.clj │ │ ├── containers.clj │ │ ├── vault │ │ └── common.clj │ │ ├── logging │ │ └── logback.clj │ │ ├── cuid.clj │ │ ├── events │ │ └── core.clj │ │ ├── script │ │ └── config.clj │ │ ├── k8s.clj │ │ ├── time.clj │ │ └── blob.clj ├── .gitignore ├── dev-resources │ ├── .gitignore │ ├── logging.properties │ ├── nginx.conf │ ├── test │ │ ├── config.edn │ │ ├── jwk │ │ │ └── pubkey.pem │ │ └── config │ │ │ └── logback-sidecar.xml │ ├── install-cli.sh │ ├── logback-json.xml │ ├── logback-loki.xml │ ├── logback-sidecar.xml │ ├── logback-test.xml │ ├── logback-agent.xml │ ├── logback-script.xml │ └── logback-container.xml ├── kaocha │ ├── default.edn │ ├── e2e.edn │ ├── junit.edn │ └── coverage.edn ├── env │ └── dev │ │ ├── common.clj │ │ ├── entities.clj │ │ ├── git.clj │ │ ├── otlp.clj │ │ ├── cache.clj │ │ ├── blob.clj │ │ ├── dispatcher.clj │ │ ├── sidecar.clj │ │ └── tests.clj ├── test │ ├── unit │ │ └── monkey │ │ │ └── ci │ │ │ ├── metrics │ │ │ ├── common_test.clj │ │ │ └── otlp_test.clj │ │ │ ├── k8s_test.clj │ │ │ ├── sid_test.clj │ │ │ ├── runtime_test.clj │ │ │ ├── blob │ │ │ └── minio_test.clj │ │ │ ├── test │ │ │ ├── extensions.clj │ │ │ ├── config.clj │ │ │ ├── api_server.clj │ │ │ ├── mailman.clj │ │ │ └── runtime │ │ │ │ └── sidecar.clj │ │ │ ├── errors_test.clj │ │ │ ├── internal_test.clj │ │ │ ├── spec_test.clj │ │ │ ├── cuid_test.clj │ │ │ ├── spec │ │ │ └── gen_test.clj │ │ │ ├── script │ │ │ └── config_test.clj │ │ │ ├── entities │ │ │ ├── bb_webhook_test.clj │ │ │ ├── user_test.clj │ │ │ ├── org_test.clj │ │ │ ├── build_test.clj │ │ │ └── repo_test.clj │ │ │ ├── events │ │ │ ├── core_test.clj │ │ │ └── builders_test.clj │ │ │ ├── build │ │ │ ├── helpers.clj │ │ │ └── container_test.clj │ │ │ ├── dispatcher │ │ │ └── http_test.clj │ │ │ ├── web │ │ │ ├── oauth2_test.clj │ │ │ └── common_test.clj │ │ │ ├── core_test.clj │ │ │ ├── agent │ │ │ ├── main_test.clj │ │ │ └── container_test.clj │ │ │ ├── sidecar │ │ │ └── runtime_test.clj │ │ │ └── runtime │ │ │ └── common_test.clj │ ├── e2e │ │ └── monkey │ │ │ └── ci │ │ │ └── e2e │ │ │ ├── basic_test.clj │ │ │ └── public_test.clj │ └── integration │ │ └── monkey │ │ └── ci │ │ └── integration_test │ │ └── examples_test.clj └── resources │ └── logback.xml ├── common ├── tests.edn ├── src │ └── monkey │ │ └── ci │ │ └── common │ │ ├── preds.cljc │ │ └── jobs.cljc └── deps.edn ├── test-lib ├── tests.edn ├── README.md ├── deps.edn ├── test │ └── monkey │ │ └── ci │ │ └── test_test.clj └── pom.xml ├── gui ├── dev-resources │ ├── .gitignore │ ├── nginx-test.conf │ └── devcards │ │ └── index.html ├── .dockerignore ├── resources │ ├── .gitignore │ └── public │ │ ├── favicon.ico │ │ └── img │ │ ├── github-mark.svg │ │ └── mark-gradient-blue-bitbucket.svg ├── tests.edn ├── src │ └── monkey │ │ └── ci │ │ └── gui │ │ ├── colors.cljc │ │ ├── admin │ │ ├── login │ │ │ ├── subs.cljc │ │ │ ├── db.cljc │ │ │ ├── events.cljc │ │ │ └── views.cljs │ │ ├── invoicing │ │ │ ├── subs.cljc │ │ │ ├── db.cljc │ │ │ └── events.cljc │ │ ├── clean │ │ │ ├── subs.cljc │ │ │ ├── db.cljc │ │ │ └── events.cljc │ │ ├── credits │ │ │ └── subs.cljc │ │ └── mailing │ │ │ └── subs.cljc │ │ ├── version.cljc │ │ ├── subs.cljc │ │ ├── artifact │ │ ├── subs.cljc │ │ └── db.cljc │ │ ├── notifications │ │ ├── subs.cljc │ │ ├── db.cljc │ │ ├── events.cljc │ │ └── views.cljs │ │ ├── billing │ │ ├── subs.cljc │ │ └── db.cljc │ │ ├── user │ │ ├── subs.cljc │ │ └── db.cljc │ │ ├── edn.cljs │ │ ├── webhooks │ │ ├── subs.cljc │ │ └── db.cljc │ │ ├── api_keys │ │ └── subs.cljc │ │ ├── download.cljs │ │ ├── main.cljs │ │ ├── repo_settings │ │ └── views.cljs │ │ ├── local_storage.cljc │ │ ├── modals.cljc │ │ ├── timer.cljc │ │ ├── logging.cljc │ │ ├── params │ │ └── subs.cljc │ │ ├── build │ │ └── subs.cljc │ │ ├── core.cljs │ │ ├── org_settings │ │ └── views.cljs │ │ ├── home │ │ └── subs.cljc │ │ ├── apis │ │ └── common.cljc │ │ ├── loki.cljc │ │ ├── clipboard.cljc │ │ ├── ssh_keys │ │ ├── subs.cljc │ │ └── db.cljc │ │ ├── login │ │ └── subs.cljc │ │ └── repo │ │ └── subs.cljc ├── .dir-locals.el ├── .gitignore ├── test │ └── monkey │ │ └── ci │ │ └── gui │ │ ├── test │ │ ├── core_test.cljs │ │ ├── components_test.cljc │ │ ├── layout_test.cljc │ │ ├── edn_test.cljs │ │ ├── cards │ │ │ ├── alert_cards.cljs │ │ │ ├── modal_cards.cljs │ │ │ ├── timer_cards.cljs │ │ │ ├── log_cards.cljs │ │ │ ├── label_cards.cljs │ │ │ ├── repo_cards.cljs │ │ │ ├── job_cards.cljs │ │ │ ├── accordion_cards.cljs │ │ │ └── pagination_cards.cljs │ │ ├── countries_test.cljc │ │ ├── modals_test.cljc │ │ ├── fixtures.cljc │ │ ├── subs_test.cljc │ │ ├── tabs_test.cljc │ │ ├── apis │ │ │ └── common_test.cljc │ │ ├── notifications │ │ │ └── subs_test.cljc │ │ ├── user │ │ │ └── subs_test.cljc │ │ ├── admin │ │ │ ├── invoicing │ │ │ │ └── subs_test.cljc │ │ │ └── clean │ │ │ │ └── subs_test.cljc │ │ ├── alerts_test.cljc │ │ ├── billing │ │ │ └── subs_test.cljc │ │ ├── loki_test.cljc │ │ ├── local_storage_test.cljs │ │ ├── artifact │ │ │ └── subs_test.cljc │ │ ├── utils_test.cljc │ │ └── clipboard_test.cljc │ │ └── shadow_runner.cljs ├── Dockerfile └── package.json ├── braid-bot ├── dev-resources │ └── config.edn ├── Dockerfile ├── src │ └── monkey │ │ └── ci │ │ └── braid │ │ └── core.clj └── deps.edn ├── hook ├── src │ └── test │ │ └── monkey │ │ └── ci │ │ └── hook │ │ └── test │ │ └── index_test.cljs ├── .gitignore ├── package.json ├── .gcloudignore └── shadow-cljs.edn ├── .monkeyci ├── deps.edn ├── clojars_test.clj ├── clojars.clj ├── minio.clj └── config.clj ├── docker └── Dockerfile ├── docs └── admin.md └── .gitignore /app/examples/caches/.gitignore: -------------------------------------------------------------------------------- 1 | cache/ -------------------------------------------------------------------------------- /app/examples/clj-build/.gitignore: -------------------------------------------------------------------------------- 1 | m2/ -------------------------------------------------------------------------------- /common/tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 {} 2 | -------------------------------------------------------------------------------- /test-lib/tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 {} 2 | -------------------------------------------------------------------------------- /app/examples/artifacts/.gitignore: -------------------------------------------------------------------------------- 1 | *.txt 2 | -------------------------------------------------------------------------------- /gui/dev-resources/.gitignore: -------------------------------------------------------------------------------- 1 | js/ 2 | sites/ 3 | -------------------------------------------------------------------------------- /app/examples/.gitignore: -------------------------------------------------------------------------------- 1 | deps.edn 2 | *.txt 3 | log/ -------------------------------------------------------------------------------- /app/examples/clj-build/tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 {} 2 | -------------------------------------------------------------------------------- /app/tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | #include "kaocha/default.edn" 3 | -------------------------------------------------------------------------------- /gui/.dockerignore: -------------------------------------------------------------------------------- 1 | *~ 2 | cljs-runtime/ 3 | manifest.edn 4 | 5 | -------------------------------------------------------------------------------- /app/src/monkey/ci/runners/k8s.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.runners.k8s) 2 | 3 | -------------------------------------------------------------------------------- /gui/resources/.gitignore: -------------------------------------------------------------------------------- 1 | js/ 2 | public/conf/ 3 | public/index.html 4 | -------------------------------------------------------------------------------- /gui/tests.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | {:tests [{:type :kaocha.type/cljs2}]} 3 | -------------------------------------------------------------------------------- /app/.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | tmp/ 3 | /storage/ 4 | logs/ 5 | /local 6 | /.m2 -------------------------------------------------------------------------------- /app/dev-resources/.gitignore: -------------------------------------------------------------------------------- 1 | *.key 2 | /*.edn 3 | /config 4 | /keys 5 | /user -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/colors.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.colors) 2 | 3 | (def primary "#008060") 4 | -------------------------------------------------------------------------------- /app/dev-resources/logging.properties: -------------------------------------------------------------------------------- 1 | # JUL logging 2 | .level=SEVERE 3 | io.prometheus.level=SEVERE 4 | -------------------------------------------------------------------------------- /app/examples/kaniko/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM docker.io/alpine:latest 2 | 3 | CMD "echo 'Test working!'" 4 | -------------------------------------------------------------------------------- /app/examples/invalid-script/build.clj: -------------------------------------------------------------------------------- 1 | (ns invalid-script.build) 2 | 3 | This is invalid clojure code 4 | -------------------------------------------------------------------------------- /app/examples/yaml/build.yaml: -------------------------------------------------------------------------------- 1 | - id: list-job 2 | image: docker.io/alpine:latest 3 | script: 4 | - ls -l 5 | -------------------------------------------------------------------------------- /gui/resources/public/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/monkey-projects/monkeyci/HEAD/gui/resources/public/favicon.ico -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/login/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.login.subs 2 | (:require [re-frame.core :as rf])) 3 | 4 | -------------------------------------------------------------------------------- /app/examples/failing/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as m])) 3 | 4 | (m/action-job "failing-job" (constantly m/failure)) 5 | 6 | 7 | -------------------------------------------------------------------------------- /braid-bot/dev-resources/config.edn: -------------------------------------------------------------------------------- 1 | {:braid-bot-id "656083c0-52bb-435e-892e-5f0ed8c454ce" 2 | :braid-bot-token "du9p1WAI_yLlTDW0VjCLEWBpzMaJJn3wfCMrakVq"} 3 | -------------------------------------------------------------------------------- /app/examples/clj-build/src/com/monkeyci/examples/clj_build.clj: -------------------------------------------------------------------------------- 1 | (ns com.monkeyci.examples.clj-build) 2 | 3 | (defn main-fn [] 4 | "This is the main functionx") 5 | -------------------------------------------------------------------------------- /app/kaocha/default.edn: -------------------------------------------------------------------------------- 1 | {:omit-system-out? true 2 | :ignore ["\\.#*.clj"] 3 | :fail-fast? true 4 | :tests [{:id :unit 5 | :test-paths ["test/unit"]}]} 6 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/version.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.version) 2 | 3 | ;; Frontend version 4 | #?(:cljs (goog-define VERSION "develop") 5 | :clj (def VERSION "clj")) 6 | -------------------------------------------------------------------------------- /app/kaocha/e2e.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | {:omit-system-out? true 3 | :ignore ["\\.#*.clj"] 4 | :fail-fast? false 5 | :tests [{:id :unit 6 | :test-paths ["test/e2e"]}]} 7 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.subs 2 | "Subs that are globally useful" 3 | (:require [monkey.ci.gui.utils :as u])) 4 | 5 | (u/db-sub :version :version) 6 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/job_context.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.job-context 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::context 5 | (s/keys :req [::build ::job ::api])) 6 | -------------------------------------------------------------------------------- /app/src/monkey/ci/version.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.version) 2 | 3 | ;; Determine version at compile time 4 | (defmacro version [] 5 | (or (System/getenv "MONKEYCI_VERSION") "0.1.0-SNAPSHOT")) 6 | -------------------------------------------------------------------------------- /gui/.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((clojurescript-mode 2 | (cider-preferred-build-tool . shadow-cljs) 3 | (cider-default-cljs-repl . shadow) 4 | (cider-shadow-watched-builds . ("frontend" "test")))) 5 | -------------------------------------------------------------------------------- /app/src/monkey/ci/build/container.clj: -------------------------------------------------------------------------------- 1 | (ns ^:no-doc monkey.ci.build.container 2 | "Functions to configure container images on a build step") 3 | 4 | (defn image [step img] 5 | (assoc step :container/image img)) 6 | -------------------------------------------------------------------------------- /app/examples/clj-build/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {ch.qos.logback/logback-classic {:mvn/version "1.5.3"}} 2 | 3 | :aliases 4 | {:test 5 | {:extra-deps {com.monkeyprojects/build {:mvn/version "0.2.0"}} 6 | :exec-fn monkey.test/all}}} 7 | -------------------------------------------------------------------------------- /app/env/dev/common.clj: -------------------------------------------------------------------------------- 1 | (ns common) 2 | 3 | (defonce env (atom :staging)) 4 | 5 | (defn set-env! [e] 6 | (reset! env e)) 7 | 8 | (defn staging! [] 9 | (set-env! :staging)) 10 | 11 | (defn prod! [] 12 | (set-env! :prod)) 13 | -------------------------------------------------------------------------------- /common/src/monkey/ci/common/preds.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.common.preds 2 | "Common predicate functions") 3 | 4 | (defn prop-pred 5 | "Returns a fn that is a predicate to match property `p` with value `v`" 6 | [p v] 7 | (comp (partial = v) p)) 8 | -------------------------------------------------------------------------------- /gui/.gitignore: -------------------------------------------------------------------------------- 1 | node_modules/ 2 | public/js 3 | 4 | /target 5 | /checkouts 6 | /src/gen 7 | 8 | pom.xml 9 | pom.xml.asc 10 | *.iml 11 | *.jar 12 | *.log 13 | .shadow-cljs 14 | .idea 15 | .lein-* 16 | .nrepl-* 17 | .DS_Store 18 | 19 | .hgignore 20 | .hg/ 21 | *.sh -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/login/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.login.db) 2 | 3 | (def submitting? ::submitting?) 4 | 5 | (defn mark-submitting [db] 6 | (assoc db submitting? true)) 7 | 8 | (defn reset-submitting [db] 9 | (dissoc db submitting?)) 10 | -------------------------------------------------------------------------------- /hook/src/test/monkey/ci/hook/test/index_test.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.hook.test.index-test 2 | (:require [cljs.test :refer [deftest testing is]] 3 | [monkey.ci.hook.index :as sut])) 4 | 5 | (deftest main 6 | (testing "returns nil" 7 | (is (nil? (sut/main))))) 8 | -------------------------------------------------------------------------------- /app/examples/regex/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as m])) 3 | 4 | (def regex-action 5 | (-> (m/action-job 6 | "regex-job" 7 | (fn [_] 8 | (println "This job contains a regex"))) 9 | (assoc ::test-regex #"some regex"))) 10 | -------------------------------------------------------------------------------- /app/src/monkey/ci/metrics/common.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.metrics.common 2 | (:require [clojure.string :as cs])) 3 | 4 | (defn counter-id [parts] 5 | (->> parts 6 | (map name) 7 | (cs/join "_") 8 | (str "monkeyci_"))) 9 | 10 | (def metric-id counter-id) 11 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/core_test.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.core-test 2 | (:require [cljs.test :refer-macros [deftest testing is]] 3 | [monkey.ci.gui.core :as sut])) 4 | 5 | #_(deftest failing 6 | (testing "fails for testing purposes" 7 | (is (= 1 0)))) 8 | -------------------------------------------------------------------------------- /hook/.gitignore: -------------------------------------------------------------------------------- 1 | node_modules/ 2 | public/js 3 | 4 | /target 5 | /checkouts 6 | /src/gen 7 | /out 8 | /compiled 9 | 10 | pom.xml 11 | pom.xml.asc 12 | *.iml 13 | *.jar 14 | *.log 15 | .shadow-cljs 16 | .idea 17 | .lein-* 18 | .nrepl-* 19 | .DS_Store 20 | 21 | .hgignore 22 | .hg/ 23 | -------------------------------------------------------------------------------- /app/examples/build-params/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as api])) 3 | 4 | (defn ^:job check-build-params [ctx] 5 | (println "Fetching build parameters") 6 | (if (some? (api/build-params ctx)) 7 | api/success 8 | api/failure)) 9 | 10 | [check-build-params] 11 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/build_api.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.build-api 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::url (s/and string? not-empty)) 5 | (s/def ::token (s/and string? not-empty)) 6 | 7 | (s/def ::api 8 | (s/keys :req-un [::url ::token])) 9 | 10 | (s/def ::client fn?) 11 | -------------------------------------------------------------------------------- /braid-bot/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM docker.io/eclipse-temurin:21-jre 2 | 3 | WORKDIR /opt/app 4 | CMD ["java", "-Dlogback.configurationFile=config/logback.xml", "-jar", "braid-bot.jar"] 5 | 6 | VOLUME /opt/app/config 7 | 8 | ENV HTTP_PORT=3000 9 | EXPOSE 3000 10 | 11 | ADD target/braid-bot.jar /opt/app 12 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/artifact/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.artifact.subs 2 | (:require [monkey.ci.gui.artifact.db :as db] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub :artifact/alerts db/alerts) 7 | (u/db-sub :artifact/downloading? db/downloading?) 8 | -------------------------------------------------------------------------------- /app/src/monkey/ci/web/response.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.web.response) 2 | 3 | (def get-events ::events) 4 | 5 | (defn add-events [r evts] 6 | (update r ::events concat evts)) 7 | 8 | (defn add-event [r evt] 9 | (update r ::events conj evt)) 10 | 11 | (defn remove-events [r] 12 | (dissoc r ::events)) 13 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/invoicing/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.invoicing.subs 2 | (:require [monkey.ci.gui.admin.invoicing.db :as db] 3 | [monkey.ci.gui.utils :as u])) 4 | 5 | (u/db-sub ::invoices db/get-invoices) 6 | (u/db-sub ::loading? db/loading?) 7 | (u/db-sub ::alerts db/get-alerts) 8 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/components_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.components-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is use-fixtures]] 3 | :clj [clojure.test :refer [deftest testing is use-fixtures]]) 4 | [monkey.ci.gui.components :as sut])) 5 | 6 | 7 | -------------------------------------------------------------------------------- /.monkeyci/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {com.monkeyci/plugin-junit {:mvn/version "0.2.0"} 2 | com.monkeyci/plugin-github {:mvn/version "0.2.0"} 3 | com.monkeyci/plugin-kaniko {:mvn/version "0.2.2-SNAPSHOT"} 4 | com.monkeyci/plugin-pushover {:mvn/version "0.1.1"} 5 | io.minio/minio {:mvn/version "8.5.17"}}} 6 | -------------------------------------------------------------------------------- /app/examples/clj-build/test/com/monkeyci/examples/clj_build_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.monkeyci.examples.clj-build-test 2 | (:require [com.monkeyci.examples.clj-build :as sut] 3 | [clojure.test :refer [deftest testing is]])) 4 | 5 | (deftest main-fn 6 | (testing "returns something" 7 | (is (some? (sut/main-fn))))) 8 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/notifications/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.notifications.subs 2 | (:require [monkey.ci.gui.notifications.db :as db] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub ::unregistering? (comp true? db/unregistering?)) 7 | (u/db-sub ::alerts db/alerts) 8 | -------------------------------------------------------------------------------- /app/kaocha/junit.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | #meta-merge 3 | [#include "default.edn" 4 | {:kaocha/fail-fast? false 5 | :kaocha/plugins [:kaocha.plugin/junit-xml 6 | :kaocha.plugin/profiling] 7 | :kaocha.plugin.junit-xml/target-file "junit.xml" 8 | ;;:kaocha/reporter [kaocha.report/documentation] 9 | }] 10 | -------------------------------------------------------------------------------- /app/src/monkey/ci/local/common.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.local.common 2 | (:require [monkey.ci.utils :as u])) 3 | 4 | (defn set-interceptors 5 | "Sets the interceptors of all route handlers" 6 | [routes i] 7 | (mapv (fn [r] 8 | (u/update-nth r 1 #(u/update-nth % 0 assoc :interceptors i))) 9 | routes)) 10 | -------------------------------------------------------------------------------- /app/examples/kaniko/.monkeyci/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as m])) 3 | 4 | (-> (m/container-job "build-image") 5 | ;; Use custom image since the kaniko one gives permission errors 6 | (m/image "docker.io/monkeyci/kaniko:1.21.0") 7 | (m/script ["/kaniko/executor --context dir:///home/monkeyci --no-push"])) 8 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/billing/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.billing.subs 2 | (:require [monkey.ci.gui.billing.db :as db] 3 | [monkey.ci.gui.utils :as u])) 4 | 5 | (u/db-sub ::billing-alerts db/get-billing-alerts) 6 | (u/db-sub ::billing-loading? db/billing-loading?) 7 | (u/db-sub ::invoicing-settings db/get-invoicing-settings) 8 | -------------------------------------------------------------------------------- /app/examples/basic-clj/build.clj: -------------------------------------------------------------------------------- 1 | ;; Basic Clojure build script 2 | (ns build 3 | (:require [monkey.ci.api :as m])) 4 | 5 | (m/action-job 6 | "simple-job" 7 | (fn [_] 8 | (println "This must be the simplest build script!") 9 | (println "Running in namespace" (ns-name *ns*)) 10 | ;; Return success response 11 | m/success)) 12 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/extensions.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.extensions 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::key keyword?) 5 | (s/def ::priority int?) 6 | (s/def ::before fn?) 7 | (s/def ::after fn?) 8 | (s/def ::extension (s/keys :req-un [::key] 9 | :opt-un [::priority ::before ::after])) 10 | -------------------------------------------------------------------------------- /app/dev-resources/nginx.conf: -------------------------------------------------------------------------------- 1 | # Test nginx config to simulate Kubernetes nginx ingress. 2 | user nginx; 3 | worker_processes auto; 4 | 5 | http { 6 | include /etc/nginx/mime.types; 7 | server { 8 | listen 8090; 9 | location / { 10 | proxy_pass http://localhost:3000; 11 | } 12 | } 13 | } 14 | 15 | events { 16 | } -------------------------------------------------------------------------------- /app/examples/single-job/build.clj: -------------------------------------------------------------------------------- 1 | ;; Build script with a single job 2 | (ns build 3 | (:require [monkey.ci.api :as m])) 4 | 5 | (defn ^:job simple-job [_] 6 | (println "This must be the simplest build script!") 7 | (println "Running in namespace" (ns-name *ns*)) 8 | ;; Return success response 9 | m/success) 10 | 11 | [simple-job] 12 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/metrics/common_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.metrics.common-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.metrics.common :as sut])) 4 | 5 | (deftest counter-id 6 | (testing "builds metrics name from parts" 7 | (is (= "monkeyci_test_metric" (sut/counter-id [:test :metric]))))) 8 | 9 | -------------------------------------------------------------------------------- /app/examples/extra-deps/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as m] 3 | ;; This dependency is included through the deps.edn file 4 | [camel-snake-kebab.core :as csk])) 5 | 6 | (m/action-job 7 | "extra-deps" 8 | (fn [_] 9 | (assoc m/success :output (csk/->snake_case "SomeSimpleScript")))) 10 | 11 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/k8s_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.k8s-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.k8s :as sut])) 4 | 5 | (deftest parse-mem 6 | (testing "parses K to gb" 7 | (is (= 1 (sut/parse-mem "1000000K")))) 8 | 9 | (testing "parses Mi to gb" 10 | (is (= 1 (sut/parse-mem "1024Mi"))))) 11 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/user/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.user.subs 2 | (:require [monkey.ci.gui.user.db :as db] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub ::general-edit db/get-general-edit-merged) 7 | (u/db-sub ::general-alerts db/get-general-alerts) 8 | (u/db-sub ::general-saving? db/general-saving?) 9 | -------------------------------------------------------------------------------- /app/examples/many-parallel-jobs/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as m])) 3 | 4 | (def n-jobs 20) 5 | 6 | (defn make-job [idx] 7 | (m/action-job (str "job-" (inc idx)) 8 | (-> m/success 9 | (m/with-message (str "Job executed: " (inc idx)))))) 10 | 11 | (->> (range n-jobs) 12 | (mapv make-job)) 13 | -------------------------------------------------------------------------------- /braid-bot/src/monkey/ci/braid/core.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.braid.core 2 | (:gen-class) 3 | (:require [clojure.tools.logging :as log] 4 | [monkey.braid.core :as mbc])) 5 | 6 | (defn handle-msg [msg] 7 | (log/info "Handling message:" msg)) 8 | 9 | (defn -main [& args] 10 | (mbc/start-bot-server 11 | (mbc/env->config) 12 | handle-msg)) 13 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/sid_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.sid-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.sid :as sut])) 4 | 5 | (deftest parse-sid 6 | (testing "parses string" 7 | (is (= ["a" "b"] (sut/parse-sid "a/b")))) 8 | 9 | (testing "leaves seq as-is" 10 | (is (= ["a" "b"] (sut/parse-sid ["a" "b"]))))) 11 | -------------------------------------------------------------------------------- /gui/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM docker.io/nginx:1.27 2 | 3 | EXPOSE 8080 4 | EXPOSE 8081 5 | EXPOSE 18080 6 | 7 | ADD nginx.conf /etc/nginx/ 8 | 9 | ADD resources/public/ /var/www/html/ 10 | ADD target/js/frontend/js/*.js /var/www/html/js/ 11 | ADD target/index.html /var/www/html/ 12 | ADD target/admin/ /var/www/html/admin/ 13 | ADD target/error-404.html /var/www/html/ 14 | -------------------------------------------------------------------------------- /app/examples/basic-script/build.clj: -------------------------------------------------------------------------------- 1 | ;; Basic Clojure build script 2 | (ns build 3 | (:require [monkey.ci.api :as m])) 4 | 5 | ;; Jobs that just print messages to stdout 6 | [(m/action-job 7 | "first" 8 | (m/bash "echo \"Hi, I'm a simple build script!\"")) 9 | (m/action-job 10 | "second" 11 | (m/bash "echo" "And I'm another part of that script"))] 12 | 13 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/runtime_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.runtime-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.runtime :as sut])) 4 | 5 | (deftest from-config 6 | (testing "gets value from config" 7 | (is (= "test-val" ((sut/from-config :test-val) 8 | {:config {:test-val "test-val"}}))))) 9 | 10 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/edn.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.edn 2 | (:require [clojure.tools.reader.edn :as edn])) 3 | 4 | (def custom-readers {'regex re-pattern}) 5 | 6 | (defn read-string [edn] 7 | (edn/read-string {:readers custom-readers} edn)) 8 | 9 | ;; For cljs.reader/read-string 10 | (doseq [[s f] custom-readers] 11 | (cljs.reader/register-tag-parser! s f)) 12 | -------------------------------------------------------------------------------- /app/examples/clj-build/.monkeyci/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as m])) 3 | 4 | (def run-tests 5 | (-> (m/container-job "unit-tests") 6 | (m/image "docker.io/clojure:tools-deps-bookworm-slim") 7 | (m/script ["clojure -Sdeps '{:mvn/local-repo \"m2\"}' -X:test"]) 8 | (m/caches (m/cache "maven-cache" "m2")))) 9 | 10 | [run-tests] 11 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/notifications/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.notifications.db) 2 | 3 | (def unregistering? ::unregistering) 4 | 5 | (defn set-unregistering [db] 6 | (assoc db unregistering? true)) 7 | 8 | (defn reset-unregistering [db] 9 | (dissoc db unregistering?)) 10 | 11 | (def alerts ::alerts) 12 | 13 | (defn set-alerts [db a] 14 | (assoc db ::alerts a)) 15 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/blob/minio_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.blob.minio-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.blob.minio :as sut])) 4 | 5 | (deftest make-client 6 | (testing "creates minio client" 7 | (is (some? (sut/make-client "http://test" "test-user" "test-pass"))))) 8 | 9 | ;; TODO Integration tests for minio code 10 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/test/extensions.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.test.extensions 2 | (:require [monkey.ci.extensions :as ext])) 3 | 4 | (defmacro with-extensions [& body] 5 | `(let [ext# @ext/registered-extensions] 6 | (try 7 | (reset! ext/registered-extensions ext/new-register) 8 | ~@body 9 | (finally 10 | (reset! ext/registered-extensions ext#))))) 11 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/layout_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.layout-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is]] 3 | :clj [clojure.test :refer [deftest testing is]]) 4 | [monkey.ci.gui.layout :as sut])) 5 | 6 | (deftest default 7 | (testing "renders contents in default layout" 8 | (is (vector? (sut/default [:p "Child panel"]))))) 9 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/clean/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.clean.subs 2 | (:require [monkey.ci.gui.admin.clean.db :as db] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub ::clean-results db/get-cleaned-processes) 7 | (u/db-sub ::clean-alerts db/get-alerts) 8 | (u/db-sub ::cleaning? db/cleaning?) 9 | (u/db-sub ::cleaned? db/cleaned?) 10 | -------------------------------------------------------------------------------- /app/src/monkey/ci/sid.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.sid 2 | "Functions for working with storage ids" 3 | (:require [clojure.string :as cs])) 4 | 5 | (def delim "/") 6 | 7 | (def sid? (every-pred vector? not-empty)) 8 | (def ->sid vec) 9 | 10 | (defn parse-sid [s] 11 | (cond-> s 12 | (string? s) (cs/split #"/"))) 13 | 14 | (def serialize-sid (partial cs/join "/")) 15 | 16 | (defn sid->repo-sid [s] 17 | (take 2 s)) 18 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/errors_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.errors-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.errors :as sut])) 4 | 5 | (deftest ->error 6 | (testing "creates error from ex-info" 7 | (let [err (sut/->error (ex-info "Test error" {:key "value"}))] 8 | (is (= "Test error" (sut/error-msg err))) 9 | (is (= "value" (:key (sut/error-props err))))))) 10 | -------------------------------------------------------------------------------- /app/examples/container-script/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | ;; Basic build script that uses Docker 3 | (:require [monkey.ci.api :as m])) 4 | 5 | [(-> (m/container-job "first-container") 6 | (m/image "debian:latest") 7 | (m/script ["echo \"I am running from Debian\""])) 8 | 9 | (-> (m/container-job "second-container") 10 | (m/image "alpine:latest") 11 | (m/script ["echo \"And I'm running from Alpine\""]))] 12 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/mailing.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.mailing 2 | (:require [monkey.ci.entities.core :as ec])) 3 | 4 | (defn select-sent-mailings [conn mailing-cuid] 5 | (->> {:select [:sm.*] 6 | :from [[:sent-mailings :sm]] 7 | :join [[:mailings :m] [:= :m.id :sm.mailing-id]] 8 | :where [:= :m.cuid mailing-cuid]} 9 | (ec/select conn) 10 | (map ec/convert-sent-mailing-select))) 11 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/edn_test.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.edn-test 2 | (:require [cljs.test :refer-macros [deftest testing is]] 3 | [monkey.ci.gui.edn :as edn])) 4 | 5 | (deftest regex-parsing 6 | (testing "can parse regexes as received from backend" 7 | (is (= "/test-regex/" ; JS form of a regex 8 | (-> "#regex \"test-regex\"" 9 | (edn/read-string) 10 | str))))) 11 | -------------------------------------------------------------------------------- /hook/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "webhook-fn", 3 | "version": "0.0.1", 4 | "private": true, 5 | "main": "compiled/index.js", 6 | "dependencies": { 7 | "@google-cloud/functions-framework": "^3.0.0", 8 | "@google-cloud/run": "^0.4.1" 9 | }, 10 | "devDependencies": { 11 | "shadow-cljs": "2.22.8" 12 | }, 13 | "scripts": { 14 | "start": "functions-framework --target=buildTrigger" 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /test-lib/README.md: -------------------------------------------------------------------------------- 1 | # MonkeyCI Test Lib 2 | 3 | This is a Clojure library that provides helper functions to use in [MonkeyCI](https://monkeyci.com) 4 | build script unit tests. 5 | 6 | ## Usage 7 | 8 | See the [MonkeyCI Documentation](https://docs.monkeyci.com/pages/unit-tests) for more details. 9 | 10 | ## License 11 | 12 | Copyright (c) 2024 by [Monkey Projects](https://www.monkey-projects.be) 13 | 14 | [GPL v3 License](../LICENSE) -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/webhooks/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.webhooks.subs 2 | (:require [monkey.ci.gui.utils :as u] 3 | [monkey.ci.gui.webhooks.db :as db] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub :repo/webhooks db/get-webhooks) 7 | (u/db-sub :webhooks/alerts db/get-alerts) 8 | (u/db-sub :webhooks/loading? db/loading?) 9 | (u/db-sub :webhooks/new db/get-new) 10 | (u/db-sub :webhooks/deleting? db/deleting?) 11 | -------------------------------------------------------------------------------- /app/examples/parallel-jobs/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :refer [action-job]])) 3 | 4 | (defn first-job [_] 5 | (println "Starting first job") 6 | (Thread/sleep 2000) 7 | (println "First job finished")) 8 | 9 | (defn second-job [_] 10 | (println "Starting second job") 11 | (Thread/sleep 2000) 12 | (println "Second job finished")) 13 | 14 | [(action-job "first" first-job) 15 | (action-job "second" second-job)] 16 | -------------------------------------------------------------------------------- /app/env/dev/entities.clj: -------------------------------------------------------------------------------- 1 | (ns entities 2 | (:require [monkey.ci.entities.migrations :as m] 3 | [next.jdbc.connection :as conn]) 4 | (:import com.zaxxer.hikari.HikariDataSource)) 5 | 6 | (def h2-conf {:jdbcUrl "jdbc:h2:mem:monkeyci-repl"}) 7 | 8 | (defn memory-db-conn [] 9 | {:ds (conn/->pool HikariDataSource h2-conf)}) 10 | 11 | (defn setup-memory-db! [] 12 | (let [conn (memory-db-conn)] 13 | (m/run-migrations! (:ds conn)) 14 | conn)) 15 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/alert_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.alert-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [monkey.ci.gui.alerts :as sut] 4 | [monkey.ci.gui.components :as c] 5 | [reagent.core] 6 | [re-frame.db :as rdb])) 7 | 8 | (defcard-rg github-error 9 | "Github error alert" 10 | [c/render-alert 11 | (sut/cust-github-repos-failed 12 | "no permission")]) 13 | -------------------------------------------------------------------------------- /app/resources/logback.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | localhost 6 | USER 7 | [%thread] %logger{36} - %msg%n 8 | 9 | 10 | 11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/internal_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.internal-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.internal :as sut])) 4 | 5 | (deftest main-test 6 | (binding [*err* (java.io.StringWriter.)] 7 | (with-redefs [clojure.core/shutdown-agents (constantly nil) 8 | cli-matic.platform/exit-script (constantly :exit)] 9 | (testing "runs cli" 10 | (is (= :exit (sut/-main "-?"))))))) 11 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/spec_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.spec :as sut])) 4 | 5 | #_(deftest url? 6 | (testing "matches valid url" 7 | (is (sut/url? "http://test"))) 8 | 9 | (testing "does not match invalid url" 10 | (is (not (sut/url? "invalid")))) 11 | 12 | (testing "matches url with query string" 13 | (is (sut/url? "http://test?key=value&other-key=value")))) 14 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/invoicing/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.invoicing.db 2 | (:require [monkey.ci.gui.loader :as lo])) 3 | 4 | (def id ::invoices) 5 | 6 | (defn get-invoices [db] 7 | (lo/get-value db id)) 8 | 9 | (defn set-invoices [db i] 10 | (lo/set-value db id i)) 11 | 12 | (defn loading? [db] 13 | (lo/loading? db id)) 14 | 15 | (defn set-alerts [db a] 16 | (lo/set-alerts db id a)) 17 | 18 | (defn get-alerts [db] 19 | (lo/get-alerts db id)) 20 | -------------------------------------------------------------------------------- /app/env/dev/git.clj: -------------------------------------------------------------------------------- 1 | (ns git 2 | (:require [monkey.ci.git :as g])) 3 | 4 | (defn clone-private [url dir pk] 5 | (let [priv (slurp pk) 6 | pub (slurp (str pk ".pub")) 7 | opts {:url url 8 | :dir (str dir "/checkout") 9 | :ssh-keys [{:private-key priv 10 | :public-key pub}] 11 | :ssh-keys-dir (str dir "/keys")}] 12 | (println "Cloning from" url "using private key" pk) 13 | (g/clone opts))) 14 | -------------------------------------------------------------------------------- /.monkeyci/clojars_test.clj: -------------------------------------------------------------------------------- 1 | (ns clojars-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [clojars :as sut])) 4 | 5 | (deftest latest-version 6 | (testing "retrieves latest version number from clojars api" 7 | (is (string? (sut/latest-version "com.monkeyci" "test"))))) 8 | 9 | (deftest extract-lib 10 | (testing "reads group and artifact from `deps.edn` file" 11 | (is (= ["com.monkeyci" "app"] 12 | (sut/extract-lib "../app/deps.edn"))))) 13 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/clean/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.clean.db 2 | (:require [monkey.ci.gui.loader :as lo])) 3 | 4 | (def clean ::clean) 5 | 6 | (defn get-cleaned-processes [db] 7 | (lo/get-value db clean)) 8 | 9 | (defn set-cleaned-processes [db p] 10 | (lo/set-value db clean p)) 11 | 12 | (defn get-alerts [db] 13 | (lo/get-alerts db clean)) 14 | 15 | (defn cleaned? [db] 16 | (lo/loaded? db clean)) 17 | 18 | (defn cleaning? [db] 19 | (lo/loading? db clean)) 20 | -------------------------------------------------------------------------------- /app/examples/many-sequential-jobs/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as m])) 3 | 4 | (def n-jobs 20) 5 | 6 | (defn make-job [idx] 7 | (cond-> (m/action-job (str "job-" (inc idx)) 8 | (-> m/success 9 | (m/with-message (str "Job executed: " (inc idx))))) 10 | ;; Make each job dependent on the previous one 11 | (pos? idx) (m/depends-on [(str "job-" idx)]))) 12 | 13 | (->> (range n-jobs) 14 | (mapv make-job)) 15 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/api_keys/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.api-keys.subs 2 | (:require [monkey.ci.gui.api-keys.db :as db] 3 | [monkey.ci.gui.utils :as u])) 4 | 5 | (u/db-sub :org-tokens/items db/get-org-tokens) 6 | (u/db-sub :org-tokens/loading? db/get-org-tokens-loading) 7 | 8 | (u/db-sub :tokens/edit db/get-token-edit) 9 | (u/db-sub :tokens/editing? (comp some? db/get-token-edit)) 10 | (u/db-sub :tokens/saving? db/saving?) 11 | (u/db-sub :tokens/new db/get-new-token) 12 | 13 | -------------------------------------------------------------------------------- /app/dev-resources/test/config.edn: -------------------------------------------------------------------------------- 1 | ;; Configuration used in tests 2 | {:storage 3 | {:type :oci 4 | :bucket-name "test-dev" 5 | :region "eu-frankfurt-1" 6 | :credentials 7 | {:tenancy-ocid "ocid1.tenancy.oc1..aaaaaaaaaelsxbhoxnxwsvj6gnetml6rct3z7myetnptr5bibc3bdfbwiveq" 8 | :user-ocid "ocid1.user.oc1..aaaaaaaagunozd7t7fs5rqwqrnshl2bgkfjufycyavx37gflyordcmhzicxa" 9 | :key-fingerprint "3c:0e:fa:d9:66:00:98:fa:df:d9:5d:8a:db:b3:32:d2" 10 | :private-key "dev-resources/test/oci.key"}}} 11 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/countries_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.countries-test 2 | (:require #?(:clj [clojure.test :refer [deftest testing is use-fixtures]] 3 | :cljs [cljs.test :refer [deftest testing is use-fixtures]]) 4 | [monkey.ci.gui.countries :as sut])) 5 | 6 | (deftest countries 7 | (testing "holds list of country names and codes" 8 | (is (not-empty sut/countries)) 9 | (is (every? (every-pred :name :code) 10 | sut/countries)))) 11 | -------------------------------------------------------------------------------- /app/src/monkey/ci/web/api/crypto.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.web.api.crypto 2 | "Cryptographic endpoint handlers" 3 | (:require [monkey.ci.web 4 | [common :as c] 5 | [crypto :as cr]] 6 | [ring.util.response :as rur])) 7 | 8 | (defn decrypt-key 9 | "Decrypts an encrypted key using the DEK associated with the org" 10 | [req] 11 | (let [d (cr/decrypter req) 12 | org-id (c/org-id req)] 13 | (rur/response {:key (d (-> (c/body req) :enc) org-id org-id)}))) 14 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/context.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.context 2 | "Job context spec" 3 | (:require [clojure.spec.alpha :as s] 4 | [monkey.ci.spec 5 | [build :as b] 6 | [common :as c]])) 7 | 8 | ;; The context is passed to a job fn 9 | (s/def ::context (s/keys :req-un [::api ::b/build :script/job])) 10 | 11 | ;; Needed to create a client 12 | (s/def :api/url ::c/url) 13 | (s/def :api/token string?) 14 | 15 | ;; The api client itself is just a fn 16 | (s/def ::api fn?) 17 | -------------------------------------------------------------------------------- /app/dev-resources/test/jwk/pubkey.pem: -------------------------------------------------------------------------------- 1 | -----BEGIN PUBLIC KEY----- 2 | MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAqAwEDYaPeqL3B7VrUOG7 3 | KH3qSwv/qNy7BW8PJdOtp1T/v2yNohNb5JnO3ILh2k+2ZgMr/aHy9xpX5oPKhWmh 4 | +b+WUx5lFIKQOurYzgPwmc9odI5hr8yLNrapyrUArp+uC6nm34/VbuSFKv5Zv7rA 5 | fBUyxBmLlBv6rLVvppgT88yn02XG5Lm6iw3MNdkIQCZ+ZDUPGkoA8411VMXH1ijJ 6 | IRLxPXqLGjQcg/K0+YDD6G8nYJihSoVbqlFHOF6wnWf+vJh7uq1iLeO5DBXvwBmC 7 | gAog+AbK7FVn3f4hlbMbPMJzcbru6bYBHCa/FlYxlCvbqVE+Yd2LCSu86qxhNkCb 8 | MwIDAQAB 9 | -----END PUBLIC KEY----- 10 | -------------------------------------------------------------------------------- /app/examples/conditional-jobs/build.clj: -------------------------------------------------------------------------------- 1 | (ns build 2 | (:require [monkey.ci.api :as m])) 3 | 4 | (defn always-action [_] 5 | (println "Action executed")) 6 | 7 | (defn main-action [_] 8 | (println "This is only run on main branch")) 9 | 10 | ;; Instead of a seq of jobs, return a function that returns the 11 | ;; jobs. This can be used to conditionally run jobs. 12 | (defn conditional-jobs [ctx] 13 | ;; Nil jobs should be skipped 14 | [always-action 15 | (when (m/main-branch? ctx) 16 | main-action)]) 17 | -------------------------------------------------------------------------------- /app/src/monkey/ci/reporting.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.reporting 2 | "Provides functions for reporting output. This can be logging, or printing 3 | to stdout, or formatting as json, etc..." 4 | (:require [clojure.tools.logging :as log])) 5 | 6 | (defn log-reporter 7 | "Just logs the input object" 8 | [obj] 9 | (log/debug "Reporting:" obj)) 10 | 11 | (defmulti make-reporter :type) 12 | 13 | (defmethod make-reporter :log [_] 14 | log-reporter) 15 | 16 | (defmethod make-reporter :default [_] 17 | log-reporter) 18 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/artifact/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.artifact.db) 2 | 3 | (defn set-downloading [db art-id] 4 | (assoc-in db [::artifacts :downloading art-id] true)) 5 | 6 | (defn reset-downloading [db art-id] 7 | (update-in db [::artifacts :downloading] dissoc art-id)) 8 | 9 | (defn downloading? [db art-id] 10 | (true? (get-in db [::artifacts :downloading art-id]))) 11 | 12 | (def alerts ::alerts) 13 | 14 | (defn set-alerts [db a] 15 | (assoc db alerts a)) 16 | 17 | (defn clear-alerts [db] 18 | (dissoc db alerts)) 19 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/gen.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.gen 2 | "Custom spec generators" 3 | (:require [clojure.spec.gen.alpha :as gen] 4 | [clojure.string :as cs])) 5 | 6 | (def byte* 7 | (gen/fmap byte (gen/choose Byte/MIN_VALUE Byte/MAX_VALUE))) 8 | 9 | (defn fixed-byte-array 10 | "Generates fixed-size byte arrays" 11 | [size] 12 | (gen/fmap byte-array (gen/vector byte* size))) 13 | 14 | (defn fixed-string 15 | "Generates fixed-size strings" 16 | [size] 17 | (gen/fmap cs/join (gen/vector (gen/char-alphanumeric) size))) 18 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/modals_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.modals-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is]] 3 | :clj [clojure.test :refer [deftest testing is]]) 4 | [monkey.ci.gui.modals :as sut] 5 | [re-frame.core :as rf])) 6 | 7 | (deftest modal 8 | (testing "renders modal" 9 | (is (= :div.modal.fade (first (sut/modal ::test-id 10 | "test title" 11 | "test contents")))))) 12 | -------------------------------------------------------------------------------- /app/kaocha/coverage.edn: -------------------------------------------------------------------------------- 1 | #kaocha/v1 2 | #meta-merge 3 | [#include "junit.edn" 4 | {:kaocha/plugins ^:append [:kaocha.plugin/cloverage] 5 | :kaocha.plugin.junit-xml/target-file "junit.xml" 6 | :cloverage/opts 7 | {:ns-exclude-regex [".*repl" ".*-test" ".*spec.*"] 8 | :ns-regex ["monkey.ci.*"] 9 | ;; Ignore logging calls 10 | :exclude-call [clojure.tools.logging/debug 11 | clojure.tools.logging/info 12 | clojure.tools.logging/warn 13 | clojure.tools.logging/error] 14 | :emma-xml? true}}] 15 | -------------------------------------------------------------------------------- /app/src/monkey/ci/storage/sql/common.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.storage.sql.common 2 | (:require [medley.core :as mc])) 3 | 4 | (def deleted? (fnil pos? 0)) 5 | 6 | (defn drop-nil [m] 7 | (mc/filter-vals some? m)) 8 | 9 | (defn get-conn [c] 10 | ((:get-conn c) c)) 11 | 12 | (defn db->labels [labels] 13 | (map #(select-keys % [:name :value]) labels)) 14 | 15 | (defn id->cuid [x] 16 | (-> x 17 | (assoc :cuid (:id x)) 18 | (dissoc :id))) 19 | 20 | (defn cuid->id [x] 21 | (-> x 22 | (assoc :id (:cuid x)) 23 | (dissoc :cuid))) 24 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/download.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.download 2 | "JS code for creating a hidden download link. This is necessary when you want to 3 | download a file over ajax." 4 | (:require [re-frame.core :as rf])) 5 | 6 | (defn make-download-link [file blob] 7 | (let [el (-> js/document (.createElement "a"))] 8 | (set! (.-href el) (-> js/window (.-URL) (.createObjectURL blob))) 9 | (set! (.-download el) file) 10 | (.click el))) 11 | 12 | (rf/reg-fx 13 | :download-link 14 | (fn [[file blob]] 15 | (make-download-link file blob))) 16 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/main.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.main 2 | "Main application site, for regular users" 3 | (:require [monkey.ci.gui.core :as c] 4 | [monkey.ci.gui.martian :as m] 5 | [monkey.ci.gui.pages :as p] 6 | [monkey.ci.gui.routing :as routing] 7 | [re-frame.core :as rf])) 8 | 9 | (defn ^:dev/after-load reload [] 10 | (c/reload [p/render])) 11 | 12 | (defn init [] 13 | (routing/start!) 14 | (rf/dispatch-sync [:initialize-db]) 15 | (m/init) 16 | (rf/dispatch [:core/load-version]) 17 | (reload)) 18 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/cuid_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.cuid-test 2 | (:require [monkey.ci.cuid :as sut] 3 | [clojure.test :refer [deftest testing is]])) 4 | 5 | (deftest random-cuid 6 | (testing "generates random 24-char string" 7 | (let [cuid (sut/random-cuid)] 8 | (is (string? cuid)) 9 | (is (= sut/cuid-length (count cuid))) 10 | (is (sut/cuid? cuid))))) 11 | 12 | (deftest cuid? 13 | (testing "recognizes a valid cuid" 14 | (is (not (sut/cuid? nil))) 15 | (is (sut/cuid? (sut/random-cuid))) 16 | (is (not (sut/cuid? "abc"))))) 17 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/spec/gen_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.gen-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [clojure.spec.gen.alpha :as g] 4 | [monkey.ci.spec.gen :as sut])) 5 | 6 | (deftest fixed-byte-array 7 | (testing "generates fixed size byte arrays" 8 | (is (every? (comp (partial = 10) count) 9 | (g/sample (sut/fixed-byte-array 10)))))) 10 | 11 | (deftest fixed-string 12 | (testing "generates fixed sized strings" 13 | (is (every? (comp (partial = 10) count) 14 | (g/sample (sut/fixed-string 10)))))) 15 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/fixtures.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.fixtures 2 | (:require [monkey.ci.gui.routing :as r] 3 | [re-frame.core :as rf] 4 | [re-frame.db :refer [app-db]])) 5 | 6 | (def reset-db 7 | #?(:cljs {:before #(reset! app-db {})})) 8 | 9 | (def restore-rf 10 | (let [r (atom nil)] 11 | {:before #(reset! r (rf/make-restore-fn)) 12 | :after #(@r)})) 13 | 14 | (def admin-router 15 | (let [r (atom nil)] 16 | {:before (fn [] 17 | (reset! r @r/router) 18 | (reset! r/router r/admin-router)) 19 | :after #(reset! r/router @r)})) 20 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/test/config.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.test.config 2 | "Helper functions for app configs") 3 | 4 | (def base-config 5 | {:artifacts {:type :disk 6 | :dir "/tmp"} 7 | :cache {:type :disk 8 | :dir "/tmp"} 9 | :build-cache {:type :disk 10 | :dir "/tmp"} 11 | :workspace {:type :disk 12 | :dir "/tmp"} 13 | :containers {:type :oci} 14 | :storage {:type :memory} 15 | :runner {:type :child} 16 | :mailman {:type :manifold}}) 17 | 18 | (def app-config 19 | (assoc base-config :vault {:type :noop})) 20 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/script/config_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.script.config-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.script.config :as sut])) 4 | 5 | (deftest set-job-filter 6 | (testing "sets job filter" 7 | (let [f ["test-filter"]] 8 | (is (= f (-> sut/empty-config 9 | (sut/set-job-filter f) 10 | (sut/job-filter)))))) 11 | 12 | (testing "does not set filter if `nil`" 13 | (is (not (contains? (-> sut/empty-config 14 | (sut/set-job-filter nil)) 15 | sut/job-filter))))) 16 | 17 | -------------------------------------------------------------------------------- /app/src/monkey/ci/dispatcher/spec.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.dispatcher.spec 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::type #{:build :job}) 5 | (s/def ::details map?) 6 | (s/def ::arch #{:arm :amd}) 7 | 8 | (s/def ::task 9 | (s/keys :req-un [::type ::resources] 10 | :opt-un [::details ::arch])) 11 | 12 | (s/def ::memory (s/and int? pos?)) 13 | (s/def ::cpus (s/and int? pos?)) 14 | 15 | (s/def ::resources 16 | (s/keys :req-un [::memory ::cpus])) 17 | 18 | (s/def ::runner keyword?) 19 | 20 | (s/def ::assignment 21 | (s/keys :req-un [::runner ::task])) 22 | 23 | (s/def ::queue 24 | (s/coll-of ::task)) 25 | -------------------------------------------------------------------------------- /app/dev-resources/install-cli.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash -e 2 | 3 | VERSION={{version}} 4 | SRC_URL="https://monkeyci-artifacts.s3.fr-par.scw.cloud/monkeyci/release-$VERSION.jar" 5 | DEST_DIR=$HOME/.config/monkeyci 6 | BIN_DIR=$HOME/bin 7 | 8 | mkdir -p $DEST_DIR 9 | echo "Downloading MonkeyCI jar into $DEST_DIR..." 10 | wget -O $DEST_DIR/monkeyci.jar $SRC_URL 11 | echo "Installing executable script..." 12 | cat << 'EOF' > $BIN_DIR/monkeyci 13 | #!/bin/sh 14 | java --sun-misc-unsafe-memory-access=allow -jar $HOME/.config/monkeyci/monkeyci.jar $* 15 | EOF 16 | chmod a+x $BIN_DIR/monkeyci 17 | echo "Installation successful, run 'monkeyci --help' for more." 18 | -------------------------------------------------------------------------------- /hook/.gcloudignore: -------------------------------------------------------------------------------- 1 | # This file specifies files that are *not* uploaded to Google Cloud 2 | # using gcloud. It follows the same syntax as .gitignore, with the addition of 3 | # "#!include" directives (which insert the entries of the given .gitignore-style 4 | # file at that point). 5 | # 6 | # For more information, run: 7 | # $ gcloud topic gcloudignore 8 | # 9 | .gcloudignore 10 | # If you would like to upload your .git directory, .gitignore file or files 11 | # from your .gitignore file, remove the corresponding line 12 | # below: 13 | .git 14 | .gitignore 15 | 16 | node_modules 17 | #!include:.gitignore 18 | out 19 | src 20 | .shadow-cljs 21 | -------------------------------------------------------------------------------- /app/src/monkey/ci/internal.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.internal 2 | "Entry point for interal use: when the app is run as a server or build agent. 3 | This is mostly the same as the user-facing entrypoint, but uses a different 4 | cli configuration." 5 | (:gen-class) 6 | (:require [monkey.ci 7 | [cli :as cli] 8 | [core :as core]])) 9 | 10 | (defn -main [& args] 11 | ;; Redirect JUL logging to slf4j, for some 3rd party libs. 12 | ;; Note that this may have performance impact, see https://www.slf4j.org/legacy.html#jul-to-slf4j 13 | (org.slf4j.bridge.SLF4JBridgeHandler/install) 14 | (core/run-cli cli/internal-config args)) 15 | -------------------------------------------------------------------------------- /hook/shadow-cljs.edn: -------------------------------------------------------------------------------- 1 | ;; shadow-cljs configuration 2 | {:source-paths 3 | ["src/dev" 4 | "src/main" 5 | "src/test"] 6 | 7 | :dependencies 8 | [] 9 | 10 | :builds 11 | {:hook {:target :node-script 12 | :output-to "compiled/index.js" 13 | :main monkey.ci.hook.index/main 14 | :release {:compiler-options 15 | {:optimizations :advanced}}} 16 | 17 | :test {:target :node-test 18 | :output-to "out/node-tests.js" 19 | :ns-regexp "-test$"}} 20 | 21 | :tdd {:target :node-test 22 | :output-to "out/node-tests.js" 23 | :ns-regexp "-test$" 24 | :autorun true}}} 25 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/entities/bb_webhook_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.bb-webhook-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.entities.bb-webhook :as sut])) 4 | 5 | (deftest by-filter 6 | (testing "creates where clause for org id" 7 | (is (= [[:= :c.cuid "test-org"]] 8 | (sut/by-filter {:org-id "test-org"})))) 9 | 10 | (testing "creates where clause for org and repo id" 11 | (is (= [:and 12 | [:= :c.cuid "test-org"] 13 | [:= :r.display-id "test-repo"]] 14 | (sut/by-filter {:org-id "test-org" 15 | :repo-id "test-repo"}))))) 16 | 17 | -------------------------------------------------------------------------------- /docker/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM docker.io/clojure:temurin-24-tools-deps-trixie-slim 2 | 3 | # We'll run the whole thing as non-root user 4 | RUN adduser --system --uid 1000 --shell /bin/bash --disabled-password monkeyci 5 | 6 | USER monkeyci 7 | 8 | WORKDIR /home/monkeyci 9 | # Config dir, can be used to specify logback config 10 | VOLUME /home/monkeyci/config 11 | # Override default memory limit for sidecar when smaller available memory 12 | ENTRYPOINT ["java", "-Xmx1g", "-Dlogback.configurationFile=config/logback.xml", "--sun-misc-unsafe-memory-access=allow", "-cp", "monkeyci.jar", "monkey.ci.internal"] 13 | 14 | COPY app/target/monkeyci-standalone.jar monkeyci.jar 15 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/metrics/otlp_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.metrics.otlp-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.metrics 4 | [core :as mc] 5 | [otlp :as sut]])) 6 | 7 | (deftest make-client 8 | (testing "creates new client using options" 9 | (let [c (sut/make-client 10 | "http://localhost:1234" 11 | (mc/make-registry) 12 | {:token "test-token" 13 | :interval 30 14 | :service "test-service"})] 15 | (is (instance? io.prometheus.metrics.exporter.opentelemetry.OpenTelemetryExporter c)) 16 | (is (nil? (.close c)))))) 17 | -------------------------------------------------------------------------------- /docs/admin.md: -------------------------------------------------------------------------------- 1 | # Administration Site 2 | 3 | In order to do some administration that can not be accessible to "regular" users, 4 | there is a separate admin site. The code for this site is also situated in the 5 | [gui](../gui) directory, although it is put into a separate module. The `index.html` 6 | page is generated at build time for each of the modules, and included in the 7 | container image. This means that regular users don't even have access to the code 8 | that is provided for the admin site. Of course, there is an additional security 9 | layer at the backend that checks if certain admin calls can even be executed by 10 | the user, by inspecting the token permissions. -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/modal_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.modal-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [monkey.ci.gui.components :as sut] 4 | [monkey.ci.gui.utils :as u] 5 | [reagent.core])) 6 | 7 | (defcard-rg simple-modal 8 | "Simple modal dialog" 9 | (let [id :test-modal] 10 | [:div 11 | [sut/modal id 12 | [:h5 "Test Dialog"] 13 | [:p "This is the dialog contents"]] 14 | [:button.btn.btn-primary {:type :button 15 | :data-bs-toggle "modal" 16 | :data-bs-target (u/->dom-id id)} 17 | "Show Dialog"]])) 18 | -------------------------------------------------------------------------------- /app/src/monkey/ci/agent/container.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.agent.container 2 | "Entrypoint for the container agent. This is similar to build agents, but 3 | runs container jobs using Podman instead." 4 | (:gen-class) 5 | (:require [clojure.tools.logging :as log] 6 | [monkey.ci.agent.runtime :as ar] 7 | [monkey.ci.config :as c] 8 | [monkey.ci.runtime.common :as rc])) 9 | 10 | (defn run-agent [conf f] 11 | (log/info "Starting container agent") 12 | (rc/with-system 13 | (ar/make-container-system conf) 14 | f)) 15 | 16 | (defn -main [& args] 17 | (run-agent (c/load-config-file (first args)) #(deref (get-in % [:poll-loop :future])))) 18 | 19 | -------------------------------------------------------------------------------- /app/src/monkey/ci/dispatcher/state.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.dispatcher.state 2 | "Event state management functions") 3 | 4 | (def get-assignments :assignments) 5 | 6 | (defn set-assignment [s id a] 7 | (assoc-in s [:assignments id] a)) 8 | 9 | (defn get-assignment [s id] 10 | (get-in s [:assignments id])) 11 | 12 | (defn remove-assignment [s id] 13 | (update s :assignments dissoc id)) 14 | 15 | (defn get-queue [s] 16 | (:queued-list s)) 17 | 18 | (defn set-queue [s q] 19 | (assoc s :queued-list q)) 20 | 21 | (defn update-queue [s f & args] 22 | (apply update s :queued-list f args)) 23 | 24 | (def get-runners :runners) 25 | 26 | (defn set-runners [s r] 27 | (assoc s :runners r)) 28 | -------------------------------------------------------------------------------- /braid-bot/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {com.monkeyprojects/braid-clj {:mvn/version "0.1.0-SNAPSHOT"} 2 | ch.qos.logback/logback-classic {:mvn/version "1.4.14"} 3 | com.github.loki4j/loki-logback-appender {:mvn/version "1.5.0-m1"} 4 | org.clojure/tools.logging {:mvn/version "1.2.4"}} 5 | :paths ["src"] 6 | 7 | :aliases 8 | {:dev 9 | {:extra-paths ["dev-resources"]} 10 | 11 | :run 12 | {:main-opts ["-m" "monkey.ci.braid.core"]} 13 | 14 | :jar 15 | {:extra-deps {com.monkeyprojects/build {:mvn/version "0.2-SNAPSHOT"}} 16 | :exec-args {:jar "target/braid-bot.jar"}} 17 | 18 | :uber 19 | {:exec-fn monkey.build/uberjar 20 | :exec-args {:main monkey.ci.braid.core}}}} 21 | -------------------------------------------------------------------------------- /gui/dev-resources/nginx-test.conf: -------------------------------------------------------------------------------- 1 | user nginx; 2 | worker_processes auto; 3 | 4 | http { 5 | server { 6 | listen 8081; 7 | location / { 8 | root /var/www/html; 9 | } 10 | location /js/ { 11 | root /var/www/html; 12 | } 13 | location /img/ { 14 | root /var/www/html; 15 | } 16 | location /conf/ { 17 | root /var/www/html; 18 | } 19 | # These paths are handled by js in the admin page 20 | rewrite ^/login$ /index.html break; 21 | rewrite ^/credits$ /index.html break; 22 | rewrite ^/builds/.*$ /index.html break; 23 | rewrite ^/forget$ /index.html break; 24 | rewrite ^/invoicing/.*$ /index.html break; 25 | } 26 | } 27 | 28 | events { 29 | } -------------------------------------------------------------------------------- /app/src/monkey/ci/pem.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.pem 2 | (:import [org.bouncycastle.util.io.pem PemObject PemWriter] 3 | java.io.StringWriter) 4 | (:require [buddy.core.keys.pem :as pem])) 5 | 6 | (defn private-key->pem 7 | "Writes private key to PEM format" 8 | [pk] 9 | (let [po (PemObject. "PRIVATE KEY" (.getEncoded pk)) 10 | sw (StringWriter.)] 11 | (with-open [pw (PemWriter. sw)] 12 | (.writeObject pw po)) 13 | (.toString sw))) 14 | 15 | (defn pem->private-key 16 | "Load private key from pem string" 17 | [str] 18 | (with-open [r (java.io.StringReader. str)] 19 | (pem/read-privkey r nil))) 20 | 21 | (def private-key? (partial instance? java.security.PrivateKey)) 22 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/timer_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.timer-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [monkey.ci.gui.timer :as sut] 4 | [reagent.core] 5 | [re-frame.core :as rf] 6 | [re-frame.db :as rdb])) 7 | 8 | (rf/reg-event-db 9 | ::simple-timer 10 | (fn [db [_ ticks]] 11 | (assoc db ::ticks ticks))) 12 | 13 | (rf/reg-sub 14 | ::simple-ticks 15 | (fn [db _] 16 | (::ticks db))) 17 | 18 | (defcard-rg simple-timer 19 | "Simple timer" 20 | (fn [] 21 | (let [t (rf/subscribe [::simple-ticks])] 22 | [:<> 23 | [sut/timer ::simple 1000 [::simple-timer]] 24 | [:p "Ticks: " @t]]))) 25 | -------------------------------------------------------------------------------- /gui/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "monkeyci-gui", 3 | "version": "0.22.0-SNAPSHOT", 4 | "private": true, 5 | "devDependencies": { 6 | "highlight.js": "^10.7.3", 7 | "marked": "^2.1.3", 8 | "process": "^0.11.10", 9 | "shadow-cljs": "^3.3.1" 10 | }, 11 | "dependencies": { 12 | "ansi_up": "^6.0.6", 13 | "chart.js": "^4.5.1", 14 | "create-react-class": "^15.7.0", 15 | "luxon": "^3.7.2", 16 | "platform": "1.3.5", 17 | "react": "^19.2.0", 18 | "react-dom": "^19.2.0", 19 | "stack-trace": "0.0.10", 20 | "stacktrace-js": "2.0.2", 21 | "ws": "^8.18.3", 22 | "xml": "1.0.1" 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/log_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.log-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [clojure.string :as cs] 4 | [monkey.ci.gui.components :as sut] 5 | [reagent.core] 6 | [re-frame.core :as rf] 7 | [re-frame.db :as rdb])) 8 | 9 | (defcard-rg plain-log 10 | "Log contents without coloring" 11 | [sut/log-contents 12 | (->> (range 10) 13 | (mapv (fn [idx] 14 | (str "This is line " (inc idx)))) 15 | (interpose [:br]) 16 | vector)]) 17 | 18 | (defcard-rg colored-log 19 | "Log with ansi coloring" 20 | [sut/log-contents ["This is \033[32mcolored\033[0;39m."]]) 21 | -------------------------------------------------------------------------------- /app/env/dev/otlp.clj: -------------------------------------------------------------------------------- 1 | (ns otlp 2 | (:require [config :as c] 3 | [monkey.ci.metrics 4 | [core :as mc] 5 | [otlp :as mo] 6 | [prometheus :as mp]])) 7 | 8 | (org.slf4j.bridge.SLF4JBridgeHandler/install) 9 | 10 | (defn local-conf [] 11 | (:otlp (c/load-config "local.edn"))) 12 | 13 | (defn run-test [conf] 14 | ;; Test to see how we can get rid of the 400 "empty data points" error 15 | ;; returned by otlp server, but no success so far... 16 | (let [reg (mp/make-registry) 17 | c (-> (mp/make-counter "test_counter" reg) 18 | (mp/counter-inc 1))] 19 | (mo/make-client (:url conf) 20 | reg 21 | (assoc conf :interval 5)))) 22 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/events/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.events.core-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.events.core :as sut])) 4 | 5 | (deftest make-event 6 | (testing "adds timestamp to event" 7 | (is (number? (-> (sut/make-event :test-event :key "value") 8 | :time)))) 9 | 10 | (testing "adds properties from varargs" 11 | (is (= {:key "value"} (-> (sut/make-event :test-event :key "value") 12 | (select-keys [:key]))))) 13 | 14 | (testing "adds properties from map" 15 | (is (= {:key "value"} (-> (sut/make-event :test-event {:key "value"}) 16 | (select-keys [:key])))))) 17 | 18 | 19 | -------------------------------------------------------------------------------- /app/src/monkey/ci/dispatcher/main.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.dispatcher.main 2 | "Main class for the dispatcher, used when running as a microservice" 3 | (:gen-class) 4 | (:require [clojure.tools.logging :as log] 5 | [monkey.ci.config :as c] 6 | [monkey.ci.dispatcher.runtime :as dr] 7 | [monkey.ci.runtime.common :as rc] 8 | [monkey.ci.web.http :as wh])) 9 | 10 | (defn -main [& args] 11 | (rc/with-system 12 | (dr/make-system (merge {:http {:port 3001}} 13 | (c/load-config-file (first args)))) 14 | (fn [{:keys [http-server]}] 15 | (log/info "Dispatcher server started") 16 | (wh/on-server-close http-server))) 17 | (log/info "Dispatcher server terminated")) 18 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/api_server.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.api-server 2 | (:require [clojure.spec.alpha :as s] 3 | [monkey.ci.spec.common :as c])) 4 | 5 | (s/def ::port int?) 6 | (s/def ::token string?) 7 | (s/def ::cache ::c/blob-store) 8 | (s/def ::artifacts ::c/blob-store) 9 | (s/def ::workspace ::c/blob-store) 10 | (s/def ::params ::c/params) 11 | (s/def ::mailman ::c/mailman) 12 | 13 | (s/def ::base-config 14 | (s/keys :req-un [::artifacts ::params ::mailman] 15 | :opt-un [::cache ::workspace])) 16 | 17 | (s/def ::config 18 | (-> (s/merge ::base-config 19 | (s/keys :opt-un [::port ::token])))) 20 | 21 | (s/def ::app-config 22 | (-> (s/merge ::base-config 23 | (s/keys :opt-un [::token])))) 24 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/test/api_server.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.test.api-server 2 | "Helper functions for working with api servers" 3 | (:require [manifold 4 | [deferred :as md] 5 | [stream :as ms]] 6 | [monkey.ci 7 | [protocols :as p] 8 | [runtime :as rt]] 9 | [monkey.ci.test.runtime :as trt])) 10 | 11 | (defrecord EmptyParams [] 12 | p/BuildParams 13 | (get-build-params [_ _] 14 | (md/success-deferred []))) 15 | 16 | (defn test-config 17 | "Creates dummy test configuration for api server" 18 | [] 19 | (assoc (trt/test-runtime) 20 | :event-stream (ms/stream 1) 21 | :params (->EmptyParams) 22 | :key-decrypter (constantly "decrypted"))) 23 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/repo_settings/views.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.repo-settings.views 2 | (:require [monkey.ci.gui.layout :as l] 3 | [monkey.ci.gui.tabs :as tabs])) 4 | 5 | (def tab-headers 6 | [{:id ::general 7 | :header "General" 8 | :link :page/repo-settings} 9 | {:id ::webhooks 10 | :header "Webhooks" 11 | :link :page/webhooks}]) 12 | 13 | (defn settings-tabs [active] 14 | [:div.col-md-2 15 | (tabs/settings-tabs tab-headers active)]) 16 | 17 | (defn settings-content [content] 18 | [:div.col-md-10 content]) 19 | 20 | (defn settings-page 21 | "Renders repo settings page for header id" 22 | [id content] 23 | (l/default 24 | [:div.row.mb-3 25 | [settings-tabs id] 26 | [settings-content content]])) 27 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/invoicing/events.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.invoicing.events 2 | (:require [monkey.ci.gui.alerts :as a] 3 | [monkey.ci.gui.loader :as lo] 4 | [monkey.ci.gui.admin.invoicing.db :as db] 5 | [re-frame.core :as rf])) 6 | 7 | (rf/reg-event-fx 8 | ::load 9 | (lo/loader-evt-handler 10 | db/id 11 | (fn [_ _ [_ org-id]] 12 | [:secure-request 13 | :get-org-invoices 14 | {:org-id org-id} 15 | [::load--success] 16 | [::load--failure]]))) 17 | 18 | (rf/reg-event-db 19 | ::load--success 20 | (fn [db [_ resp]] 21 | (lo/on-success db db/id resp))) 22 | 23 | (rf/reg-event-db 24 | ::load--failure 25 | (fn [db [_ resp]] 26 | (lo/on-failure db db/id a/invoice-load-failed resp))) 27 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/build/helpers.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.build.helpers 2 | "Test helper functions" 3 | (:require [clojure.java.io :as io]) 4 | (:import org.apache.commons.io.FileUtils)) 5 | 6 | (defn ^java.io.File create-tmp-dir [] 7 | (doto (io/file (System/getProperty "java.io.tmpdir") (str "tmp-" (random-uuid))) 8 | (.mkdirs))) 9 | 10 | (defn with-tmp-dir-fn 11 | "Creates a temp dir and passes it to `f`. Recursively deletes the temp dir afterwards." 12 | [f] 13 | (let [tmp (create-tmp-dir)] 14 | (try 15 | (f (.getAbsolutePath tmp)) 16 | (finally 17 | (FileUtils/deleteDirectory tmp))))) 18 | 19 | (defmacro with-tmp-dir [dir & body] 20 | `(with-tmp-dir-fn 21 | (fn [d#] 22 | (let [~dir d#] 23 | ~@body)))) 24 | -------------------------------------------------------------------------------- /app/env/dev/cache.clj: -------------------------------------------------------------------------------- 1 | (ns cache 2 | (:require [config :as co] 3 | [monkey.ci.logging :as l] 4 | [monkey.oci.os.core :as os])) 5 | 6 | (defn- call-os [f opts] 7 | (let [conf (co/oci-config :cache) 8 | client (os/make-client conf)] 9 | @(f client (-> conf 10 | (select-keys [:bucket-name :ns]) 11 | (merge opts))))) 12 | 13 | (defn list-caches 14 | [sid] 15 | (let [conf (co/oci-config :cache) 16 | path (l/sid->path conf nil sid)] 17 | (call-os os/list-objects (when path {:prefix path})))) 18 | 19 | (defn delete-cache 20 | [sid n] 21 | (let [conf (co/oci-config :cache) 22 | path (l/sid->path conf nil sid)] 23 | (call-os os/delete-object {:object-name (str path "/" n)}))) 24 | -------------------------------------------------------------------------------- /app/src/monkey/ci/containers.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.containers 2 | "Generic functionality for running containers") 3 | 4 | (def image (some-fn :container/image :image)) 5 | (def env :container/env) 6 | (def cmd :container/cmd) 7 | (def args :container/args) 8 | (def mounts :container/mounts) 9 | (def entrypoint :container/entrypoint) 10 | (def platform :container/platform) 11 | (def arch :arch) 12 | 13 | (def props 14 | "Serializable properties for container jobs" 15 | [:image :container/image env cmd args entrypoint]) 16 | 17 | (def base-cmd 18 | "Base command line for app processes" 19 | ["java" "-cp" "monkeyci.jar" 20 | "-Dlogback.configurationFile=config/logback.xml" 21 | "monkey.ci.core"]) 22 | 23 | (defn make-cmd [& args] 24 | (vec (concat base-cmd args))) 25 | -------------------------------------------------------------------------------- /common/src/monkey/ci/common/jobs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.common.jobs) 2 | 3 | (defn sort-by-deps 4 | "Sorts the given list of jobs so those with least dependencies come first, 5 | and jobs that are dependent on them come later." 6 | [jobs] 7 | (loop [rem (->> jobs (sort-by :id) vec) 8 | proc? #{} 9 | res []] 10 | (if (empty? rem) 11 | res 12 | (let [next-jobs (->> rem 13 | (filter (comp (partial every? proc?) :dependencies)))] 14 | (if (empty? next-jobs) 15 | ;; Safety, should not happen 16 | (concat res rem) 17 | (recur (remove (set next-jobs) rem) 18 | (clojure.set/union proc? (set (map :id next-jobs))) 19 | (concat res next-jobs)))))) ) 20 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/clean/events.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.clean.events 2 | (:require [monkey.ci.gui.admin.clean.db :as db] 3 | [monkey.ci.gui.alerts :as a] 4 | [monkey.ci.gui.loader :as lo] 5 | [monkey.ci.gui.martian] 6 | [re-frame.core :as rf])) 7 | 8 | (rf/reg-event-fx 9 | ::clean 10 | (lo/loader-evt-handler 11 | db/clean 12 | (fn [& _] 13 | [:secure-request 14 | :admin-reaper 15 | {} 16 | [::clean--success] 17 | [::clean--failed]]))) 18 | 19 | (rf/reg-event-db 20 | ::clean--success 21 | (fn [db [_ resp]] 22 | (lo/on-success db db/clean resp))) 23 | 24 | (rf/reg-event-db 25 | ::clean--failed 26 | (fn [db [_ resp]] 27 | (lo/on-failure db db/clean a/clean-proc-failed resp))) 28 | -------------------------------------------------------------------------------- /app/env/dev/blob.clj: -------------------------------------------------------------------------------- 1 | (ns blob 2 | (:require [clojure.java.io :as io] 3 | [monkey.ci.blob :as blob])) 4 | 5 | (defn- used-memory 6 | "Returns used memory in gbs" 7 | [] 8 | (let [rt (Runtime/getRuntime)] 9 | (-> (- (.totalMemory rt) (.freeMemory rt)) 10 | (/ (* 1024 1024 1024)) 11 | (float)))) 12 | 13 | (defn compression-test [src dest] 14 | (let [destf (io/file dest)] 15 | (printf "Memory used: %.2f GB\n" (used-memory)) 16 | (println "Archiving" src "into" dest "...") 17 | (.delete destf) 18 | (blob/make-archive (io/file src) destf) 19 | (printf "Done archiving. Resulting size is %.2f MB. Memory used is now: %.2f GB\n" 20 | (-> destf (.length) (/ (* 1024 1024)) (float)) 21 | (used-memory)))) 22 | -------------------------------------------------------------------------------- /app/src/monkey/ci/vault/common.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.vault.common 2 | (:require [buddy.core 3 | [codecs :as codecs] 4 | [crypto :as bcc]])) 5 | 6 | ;; Key size determines algorithm and iv length 7 | (def algo {:algo :aes-256-gcm}) 8 | 9 | (defn encrypt 10 | "Performs AES encryption of the given text" 11 | [enc-key iv txt] 12 | (-> (bcc/encrypt (codecs/str->bytes txt) 13 | enc-key 14 | iv 15 | algo) 16 | (codecs/bytes->b64-str))) 17 | 18 | (defn decrypt 19 | "Performs AES decryption of the given encrypted value" 20 | [enc-key iv enc] 21 | (-> (bcc/decrypt (codecs/b64->bytes enc) 22 | enc-key 23 | iv 24 | algo) 25 | (codecs/bytes->str))) 26 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/ssh_key.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.ssh-key 2 | (:require [honey.sql :as h] 3 | [monkey.ci.entities.core :as ec])) 4 | 5 | (defn select-ssh-keys-as-entity [conn org-cuid] 6 | (->> (ec/select conn 7 | {:select [[:k.cuid :id] 8 | :k.private-key 9 | :k.public-key 10 | :k.description 11 | :k.label-filters 12 | [:c.cuid :org-id]] 13 | :from [[:ssh-keys :k] 14 | [:orgs :c]] 15 | :where [:and 16 | [:= :c.cuid org-cuid] 17 | [:= :c.id :k.org-id]]}) 18 | (map ec/convert-label-filters-select))) 19 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/dispatcher/http_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.dispatcher.http-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.dispatcher.http :as sut] 4 | [monkey.ci.metrics.core :as metrics] 5 | [ring.mock.request :as mock])) 6 | 7 | (deftest make-handler 8 | (let [app (sut/make-handler {:metrics (metrics/make-registry)})] 9 | (testing "creates routing fn" 10 | (is (fn? app))) 11 | 12 | (testing "`/health` returns ok" 13 | (is (= 200 (-> (mock/request :get "/health") 14 | (app) 15 | :status)))) 16 | 17 | (testing "`/metrics` returns metrics" 18 | (is (= 200 (-> (mock/request :get "/metrics") 19 | (app) 20 | :status)))))) 21 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/entities/user_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.user-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.entities 4 | [core :as ec] 5 | [user :as sut]] 6 | [monkey.ci.entities.helpers :as eh])) 7 | 8 | (deftest select-user-orgs 9 | (eh/with-prepared-db conn 10 | (testing "retrieves all orgs linked to a user" 11 | (let [[org other-org] (->> (repeatedly 2 eh/gen-org) 12 | (map (partial ec/insert-org conn))) 13 | user (ec/insert-user conn (eh/gen-user)) 14 | _ (ec/insert-user-org conn {:user-id (:id user) 15 | :org-id (:id org)})] 16 | (is (= [org] (sut/select-user-orgs conn (:cuid user)))))))) 17 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/label_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.label-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [monkey.ci.gui.labels :as sut] 4 | [reagent.core] 5 | [re-frame.core :as rf] 6 | [re-frame.db :as rdb])) 7 | 8 | (defcard-rg label-filter-render 9 | "Display editor for label filters" 10 | [sut/render-filter-editor 11 | ::filter-editor-0 12 | [[{:label "label-1" :value "value 1"} 13 | {:label "label-2" :value "value 2"}] 14 | [{:label "label-1" :value "value 4"} 15 | {:label "label-3" :value "value 3"}] 16 | [{:label "label-3" :value "value 5"}]]]) 17 | 18 | (defcard-rg label-filter-editor 19 | "Functional label filter editor" 20 | [sut/edit-label-filters ::filter-editor-1]) 21 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/subs_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.subs-test 2 | (:require #?(:clj [clojure.test :refer [deftest testing is use-fixtures]] 3 | :cljs [cljs.test :refer-macros [deftest testing is use-fixtures]]) 4 | [monkey.ci.gui.subs :as sut] 5 | [monkey.ci.gui.test.fixtures :as tf] 6 | [re-frame.core :as rf] 7 | [re-frame.db :refer [app-db]])) 8 | 9 | (use-fixtures :each tf/reset-db) 10 | 11 | (rf/clear-subscription-cache!) 12 | 13 | (deftest version 14 | (let [v (rf/subscribe [:version])] 15 | (testing "exists" 16 | (is (some? v))) 17 | 18 | (testing "returns version from db" 19 | (is (nil? @v)) 20 | (is (some? (reset! app-db {:version "test-version"}))) 21 | (is (= "test-version" @v))))) 22 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/billing/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.billing.db 2 | (:require [monkey.ci.gui.loader :as lo])) 3 | 4 | (def billing-id ::billing) 5 | 6 | (defn set-invoicing-settings [db s] 7 | (lo/set-value db billing-id s)) 8 | 9 | (defn update-invoicing-settings [db f & args] 10 | (apply lo/update-value db billing-id f args)) 11 | 12 | (defn get-invoicing-settings [db] 13 | (lo/get-value db billing-id)) 14 | 15 | (defn set-billing-alerts [db a] 16 | (lo/set-alerts db billing-id a)) 17 | 18 | (defn reset-billing-alerts [db] 19 | (lo/reset-alerts db billing-id)) 20 | 21 | (defn get-billing-alerts [db] 22 | (lo/get-alerts db billing-id)) 23 | 24 | (defn set-billing-loading [db] 25 | (lo/set-loading db billing-id)) 26 | 27 | (defn billing-loading? [db] 28 | (lo/loading? db billing-id)) 29 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/tabs_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.tabs-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is use-fixtures]] 3 | :clj [clojure.test :refer [deftest testing is use-fixtures]]) 4 | [monkey.ci.gui.test.fixtures :as f] 5 | [monkey.ci.gui.tabs :as sut] 6 | [re-frame.core :as rf])) 7 | 8 | (rf/clear-subscription-cache!) 9 | 10 | (use-fixtures :each f/reset-db) 11 | 12 | (deftest tab-changed-evt 13 | (testing "updates current tab id in db" 14 | (let [id ::test-tab 15 | tab {:id ::changed} 16 | c (rf/subscribe [:tab/current id])] 17 | (is (some? c)) 18 | (is (nil? @c)) 19 | (is (nil? (rf/dispatch-sync [:tab/tab-changed id ::changed]))) 20 | (is (= ::changed @c))))) 21 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/local_storage.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.local-storage 2 | "Provides fx and cofx to access browser local storage" 3 | (:require [clojure.edn :as edn] 4 | [re-frame.core :as rf])) 5 | 6 | (defn local-storage-enabled? [] 7 | #?(:cljs (exists? js/localStorage) 8 | :clj false)) 9 | 10 | (rf/reg-fx 11 | :local-storage 12 | (fn [[id value]] 13 | #?(:cljs (when (local-storage-enabled?) 14 | (.setItem js/localStorage (str id) (pr-str value))) 15 | :clj nil))) 16 | 17 | (rf/reg-cofx 18 | :local-storage 19 | (fn [cofx id] 20 | (assoc cofx :local-storage #?(:cljs (when (local-storage-enabled?) 21 | (edn/read-string (.getItem js/localStorage (str id)))) 22 | :clj :not-available)))) 23 | -------------------------------------------------------------------------------- /app/src/monkey/ci/logging/logback.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.logging.logback 2 | "Utility functions for Logback" 3 | (:import [ch.qos.logback.classic.joran JoranConfigurator] 4 | [java.io ByteArrayInputStream] 5 | [org.slf4j LoggerFactory])) 6 | 7 | (defn configure-logback 8 | "Configures logback using the configuration in the argument, instead of from a file." 9 | [config] 10 | (with-open [s (ByteArrayInputStream. (.getBytes config "UTF-8"))] 11 | (let [ctx (LoggerFactory/getILoggerFactory)] 12 | (.reset ctx) 13 | (doto (JoranConfigurator.) 14 | (.setContext ctx) 15 | (.doConfigure s))))) 16 | 17 | (defn configure-from-env 18 | "Configures logback using the configuration in the given env var" 19 | [env] 20 | (some-> (System/getenv env) 21 | (configure-logback))) 22 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/repo_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.repo-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [monkey.ci.gui.repo.views :as sut] 4 | [monkey.ci.gui.utils :as u] 5 | [reagent.core] 6 | [re-frame.db :as rdb])) 7 | 8 | (defcard-rg labels 9 | "Simple labels component" 10 | [sut/labels [{:name "project" 11 | :value "MonkeyCI"} 12 | {:name "kind" 13 | :value "Application"}]]) 14 | 15 | (defcard-rg confirm-delete-modal 16 | "Delete confirmation dialog" 17 | [:div 18 | [sut/confirm-delete-modal 19 | {:name "test repo"}] 20 | [:button.btn.btn-primary 21 | {:data-bs-toggle :modal 22 | :data-bs-target (u/->dom-id ::sut/delete-repo-confirm)} 23 | "Show Dialog"]]) 24 | -------------------------------------------------------------------------------- /app/examples/caches/build.clj: -------------------------------------------------------------------------------- 1 | (ns caches.build 2 | "Example script to demonstrate the use of caches" 3 | (:require [babashka.fs :as fs] 4 | [monkey.ci.api :as m])) 5 | 6 | (def cache-dir "cache") 7 | 8 | (def caching-step 9 | (-> (m/action-job 10 | "restore-and-save-cache" 11 | (fn [ctx] 12 | (let [d (fs/file (get-in ctx [:job :work-dir]) cache-dir)] 13 | (when-not (fs/exists? d) 14 | (fs/create-dir d)) 15 | (let [f (fs/list-dir d)] 16 | (println "There currently are" (count f) "files in cache") 17 | ;; Write to cache 18 | (spit (fs/file d (str "file-" (System/currentTimeMillis) ".txt")) 19 | "Another file added to cache"))))) 20 | (m/caches (m/cache "example-cache" cache-dir)))) 21 | 22 | [caching-step] 23 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/apis/common_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.apis.common-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is use-fixtures]] 3 | :clj [clojure.test :refer [deftest testing is use-fixtures]]) 4 | [day8.re-frame.test :as rf-test] 5 | [monkey.ci.gui.apis.common :as sut] 6 | [re-frame.core :as rf] 7 | [re-frame.db :refer [app-db]])) 8 | 9 | (deftest ext-api-process-response 10 | (testing "converts response body keys to kebab-case" 11 | (rf-test/run-test-sync 12 | (rf/reg-event-db 13 | ::test-event 14 | (fn [db [_ val]] 15 | (assoc db ::response val))) 16 | (rf/dispatch [:ext-api/process-response [::test-event] {"test_key" "test value"}]) 17 | (is (= {:test-key "test value"} (::response @app-db)))))) 18 | -------------------------------------------------------------------------------- /app/src/monkey/ci/runners/interceptors.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.runners.interceptors 2 | "Reusable mailman interceptors for runners" 3 | (:require [clojure.tools.logging :as log] 4 | [monkey.ci.events.mailman.interceptors :as emi] 5 | [monkey.ci.storage :as st])) 6 | 7 | (defn save-runner-details [get-details] 8 | "Interceptor that stores build runner details generated by a function that 9 | operates on the context. This assumes the db is present in the context." 10 | {:name ::save-runner-details 11 | :enter (fn [ctx] 12 | (let [sid (get-in ctx [:event :sid]) 13 | details (get-details ctx)] 14 | (when details 15 | (log/debug "Saving runner details:" details) 16 | (st/save-runner-details (emi/get-db ctx) sid details)) 17 | ctx))}) 18 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/build/container_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.build.container-test 2 | (:require [clojure.test :refer :all] 3 | [clojure.spec.alpha :as s] 4 | [monkey.ci.build 5 | [container :as sut] 6 | [spec :as spec]])) 7 | 8 | (deftest image 9 | (testing "adds image to job config" 10 | (is (= "test-image" (-> {} 11 | (sut/image "test-image") 12 | :container/image))))) 13 | 14 | (deftest image-spec 15 | (testing "allows valid jobs" 16 | (is (s/valid? :ci/job {:container/image "test-image" 17 | :container/cmd ["test" "cmd"]}))) 18 | 19 | (testing "allows mounts" 20 | (is (s/valid? :ci/job {:container/image "test-image" 21 | :container/mounts [["/host/vol" "/container/vol"]]})))) 22 | -------------------------------------------------------------------------------- /gui/dev-resources/devcards/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | monkey.ci.gui.test.cards 5 | 6 | 7 | 8 | 10 | 11 | 12 | 13 | 14 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /app/src/monkey/ci/cuid.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.cuid 2 | "Functions for working with cuids, which are like uuids but are a bit better 3 | to handle for humans.") 4 | 5 | (def cuid-chars (->> [[\A \Z] [\a \z] [\0 \9]] 6 | (mapcat (comp (fn [[s e]] (range s (inc e))) (partial map int))) 7 | (mapv char) 8 | (vec))) 9 | (def cuid-length 24) 10 | 11 | (defn random-cuid 12 | "Generates a random 24 char cuid, which is like a UUID but (a little bit) more human-readable. 13 | Also, cuids have more possible values than uuids, at the cost of consuming 50% more memory." 14 | [] 15 | (->> (repeatedly cuid-length #(get cuid-chars (rand-int (count cuid-chars)))) 16 | (apply str))) 17 | 18 | (def cuid-regex #"[A-Za-z0-9]{24}") 19 | 20 | (defn cuid? [x] 21 | (and x (some? (re-matches cuid-regex x)))) 22 | -------------------------------------------------------------------------------- /app/src/monkey/ci/events/core.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.events.core 2 | (:require [monkey.ci.time :as t])) 3 | 4 | (defn make-event 5 | "Creates a new event with required properties. Additional properties are given as 6 | map keyvals, or as a single map." 7 | [type & props] 8 | (-> (if (= 1 (count props)) 9 | (first props) 10 | (apply hash-map props)) 11 | (assoc :type type 12 | :time (t/now)))) 13 | 14 | ;;; Utility functions for building events 15 | 16 | (defn make-result [status exit-code msg] 17 | {:status status 18 | :exit exit-code 19 | :message msg}) 20 | 21 | (defn exception-result [ex] 22 | (-> (make-result :error 1 (ex-message ex)) 23 | (assoc :exception ex))) 24 | 25 | (defn set-result [evt r] 26 | (assoc evt :result r)) 27 | 28 | (def result :result) 29 | (def result-exit (comp :exit result)) 30 | -------------------------------------------------------------------------------- /app/src/monkey/ci/dispatcher/http.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.dispatcher.http 2 | "Http endpoints for the dispatcher. Mainly for monitoring." 3 | (:require [monkey.ci.metrics.core :as metrics] 4 | [monkey.ci.web 5 | [common :as wc] 6 | [http :as wh]] 7 | [reitit.ring :as rr])) 8 | 9 | (defn health [_] 10 | (wh/text-response "ok")) 11 | 12 | (defn metrics [req] 13 | (-> (wc/from-rt req :metrics) 14 | (metrics/scrape) 15 | (wh/text-response))) 16 | 17 | (def routes 18 | [["/health" {:get health}] 19 | ["/metrics" {:get metrics}]]) 20 | 21 | (defn make-router 22 | "Creates reitit router for the dispatcher" 23 | [conf] 24 | (rr/router 25 | routes 26 | {:data {::wc/runtime (wc/->RuntimeWrapper conf)}})) 27 | 28 | (defn make-handler [conf] 29 | (-> (make-router conf) 30 | (wc/make-app))) 31 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/containers.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.containers 2 | "Container related config and context specs" 3 | (:require [clojure.spec.alpha :as s] 4 | [monkey.ci.spec 5 | [build :as b] 6 | [common :as c]])) 7 | 8 | (s/def ::dev-mode? boolean?) 9 | (s/def ::log-maker fn?) 10 | 11 | (s/def ::podman-context 12 | (s/keys :req-un [::b/build ::log-maker] 13 | :opt-un [::dev-mode? ::c/artifacts ::c/cache])) 14 | 15 | (s/def ::org-id c/id?) 16 | (s/def ::repo-id c/id?) 17 | (s/def ::build-id c/id?) 18 | (s/def ::job-id c/id?) 19 | (s/def ::loki-url ::c/url) 20 | 21 | (s/def ::token string?) 22 | (s/def ::image-url string?) 23 | (s/def ::image-tag string?) 24 | 25 | (s/def ::promtail-config 26 | (s/keys :req-un [::org-id ::repo-id ::build-id ::job-id ::loki-url] 27 | :opt-un [::token ::image-url ::image-tag])) 28 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/notifications/subs_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.notifications.subs-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is use-fixtures]] 3 | :clj [clojure.test :refer [deftest testing is use-fixtures]]) 4 | [day8.re-frame.test :as rf-test] 5 | [monkey.ci.gui.notifications.db :as db] 6 | [monkey.ci.gui.notifications.subs :as sut] 7 | [monkey.ci.gui.test.fixtures :as f] 8 | [monkey.ci.gui.test.helpers :as h] 9 | [re-frame.core :as rf])) 10 | 11 | (rf/clear-subscription-cache!) 12 | 13 | (use-fixtures :each f/reset-db) 14 | 15 | (deftest unregistering? 16 | (h/verify-sub [::sut/unregistering?] db/set-unregistering true false)) 17 | 18 | (deftest alerts 19 | (h/verify-sub [::sut/alerts] #(db/set-alerts % ::test-alert) ::test-alert nil)) 20 | 21 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/join_request.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.join-request 2 | (:require [medley.core :as mc] 3 | [monkey.ci.entities.core :as ec])) 4 | 5 | (def base-query 6 | {:select [:jr.status :jr.request-msg :jr.response-msg 7 | [:jr.cuid :id] [:u.cuid :user-id] [:c.cuid :org-id]] 8 | :from [[:join-requests :jr]] 9 | :join [[:users :u] [:= :u.id :jr.user-id] 10 | [:orgs :c] [:= :c.id :jr.org-id]]}) 11 | 12 | (defn select-join-request-as-entity [conn cuid] 13 | (some-> (ec/select 14 | conn 15 | (assoc base-query :where [:= :jr.cuid cuid])) 16 | first 17 | (update :status keyword) 18 | (as-> x (mc/filter-vals some? x)))) 19 | 20 | (defn select-user-join-requests [conn user-cuid] 21 | (ec/select 22 | conn 23 | (assoc base-query 24 | :where [:= :u.cuid user-cuid]))) 25 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/user/subs_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.user.subs-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is use-fixtures async]] 3 | :clj [clojure.test :refer [deftest testing is use-fixtures]]) 4 | [monkey.ci.gui.user.db :as db] 5 | [monkey.ci.gui.user.subs :as sut] 6 | [monkey.ci.gui.test.fixtures :as f] 7 | [monkey.ci.gui.test.helpers :as h] 8 | [re-frame.core :as rf] 9 | [re-frame.db :refer [app-db]])) 10 | 11 | (use-fixtures :each f/reset-db) 12 | 13 | (rf/clear-subscription-cache!) 14 | 15 | (h/verify-sub [::sut/general-edit] db/get-general-edit-merged {:receive-mailing true} {:receive-mailing true}) 16 | (h/verify-sub [::sut/general-alerts] db/get-general-alerts ::test-alerts nil) 17 | (h/verify-sub [::sut/general-saving?] db/general-saving? true false) 18 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/web/oauth2_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.web.oauth2-test 2 | (:require 3 | [clojure.test :refer [deftest is testing]] 4 | [monkey.ci.test.helpers :as h] 5 | [monkey.ci.web.oauth2 :as sut])) 6 | 7 | (deftest login-handler 8 | (testing "returns refresh token if provided" 9 | (h/with-memory-store st 10 | (let [handler (sut/login-handler 11 | (constantly {:status 200 12 | :body {:access-token "test-access-token" 13 | :refresh-token "test-refresh-token"}}) 14 | (constantly {:id "test-user" 15 | :sid [:github "test-id"]})) 16 | req (h/->req {:storage st})] 17 | (is (= "test-refresh-token" 18 | (-> (handler req) 19 | :body 20 | :refresh-token))))))) 21 | -------------------------------------------------------------------------------- /app/test/e2e/monkey/ci/e2e/basic_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.e2e.basic-test 2 | "Basic end-to-end tests that verify connectivity and public endpoints" 3 | (:require [clojure.test :refer [deftest testing is]] 4 | [aleph.http :as http] 5 | [clj-commons.byte-streams :as bs] 6 | [monkey.ci.e2e.common :refer [sut-url]])) 7 | 8 | (deftest health 9 | (testing "/health" 10 | (is (= 200 (-> (http/get (sut-url "/health")) 11 | (deref) 12 | :status))))) 13 | 14 | (deftest metrics 15 | (testing "/metrics" 16 | (let [r (http/get (sut-url "/metrics"))] 17 | (is (= 200 (:status @r))) 18 | (is (not-empty (bs/to-string (:body @r))))))) 19 | 20 | (deftest version 21 | (testing "/version" 22 | (let [r (http/get (sut-url "/version"))] 23 | (is (= 200 (:status @r))) 24 | (is (not-empty (bs/to-string (:body @r))))))) 25 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/modals.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.modals 2 | "Functions for displaying modal dialogs") 3 | 4 | (defn modal-dismiss-btn [lbl] 5 | [:button.btn.btn-secondary {:type :button 6 | :data-bs-dismiss "modal"} 7 | lbl]) 8 | 9 | (defn modal 10 | "Renders a modal box with a close button by default" 11 | [id title contents & [footer]] 12 | [:div.modal.fade 13 | {:id id 14 | :role :dialog 15 | :tab-index -1} 16 | [:div.modal-dialog 17 | {:role :document} 18 | [:div.modal-content 19 | [:div.modal-header 20 | [:div.modal-title title] 21 | [:button.btn-close {:type :button 22 | :data-bs-dismiss "modal" 23 | :aria-label "Close"}]] 24 | [:div.modal-body 25 | contents] 26 | [:div.modal-footer 27 | (or footer 28 | [modal-dismiss-btn "Close"])]]]]) 29 | -------------------------------------------------------------------------------- /app/dev-resources/logback-json.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | true 6 | 7 | logs/json-%d{yyyy-MM-dd}.log 8 | 30 9 | 1GB 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/credit_subs.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.credit-subs 2 | (:require [monkey.ci.entities.core :as ec])) 3 | 4 | (defn select-credit-subs [conn f] 5 | (->> {:select [:cs.* [:c.cuid :org-cuid]] 6 | :from [[:credit-subscriptions :cs]] 7 | :join [[:orgs :c] [:= :c.id :cs.org-id]] 8 | :where f} 9 | (ec/select conn) 10 | (map ec/convert-credit-sub-select) 11 | (map (fn [r] 12 | (-> r 13 | (dissoc :cuid :org-cuid) 14 | (assoc :id (:cuid r) 15 | :org-id (:org-cuid r))))))) 16 | 17 | (defn by-cuid [id] 18 | [:= :cs.cuid id]) 19 | 20 | (defn by-org [id] 21 | [:= :c.cuid id]) 22 | 23 | (defn active-at [at] 24 | (let [ts (ec/->ts at)] 25 | [:and 26 | [:<= :cs.valid-from ts] 27 | [:or 28 | [:is :cs.valid-until nil] 29 | [:<= ts :cs.valid-until]]])) 30 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/timer.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.timer 2 | "Timer component" 3 | (:require [re-frame.core :as rf])) 4 | 5 | (rf/reg-event-fx 6 | ::timer-tick 7 | (fn [{:keys [db]} [_ id evt]] 8 | {:db (update-in db [::timer id] (fnil inc 0)) 9 | :dispatch evt})) 10 | 11 | (rf/reg-sub 12 | ::timer-ticks 13 | (fn [db [_ id]] 14 | (get-in db [::timer id]))) 15 | 16 | (defn timer 17 | "Renders a timer component that dispatches the given event after the timeout. 18 | As long as the component remains active, the timer is also active." 19 | [id timeout evt] 20 | (let [ticks (rf/subscribe [::timer-ticks id])] 21 | ;; We could also use an fx handler for this 22 | #?(:cljs 23 | (js/setTimeout #(rf/dispatch [::timer-tick id (conj evt @ticks)]) timeout)) 24 | ;; We need this otherwise component won't be rendered and timer not activated 25 | [:div {:style {:display :none}} @ticks])) 26 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/types.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.types 2 | "Special type treatments for sql" 3 | (:require [next.jdbc 4 | [prepare :as p] 5 | [result-set :as rs]])) 6 | 7 | ;; (defn uuid->bytes [uuid] 8 | ;; (-> (doto (java.nio.ByteBuffer/wrap (byte-array 16)) 9 | ;; (.putLong (.getMostSignificantBits uuid)) 10 | ;; (.putLong (.getLeastSignificantBits uuid))) 11 | ;; (.array))) 12 | 13 | ;; (defn bytes->uuid [arr] 14 | ;; (when (= 16 (count arr)) 15 | ;; (let [bb (java.nio.ByteBuffer/wrap arr)] 16 | ;; (java.util.UUID. (.getLong bb) (.getLong bb))))) 17 | 18 | ;; (extend-protocol p/SettableParameter 19 | ;; java.util.UUID 20 | ;; (set-parameter [uuid stmt idx] 21 | ;; (.setObject stmt idx (uuid->bytes uuid)))) 22 | 23 | ;; (extend-protocol rs/ReadableColumn 24 | ;; (class (byte-array 0)) 25 | ;; (read-column-by-index [arr _ _] 26 | ;; arr)) 27 | -------------------------------------------------------------------------------- /app/src/monkey/ci/web/api/repo.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.web.api.repo 2 | "Repository api handlers" 3 | (:require [monkey.ci.storage :as st] 4 | [monkey.ci.web.common :as c] 5 | [ring.util.response :as rur])) 6 | 7 | (def repo-id c/gen-repo-display-id) 8 | 9 | (c/make-entity-endpoints "repo" 10 | ;; The repo is part of the org, so combine the ids 11 | {:get-id (c/id-getter (juxt :org-id :repo-id)) 12 | :getter st/find-repo 13 | :saver st/save-repo 14 | :deleter st/delete-repo 15 | :new-id repo-id}) 16 | 17 | (defn list-webhooks [req] 18 | (-> (c/req->storage req) 19 | (st/find-webhooks-for-repo (c/repo-sid req)) 20 | ;; Do not return the secret key, it should remain secret 21 | (as-> m (map #(dissoc % :secret-key) m)) 22 | (rur/response))) 23 | -------------------------------------------------------------------------------- /test-lib/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {com.monkeyci/app {:mvn/version "0.21.2"}} 2 | :paths ["src" "resources"] 3 | 4 | :aliases 5 | {:dev 6 | {:override-deps {com.monkeyci/app {:local/root "../app"}} 7 | :extra-paths ["test" "dev-resources" "env/dev"]} 8 | 9 | :test 10 | {:extra-deps {com.monkeyprojects/build {:mvn/version "0.3.1"}} 11 | :extra-paths ["test" "dev-resources"] 12 | :exec-fn monkey.test/all} 13 | 14 | :junit 15 | {:exec-fn monkey.test/junit} 16 | 17 | :watch 18 | {:exec-fn monkey.test/watch} 19 | 20 | :jar 21 | {:extra-deps {com.monkeyprojects/build {:mvn/version "0.3.1"}} 22 | :exec-fn monkey.build/jar 23 | :exec-args {:lib com.monkeyci/test 24 | :version [[:env "MONKEYCI_VERSION"] "0.22.0-SNAPSHOT"] 25 | :jar "target/monkeyci-test.jar"}} 26 | 27 | :install 28 | {:exec-fn monkey.build/jar+install} 29 | 30 | :deploy 31 | {:exec-fn monkey.build/jar+deploy}}} 32 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # These are some examples of commonly ignored file patterns. 2 | # You should customize this list as applicable to your project. 3 | # Learn more about .gitignore: 4 | # https://www.atlassian.com/git/tutorials/saving-changes/gitignore 5 | 6 | # Node artifact files 7 | node_modules/ 8 | dist/ 9 | 10 | # Compiled Java class files 11 | *.class 12 | 13 | # Compiled Python bytecode 14 | *.py[cod] 15 | 16 | # Log files 17 | *.log 18 | logs/ 19 | 20 | # Package files 21 | *.jar 22 | 23 | # Maven 24 | target/ 25 | dist/ 26 | 27 | # JetBrains IDE 28 | .idea/ 29 | 30 | # Unit test reports 31 | TEST*.xml 32 | 33 | # Generated by MacOS 34 | .DS_Store 35 | 36 | # Generated by Windows 37 | Thumbs.db 38 | 39 | # Applications 40 | *.app 41 | *.exe 42 | *.war 43 | 44 | # Large media files 45 | *.mp4 46 | *.tiff 47 | *.avi 48 | *.flv 49 | *.mov 50 | *.wmv 51 | 52 | .cpcache/ 53 | .nrepl-port 54 | junit.xml 55 | tmp/ 56 | /app/*.sh 57 | \#.* -------------------------------------------------------------------------------- /app/dev-resources/logback-loki.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | http://loki.monkey-projects.be/loki/api/v1/push 6 | monkeyci 7 | 8 | 9 | 12 | 13 | l=%level h=${HOSTNAME} c=%logger{20} t=%thread | %msg %ex 14 | 15 | 16 | true 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/credits/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.credits.subs 2 | (:require [monkey.ci.gui.admin.credits.db :as db] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub :credits/issues db/get-issues) 7 | (u/db-sub :credits/issues-loading? db/issues-loading?) 8 | (u/db-sub :credits/issue-alerts db/get-issue-alerts) 9 | (u/db-sub :credits/issue-saving? (comp true? db/issue-saving?)) 10 | (u/db-sub :credits/show-issue-form? (comp true? db/show-issue-form?)) 11 | 12 | (u/db-sub :credits/subs db/get-subs) 13 | (u/db-sub :credits/subs-loading? db/subs-loading?) 14 | (u/db-sub :credits/sub-alerts db/get-sub-alerts) 15 | (u/db-sub :credits/sub-saving? (comp true? db/sub-saving?)) 16 | (u/db-sub :credits/show-sub-form? (comp true? db/show-sub-form?)) 17 | 18 | (u/db-sub :credits/issue-all-alerts db/issue-all-alerts) 19 | (u/db-sub :credits/issuing-all? (comp true? db/issuing-all?)) 20 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/logging.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.logging 2 | (:require #?(:clj [clojure.tools.logging :as log]))) 3 | 4 | #?(:clj 5 | (defn log-fn [level msg] 6 | (log/log level msg))) 7 | 8 | (def trace #?@(:clj [(partial log-fn :trace)] 9 | :node [(constantly nil)] 10 | :cljs [(.-trace js/console)])) 11 | 12 | (def debug #?@(:clj [(partial log-fn :debug)] 13 | :node [(constantly nil)] 14 | :cljs [(.-debug js/console)])) 15 | 16 | (def info #?@(:clj [(partial log-fn :info)] 17 | :node [(constantly nil)] 18 | :cljs [(.-info js/console)])) 19 | 20 | (def warn #?@(:clj [(partial log-fn :warn)] 21 | :node [(constantly nil)] 22 | :cljs [(.-warn js/console)])) 23 | 24 | (def error #?@(:clj [(partial log-fn :error)] 25 | :node [(constantly nil)] 26 | :cljs [(.-error js/console)])) 27 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/invoice.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.invoice 2 | (:require [monkey.ci.entities.core :as ec])) 3 | 4 | (def base-query 5 | {:select [:i.* [:c.cuid :org-cuid]] 6 | :from [[:invoices :i]] 7 | :join [[:orgs :c] [:= :c.id :i.org-id]]}) 8 | 9 | (defn select-invoice-with-org [conn cuid] 10 | (->> (assoc base-query 11 | :where [:= :i.cuid cuid]) 12 | (ec/select conn) 13 | (map ec/convert-inv-select) 14 | first)) 15 | 16 | (defn select-invoices-for-org [conn org-cuid] 17 | (->> (assoc base-query 18 | :where [:= :c.cuid org-cuid]) 19 | (ec/select conn) 20 | (map ec/convert-inv-select))) 21 | 22 | (defn select-org-invoicing-for-org [conn org-cuid] 23 | (->> {:select [:i.*] 24 | :from [[:org-invoicings :i]] 25 | :join [[:orgs :o] [:= :o.id :i.org-id]] 26 | :where [:= :o.cuid org-cuid]} 27 | (ec/select conn) 28 | first)) 29 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/shadow_runner.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.shadow-runner 2 | "Custom implementation of the kaocha cljs2 shadow runner. Need to override the 3 | default one, because it doesn't support reagent 19." 4 | {:dev/always true} 5 | (:require [goog.dom :as gdom] 6 | [kaocha.cljs2.shadow-runner :as kcs] 7 | [lambdaisland.chui.ui :as ui] 8 | [reagent.dom.client :as rd])) 9 | 10 | (defn ^:dev/after-load start [] 11 | ;; FIXME There's a problem with test data. Not all tests show up, and test results 12 | ;; are incomplete. 13 | (kcs/start)) 14 | 15 | (defn render! [el] 16 | (ui/set-state-from-location) 17 | (rd/render el [ui/app])) 18 | 19 | (defn ^:export init [] 20 | (let [app (gdom/createElement "div") 21 | root (rd/create-root app)] 22 | (gdom/setProperties app #js {:id "chui-container"}) 23 | (gdom/append js/document.body app) 24 | (render! root)) 25 | (start)) 26 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/admin/invoicing/subs_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.admin.invoicing.subs-test 2 | (:require #?(:clj [clojure.test :refer [deftest testing is use-fixtures]] 3 | :cljs [cljs.test :refer [deftest testing is use-fixtures]]) 4 | [day8.re-frame.test :as rf-test] 5 | [monkey.ci.gui.admin.invoicing.db :as db] 6 | [monkey.ci.gui.admin.invoicing.subs :as sut] 7 | [monkey.ci.gui.loader :as lo] 8 | [monkey.ci.gui.test.helpers :as h] 9 | [re-frame.core :as rf] 10 | [re-frame.db :refer [app-db]])) 11 | 12 | (deftest invoices 13 | (h/verify-sub [::sut/invoices] #(db/set-invoices % ::test-invoices) ::test-invoices nil)) 14 | 15 | (deftest loading? 16 | (h/verify-sub [::sut/loading?] #(lo/set-loading % db/id) true false)) 17 | 18 | (deftest alerts 19 | (h/verify-sub [::sut/alerts] #(db/set-alerts % ::test-alerts) ::test-alerts nil)) 20 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/notifications/events.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.notifications.events 2 | (:require [monkey.ci.gui.martian] 3 | [monkey.ci.gui.alerts :as a] 4 | [monkey.ci.gui.notifications.db :as db] 5 | [re-frame.core :as rf])) 6 | 7 | (rf/reg-event-fx 8 | ::unregister-email 9 | (fn [{:keys [db]} [_ params]] 10 | {:dispatch [:martian.re-frame/request 11 | :unregister-email 12 | params 13 | [::unregister-email--success] 14 | [::unregister-email--failure]] 15 | :db (-> db 16 | (db/set-unregistering) 17 | (db/set-alerts []))})) 18 | 19 | (rf/reg-event-db 20 | ::unregister-email--success 21 | (fn [db _] 22 | (db/reset-unregistering db))) 23 | 24 | (rf/reg-event-db 25 | ::unregister-email--failure 26 | (fn [db [_ err]] 27 | (-> db 28 | (db/reset-unregistering) 29 | (db/set-alerts [(a/unregister-email-failed err)])))) 30 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/runner.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.runner 2 | (:require [clojure.spec.alpha :as s] 3 | [monkey.ci.spec.common :as sc])) 4 | 5 | (s/def ::config map?) ; TODO Specify 6 | 7 | (s/def ::org-id (s/and string? not-empty)) 8 | (s/def ::repo-id (s/and string? not-empty)) 9 | (s/def ::sid (s/coll-of string?)) 10 | 11 | (s/def ::build 12 | (s/keys :req-un [::org-id ::repo-id] 13 | :opt-un [::sid])) 14 | 15 | (s/def ::workspace ::sc/blob-store) 16 | (s/def ::artifacts ::sc/blob-store) 17 | (s/def ::cache ::sc/blob-store) 18 | (s/def ::runner ifn?) 19 | (s/def ::maker fn?) 20 | (s/def ::logging (s/keys :req-un [::maker])) 21 | (s/def ::mailman ::sc/mailman) 22 | 23 | (s/def ::port int?) 24 | (s/def ::token string?) 25 | (s/def ::api-config 26 | (s/keys :req-un [::port ::token])) 27 | 28 | (s/def ::runtime 29 | (s/keys :req-un [::config ::workspace ::artifacts ::cache ::mailman 30 | ::git ::build ::api-config])) 31 | -------------------------------------------------------------------------------- /gui/resources/public/img/github-mark.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/params/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.params.subs 2 | (:require [medley.core :as mc] 3 | [monkey.ci.gui.params.db :as db] 4 | [monkey.ci.gui.utils :as u] 5 | [re-frame.core :as rf])) 6 | 7 | (u/db-sub :org/params db/params) 8 | (u/db-sub :params/alerts db/alerts) 9 | (u/db-sub :params/loading? (comp true? db/loading?)) 10 | (u/db-sub :params/saving? (comp true? db/saving?)) 11 | (u/db-sub :params/set-deleting? (comp true? db/set-deleting?)) 12 | (u/db-sub :params/set-alerts db/get-set-alerts) 13 | (u/db-sub :params/editing? db/editing?) 14 | (u/db-sub :params/editing db/get-editing) 15 | 16 | (rf/reg-sub 17 | :org/param 18 | (fn [db [_ set-id param-idx]] 19 | (some-> (db/get-editing db set-id) 20 | :parameters 21 | (nth param-idx)))) 22 | 23 | (rf/reg-sub 24 | :params/new-sets 25 | (fn [db _] 26 | (->> (db/edit-sets db) 27 | (mc/filter-keys db/temp-id?) 28 | (vals)))) 29 | -------------------------------------------------------------------------------- /gui/resources/public/img/mark-gradient-blue-bitbucket.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /app/src/monkey/ci/script/config.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.script.config 2 | "Build script configuration functions, used by the process controller to 3 | create a valid configuration that can then be read by the build script runner." 4 | (:require [monkey.ci.spec.script :as ss])) 5 | 6 | (def empty-config {}) 7 | 8 | (def api ::ss/api) 9 | 10 | (defn set-api [c a] 11 | (assoc c api a)) 12 | 13 | (def build ::ss/build) 14 | 15 | (defn build->out [build] 16 | (-> build 17 | (dissoc :status :cleanup?) 18 | (update :git dissoc :ssh-keys))) 19 | 20 | (defn set-build [c b] 21 | (assoc c build (build->out b))) 22 | 23 | (def result ::ss/result) 24 | 25 | (defn set-result [c b] 26 | (assoc c result b)) 27 | 28 | (def archs ::ss/archs) 29 | 30 | (defn set-archs [c a] 31 | (assoc c archs a)) 32 | 33 | (def job-filter ::ss/filter) 34 | 35 | (defn set-job-filter [c f] 36 | (cond-> c 37 | true (dissoc job-filter) 38 | (not-empty f) (assoc job-filter f))) 39 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/admin/clean/subs_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.admin.clean.subs-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is use-fixtures]] 3 | :clj [clojure.test :refer [deftest testing is use-fixtures]]) 4 | [monkey.ci.gui.admin.clean.db :as db] 5 | [monkey.ci.gui.admin.clean.subs :as sut] 6 | [monkey.ci.gui.loader :as lo] 7 | [monkey.ci.gui.test.helpers :as h] 8 | [re-frame.core :as rf])) 9 | 10 | (deftest clean-results 11 | (h/verify-sub [::sut/clean-results] #(db/set-cleaned-processes % ::cleaned) ::cleaned nil)) 12 | 13 | (deftest clean-alerts 14 | (h/verify-sub [::sut/clean-alerts] #(lo/set-alerts % db/clean ::test-alerts) ::test-alerts nil)) 15 | 16 | (deftest cleaned? 17 | (h/verify-sub [::sut/cleaned?] #(lo/set-loaded % db/clean) true false)) 18 | 19 | (deftest cleaning? 20 | (h/verify-sub [::sut/cleaning?] #(lo/set-loading % db/clean) true false)) 21 | -------------------------------------------------------------------------------- /app/test/e2e/monkey/ci/e2e/public_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.e2e.public-test 2 | "Tests public routes" 3 | (:require [clojure.test :refer [deftest testing is]] 4 | [aleph.http :as http] 5 | [buddy.core.keys :as bck] 6 | [cheshire.core :as json] 7 | [monkey.ci.e2e.common :refer [sut-url]])) 8 | 9 | (deftest jwks 10 | (testing "/auth/jwks" 11 | (let [r (-> (http/get (sut-url "/auth/jwks")) 12 | (deref))] 13 | (is (= 200 (:status r))) 14 | (let [body (-> (:body r) 15 | (slurp) 16 | (json/parse-string keyword))] 17 | (is (not-empty body)) 18 | (is (not-empty (:keys body)) 19 | "contains non-empty keys") 20 | (is (bck/public-key? (-> body 21 | :keys 22 | (first) 23 | (bck/jwk->public-key))) 24 | "first key contains public key"))))) 25 | -------------------------------------------------------------------------------- /app/test/integration/monkey/ci/integration_test/examples_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.integration-test.examples-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [clojure.tools.logging :as log] 4 | [monkey.ci 5 | [cli :as cli] 6 | [core :as core]])) 7 | 8 | (defn run-example [path] 9 | (log/info "Running example at" path) 10 | (let [inv (-> cli/run-build-cmd 11 | :runs 12 | (core/system-invoker {}))] 13 | (inv {:dev-mode true 14 | :workdir "examples" 15 | :dir path}))) 16 | 17 | (defn success? [r] 18 | (= 0 r #_(deref r 30000 :timeout))) 19 | 20 | (deftest ^:integration examples 21 | (letfn [(run-example-test [n] 22 | (testing (format "runs %s example" n) 23 | (is (success? (run-example n)))))] 24 | (->> ["basic-clj" 25 | "basic-script" 26 | "build-params"] 27 | (map run-example-test) 28 | (doall)))) 29 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/entities/org_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.org-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.entities 4 | [core :as c] 5 | [org :as sut] 6 | [helpers :as h]])) 7 | 8 | (deftest ^:sql org-with-repos 9 | (testing "returns org and its repos" 10 | (h/with-prepared-db conn 11 | (let [org (c/insert-org conn {:name "test org"}) 12 | repos (->> (range 3) 13 | (map #(c/insert-repo conn {:org-id (:id org) 14 | :display-id (str "repo-" %) 15 | :name (str "repo-" %)})) 16 | (doall)) 17 | match (sut/org-with-repos conn (c/by-cuid (:cuid org)))] 18 | (is (some? match)) 19 | (is (= (:id org) (:id match))) 20 | (is (map? (:repos match))) 21 | (is (= (count repos) (count (:repos match)))))))) 22 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/mailing/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.mailing.subs 2 | (:require [monkey.ci.gui.admin.mailing.db :as db] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub ::mailing-list (comp reverse 7 | (partial sort-by :creation-time) 8 | db/get-mailings)) 9 | (u/db-sub ::loading? db/loading?) 10 | (u/db-sub ::alerts db/get-alerts) 11 | 12 | (u/db-sub ::editing db/get-editing) 13 | (u/db-sub ::edit-alerts db/get-editing-alerts) 14 | 15 | (u/db-sub ::sent-mailings (comp reverse 16 | (partial sort-by :sent-at) 17 | db/get-sent-mailings)) 18 | (u/db-sub ::sent-alerts db/get-sent-alerts) 19 | (u/db-sub ::sent-loading? db/sent-loading?) 20 | 21 | (u/db-sub ::new-delivery db/get-new-delivery) 22 | 23 | (rf/reg-sub 24 | ::show-delivery? 25 | :<- [::new-delivery] 26 | (fn [d _] 27 | (some? d))) 28 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/script.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.script 2 | (:require [clojure.spec.alpha :as s] 3 | [manifold.deferred :as md] 4 | [monkey.ci.protocols :as p] 5 | [monkey.ci.spec 6 | [build-api :as ba] 7 | [common :as c]])) 8 | 9 | (s/def ::api ::ba/api) 10 | (s/def ::build map?) ; TODO specify 11 | (s/def ::job map?) ; TODO specify 12 | (s/def ::filter (s/coll-of string?)) 13 | (s/def ::result md/deferred?) 14 | 15 | (s/def ::config 16 | (s/keys :req [::api ::build] 17 | :opt [::result ::filter])) 18 | 19 | (s/def ::artifacts p/repo?) 20 | (s/def ::cache p/repo?) 21 | (s/def ::mailman ::c/mailman) 22 | 23 | (s/def ::runtime 24 | (s/keys :req-un [::artifacts ::cache ::mailman])) 25 | 26 | (s/def :context/api ::ba/client) 27 | 28 | (s/def ::arch #{:arm :amd}) 29 | (s/def ::archs (s/coll-of ::arch)) 30 | 31 | (s/def ::context 32 | (s/keys :req-un [::build :context/api] 33 | :opt-un [::job ::archs])) 34 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.core-test 2 | (:require [clojure.test :refer :all] 3 | [monkey.ci.core :as sut])) 4 | 5 | (deftest main-test 6 | (binding [*err* (java.io.StringWriter.)] 7 | (with-redefs [clojure.core/shutdown-agents (constantly nil) 8 | cli-matic.platform/exit-script (constantly :exit)] 9 | (testing "runs cli" 10 | (is (= :exit (sut/-main "-?"))))))) 11 | 12 | (deftest system-invoker 13 | (testing "creates a fn" 14 | (is (fn? (sut/system-invoker {} {})))) 15 | 16 | (testing "invokes command with context" 17 | (let [inv (sut/system-invoker {:command (constantly "test-result")} {})] 18 | (is (= "test-result" (inv {}))))) 19 | 20 | (testing "passes config" 21 | (let [inv (sut/system-invoker {:command identity} 22 | {}) 23 | args {:key "value"}] 24 | ;; Config is passed to the command 25 | (is (= args (:args (inv args))))))) 26 | 27 | -------------------------------------------------------------------------------- /app/src/monkey/ci/k8s.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.k8s 2 | "Kubernetes functionality, used by build and container runners." 3 | (:require [clojure.math :as m] 4 | #_[kubernetes-api.core :as k8s])) 5 | 6 | (def mem-regex #"^(\d+)(G|M|K|Gi|Mi|Ki)$") 7 | 8 | (defn parse-mem 9 | "Parses a kubernetes style memory amount to gbs" 10 | [s] 11 | (when-let [[_ n u] (re-matches mem-regex s)] 12 | ;; TODO when i is specified, it's a power of 2 13 | (let [dpu {"G" identity 14 | "M" #(/ % 1e3) 15 | "K" #(/ % 1e6) 16 | "Gi" identity 17 | "Mi" #(/ % (m/pow 2 10)) 18 | "Ki" #(/ % (m/pow 2 20))}] 19 | (int ((get dpu u) (Integer/parseInt n)))))) 20 | 21 | #_(defn make-client [url token] 22 | (k8s/client url {:token token :insecure? true})) 23 | 24 | #_(defn list-nodes 25 | "Lists all kubernetes nodes." 26 | [cl] 27 | (->> (k8s/invoke cl {:kind :Node 28 | :action :list}) 29 | :items)) 30 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/token.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.token 2 | "SQL functions for user and org tokens" 3 | (:require [monkey.ci.entities.core :as ec])) 4 | 5 | (defn- select-tokens [conn table owner-table owner-key f] 6 | (letfn [(convert [r] 7 | (-> r 8 | (ec/convert-token) 9 | (assoc owner-key (:owner-cuid r))))] 10 | (->> {:select [:t.* [:o.cuid :owner-cuid]] 11 | :from [[table :t]] 12 | :join [[owner-table :o] [:= :o.id (keyword (str "t." (name owner-key)))]] 13 | :where f} 14 | (ec/select conn) 15 | (map convert)))) 16 | 17 | (defn by-owner [owner-id] 18 | [:= :o.cuid owner-id]) 19 | 20 | (defn by-token [token] 21 | [:= :t.token token]) 22 | 23 | (def by-org by-owner) 24 | (def by-user by-owner) 25 | 26 | (defn select-user-tokens [conn f] 27 | (select-tokens conn :user-tokens :users :user-id f)) 28 | 29 | (defn select-org-tokens [conn f] 30 | (select-tokens conn :org-tokens :orgs :org-id f)) 31 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/agent/main_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.agent.main-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [babashka.fs :as fs] 4 | [monkey.ci.agent.main :as sut] 5 | [monkey.ci.utils :as u] 6 | [monkey.ci.web.http :as wh] 7 | [monkey.ci.test 8 | [config :as tc] 9 | [helpers :as h]])) 10 | 11 | (deftest main 12 | (with-redefs [wh/on-server-close (fn [s] 13 | (future (.close (:server s)))) 14 | u/add-shutdown-hook! (constantly nil)] 15 | (h/with-tmp-dir dir 16 | (let [config-file (fs/path dir "config.edn")] 17 | (is (nil? (spit (fs/file config-file) (-> tc/base-config 18 | (assoc :poll-loop {:type :manifold}) 19 | (pr-str))))) 20 | (testing "starts agent runtime" 21 | (is (nil? (sut/-main (str config-file))))))))) 22 | -------------------------------------------------------------------------------- /app/env/dev/dispatcher.clj: -------------------------------------------------------------------------------- 1 | (ns dispatcher 2 | (:require [com.stuartsierra.component :as co] 3 | [config :as c] 4 | [monkey.ci.dispatcher.runtime :as dr] 5 | [monkey.ci.events.mailman :as em])) 6 | 7 | (def default-config 8 | {:http {:port 3003}}) 9 | 10 | (defn run-dispatcher [conf] 11 | (-> (dr/make-system (merge default-config conf)) 12 | (co/start))) 13 | 14 | (defn stop-dispatcher [sys] 15 | (co/stop sys) 16 | nil) 17 | 18 | (defonce dispatcher (atom nil)) 19 | 20 | (defn stop! [] 21 | (when @dispatcher 22 | (swap! dispatcher stop-dispatcher))) 23 | 24 | (defn run-dispatcher! 25 | ([conf] 26 | (stop!) 27 | (reset! dispatcher (run-dispatcher conf))) 28 | ([] 29 | (run! (select-keys @c/global-config [:mailman :storage])))) 30 | 31 | (defn run-staging! [] 32 | (-> (c/load-config "oci/staging-config.edn") 33 | (run-dispatcher!))) 34 | 35 | (defn post-event! [evt] 36 | (let [mm (:mailman @dispatcher)] 37 | (em/post-events mm [evt]))) 38 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/webhook.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.webhook 2 | "Webhook related functionality" 3 | (:require [honey.sql :as h] 4 | [monkey.ci.entities.core :as ec])) 5 | 6 | (def base-query 7 | {:select [[:c.cuid :org-id] 8 | [:r.display-id :repo-id] 9 | [:w.cuid :id] 10 | [:w.secret :secret-key] 11 | :w.creation-time 12 | :w.last-inv-time] 13 | :from [[:webhooks :w]] 14 | :join [[:repos :r] [:= :r.id :w.repo-id] 15 | [:orgs :c] [:= :c.id :r.org-id]]}) 16 | 17 | (defn select-webhooks-as-entity 18 | "Select the necessary properties for a webhook to return it as an entity." 19 | [conn f] 20 | (->> (ec/select conn 21 | (assoc base-query 22 | :where f)) 23 | (map ec/convert-webhook-select))) 24 | 25 | (defn by-cuid [cuid] 26 | [:= :w.cuid cuid]) 27 | 28 | (defn by-repo [org-id repo-id] 29 | [:and 30 | [:= :c.cuid org-id] 31 | [:= :r.display-id repo-id]]) 32 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/alerts_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.alerts-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is use-fixtures]] 3 | :clj [clojure.test :refer [deftest testing is use-fixtures]]) 4 | [clojure.string :as cs] 5 | [monkey.ci.gui.alerts :as sut])) 6 | 7 | (deftest alert-msg 8 | (testing "creates function that generates alert" 9 | (let [msg (sut/alert-msg :info (constantly "test alert"))] 10 | (is (fn? msg)) 11 | (is (= {:type :info 12 | :message "test alert"} 13 | (msg))))) 14 | 15 | (testing "passes arguments to formatter" 16 | (let [msg (sut/alert-msg :info (fn [& args] (cs/join "-" args)))] 17 | (is (= "a-b-c" (-> (msg "a" "b" "c") :message)))))) 18 | 19 | (deftest error-msg 20 | (testing "generates error message" 21 | (let [msg (sut/error-msg "test msg")] 22 | (is (= {:type :danger 23 | :message "test msg: test error"} 24 | (msg "test error")))))) 25 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/build/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.build.subs 2 | (:require [clojure.string :as cs] 3 | [monkey.ci.common.jobs :as cj] 4 | [monkey.ci.gui.build.db :as db] 5 | [monkey.ci.gui.loader :as lo] 6 | [monkey.ci.gui.logging :as log] 7 | [monkey.ci.gui.utils :as u] 8 | [re-frame.core :as rf])) 9 | 10 | (u/db-sub :build/alerts db/get-alerts) 11 | (u/db-sub :build/current db/get-build) 12 | (u/db-sub :build/canceling? db/canceling?) 13 | (u/db-sub :build/retrying? db/retrying?) 14 | 15 | (def split-log-path #(cs/split % #"/")) 16 | 17 | (defn- strip-prefix [l] 18 | (-> l 19 | (assoc :path (:name l)) 20 | (update :name (comp last split-log-path)))) 21 | 22 | (rf/reg-sub 23 | :build/jobs 24 | :<- [:build/current] 25 | (fn [b _] 26 | ;; Sort the jobs in the build by dependency order 27 | (-> b :script :jobs vals 28 | (cj/sort-by-deps)))) 29 | 30 | (rf/reg-sub 31 | :build/loading? 32 | (fn [db _] 33 | (lo/loading? db (db/get-id db)))) 34 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/billing/subs_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.billing.subs-test 2 | (:require #?(:clj [clojure.test :refer [deftest testing is use-fixtures]] 3 | :cljs [cljs.test :refer [deftest testing is use-fixtures]]) 4 | [day8.re-frame.test :as rf-test] 5 | [monkey.ci.gui.billing.db :as db] 6 | [monkey.ci.gui.billing.subs :as sut] 7 | [monkey.ci.gui.test.fixtures :as f] 8 | [monkey.ci.gui.test.helpers :as h] 9 | [re-frame.core :as rf] 10 | [re-frame.db :refer [app-db]])) 11 | 12 | (rf/clear-subscription-cache!) 13 | 14 | (use-fixtures :each f/reset-db) 15 | 16 | (deftest billing-alerts 17 | (h/verify-sub [::sut/billing-alerts] #(db/set-billing-alerts % ::alerts) ::alerts nil)) 18 | 19 | (deftest billing-loading? 20 | (h/verify-sub [::sut/billing-loading?] db/set-billing-loading true false)) 21 | 22 | (deftest invoicing-settings 23 | (h/verify-sub [::sut/invoicing-settings] #(db/set-invoicing-settings % ::settings) ::settings nil)) 24 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/agent/container_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.agent.container-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [babashka.fs :as fs] 4 | [monkey.ci.agent.container :as sut] 5 | [monkey.ci.runtime.common :as rc] 6 | [monkey.ci.utils :as u] 7 | [monkey.ci.test 8 | [config :as tc] 9 | [helpers :as h]])) 10 | 11 | (deftest main 12 | (let [sys (atom nil)] 13 | (with-redefs [rc/with-system (fn [s _] 14 | (reset! sys s) 15 | nil)] 16 | (h/with-tmp-dir dir 17 | (let [config-file (fs/path dir "config.edn")] 18 | (is (nil? (spit (fs/file config-file) (-> tc/base-config 19 | (assoc :poll-loop {:type :manifold}) 20 | (pr-str))))) 21 | (testing "starts agent runtime" 22 | (is (nil? (sut/-main (str config-file)))) 23 | (is (some? @sys)))))))) 24 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/core.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.core 2 | (:require [day8.re-frame.http-fx] 3 | [monkey.ci.gui.download] 4 | [monkey.ci.gui.events] 5 | [monkey.ci.gui.login.views :as lv] 6 | [monkey.ci.gui.pages :as p] 7 | [monkey.ci.gui.server-events] 8 | [monkey.ci.gui.utils :as u] 9 | [reagent.core :as rc] 10 | [reagent.dom.client :as rd] 11 | [re-frame.core :as rf] 12 | [re-frame.db :refer [app-db]])) 13 | 14 | (defonce app-root (atom nil)) 15 | 16 | (defn- get-app-root! [] 17 | (swap! app-root (fn [r] 18 | (or r (rd/create-root (.getElementById js/document "root")))))) 19 | 20 | (defn reload [root-comp] 21 | ;; Creating the root multiple times gives a react warning on reload. However, if we 22 | ;; keep track of the existing root instead, re-frame subs give problems, that's why 23 | ;; the pages ns is on "always reload". 24 | (let [root (get-app-root!)] 25 | (rf/clear-subscription-cache!) 26 | (rd/render root root-comp))) 27 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/job_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.job-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [monkey.ci.gui.job.views :as sut] 4 | [reagent.core] 5 | [re-frame.db :as rdb])) 6 | 7 | (defcard-rg job-details-basic 8 | "Display basic job details" 9 | [sut/job-details 10 | {:start-time 1726210910713 11 | :end-time 1726210930713 12 | :message "Test message" 13 | :status :running}]) 14 | 15 | (defcard-rg job-details-long-msg 16 | "Job details with long message" 17 | [sut/job-details 18 | {:status :success 19 | :start-time 1726210910713 20 | :end-time 1726210930713 21 | :message "Lorem ipsum odor amet, consectetuer adipiscing elit. Praesent ipsum quis praesent; mauris nam mattis egestas egestas donec. Ultricies molestie vitae mus neque lacinia mauris tristique fusce. Atortor et praesent molestie molestie vulputate eleifend sit. Dignissim faucibus ut et consectetur lectus feugiat libero integer. Auctor senectus semper primis semper amet justo magna natoque enim."}]) 22 | -------------------------------------------------------------------------------- /.monkeyci/clojars.clj: -------------------------------------------------------------------------------- 1 | (ns clojars 2 | "Functions for interacting with Clojars API" 3 | (:require [aleph.http :as http] 4 | [clj-commons.byte-streams :as bs] 5 | [clojure 6 | [edn :as edn] 7 | [string :as cs]] 8 | [clojure.java.io :as io])) 9 | 10 | (def base-url "https://clojars.org/api") 11 | 12 | (defn latest-version 13 | "Fetches latest version number for the given artifact from clojars" 14 | ([group artifact] 15 | (->> @(http/get (cs/join "/" [base-url "artifacts" group artifact]) 16 | {:headers {"accept" "application/edn"}}) 17 | :body 18 | (bs/to-string) 19 | (edn/read-string) 20 | :latest_version)) 21 | ([artifact] 22 | (latest-version "com.monkeyci" artifact))) 23 | 24 | (defn extract-lib 25 | "Extracts lib info from deps file" 26 | [deps] 27 | (with-open [f (io/reader (io/file deps))] 28 | (when-let [s (-> (edn/read (java.io.PushbackReader. f)) 29 | (get-in [:aliases :jar :exec-args :lib]))] 30 | [(namespace s) (name s)]))) 31 | -------------------------------------------------------------------------------- /app/env/dev/sidecar.clj: -------------------------------------------------------------------------------- 1 | (ns sidecar 2 | (:require 3 | [config :as co] 4 | [monkey.ci.runners.runtime :as rr] 5 | [monkey.ci.sidecar.config :as cs] 6 | [monkey.ci.sidecar.core :as sc] 7 | [monkey.ci.sidecar.runtime :as rs])) 8 | 9 | (defn run-test [] 10 | (rr/with-runner-system @co/global-config 11 | (fn [sys] 12 | (let [api (:api-config sys) 13 | conf (-> {} 14 | (cs/set-build (or (:build sys) 15 | {:build-id (str "test-build-" (random-uuid)) 16 | :workspace "test-ws" 17 | :checkout-dir "tmp/checkout"})) 18 | (cs/set-job {:id "test-job"}) 19 | (cs/set-events-file "/tmp/events.edn") 20 | (cs/set-start-file "/tmp/start") 21 | (cs/set-abort-file "/tmp/abort") 22 | (cs/set-api {:url (format "http://localhost:%d" (:port api)) 23 | :token (:token api)}))] 24 | @(rs/with-runtime conf sc/run))))) 25 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/org_settings/views.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.org-settings.views 2 | (:require [monkey.ci.gui.components :as co] 3 | [monkey.ci.gui.layout :as l] 4 | [monkey.ci.gui.tabs :as tabs])) 5 | 6 | (def tab-id ::settings-tabs) 7 | 8 | (def tab-headers 9 | [{:id ::general 10 | :header "General" 11 | :link :page/org-settings} 12 | {:id ::billing 13 | :header "Plan & Billing" 14 | :link :page/billing} 15 | {:id ::params 16 | :header "Parameters" 17 | :link :page/org-params} 18 | {:id ::ssh-keys 19 | :header "SSH keys" 20 | :link :page/org-ssh-keys} 21 | {:id ::api-keys 22 | :header "Api keys" 23 | :link :page/org-api-keys}]) 24 | 25 | (defn settings-tabs [active] 26 | [:div.col-md-3 27 | (tabs/settings-tabs tab-headers active)]) 28 | 29 | (defn settings-content [content] 30 | [:div.col-md-9 content]) 31 | 32 | (defn settings-page 33 | "Renders organization settings page for given id" 34 | [id content] 35 | (l/default 36 | [:div.row.mb-3 37 | [settings-tabs id] 38 | [settings-content content]])) 39 | 40 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/notifications/views.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.notifications.views 2 | "Views for notification management, mainly unsubscribing from emails." 3 | (:require [monkey.ci.gui.components :as co] 4 | [monkey.ci.gui.layout :as l] 5 | [monkey.ci.gui.template :as t] 6 | [monkey.ci.gui.notifications.events :as e] 7 | [monkey.ci.gui.notifications.subs :as s] 8 | [re-frame.core :as rf])) 9 | 10 | (defn status-desc [] 11 | (let [u? (rf/subscribe [::s/unregistering?])] 12 | (if @u? 13 | [:p "Removing your email address from our list, one moment please..."] 14 | [:p "Your email address has been removed from our list. Sorry to see you go!"]))) 15 | 16 | (defn unsubscribe-email [route] 17 | (let [opts (-> (get-in route [:parameters :query]) 18 | (select-keys [:id :email]))] 19 | (rf/dispatch-sync [::e/unregister-email opts]) 20 | (fn [_] 21 | [l/public 22 | [:<> 23 | [:h3 "Unsubscribe Email"] 24 | [status-desc] 25 | [:img {:src "/img/oc-sending.svg" :width "300em"}]]]))) 26 | -------------------------------------------------------------------------------- /app/env/dev/tests.clj: -------------------------------------------------------------------------------- 1 | (ns tests 2 | (:require [babashka.process :as bp])) 3 | 4 | (defn gen-deps [watch?] 5 | {:aliases 6 | {:monkeyci/test 7 | {:extra-deps {'lambdaisland/kaocha {:mvn/version "1.91.1392"}} 8 | :paths ["."] 9 | :exec-fn 'kaocha.runner/exec-fn 10 | :exec-args (cond-> {:tests [{:type :kaocha.type/clojure.test 11 | :id :unit 12 | :ns-patterns ["-test$"] 13 | :source-paths ["."] 14 | :test-paths ["."]}]} 15 | watch? (assoc :watch? true))}}}) 16 | 17 | (defn run-tests 18 | "Runs the unit tests for the script in given dir" 19 | [dir & [watch?]] 20 | (let [deps (pr-str (gen-deps (true? watch?))) 21 | {:keys [err out]} @(bp/process ["clojure" "-Sdeps" deps "-X:monkeyci/test"] 22 | {:err :string 23 | :out :string 24 | :dir dir})] 25 | 26 | (when out 27 | (println out)) 28 | (when err 29 | (println err)))) 30 | -------------------------------------------------------------------------------- /.monkeyci/minio.clj: -------------------------------------------------------------------------------- 1 | (ns minio 2 | (:require [babashka.fs :as fs] 3 | [clojure.java.io :as io]) 4 | (:import [io.minio MinioClient PutObjectArgs])) 5 | 6 | (defn make-s3-client [url access-key secret] 7 | (.. (MinioClient/builder) 8 | (endpoint url) 9 | (credentials access-key secret) 10 | (build))) 11 | 12 | (defn put-object-args [bucket dest stream size] 13 | (.. (PutObjectArgs/builder) 14 | (bucket bucket) 15 | (object dest) 16 | (stream stream size -1) 17 | ;; Make file publicly available 18 | (headers {"x-amz-acl" "public-read"}))) 19 | 20 | (defn put-s3-object 21 | "Uploads the file `f` to given bucket destination" 22 | [client bucket dest stream size & [tags]] 23 | (with-open [s stream] 24 | (let [args (cond-> (put-object-args bucket dest s size) 25 | tags (.tags tags) 26 | true (.build))] 27 | (.putObject client args)))) 28 | 29 | (defn put-s3-file 30 | "Uploads the file `f` to given bucket destination" 31 | [client bucket dest f & [tags]] 32 | (put-s3-object client bucket dest (io/input-stream f) (fs/size f) tags)) 33 | -------------------------------------------------------------------------------- /app/src/monkey/ci/build/v2.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.build.v2 2 | "A group of functions written on top of the more low-level build functions, meant 3 | to improve writing build scripts. They should make the build scripts more intuitive, 4 | more readable. And, dare I say it, prettier? 5 | 6 | The general intention is to provide functions for most purposes, without the user 7 | having to resort to using keywords and maps. 8 | 9 | This namespace is deprecated, in favor of `monkey.ci.api`." 10 | 11 | (:require [monkey.ci.api :as api])) 12 | 13 | ;; Import all functions from api, for compatibility. 14 | (doseq [[a v] (ns-publics 'monkey.ci.api)] 15 | (intern *ns* a v)) 16 | 17 | (defn ^:deprecated cpus 18 | "Gets or sets requested cpu count for container jobs. Deprecated, use 19 | `size` instead." 20 | ([job] 21 | (:cpus job)) 22 | ([job n] 23 | (api/try-unwrap job assoc :cpus n))) 24 | 25 | (defn ^:deprecated memory 26 | "Gets or sets requested memory for container jobs, in GBs. Deprecated, 27 | use `size` instead." 28 | ([job] 29 | (:memory job)) 30 | ([job n] 31 | (api/try-unwrap job assoc :memory n))) 32 | -------------------------------------------------------------------------------- /app/src/monkey/ci/storage/cached.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.storage.cached 2 | "Cached storage implementation. It wraps another storage and adds caching to it. 3 | This currently is a very naive implementation. It should be expanded with event processing, 4 | in case there are multiple replicas. Or we should replace it with a 'real' database." 5 | (:require [clojure.tools.logging :as log] 6 | [monkey.ci.protocols :as p])) 7 | 8 | (deftype CachedStorage [src cache] 9 | p/Storage 10 | (write-obj [_ sid obj] 11 | (when-let [r (p/write-obj src sid obj)] 12 | (p/write-obj cache sid obj) 13 | r)) 14 | 15 | (read-obj [_ sid] 16 | (if-let [v (p/read-obj cache sid)] 17 | v 18 | (let [v (p/read-obj src sid)] 19 | (log/trace "Adding to cache:" sid) 20 | (p/write-obj cache sid v) 21 | v))) 22 | 23 | (delete-obj [_ sid] 24 | (p/delete-obj cache sid) 25 | (p/delete-obj src sid)) 26 | 27 | (obj-exists? [_ sid] 28 | ;; Check the src directly 29 | (p/obj-exists? src sid)) 30 | 31 | (list-obj [_ sid] 32 | ;; Always list from src 33 | (p/list-obj src sid))) 34 | 35 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/loki_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.loki-test 2 | (:require #?(:clj [clojure.test :refer [deftest testing is]] 3 | :cljs [cljs.test :refer-macros [deftest testing is]]) 4 | [monkey.ci.gui.loki :as sut] 5 | [re-frame.core :as rf] 6 | [re-frame.db :refer [app-db]])) 7 | 8 | (deftest job-query 9 | (testing "creates query map" 10 | (is (= {"repo_id" "test-repo" 11 | "build_id" "test-build" 12 | "job_id" "test-job"} 13 | (sut/job-query ["test-cust" "test-repo" "test-build"] "test-job"))))) 14 | 15 | (deftest query->str 16 | (testing "returns query string" 17 | (is (= "{repo_id=\"test-repo\",build_id=\"test-build\",job_id=\"test-job\"}" 18 | (sut/query->str 19 | (sut/job-query ["test-cust" "test-repo" "test-build"] "test-job")))))) 20 | 21 | (deftest request-params 22 | (testing "adds start and end time from job" 23 | (let [job {:start-time 10000 24 | :end-time 20000} 25 | q (sut/request-params ["test"] job)] 26 | (is (some? (:start q))) 27 | (is (some? (:end q)))))) 28 | -------------------------------------------------------------------------------- /test-lib/test/monkey/ci/test_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.test-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [babashka.fs :as fs] 4 | [monkey.ci 5 | [api :as api] 6 | [test :as sut]])) 7 | 8 | (deftest test-ctx 9 | (testing "is a context map" 10 | (is (map? sut/test-ctx))) 11 | 12 | (testing "contains a basic build" 13 | (is (some? (:build sut/test-ctx))))) 14 | 15 | (deftest with-tmp-checkout-dir 16 | (testing "sets temp checkout dir in context" 17 | (is (some? (-> sut/test-ctx 18 | (sut/with-tmp-checkout-dir) 19 | (sut/checkout-dir)))))) 20 | 21 | (deftest with-tmp-dir 22 | (testing "invokes body in tmp dir, deletes dir afterward" 23 | (let [r (sut/with-tmp-dir dir 24 | (if (fs/exists? dir) dir ::error))] 25 | (is (not= ::error r)) 26 | (is (not (fs/exists? r)))))) 27 | 28 | (deftest set-main-branch 29 | (testing "sets main branch in context" 30 | (is (= "test-main" 31 | (-> sut/test-ctx 32 | (sut/set-main-branch "test-main") 33 | (api/main-branch)))))) 34 | -------------------------------------------------------------------------------- /app/src/monkey/ci/metrics/otlp.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.metrics.otlp 2 | "OpenTelemetry client implementation, used to push metrics to an OTLP 3 | collector endpoint (e.g. Scaleway cockpit)." 4 | (:require [monkey.ci.version :as v]) 5 | (:import [io.prometheus.metrics.exporter.opentelemetry OpenTelemetryExporter])) 6 | 7 | (defn- add-labels [builder lbls] 8 | (reduce-kv (fn [b k v] 9 | (.resourceAttribute b k v)) 10 | builder 11 | lbls)) 12 | 13 | (defn make-client 14 | "Creates a new OTLP client that pushes to given url, using metrics from the 15 | specified Prometheus registry. The client automatically pushes metrics 16 | data at configured intervals (by default 60 seconds)." 17 | [url reg {:keys [token interval service labels]}] 18 | (cond-> (.. (OpenTelemetryExporter/builder) 19 | (endpoint url) 20 | (registry reg) 21 | (protocol "http/protobuf") 22 | (serviceVersion (v/version))) 23 | token (.header "X-TOKEN" token) 24 | interval (.intervalSeconds interval) 25 | service (.serviceName service) 26 | labels (add-labels labels) 27 | true (.buildAndStart))) 28 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/test/mailman.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.test.mailman 2 | "Functionality for testing mailman events" 3 | (:require [monkey.ci.protocols :as p] 4 | [monkey.mailman.core :as mmc])) 5 | 6 | (defrecord TestBroker [posted] 7 | mmc/EventPoster 8 | (post-events [this events] 9 | (swap! posted (comp vec concat) events)) 10 | 11 | mmc/EventReceiver 12 | (add-listener [this l] 13 | ;; Noop 14 | ) 15 | 16 | (poll-events [this n] 17 | (take n @posted))) 18 | 19 | (defn test-broker [] 20 | (->TestBroker (atom []))) 21 | 22 | (defrecord TestListener [routes opts] 23 | mmc/Listener 24 | (unregister-listener [_] 25 | ;; noop 26 | nil)) 27 | 28 | (defrecord TestComponent [broker] 29 | p/AddRouter 30 | (add-router [this r opts] 31 | [(->TestListener r opts)])) 32 | 33 | (defn test-component [] 34 | (->TestComponent (test-broker))) 35 | 36 | (defn- broker-posted [broker] 37 | (or (:posted broker) 38 | (get-in broker [:broker :posted]))) 39 | 40 | (defn get-posted [broker] 41 | (some-> (broker-posted broker) 42 | (deref))) 43 | 44 | (defn clear-posted! [broker] 45 | (reset! (broker-posted broker) [])) 46 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/home/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.home.subs 2 | (:require [monkey.ci.gui.home.db :as db] 3 | [monkey.ci.gui.login.subs] 4 | [monkey.ci.gui.utils :as u] 5 | [re-frame.core :as rf])) 6 | 7 | (u/db-sub :user/orgs db/get-orgs) 8 | (u/db-sub :user/alerts db/get-alerts) 9 | (u/db-sub :org/join-alerts db/join-alerts) 10 | (u/db-sub :org/searching? (comp true? db/org-searching?)) 11 | (u/db-sub :org/search-results db/search-results) 12 | (u/db-sub :user/join-requests db/join-requests) 13 | 14 | (rf/reg-sub 15 | :org/joining? 16 | (fn [db [_ cust-id]] 17 | (if cust-id 18 | (db/org-joining? db cust-id) 19 | (or (db/org-joining? db) #{})))) 20 | 21 | (rf/reg-sub 22 | :org/join-list 23 | :<- [:org/search-results] 24 | :<- [:login/user] 25 | :<- [:user/join-requests] 26 | :<- [:org/joining?] 27 | (fn [[r u jr j?] _] 28 | (when r 29 | (let [cust (set (:orgs u)) 30 | mark-joined (fn [{:keys [id] :as c}] 31 | (cond-> c 32 | (cust id) (assoc :status :joined) 33 | (j? id) (assoc :status :joining)))] 34 | (map mark-joined r))))) 35 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/user/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.user.db 2 | (:require [monkey.ci.gui.login.db :as udb])) 3 | 4 | (def get-user-settings ::user-settings) 5 | 6 | (defn set-user-settings [db s] 7 | (assoc db ::user-settings s)) 8 | 9 | (def get-general-edit ::general-edit) 10 | 11 | (defn set-general-edit [db v] 12 | (assoc db ::general-edit v)) 13 | 14 | (defn reset-general-edit [db] 15 | (dissoc db ::general-edit)) 16 | 17 | (defn update-general-edit [db f & args] 18 | (apply update db ::general-edit f args)) 19 | 20 | (def default-settings {:receive-mailing true}) 21 | 22 | (defn get-general-edit-merged 23 | "Combines user and default values with overwritten settings" 24 | [db] 25 | (merge (udb/user db) default-settings (get-general-edit db))) 26 | 27 | (def get-general-alerts ::general-alerts) 28 | 29 | (defn set-general-alerts [db a] 30 | (assoc db ::general-alerts a)) 31 | 32 | (defn reset-general-alerts [db] 33 | (dissoc db ::general-alerts)) 34 | 35 | (def general-saving? (comp true? ::general-saving)) 36 | 37 | (defn set-general-saving [db] 38 | (assoc db ::general-saving true)) 39 | 40 | (defn reset-general-saving [db] 41 | (dissoc db ::general-saving)) 42 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/sidecar/runtime_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.sidecar.runtime-test 2 | (:require [clojure.spec.alpha :as spec] 3 | [clojure.test :refer [deftest is testing]] 4 | [monkey.ci.sidecar 5 | [config :as sc] 6 | [runtime :as sut]] 7 | [monkey.ci.spec.sidecar :as ss])) 8 | 9 | (def config 10 | (-> {} 11 | (sc/set-poll-interval 500) 12 | (sc/set-events-file "test-events") 13 | (sc/set-abort-file "test-abort") 14 | (sc/set-start-file "test-start") 15 | (sc/set-api {:url "http://test-api" :token "test-token"}) 16 | (sc/set-workspace {:type :disk 17 | :dir "test-dir"}) 18 | (sc/set-job {:id "test-job"}) 19 | (sc/set-sid ["test-cust" "test-repo" "test-build"]))) 20 | 21 | (deftest make-system 22 | (testing "creates system map with runtime" 23 | (is (some? (:runtime (sut/make-system config)))))) 24 | 25 | (deftest with-runtime 26 | (testing "passes runtime component to arg" 27 | (let [res (sut/with-runtime config identity)] 28 | (is (sut/runtime? res)) 29 | (is (spec/valid? ::ss/runtime res) 30 | (spec/explain-str ::ss/runtime res))))) 31 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/entities/build_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.build-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.entities 4 | [build :as sut] 5 | [core :as ec] 6 | [helpers :as eh]])) 7 | 8 | (deftest select-build-by-sid 9 | (testing "finds matching build" 10 | (eh/with-prepared-db conn 11 | (let [org (ec/insert-org conn {:name "test org"}) 12 | repo (ec/insert-repo conn 13 | {:display-id "test-repo" 14 | :name "test repo" 15 | :org-id (:id org)}) 16 | build (ec/insert-build conn 17 | {:display-id "test-build" 18 | :idx 1 19 | :repo-id (:id repo)})] 20 | (is (= build (-> (sut/select-build-by-sid conn 21 | (:cuid org) 22 | (:display-id repo) 23 | (:display-id build)) 24 | (select-keys (keys build))))))))) 25 | -------------------------------------------------------------------------------- /.monkeyci/config.clj: -------------------------------------------------------------------------------- 1 | (ns config 2 | "Configuration settings" 3 | (:require [monkey.ci.api :as m] 4 | [predicates :as p])) 5 | 6 | (defn tag-version 7 | "Extracts the version from the tag" 8 | [ctx] 9 | (some->> (m/git-ref ctx) 10 | (re-matches p/tag-regex) 11 | (second))) 12 | 13 | (defn image-version 14 | "Retrieves image version from the tag, or the build id if this is the main branch." 15 | [ctx] 16 | ;; Prefix prod images with "release" for image retention policies 17 | (or (some->> (tag-version ctx) (str "release-")) 18 | (m/build-id ctx) 19 | ;; Fallback 20 | "latest")) 21 | 22 | (def img-base "rg.fr-par.scw.cloud/monkeyci") 23 | (def app-img (str img-base "/monkeyci-api")) 24 | (def gui-img (str img-base "/monkeyci-gui")) 25 | 26 | (defn app-image [ctx] 27 | (str app-img ":" (image-version ctx))) 28 | 29 | (defn archs [_] 30 | ;; Use fallback for safety 31 | #_(or (m/archs ctx) [:amd]) 32 | ;; Using single arch for now. When using a container agent, it may happen that 33 | ;; multiple builds run on the same agent but for different architectures, which may 34 | ;; mess up the result (e.g. amd container but actually arm arch) 35 | [:amd]) 36 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/apis/common.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.apis.common 2 | (:require #?@(:node [] 3 | :cljs [[ajax.core :as ajax]]) 4 | [camel-snake-kebab.core :as csk] 5 | [clojure.walk :as w] 6 | [re-frame.core :as rf])) 7 | 8 | (def format #?@(:node [] 9 | :cljs [(ajax/json-response-format)])) 10 | 11 | (defn- convert-keys 12 | "Since github uses snake casing for its keys, we convert them to clojure-style 13 | kebab-case keywords here." 14 | [obj] 15 | (w/postwalk (fn [x] 16 | (if (map-entry? x) 17 | [(csk/->kebab-case-keyword (first x)) (second x)] 18 | x)) 19 | obj)) 20 | 21 | (defn api-request 22 | "Builds an xhrio request map to access an external api." 23 | [{:keys [token] :as opts}] 24 | (-> opts 25 | (assoc :response-format format 26 | ;; Route the response to convert map keys 27 | :on-success [:ext-api/process-response (:on-success opts)]) 28 | (assoc-in [:headers "Authorization"] (str "Bearer " token)))) 29 | 30 | (rf/reg-event-fx 31 | :ext-api/process-response 32 | (fn [_ [_ evt resp]] 33 | {:dispatch (conj evt (convert-keys resp))})) 34 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/entities/repo_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.repo-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.entities 4 | [core :as ec] 5 | [helpers :as eh] 6 | [repo :as sut]])) 7 | 8 | (deftest ^:sql repos-with-labels 9 | (eh/with-prepared-db conn 10 | (testing "selects repos and their labels" 11 | (let [org (ec/insert-org conn {:name "test org"}) 12 | repo (ec/insert-repo conn {:org-id (:id org) 13 | :display-id "test-repo" 14 | :name "test repo"})] 15 | (is (= 2 (count (ec/insert-repo-labels 16 | conn 17 | [{:repo-id (:id repo) 18 | :name "first" 19 | :value "test value"} 20 | {:repo-id (:id repo) 21 | :name "second" 22 | :value "another value"}])))) 23 | (let [m (sut/repos-with-labels conn (ec/by-id (:id repo)))] 24 | (is (some? m)) 25 | (is (= ["first" "second"] 26 | (->> m first :labels (map :name))))))))) 27 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/loki.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.loki 2 | "Functions for fetching loki logs" 3 | (:require [clojure.string :as cs])) 4 | 5 | (defn query->str [q] 6 | (letfn [(entry [[k v]] 7 | (str k "=\"" v "\""))] 8 | (str "{" 9 | (->> q 10 | (map entry) 11 | (cs/join ",")) 12 | "}"))) 13 | 14 | (defn job-query 15 | "Creates a query object for the given build sid and job" 16 | [[_ repo-id build-id] job-id] 17 | {"repo_id" repo-id 18 | "build_id" build-id 19 | "job_id" job-id}) 20 | 21 | (defn- millis->nanos [ms] 22 | (* ms 1000000)) 23 | 24 | (defn request-params [sid {:keys [id start-time end-time]}] 25 | ;; Timestamp is required otherwise loki may return empty results 26 | ;; when query cache is cleared. We take the time period extra large 27 | ;; to ensure logs that have been committed later are also found. 28 | (cond-> {:query (query->str (job-query sid id)) 29 | :start (millis->nanos (- start-time 10000)) 30 | :direction "forward"} 31 | end-time (assoc :end (millis->nanos (+ end-time 30000))))) 32 | 33 | (defn with-query 34 | "Sets given query on the job request" 35 | [r q] 36 | (assoc-in r [:params :query] q)) 37 | -------------------------------------------------------------------------------- /app/src/monkey/ci/storage/sql/email_registration.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.storage.sql.email-registration 2 | (:require [monkey.ci.entities.core :as ec] 3 | [monkey.ci.storage.sql.common :as sc])) 4 | 5 | (defn- db->email-registration [reg] 6 | (sc/cuid->id reg)) 7 | 8 | (defn select-email-registration [conn cuid] 9 | (some-> (ec/select-email-registration conn (ec/by-cuid cuid)) 10 | (db->email-registration))) 11 | 12 | (defn select-email-registration-by-email [st email] 13 | (some-> (ec/select-email-registration (sc/get-conn st) [:= :email email]) 14 | (db->email-registration))) 15 | 16 | (defn select-email-registrations [st] 17 | (->> (ec/select-email-registrations (sc/get-conn st) nil) 18 | (map db->email-registration))) 19 | 20 | (defn insert-email-registration [conn reg] 21 | ;; Updates not supported 22 | (ec/insert-email-registration conn (-> reg 23 | (assoc :cuid (:id reg)) 24 | (dissoc :id)))) 25 | 26 | (defn delete-email-registration [conn cuid] 27 | (ec/delete-email-registrations conn (ec/by-cuid cuid))) 28 | 29 | (defn count-email-registrations [st] 30 | (ec/count-entities (sc/get-conn st) :email-registrations)) 31 | -------------------------------------------------------------------------------- /test-lib/pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4.0.0 4 | jar 5 | com.monkeyci 6 | test 7 | 0.10.1-SNAPSHOT 8 | monkeyci-test 9 | 10 | 11 | GPL 3 12 | https://www.gnu.org/licenses/gpl-3.0.en.html#license-text 13 | 14 | 15 | 16 | 17 | org.clojure 18 | clojure 19 | 1.12.0 20 | 21 | 22 | com.monkeyci 23 | app 24 | 0.10.0 25 | 26 | 27 | 28 | src 29 | 30 | 31 | 32 | clojars 33 | https://repo.clojars.org/ 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /app/src/monkey/ci/time.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.time 2 | "Time related utility functions" 3 | (:require [clojure.tools.logging :as log] 4 | [java-time.api :as jt]) 5 | (:import java.time.OffsetDateTime)) 6 | 7 | (defn now [] 8 | (System/currentTimeMillis)) 9 | 10 | (defn hours->millis [h] 11 | (* h 3600 1000)) 12 | 13 | (defn day-start 14 | "Returns the date at midnight for given time object" 15 | [date] 16 | (jt/truncate-to date :days)) 17 | 18 | (defn date-seq 19 | "Lazy seq of dates, starting at given date." 20 | [^OffsetDateTime start] 21 | (let [m (day-start start)] 22 | (lazy-seq (cons m (date-seq (jt/plus m (jt/days 1))))))) 23 | 24 | (def utc-zone (jt/zone-id "UTC")) 25 | 26 | (defn epoch->date 27 | "Converts epoch millis to local date using utc zone" 28 | [ms] 29 | (-> (jt/instant ms) 30 | (jt/local-date utc-zone))) 31 | 32 | (defn same-date? 33 | "True if the two epoch millis denote the same UTC date" 34 | [a b] 35 | (and a b 36 | (= (epoch->date a) 37 | (epoch->date b)))) 38 | 39 | (defn same-dom? 40 | "True if the two epoch millis are about the same day-of-month (in UTC)" 41 | [a b] 42 | (->> [a b] 43 | (map (comp #(jt/as % :day-of-month) 44 | epoch->date)) 45 | (apply =))) 46 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/clipboard.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.clipboard 2 | (:require [monkey.ci.gui.components :as co] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (rf/reg-sub 7 | ::current 8 | (fn [db _] 9 | (::current db))) 10 | 11 | (rf/reg-event-fx 12 | ::clipboard-copy 13 | (fn [{:keys [db]} [_ v]] 14 | {:db (assoc db ::current v) 15 | :clipboard/set v})) 16 | 17 | (rf/reg-fx 18 | :clipboard/set 19 | (fn [val] 20 | (.. js/navigator 21 | -clipboard 22 | (writeText val)))) 23 | 24 | (defn copy-handler 25 | "Creates an event handler that when invoked, copies `v` into the clipboard." 26 | [v] 27 | (u/link-evt-handler [::clipboard-copy v])) 28 | 29 | (defn clipboard-copy 30 | "Renders an icon that, when clicked, copies the specified value into 31 | the clipboard. The value is stored in the db, and whenever the value 32 | in db differs from the specified value, the icon changes back to the 33 | original value." 34 | [v desc] 35 | (let [c (rf/subscribe [::current])] 36 | [:a {:href "#" 37 | :on-click (copy-handler v) 38 | ;; TODO Use bootstrap tooltips 39 | :title desc} 40 | [co/icon (if (= v @c) 41 | :clipboard-check 42 | :clipboard)]])) 43 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/ssh_keys/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.ssh-keys.subs 2 | (:require [monkey.ci.gui.ssh-keys.db :as db] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub :ssh-keys/loading? db/loading?) 7 | (u/db-sub :ssh-keys/alerts db/get-alerts) 8 | (u/db-sub :ssh-keys/keys db/get-value) 9 | (u/db-sub :ssh-keys/editing-keys db/get-editing-keys) 10 | 11 | (rf/reg-sub 12 | ;; Retrieves the editing version of a given ssh key, or `nil` if the 13 | ;; key is not being edited. 14 | :ssh-keys/editing 15 | :<- [:ssh-keys/editing-keys] 16 | (fn [ed [_ k]] 17 | (let [get-key (juxt :id :temp-id) 18 | by-id (group-by get-key ed)] 19 | (some-> (get by-id (get-key k)) 20 | first)))) 21 | 22 | (rf/reg-sub 23 | :ssh-keys/display-keys 24 | :<- [:ssh-keys/keys] 25 | :<- [:ssh-keys/editing-keys] 26 | (fn [[orig ed] _] 27 | (let [by-id (group-by :id ed) 28 | mark-editing #(assoc % :editing? true)] 29 | (-> (map (fn [k] 30 | (or (some-> (get by-id (:id k)) 31 | first 32 | (mark-editing)) 33 | k)) 34 | orig) 35 | (concat (->> (filter db/new-set? ed) 36 | (map mark-editing))))))) 37 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/local_storage_test.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.local-storage-test 2 | (:require [cljs.test :refer-macros [deftest testing is use-fixtures]] 3 | [day8.re-frame.test :as rf-test] 4 | [monkey.ci.gui.local-storage :as sut] 5 | [monkey.ci.gui.test.fixtures :as f] 6 | [re-frame.core :as rf] 7 | [re-frame.db :refer [app-db]])) 8 | 9 | (rf/clear-subscription-cache!) 10 | 11 | (use-fixtures :each f/restore-rf) 12 | 13 | ;; Local browser storage is not available in node 14 | (when (sut/local-storage-enabled?) 15 | (deftest local-storage 16 | (testing "can store and load from browser local storage" 17 | (let [id ::test-storage 18 | val {:key "value"}] 19 | (rf-test/run-test-sync 20 | (rf/reg-event-fx 21 | ::init-storage 22 | (fn [_ _] 23 | {:local-storage [id val]})) 24 | 25 | (rf/reg-event-fx 26 | ::load-storage 27 | [(rf/inject-cofx :local-storage id)] 28 | (fn [{:keys [db] :as ctx} _] 29 | {:db (assoc db ::loaded-value (get ctx :local-storage))})) 30 | 31 | (rf/dispatch [::init-storage]) 32 | (rf/dispatch [::load-storage]) 33 | (is (= val (::loaded-value @app-db)))))))) 34 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/login/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.login.subs 2 | (:require [monkey.ci.gui.login.db :as db] 3 | [monkey.ci.gui.utils :as u] 4 | [re-frame.core :as rf])) 5 | 6 | (u/db-sub :login/submitting? db/submitting?) 7 | (u/db-sub :login/alerts db/alerts) 8 | (u/db-sub :login/token db/token) 9 | (u/db-sub :login/github-client-id (comp :client-id db/github-config)) 10 | (u/db-sub :login/bitbucket-client-id (comp :client-id db/bitbucket-config)) 11 | 12 | (defn- add-github-user [u db] 13 | (let [gu (db/github-user db)] 14 | (cond-> u 15 | gu (-> (assoc :github gu) 16 | (merge (select-keys gu [:name :avatar-url])))))) 17 | 18 | (defn- add-bitbucket-user [u db] 19 | (let [bu (db/bitbucket-user db)] 20 | (cond-> u 21 | bu (assoc :bitbucket bu 22 | :name (:display-name bu) 23 | :avatar-url (get-in bu [:links :avatar :href]))))) 24 | 25 | (rf/reg-sub 26 | :login/user 27 | (fn [db _] 28 | (-> (db/user db) 29 | (add-github-user db) 30 | (add-bitbucket-user db)))) 31 | 32 | (rf/reg-sub 33 | :login/github-user? 34 | :<- [:login/user] 35 | (fn [u _] 36 | (some? (:github u)))) 37 | 38 | (rf/reg-sub 39 | :login/bitbucket-user? 40 | :<- [:login/user] 41 | (fn [u _] 42 | (some? (:bitbucket u)))) 43 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/accordion_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.accordion-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [monkey.ci.gui.components :as sut] 4 | [reagent.core] 5 | [re-frame.db :as rdb])) 6 | 7 | (defcard-rg accordion-basic 8 | "Basic accordion with one tab open" 9 | [sut/accordion 10 | ::accordion-basic 11 | [{:title "Item 1" 12 | :collapsed true 13 | :contents [:p "This is the first item"]} 14 | {:title "Item 2" 15 | :collapsed false 16 | :contents [:p "This is the second item"]} 17 | {:title "Item 3" 18 | :collapsed true 19 | :contents [:p "This is the third item"]}]]) 20 | 21 | (defcard-rg accordion-with-body 22 | "Accordion with more complicated body" 23 | [sut/accordion 24 | ::accordion-with-body 25 | [{:title "Overview" 26 | :contents 27 | [:div 28 | [:h2 "This is the overview"] 29 | [:ul 30 | [:li "Here we can"] 31 | [:li "Add more complicated things"]]]} 32 | {:title [:span "Details" [:span.ms-1.badge.text-bg-success "success"]] 33 | :collapsed true 34 | :contents 35 | [:div 36 | [:h2 "These are the details"] 37 | [:ul 38 | [:li "Here we can"] 39 | [:li "Add more complicated things"]]]}]]) 40 | -------------------------------------------------------------------------------- /app/src/monkey/ci/storage/sql/user_token.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.storage.sql.user-token 2 | (:require [monkey.ci.entities 3 | [core :as ec] 4 | [token :as et]] 5 | [monkey.ci.storage.sql.common :as sc])) 6 | 7 | (defn upsert-user-token [conn token] 8 | (let [u (->> (ec/select-users conn (ec/by-cuid (:user-id token))) 9 | first) 10 | t (-> token 11 | (sc/id->cuid) 12 | (assoc :user-id (:id u))) 13 | m (->> (ec/select-user-tokens conn (ec/by-cuid (:id token))) 14 | first)] 15 | (if m 16 | (ec/update-user-token conn (merge m t)) 17 | (ec/insert-user-token conn t)))) 18 | 19 | (defn select-user-token [conn [user-id token-id]] 20 | (some-> (ec/select-user-tokens conn (ec/by-cuid token-id)) 21 | first 22 | (sc/cuid->id) 23 | (assoc :user-id user-id))) 24 | 25 | (defn select-user-tokens [st user-id] 26 | (->> (et/select-user-tokens (sc/get-conn st) (et/by-user user-id)) 27 | (map sc/cuid->id))) 28 | 29 | (defn select-user-token-by-token [st token] 30 | (->> (et/select-user-tokens (sc/get-conn st) (et/by-token token)) 31 | (map sc/cuid->id) 32 | first)) 33 | 34 | (defn delete-user-token [conn token-id] 35 | (ec/delete-entities conn :user-tokens (ec/by-cuid token-id))) 36 | -------------------------------------------------------------------------------- /app/src/monkey/ci/storage/sql/org_token.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.storage.sql.org-token 2 | (:require [clojure.tools.logging :as log] 3 | [monkey.ci.entities 4 | [core :as ec] 5 | [token :as et]] 6 | [monkey.ci.storage.sql.common :as sc])) 7 | 8 | (defn upsert-org-token [conn token] 9 | (let [u (->> (ec/select-orgs conn (ec/by-cuid (:org-id token))) 10 | first) 11 | t (-> token 12 | (sc/id->cuid) 13 | (assoc :org-id (:id u))) 14 | m (->> (ec/select-org-tokens conn (ec/by-cuid (:id token))) 15 | first)] 16 | (if m 17 | (ec/update-org-token conn (merge m t)) 18 | (ec/insert-org-token conn t)))) 19 | 20 | (defn select-org-token [conn [org-id token-id]] 21 | (some-> (ec/select-org-tokens conn (ec/by-cuid token-id)) 22 | first 23 | (sc/cuid->id) 24 | (assoc :org-id org-id))) 25 | 26 | (defn select-org-tokens [st org-id] 27 | (->> (et/select-org-tokens (sc/get-conn st) (et/by-org org-id)) 28 | (map sc/cuid->id))) 29 | 30 | (defn select-org-token-by-token [st token] 31 | (->> (et/select-org-tokens (sc/get-conn st) (et/by-token token)) 32 | (map sc/cuid->id) 33 | first)) 34 | 35 | (defn delete-org-token [conn token-id] 36 | (ec/delete-entities conn :org-tokens (ec/by-cuid token-id))) 37 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/artifact/subs_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.artifact.subs-test 2 | (:require #?(:clj [clojure.test :refer [deftest testing is use-fixtures]] 3 | :cljs [cljs.test :refer-macros [deftest testing is use-fixtures]]) 4 | [monkey.ci.gui.build.db :as bdb] 5 | [monkey.ci.gui.artifact.db :as db] 6 | [monkey.ci.gui.artifact.subs :as sut] 7 | [monkey.ci.gui.routing :as r] 8 | [monkey.ci.gui.test.fixtures :as tf] 9 | [re-frame.core :as rf] 10 | [re-frame.db :refer [app-db]])) 11 | 12 | (use-fixtures :each tf/reset-db) 13 | 14 | (rf/clear-subscription-cache!) 15 | 16 | (deftest artifact-alerts 17 | (let [a (rf/subscribe [:artifact/alerts])] 18 | (testing "exists" 19 | (is (some? a))) 20 | 21 | (testing "returns alerts from db" 22 | (is (nil? @a)) 23 | (is (some? (reset! app-db (db/set-alerts {} ::alerts)))) 24 | (is (= ::alerts @a))))) 25 | 26 | (deftest artifact-downloading? 27 | (let [art-id (str (random-uuid)) 28 | b (rf/subscribe [:artifact/downloading? art-id])] 29 | (testing "exists" 30 | (is (some? b))) 31 | 32 | (testing "returns downloading state from db" 33 | (is (false? @b)) 34 | (is (some? (reset! app-db (db/set-downloading {} art-id)))) 35 | (is (true? @b))))) 36 | -------------------------------------------------------------------------------- /app/examples/artifacts/build.clj: -------------------------------------------------------------------------------- 1 | (ns artifacts.build 2 | "Example script to demonstrate the use of caches" 3 | (:require [babashka.fs :as fs] 4 | [monkey.ci.api :as m])) 5 | 6 | (def artifact-file "artifact.txt") 7 | 8 | (def artifact 9 | (m/artifact "example-artifact" artifact-file)) 10 | 11 | (def create-artifact 12 | (-> (m/action-job 13 | "create-artifact" 14 | (fn [ctx] 15 | (spit (m/in-work ctx artifact-file) "This is a test artifact"))) 16 | (m/save-artfiacts artifact))) 17 | 18 | (def use-artifact 19 | (-> (m/action-job 20 | "use-artifact" 21 | (fn [ctx] 22 | (let [f (m/in-work ctx artifact-file)] 23 | (if (fs/exists? f) 24 | (do 25 | (slurp f) 26 | m/success) 27 | (assoc m/failure :message "Artifact file not found"))))) 28 | (m/restore-artifats (m/artifact artifact)) 29 | (m/depends-on "create-artifact"))) 30 | 31 | (def cleanup 32 | (-> (m/action-job 33 | "cleanup" 34 | (fn [ctx] 35 | (fs/delete-if-exists (m/in-work ctx artifact-file)) 36 | m/success)) 37 | (m/depends-on "use-artifact"))) 38 | 39 | ;; Order in which you define them here does not matter, it's the dependencies 40 | ;; that determine execution order. 41 | [create-artifact 42 | cleanup 43 | use-artifact] 44 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/ssh_keys/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.ssh-keys.db 2 | (:require [monkey.ci.gui.loader :as lo])) 3 | 4 | (def id ::ssh-keys) 5 | 6 | (def set-loading #(lo/set-loading % id)) 7 | (def loading? #(lo/loading? % id)) 8 | 9 | (def set-alerts #(lo/set-alerts %1 id %2)) 10 | (def get-alerts #(lo/get-alerts % id)) 11 | (def reset-alerts #(lo/reset-alerts % id)) 12 | 13 | (def set-value #(lo/set-value %1 id %2)) 14 | (def get-value #(lo/get-value % id)) 15 | 16 | (def editing-keys ::editing-keys) 17 | 18 | (def get-editing-keys editing-keys) 19 | 20 | (def set-id (some-fn :temp-id :id)) 21 | (def new-set? (comp some? :temp-id)) 22 | 23 | (defn set-editing-keys [db k] 24 | (assoc db editing-keys k)) 25 | 26 | (defn update-editing-keys [db f & args] 27 | (apply update db editing-keys f args)) 28 | 29 | (defn get-new-keys [db] 30 | (filter new-set? (get-editing-keys db))) 31 | 32 | (defn same-id? [id] 33 | (comp (partial = id) set-id)) 34 | 35 | (defn update-editing-key 36 | "Updates a single ssh key by id" 37 | [db id f & args] 38 | (update-editing-keys db (fn [keys] 39 | (let [existing (->> keys 40 | (filter (same-id? id)) 41 | (first))] 42 | (replace {existing (apply f existing args)} keys))))) 43 | -------------------------------------------------------------------------------- /common/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {prismatic/schema {:mvn/version "1.4.1"}} 2 | :paths ["src"] 3 | 4 | :aliases 5 | ;; clj -X:test 6 | {:test 7 | {:extra-paths [:test-paths] 8 | :extra-deps {com.monkeyprojects/build {:mvn/version "0.3.1"}} 9 | :exec-fn monkey.test/all} 10 | 11 | ;; clj -M:test:junit 12 | :junit 13 | {:exec-fn monkey.test/junit} 14 | 15 | :watch 16 | ;; clj -X:test:watch 17 | {:extra-deps {org.clojure/tools.namespace {:mvn/version "1.5.0"}} 18 | :exec-fn monkey.test/watch} 19 | 20 | ;; clj -X:jar 21 | :jar 22 | {:extra-deps {com.monkeyprojects/build {:mvn/version "0.3.1" 23 | :exclusions [org.slf4j/slfj4-nop]}} 24 | :exec-fn monkey.build/jar 25 | :exec-args {:jar "target/common.jar" 26 | :lib com.monkeyci/common 27 | :version [[:env "MONKEYCI_VERSION"] "0.22.2-SNAPSHOT"] 28 | :scm {:url "https://github.com/monkey-projects/monkeyci"} 29 | :pom-data [[:licenses 30 | [:license 31 | [:name "GPL v3"] 32 | [:url "https://www.gnu.org/licenses/gpl-3.0.en.html#license-text"]]]]}} 33 | 34 | ;; clj -X:jar:install 35 | :install 36 | {:exec-fn monkey.build/jar+install} 37 | 38 | ;; clj -X:jar:deploy 39 | :deploy 40 | {:exec-fn monkey.build/jar+deploy}}} 41 | -------------------------------------------------------------------------------- /app/dev-resources/test/config/logback-sidecar.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | http://loki.monkey-projects.be/loki/api/v1/push 6 | monkeyci 7 | 8 | 9 | 12 | 13 | l=%level h=${HOSTNAME} c=%logger{20} t=%thread | %msg %ex 14 | 15 | 16 | true 17 | 1000 18 | 19 | 20 | 21 | 22 | DEBUG 23 | 24 | 25 | %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /app/src/monkey/ci/entities/credit_cons.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.entities.credit-cons 2 | (:require [monkey.ci.entities.core :as ec])) 3 | 4 | (def basic-query 5 | {:select [:cc.* 6 | [:c.cuid :org-cuid] 7 | [:r.display-id :repo-did] 8 | [:b.display-id :build-did] 9 | [:cred.cuid :cred-cuid]] 10 | :from [[:credit-consumptions :cc]] 11 | :join [[:builds :b] [:= :b.id :cc.build-id] 12 | [:repos :r] [:= :r.id :b.repo-id] 13 | [:orgs :c] [:= :c.id :r.org-id] 14 | [:org-credits :cred] [:= :cred.id :cc.credit-id]]}) 15 | 16 | (defn select-credit-cons [conn f] 17 | (->> (assoc basic-query :where f) 18 | (ec/select conn) 19 | (map ec/convert-credit-cons-select) 20 | (map (fn [r] 21 | (-> r 22 | (dissoc :cuid :org-cuid :repo-did :build-did :cred-cuid) 23 | (assoc :id (:cuid r) 24 | :org-id (:org-cuid r) 25 | :repo-id (:repo-did r) 26 | :build-id (:build-did r) 27 | :credit-id (:cred-cuid r))))))) 28 | 29 | (defn by-cuid [id] 30 | [:= :cc.cuid id]) 31 | 32 | (defn by-org [id] 33 | [:= :c.cuid id]) 34 | 35 | (defn since [ts] 36 | [:>= :cc.consumed-at (ec/->ts ts)]) 37 | 38 | (defn by-org-since [id ts] 39 | [:and (by-org id) (since ts)]) 40 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/runtime/common_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.runtime.common-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [com.stuartsierra.component :as co] 4 | [manifold.deferred :as md] 5 | [monkey.ci.runtime.common :as sut] 6 | [monkey.ci.utils :as u])) 7 | 8 | (defrecord TestComponent [started? stopped?] 9 | co/Lifecycle 10 | (start [this] 11 | (assoc this :started (reset! started? true))) 12 | 13 | (stop [this] 14 | (assoc this :stopped (reset! stopped? true)))) 15 | 16 | (deftest with-system-async 17 | (let [started? (atom false) 18 | stopped? (atom false) 19 | sys (->TestComponent started? stopped?) 20 | d (md/deferred) 21 | hook-registered? (atom false)] 22 | (with-redefs [u/add-shutdown-hook! (fn [h] 23 | (reset! hook-registered? true))] 24 | (let [r (sut/with-system-async sys (constantly d))] 25 | (testing "starts system and invokes `f`" 26 | (is (true? @started?)) 27 | (is (md/deferred? r))) 28 | 29 | (testing "stops system on realization" 30 | (is (some? (md/success! d ::ok))) 31 | (is (true? @stopped?)) 32 | (is (md/realized? r))) 33 | 34 | (testing "registers shutdown hook" 35 | (is (true? @hook-registered?))))))) 36 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/test/runtime/sidecar.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.test.runtime.sidecar 2 | "Helper functions for working with sidecar runtimes" 3 | (:require [monkey.ci 4 | [cuid :as cuid] 5 | [logging :as l]] 6 | [monkey.ci.test.mailman :as tm])) 7 | 8 | (defn set-log-maker [rt e] 9 | (assoc rt :log-maker e)) 10 | 11 | (defn set-events-file [rt f] 12 | (assoc-in rt [:paths :events-file] f)) 13 | 14 | (defn set-start-file [rt f] 15 | (assoc-in rt [:paths :start-file] f)) 16 | 17 | (defn set-abort-file [rt f] 18 | (assoc-in rt [:paths :abort-file] f)) 19 | 20 | (defn set-poll-interval [rt i] 21 | (assoc rt :poll-interval i)) 22 | 23 | (defn set-sid [rt sid] 24 | (assoc rt :sid sid)) 25 | 26 | (defn set-job [rt job] 27 | (assoc rt :job job)) 28 | 29 | (defn set-mailman [rt mm] 30 | (assoc rt :mailman mm)) 31 | 32 | (def test-rt {}) 33 | 34 | (defn make-test-rt [& [conf]] 35 | (-> test-rt 36 | (set-log-maker (constantly (l/->InheritLogger))) 37 | (set-events-file "test-events") 38 | (set-start-file "test-start") 39 | (set-abort-file "test-abort") 40 | (set-poll-interval 100) 41 | (set-sid [(cuid/random-cuid) (cuid/random-cuid) (str "test-build-" (random-uuid))]) 42 | (set-job {:id (str "test-job-" (random-uuid))}) 43 | (set-mailman (tm/test-component)) 44 | (merge conf))) 45 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/login/events.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.login.events 2 | (:require [monkey.ci.gui.admin.login.db :as db] 3 | [monkey.ci.gui.alerts :as a] 4 | [monkey.ci.gui.login.db :as ldb] 5 | [monkey.ci.gui.logging :as log] 6 | [monkey.ci.gui.martian] 7 | [re-frame.core :as rf])) 8 | 9 | (rf/reg-event-fx 10 | ::submit 11 | (fn [{:keys [db]} [_ {:keys [username password]}]] 12 | {:dispatch [:martian.re-frame/request 13 | :admin-login 14 | {:creds {:username (first username) 15 | :password (first password)}} 16 | [::submit--success] 17 | [::submit--failed]] 18 | :db (-> db 19 | (db/mark-submitting) 20 | (ldb/clear-alerts))})) 21 | 22 | (rf/reg-event-fx 23 | ::submit--success 24 | (fn [{:keys [db]} [_ {user :body}]] 25 | {:db (-> db 26 | (ldb/set-user (-> user 27 | (select-keys [:id]) 28 | (assoc :name (:type-id user)))) 29 | (ldb/set-token (:token user))) 30 | ;; Redirect to admin root page 31 | :dispatch [:route/goto :admin/root]})) 32 | 33 | (rf/reg-event-db 34 | ::submit--failed 35 | (fn [db [_ err]] 36 | (log/warn "Login failed:" (str err)) 37 | (ldb/set-alerts db [(a/admin-login-failed err)]))) 38 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/utils_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.utils-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is]] 3 | :clj [clojure.test :refer [deftest testing is]]) 4 | [monkey.ci.gui.utils :as sut])) 5 | 6 | (deftest ->sid 7 | (testing "creates sid string from values from map" 8 | (is (= "a/b/c" 9 | (-> {:first "a" 10 | :second "b" 11 | :third "c"} 12 | (sut/->sid :first :second :third)))))) 13 | 14 | (deftest build-elapsed 15 | (testing "0 if empty" 16 | (is (= 0 (sut/build-elapsed {})))) 17 | 18 | (testing "total millis between start time and end time" 19 | (let [b {:start-time 10 20 | :end-time 100} 21 | e (sut/build-elapsed b)] 22 | (is (= 90 e))))) 23 | 24 | (deftest pluralize 25 | (testing "returns first arg if singular" 26 | (is (= "single" (sut/pluralize "single" 1)))) 27 | 28 | (testing "returns pluralized arg if multiple or zero" 29 | (is (= "singles" (sut/pluralize "single" 10))) 30 | (is (= "singles" (sut/pluralize "single" 0)))) 31 | 32 | (testing "returns plural if specified" 33 | (is (= "cities" (sut/pluralize "city" 2 "cities"))))) 34 | 35 | (deftest update-nth 36 | (testing "applies `f` to the nth item in the list" 37 | (is (= [0 2 2] 38 | (sut/update-nth [0 1 2] 1 inc))))) 39 | -------------------------------------------------------------------------------- /app/dev-resources/logback-sidecar.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | http://loki.monkey-projects.be/loki/api/v1/push 6 | monkeyci 7 | 8 | 9 | 12 | 13 | l=%level h=${HOSTNAME} c=%logger{20} t=%thread | %msg %ex 14 | 15 | 16 | true 17 | 1000 18 | 19 | 20 | 21 | 22 | DEBUG 23 | 24 | 25 | %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/events/builders_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.events.builders-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [monkey.ci.build.core :as bc] 4 | [monkey.ci.edn :as edn] 5 | [monkey.ci.events.builders :as sut])) 6 | 7 | (deftest job-executed-evt 8 | (testing "adds status from result" 9 | (is (= :success 10 | (-> (sut/job-executed-evt "test-job" ["test-build"] {:status :success}) 11 | :status)))) 12 | 13 | (testing "adds result" 14 | (is (= {:output "test result"} 15 | (-> (sut/job-executed-evt "test-job" ["test-build"] {:status :success 16 | :output "test result"}) 17 | :result))))) 18 | 19 | (deftest job->event 20 | (testing "makes action job serializable" 21 | (let [r (-> (bc/action-job "test-job" (constantly nil)) 22 | (sut/job->event) 23 | (edn/->edn) 24 | (edn/edn->))] 25 | (is (map? r)) 26 | (is (= "test-job" (:id r))))) 27 | 28 | (testing "makes container job serializable" 29 | (let [r (-> (bc/container-job "test-job" {:image "test-img"}) 30 | (sut/job->event) 31 | (edn/->edn) 32 | (edn/edn->))] 33 | (is (map? r)) 34 | (is (= "test-job" (:id r))) 35 | (is (= "test-img" (:image r)))))) 36 | -------------------------------------------------------------------------------- /app/src/monkey/ci/agent/main.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.agent.main 2 | "Main entry point for the build agent. This is a process that picks up `build/queued` 3 | events and runs them as container child processes. There is a single build api server, 4 | hosted by the agent process that serves all builds. This allows to run the builds on 5 | one or more virtual machines, which is faster than provisioning containers for each 6 | build separately, albeit somewhat less efficient if there are few builds. Because 7 | build scripts are mostly waiting for containers to finish, we can stack many parallel 8 | builds on one VM. 9 | 10 | It may be possible to suspend the build VMs after a certain inactivity timeout, to 11 | conserve computing capacity." 12 | (:gen-class) 13 | (:require [clojure.tools.logging :as log] 14 | [monkey.ci.agent.runtime :as ar] 15 | [monkey.ci.config :as c] 16 | [monkey.ci.runtime.common :as rc] 17 | [monkey.ci.web.http :as wh])) 18 | 19 | (defn run-agent [conf waiter] 20 | (log/info "Starting build agent") 21 | (rc/with-system-async 22 | (ar/make-system conf) 23 | (fn [{:keys [api-server] :as sys}] 24 | (log/debug "API server started at port" (:port api-server)) 25 | (waiter sys)))) 26 | 27 | (defn -main [& args] 28 | @(run-agent (c/load-config-file (first args)) 29 | (comp wh/on-server-close :api-server))) 30 | -------------------------------------------------------------------------------- /app/src/monkey/ci/web/http.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.web.http 2 | "Http server component" 3 | (:require [aleph 4 | [http :as aleph] 5 | [netty :as netty]] 6 | [clojure.tools.logging :as log] 7 | [com.stuartsierra.component :as co] 8 | [manifold.deferred :as md] 9 | [ring.util.response :as rur])) 10 | 11 | (defn start-server 12 | "Starts http server. Returns a server object that can be passed to 13 | `stop-server`." 14 | [config app] 15 | (let [http-opts (merge {:port 3000} config)] 16 | (log/info "Starting HTTP server at port" (:port http-opts)) 17 | (aleph/start-server (:handler app) http-opts))) 18 | 19 | (defn stop-server [s] 20 | (when s 21 | (log/info "Shutting down HTTP server...") 22 | (.close s))) 23 | 24 | (defrecord HttpServer [config app] 25 | co/Lifecycle 26 | (start [this] 27 | (assoc this :server (start-server config app))) 28 | (stop [{:keys [server] :as this}] 29 | (when server 30 | (stop-server server)) 31 | (dissoc this :server)) 32 | 33 | clojure.lang.IFn 34 | (invoke [this] 35 | (co/stop this))) 36 | 37 | (defn on-server-close 38 | "Returns a deferred that resolves when the server shuts down." 39 | [server] 40 | (md/future (netty/wait-for-close (:server server)))) 41 | 42 | (defn text-response [txt] 43 | (-> (rur/response txt) 44 | (rur/content-type "text/plain"))) 45 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/repo/subs.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.repo.subs 2 | (:require [monkey.ci.gui.org.subs] 3 | [monkey.ci.gui.repo.db :as db] 4 | [monkey.ci.gui.time :as t] 5 | [monkey.ci.gui.utils :as u] 6 | [re-frame.core :as rf])) 7 | 8 | (rf/reg-sub 9 | :repo/info 10 | :<- [:org/info] 11 | (fn [c [_ repo-id]] 12 | (db/find-repo-in-org c repo-id))) 13 | 14 | (rf/reg-sub 15 | :repo/builds 16 | (fn [db _] 17 | (let [params (get-in db [:route/current :parameters :path]) 18 | parse-time (fn [b] 19 | (update b :start-time (comp str t/parse)))] 20 | (some->> (db/get-builds db) 21 | (map parse-time) 22 | (sort-by :start-time) 23 | (reverse) 24 | (map (partial merge params)))))) 25 | 26 | (u/db-sub :repo/alerts db/alerts) 27 | (u/db-sub :repo/latest-build db/latest-build) 28 | (u/db-sub :repo/trigger-form db/trigger-form) 29 | (u/db-sub :repo/show-trigger-form? db/show-trigger-form?) 30 | (u/db-sub :repo/edit-alerts db/edit-alerts) 31 | (u/db-sub :repo/editing db/editing) 32 | (u/db-sub :repo/saving? (comp true? db/saving?)) 33 | (u/db-sub :repo/deleting? (comp true? db/deleting?)) 34 | 35 | (rf/reg-sub 36 | :builds/init-loading? 37 | :<- [:loader/init-loading? db/id] 38 | (fn [l _] 39 | l)) 40 | 41 | (rf/reg-sub 42 | :builds/loaded? 43 | :<- [:loader/loaded? db/id] 44 | (fn [l _] 45 | l)) 46 | -------------------------------------------------------------------------------- /app/dev-resources/logback-test.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | INFO 5 | 6 | 7 | [%blue(DEV)] %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 8 | 9 | 10 | 11 | 12 | true 13 | 14 | %d{yyyy-MM-dd HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 15 | 16 | 17 | logs/app-%d{yyyy-MM-dd}.log 18 | 30 19 | 1GB 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/clipboard_test.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.clipboard-test 2 | (:require #?(:cljs [cljs.test :refer-macros [deftest testing is use-fixtures]] 3 | :clj [clojure.test :refer [deftest testing is use-fixtures]]) 4 | [monkey.ci.gui.clipboard :as sut] 5 | [monkey.ci.gui.test.fixtures :as f] 6 | [monkey.ci.gui.test.helpers :as h] 7 | [re-frame.core :as rf] 8 | [re-frame.db :refer [app-db]])) 9 | 10 | (use-fixtures :each f/reset-db) 11 | 12 | (deftest clipboard-copy 13 | (testing "renders icon" 14 | (is (vector? (sut/clipboard-copy "test" "some description"))))) 15 | 16 | (deftest current-sub 17 | (let [s (rf/subscribe [::sut/current])] 18 | (testing "exists" 19 | (is (some? s))) 20 | 21 | (testing "returns current value" 22 | (is (nil? @s)) 23 | (is (some? (reset! app-db {::sut/current "test-val"}))) 24 | (is (= "test-val" @s))))) 25 | 26 | (deftest clipboard-copy-evt 27 | (testing "updates value in db" 28 | (h/catch-fx :clipboard/set) ; Avoid overwriting the user's clipboard 29 | (is (nil? (::sut/current @app-db))) 30 | (rf/dispatch-sync [::sut/clipboard-copy "new value"]) 31 | (is (= "new value" (::sut/current @app-db)))) 32 | 33 | (testing "triggers clipboard/set fx" 34 | (let [f (h/catch-fx :clipboard/set)] 35 | (rf/dispatch-sync [::sut/clipboard-copy "new value"]) 36 | (is (= "new value" (first @f)))))) 37 | -------------------------------------------------------------------------------- /app/dev-resources/logback-agent.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | INFO 5 | 6 | 7 | [%blue(AGENT)] %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 8 | 9 | 10 | 11 | 12 | true 13 | 14 | %d{yyyy-MM-dd HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 15 | 16 | 17 | logs/agent-%d{yyyy-MM-dd}.log 18 | 30 19 | 1GB 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /app/dev-resources/logback-script.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 24 | 25 | 26 | 27 | TRACE 28 | 29 | 30 | %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /app/dev-resources/logback-container.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | INFO 5 | 6 | 7 | [%blue(CONTAINER)] %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 8 | 9 | 10 | 11 | 12 | true 13 | 14 | %d{yyyy-MM-dd HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 15 | 16 | 17 | logs/container-%d{yyyy-MM-dd}.log 18 | 30 19 | 1GB 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /app/src/monkey/ci/blob.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.blob 2 | "Blob storage functionality, used to store and restore large files 3 | or entire directories." 4 | (:require [monkey.ci 5 | [oci :as oci] 6 | [protocols :as p] 7 | [utils :as u]] 8 | [monkey.ci.blob 9 | [common :as bc] 10 | [disk :as bd] 11 | [oci :as bo] 12 | [s3 :as bs3]] 13 | [monkey.oci.os.core :as os])) 14 | 15 | (defn save 16 | "Saves blob from src to dest, with optional metadata" 17 | [blob src dest & [md]] 18 | (p/save-blob blob src dest md)) 19 | 20 | (def restore p/restore-blob) 21 | (def input-stream p/get-blob-stream) 22 | (def make-archive bc/make-archive) 23 | 24 | (defmulti make-blob-store (fn [conf k] 25 | (get-in conf [k :type]))) 26 | 27 | (def blob-store? p/blob-store?) 28 | 29 | (defmethod make-blob-store :disk [conf k] 30 | ;; Make storage dir relative to the work dir 31 | (bd/->DiskBlobStore (u/abs-path (:work-dir conf) (get-in conf [k :dir])))) 32 | 33 | (def extension bc/extension) 34 | 35 | (defmethod make-blob-store :oci [conf k] 36 | (let [oci-conf (get conf k) 37 | client (-> (os/make-client oci-conf) 38 | (oci/add-inv-interceptor :blob))] 39 | (bo/->OciBlobStore client oci-conf ))) 40 | 41 | (defmethod make-blob-store :s3 [conf k] 42 | (let [s3-config (get conf k)] 43 | (bs3/->S3BlobStore (bs3/make-client s3-config) s3-config))) 44 | -------------------------------------------------------------------------------- /app/src/monkey/ci/web/api/ssh_keys.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.web.api.ssh-keys 2 | (:require [monkey.ci.storage :as st] 3 | [monkey.ci.web 4 | [common :as c] 5 | [crypto :as cr]])) 6 | 7 | (defn- req->encrypter [req] 8 | #((cr/encrypter req) %1 (c/org-id req) %2)) 9 | 10 | (defn- req->decrypter [req] 11 | #((cr/decrypter req) %1 (c/org-id req) %2)) 12 | 13 | (defn- update-pk [f ssh-key] 14 | (update ssh-key :private-key f (:id ssh-key))) 15 | 16 | (defn- encrypt [encrypter ssh-key] 17 | (update-pk encrypter ssh-key)) 18 | 19 | (defn- decrypt [decrypter ssh-key] 20 | (update-pk decrypter ssh-key)) 21 | 22 | (defn- encrypt-all [req ssh-keys] 23 | (map (partial encrypt (req->encrypter req)) ssh-keys)) 24 | 25 | (defn- decrypt-all [req ssh-keys] 26 | (map (partial decrypt (req->decrypter req)) ssh-keys)) 27 | 28 | (defn get-org-ssh-keys [req] 29 | (c/get-list-for-org (comp (partial decrypt-all req) c/drop-ids st/find-ssh-keys) req)) 30 | 31 | (defn get-repo-ssh-keys [req] 32 | (c/get-for-repo-by-label (comp c/drop-ids st/find-ssh-keys) 33 | (comp (map (partial decrypt (req->decrypter req))) 34 | (map :private-key)) 35 | req)) 36 | 37 | (defn update-ssh-keys [req] 38 | (letfn [(encrypt-and-save [st org-id ssh-keys] 39 | (->> (encrypt-all req ssh-keys) 40 | (st/save-ssh-keys st org-id)))] 41 | (c/update-for-org encrypt-and-save req))) 42 | -------------------------------------------------------------------------------- /app/src/monkey/ci/spec/sidecar.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.spec.sidecar 2 | "Specs for sidecar configuration" 3 | (:require [clojure.spec.alpha :as s] 4 | [monkey.ci.protocols :as p] 5 | [monkey.ci.spec 6 | [build :as b] 7 | [build-api :as ba] 8 | [common :as c] 9 | [events :as e]])) 10 | 11 | (s/def ::events-file string?) 12 | (s/def ::start-file string?) 13 | (s/def ::abort-file string?) 14 | 15 | ;; TODO Remove this, unnecessary 16 | (s/def ::job-config 17 | (s/keys :req [::job ::sid])) 18 | 19 | (s/def ::job 20 | (s/keys :req-un [:job/id] 21 | :opt-un [:job/caches :job/save-artifacts :job/restore-artifacts :job/script 22 | :job/memory :job/cpus :job/arch])) 23 | 24 | (s/def ::checkout-dir string?) 25 | 26 | (s/def ::build 27 | (s/keys :req-un [:build/workspace :build/org-id :build/repo-id :build/build-id] 28 | :opt-un [::checkout-dir])) 29 | 30 | (s/def ::sid (s/coll-of string?)) 31 | 32 | (s/def ::api ::ba/api) 33 | 34 | (s/def ::config 35 | (s/keys :req [::events-file ::start-file ::abort-file ::job-config ::api])) 36 | 37 | (s/def ::log-maker fn?) 38 | (s/def ::paths 39 | (s/keys :req-un [::events-file ::start-file ::abort-file])) 40 | 41 | (s/def ::workspace ::c/workspace) 42 | (s/def ::artifacts p/repo?) 43 | (s/def ::cache p/repo?) 44 | 45 | (s/def ::runtime 46 | (s/keys :req-un [::job ::paths ::sid] 47 | :opt-un [::workspace ::artifacts ::cache ::log-maker ::poll-interval ::c/mailman])) 48 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/admin/login/views.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.admin.login.views 2 | (:require [monkey.ci.gui.admin.login.events :as e] 3 | [monkey.ci.gui.components :as co] 4 | [monkey.ci.gui.forms :as f] 5 | [monkey.ci.gui.layout :as l] 6 | [monkey.ci.gui.login.subs])) 7 | 8 | (defn login-form [] 9 | [:form#admin-login 10 | {:on-submit (f/submit-handler [::e/submit])} 11 | [:div.mb-4 12 | [:label.form-label 13 | {:for :username} 14 | "Username"] 15 | [:input.form-control 16 | {:type :text 17 | :name :username 18 | :id :username}]] 19 | [:div.mb-4 20 | [:label.form-label 21 | {:for :password} 22 | "Password"] 23 | [:input.form-control 24 | {:type :password 25 | :name :password 26 | :id :password}]] 27 | [:div.d-grid.mb-4 28 | [:button.btn.btn-primary.btn-lg 29 | {:type :submit} 30 | "Log in"]]]) 31 | 32 | (defn login [] 33 | [:<> 34 | [:div.bg-soft-success 35 | [:div.container.content-space-1.content-space-t-md-3 36 | [:div.mx-auto 37 | {:style {:max-width "30rem"}} 38 | [:div.card.card-lg.zi-2 39 | [:div.card-header.text-center 40 | [:h4.cardtitle "Log in"] 41 | [:p.card-text "This area is accessible to system administrators only."]] 42 | [:div.card-body 43 | [co/alerts [:login/alerts]] 44 | [login-form]]]]]] 45 | [co/bg-shape]]) 46 | 47 | (defn page [] 48 | [:<> 49 | [l/header] 50 | [login] 51 | [l/footer]]) 52 | -------------------------------------------------------------------------------- /app/src/monkey/ci/storage/sql/webhook.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.storage.sql.webhook 2 | (:require [clojure.spec.alpha :as spec] 3 | [monkey.ci.entities 4 | [core :as ec] 5 | [webhook :as ewh]] 6 | [monkey.ci.storage.sql 7 | [common :as sc] 8 | [repo :as sr]])) 9 | 10 | (defn- webhook->db [wh repo-id] 11 | (-> wh 12 | (dissoc :id :repo-id :org-id :secret-key) 13 | (assoc :cuid (:id wh) 14 | :repo-id repo-id 15 | :secret (:secret-key wh)))) 16 | 17 | (defn- insert-webhook [conn wh repo-id] 18 | (ec/insert-webhook conn (webhook->db wh repo-id))) 19 | 20 | (defn- update-webhook [conn wh existing repo-id] 21 | (ec/update-webhook conn (merge existing (webhook->db wh repo-id)))) 22 | 23 | (defn upsert-webhook [conn wh] 24 | (spec/valid? :entity/webhook wh) 25 | (if-let [repo-id (sr/select-repo-id-by-sid conn [(:org-id wh) (:repo-id wh)])] 26 | (if-let [existing (ec/select-webhook conn (ec/by-cuid (:id wh)))] 27 | (update-webhook conn wh existing repo-id) 28 | (insert-webhook conn wh repo-id)) 29 | (throw (ex-info "Repository does not exist" wh)))) 30 | 31 | (defn select-webhook [conn cuid] 32 | (-> (ewh/select-webhooks-as-entity conn (ewh/by-cuid cuid)) 33 | (first))) 34 | 35 | (defn select-repo-webhooks [st [org-id repo-id]] 36 | (ewh/select-webhooks-as-entity (sc/get-conn st) (ewh/by-repo org-id repo-id))) 37 | 38 | (defn delete-webhook [conn cuid] 39 | (ec/delete-webhooks conn (ec/by-cuid cuid))) 40 | -------------------------------------------------------------------------------- /gui/src/monkey/ci/gui/webhooks/db.cljc: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.webhooks.db 2 | (:require [monkey.ci.gui.loader :as l])) 3 | 4 | (def id ::webhooks) 5 | 6 | (defn get-webhooks [db] 7 | (l/get-value db id)) 8 | 9 | (defn set-webhooks [db w] 10 | (l/set-value db id w)) 11 | 12 | (defn update-webhooks [db f & args] 13 | (apply l/update-value db id f args)) 14 | 15 | (defn set-alerts [db a] 16 | (l/set-alerts db id a)) 17 | 18 | (defn get-alerts [db] 19 | (l/get-alerts db id)) 20 | 21 | (defn reset-alerts [db] 22 | (l/reset-alerts db id)) 23 | 24 | (defn loading? [db] 25 | (l/loading? db id)) 26 | 27 | (defn loaded? [db] 28 | (l/loaded? db id)) 29 | 30 | (defn set-new [db e] 31 | (assoc db ::new e)) 32 | 33 | (defn reset-new [db] 34 | (dissoc db ::new)) 35 | 36 | (def get-new ::new) 37 | 38 | (def creating? ::creating?) 39 | 40 | (defn set-creating [db] 41 | (assoc db ::creating? true)) 42 | 43 | (defn reset-creating [db] 44 | (dissoc db ::creating?)) 45 | 46 | (defn deleting? [db id] 47 | (contains? (::deleting? db) id)) 48 | 49 | (defn set-deleting [db id] 50 | (update db ::deleting? (fnil conj #{}) id)) 51 | 52 | (defn reset-deleting [db id] 53 | (update db ::deleting? (fnil disj #{}) id)) 54 | 55 | (def get-delete-curr 56 | "Retrieves the id of the webhook that is currently being deleted (that is displaying 57 | the modal)." 58 | ::delete-curr) 59 | 60 | (defn set-delete-curr [db id] 61 | (assoc db ::delete-curr id)) 62 | 63 | (defn reset-delete-curr [db id] 64 | (dissoc db ::delete-curr)) 65 | -------------------------------------------------------------------------------- /app/test/unit/monkey/ci/web/common_test.clj: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.web.common-test 2 | (:require [clj-commons.byte-streams :as bs] 3 | [clojure.test :refer [deftest is testing]] 4 | [monkey.ci.web.common :as sut] 5 | [muuntaja.core :as m])) 6 | 7 | (deftest parse-body 8 | (testing "parses string body according to content type" 9 | (is (= {:test-key "test value"} 10 | (-> {:body "{\"test_key\": \"test value\"}" 11 | :headers {"Content-Type" "application/json"}} 12 | (sut/parse-body) 13 | :body)))) 14 | 15 | (testing "parses input stream body according to content type" 16 | (is (= {:test-key "test value"} 17 | (-> {:body (bs/to-input-stream (.getBytes "{\"test_key\": \"test value\"}")) 18 | :headers {"Content-Type" "application/json"}} 19 | (sut/parse-body) 20 | :body))))) 21 | 22 | (deftest req->ext-uri 23 | (testing "determines external uri using host, scheme and path" 24 | (is (= "http://test:1234/v1" 25 | (sut/req->ext-uri 26 | {:scheme :http 27 | :uri "/v1/org/test-cust" 28 | :headers {"host" "test:1234"}} 29 | "/org"))))) 30 | 31 | (deftest muuntaja 32 | (testing "can encode/decode regexes using edn" 33 | (let [m (sut/make-muuntaja) 34 | ct "application/edn"] 35 | (is (= "test-regex" 36 | (->> (m/encode m ct #"test-regex") 37 | (m/decode m ct) 38 | str)))))) 39 | -------------------------------------------------------------------------------- /gui/test/monkey/ci/gui/test/cards/pagination_cards.cljs: -------------------------------------------------------------------------------- 1 | (ns monkey.ci.gui.test.cards.pagination-cards 2 | (:require [devcards.core :refer-macros [defcard-rg]] 3 | [monkey.ci.gui.table :as sut] 4 | [reagent.core] 5 | [re-frame.core :as rf] 6 | [re-frame.db :as rdb])) 7 | 8 | (defcard-rg small-pagination 9 | "Pagination for low number of pages" 10 | [sut/render-pagination ::test 3 1]) 11 | 12 | (defcard-rg first-page 13 | "First page should disable prev btn" 14 | [sut/render-pagination ::test 3 0]) 15 | 16 | (defcard-rg last-page 17 | "Last page should disable next btn" 18 | [sut/render-pagination ::test 3 2]) 19 | 20 | (defcard-rg large-pagination 21 | "Pagination for large number of pages" 22 | [sut/render-pagination ::test 100 20]) 23 | 24 | (defcard-rg large-pagination-low-current 25 | "Pagination for large number of pages with low current" 26 | [sut/render-pagination ::test 100 1]) 27 | 28 | (defcard-rg large-pagination-high-current 29 | "Pagination for large number of pages with high current" 30 | [sut/render-pagination ::test 100 98]) 31 | 32 | (defcard-rg active-low-count 33 | "Active pagination with low number of pages" 34 | (let [id ::low-count] 35 | (rf/dispatch [:pagination/set id {:count 3 :current 1}]) 36 | [sut/pagination id])) 37 | 38 | (defcard-rg active-high-count 39 | "Active pagination with high number of pages" 40 | (let [id ::high-count] 41 | (rf/dispatch [:pagination/set id {:count 20 :current 10}]) 42 | [sut/pagination id])) 43 | --------------------------------------------------------------------------------