├── .gitignore
├── .talismanrc
├── .tool-versions
├── .travis.yml
├── CHANGELOG.md
├── CODE_OF_CONDUCT.md
├── CONTRIBUTING.md
├── LICENSE
├── README.md
├── Vagrantfile
├── ansiparse-externs.js
├── ansiparse.js
├── doc
├── FAQ.md
├── basic-clojure.md
├── howto.md
├── img
│ ├── lambdacd-logo.png
│ ├── pipeline-overview.png
│ └── readme-screenshot.png
└── walkthrough.md
├── env
├── dev
│ ├── clj
│ │ └── lambdacd
│ │ │ └── dev.clj
│ └── cljs
│ │ └── lambdacd
│ │ └── dev.cljs
└── prod
│ └── cljs
│ └── lambdacd
│ └── prod.cljs
├── example
└── clj
│ └── todopipeline
│ ├── pipeline.clj
│ └── steps.clj
├── go
├── package-lock.json
├── package.json
├── project.clj
├── resources
├── logback.xml
└── public
│ ├── css
│ └── thirdparty
│ │ ├── font-awesome-4.4.0
│ │ ├── css
│ │ │ ├── font-awesome.css
│ │ │ └── font-awesome.min.css
│ │ └── fonts
│ │ │ ├── FontAwesome.otf
│ │ │ ├── fontawesome-webfont.eot
│ │ │ ├── fontawesome-webfont.svg
│ │ │ ├── fontawesome-webfont.ttf
│ │ │ ├── fontawesome-webfont.woff
│ │ │ └── fontawesome-webfont.woff2
│ │ └── normalize.css
│ ├── favicon-16x16.png
│ ├── favicon-32x32.png
│ ├── favicon-96x96.png
│ ├── favicon.ico
│ └── visualStyleguide.html
├── scripts
├── github-release.sh
├── migrate-to-new-package-structure.sh
├── testwrapper.sh
└── travis_prebuild.sh
├── src
├── clj
│ └── lambdacd
│ │ ├── core.clj
│ │ ├── event_bus.clj
│ │ ├── event_bus_legacy.clj
│ │ ├── event_bus_new.clj
│ │ ├── execution
│ │ ├── core.clj
│ │ └── internal
│ │ │ ├── build_metadata.clj
│ │ │ ├── execute_step.clj
│ │ │ ├── execute_steps.clj
│ │ │ ├── kill.clj
│ │ │ ├── pipeline.clj
│ │ │ ├── retrigger.clj
│ │ │ ├── serial_step_result_producer.clj
│ │ │ └── util.clj
│ │ ├── internal
│ │ ├── default_pipeline_state.clj
│ │ ├── default_pipeline_state_persistence.clj
│ │ └── running_builds_tracking.clj
│ │ ├── presentation
│ │ ├── pipeline_state.clj
│ │ ├── pipeline_structure.clj
│ │ └── unified.clj
│ │ ├── runners.clj
│ │ ├── state
│ │ ├── core.clj
│ │ ├── internal
│ │ │ ├── dead_steps_marking.clj
│ │ │ └── pipeline_state_updater.clj
│ │ └── protocols.clj
│ │ ├── step_id.clj
│ │ ├── stepresults
│ │ ├── flatten.clj
│ │ ├── merge.clj
│ │ └── merge_resolvers.clj
│ │ ├── steps
│ │ ├── control_flow.clj
│ │ ├── git.clj
│ │ ├── manualtrigger.clj
│ │ └── shell.clj
│ │ ├── stepstatus
│ │ ├── predicates.clj
│ │ └── unify.clj
│ │ ├── stepsupport
│ │ ├── chaining.clj
│ │ ├── killable.clj
│ │ ├── metadata.clj
│ │ └── output.clj
│ │ ├── ui
│ │ ├── api.clj
│ │ ├── core.clj
│ │ ├── internal
│ │ │ └── util.clj
│ │ └── ui_page.clj
│ │ └── util
│ │ └── internal
│ │ ├── async.clj
│ │ ├── bash.clj
│ │ ├── coll.clj
│ │ ├── exceptions.clj
│ │ ├── map.clj
│ │ ├── sugar.clj
│ │ └── temp.clj
├── cljs
│ └── lambdacd
│ │ ├── ajax.cljs
│ │ ├── api.cljs
│ │ ├── commons.cljs
│ │ ├── console_output_processor.cljs
│ │ ├── db.cljs
│ │ ├── history.cljs
│ │ ├── logic.cljs
│ │ ├── output.cljs
│ │ ├── pipeline.cljs
│ │ ├── route.cljs
│ │ ├── state.cljs
│ │ ├── time.cljs
│ │ ├── ui_core.cljs
│ │ └── utils.cljs
└── less
│ ├── _variables.less
│ ├── app.less
│ ├── history.less
│ ├── layout.less
│ ├── main.less
│ ├── pipeline.less
│ ├── resets.less
│ ├── step-results.less
│ └── tooltip.less
├── suppression.xml
├── test
├── clj
│ └── lambdacd
│ │ ├── core_test.clj
│ │ ├── event_bus_test.clj
│ │ ├── example
│ │ ├── pipeline_test.clj
│ │ └── steps_test.clj
│ │ ├── execution
│ │ └── internal
│ │ │ ├── build_metadata_test.clj
│ │ │ ├── execute_step_test.clj
│ │ │ ├── execute_steps_test.clj
│ │ │ ├── kill_test.clj
│ │ │ ├── pipeline_test.clj
│ │ │ ├── retrigger_test.clj
│ │ │ └── util_test.clj
│ │ ├── internal
│ │ ├── default_pipeline_state_persistence_test.clj
│ │ ├── default_pipeline_state_test.clj
│ │ └── running_builds_tracking_test.clj
│ │ ├── presentation
│ │ ├── pipeline_state_test.clj
│ │ ├── pipeline_structure_test.clj
│ │ └── unified_test.clj
│ │ ├── runners_test.clj
│ │ ├── smoketest
│ │ ├── pipeline.clj
│ │ ├── smoke_test.clj
│ │ └── steps.clj
│ │ ├── state
│ │ ├── core_test.clj
│ │ └── internal
│ │ │ ├── dead_steps_marking_test.clj
│ │ │ └── pipeline_state_updater_test.clj
│ │ ├── step_id_test.clj
│ │ ├── stepresults
│ │ ├── flatten_test.clj
│ │ ├── merge_resolvers_test.clj
│ │ └── merge_test.clj
│ │ ├── steps
│ │ ├── control_flow_test.clj
│ │ ├── git_test.clj
│ │ ├── manualtrigger_test.clj
│ │ └── shell_test.clj
│ │ ├── stepstatus
│ │ ├── predicates_test.clj
│ │ └── unify_test.clj
│ │ ├── stepsupport
│ │ ├── chaining_test.clj
│ │ ├── killable_test.clj
│ │ └── output_test.clj
│ │ ├── stress_test.clj
│ │ ├── testsupport
│ │ ├── data.clj
│ │ ├── matchers.clj
│ │ ├── matchers_test.clj
│ │ ├── noop_pipeline_state.clj
│ │ ├── reporter.clj
│ │ ├── test_util.clj
│ │ └── test_util_test.clj
│ │ ├── ui
│ │ └── internal
│ │ │ └── util_test.clj
│ │ └── util
│ │ └── internal
│ │ ├── bash_test.clj
│ │ ├── coll_test.clj
│ │ ├── exceptions_test.clj
│ │ ├── map_test.clj
│ │ ├── sugar_test.clj
│ │ └── temp_test.clj
└── cljs
│ └── lambdacd
│ ├── console_output_processor_test.cljs
│ ├── db_test.cljs
│ ├── dom_utils.cljs
│ ├── history_test.cljs
│ ├── logic_test.cljs
│ ├── output_test.cljs
│ ├── pipeline_test.cljs
│ ├── route_test.cljs
│ ├── runner.cljs
│ ├── state_test.cljs
│ ├── testdata.cljs
│ ├── testutils.cljs
│ ├── time_test.cljs
│ ├── ui_core_test.cljs
│ └── utils_test.cljs
└── visual-styleguide
└── src
└── cljs
└── lambdacd
├── styleguide.cljs
└── testcases.cljs
/.gitignore:
--------------------------------------------------------------------------------
1 | /target
2 | /classes
3 | /checkouts
4 | pom.xml
5 | pom.xml.asc
6 | *.jar
7 | *.class
8 | /.lein-*
9 | /.nrepl-port
10 | .idea
11 | *.iml
12 | .vagrant
13 | js-gen
14 | figwheel_server.log
15 | node_modules
16 | resources/public/css/pipeline.css
17 | resources/public/css/main.css
18 | gh-pages-api-doc-release
19 | resources/public/test
20 |
--------------------------------------------------------------------------------
/.talismanrc:
--------------------------------------------------------------------------------
1 | fileignoreconfig:
2 | - filename: package-lock.json
3 | checksum: 39475421dd2e096b43f2ec267cbb3ebc70b1b259f8d93297cbe9996400649577
4 | ignore_detectors: []
5 | scopeconfig: []
6 |
--------------------------------------------------------------------------------
/.tool-versions:
--------------------------------------------------------------------------------
1 | nodejs 15.11.0
2 | leiningen 2.9.6
3 | clojure 1.9.0.381
4 | java openjdk-16
5 | golang 1.16
6 |
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | dist: focal # run the build on ubuntu 20.04 for a recent nodejs version
2 |
3 | before_script:
4 | - ./scripts/travis_prebuild.sh
5 | - ./go deps
6 | language: clojure
7 | env:
8 | matrix:
9 | - CLOJURE_VERSION: 1.8.0
10 | - CLOJURE_VERSION: 1.9.0
11 | addons:
12 | chrome: stable
13 |
14 | script: ./go test && ./go check-style
15 |
16 | jobs:
17 | include:
18 | - stage: check dependencies for vulnerabilities
19 | script: travis_wait 30 ./go check-dependencies
20 | - stage: check for flakyness
21 | script: ./go test-clj-unit-repeat
22 | sudo: required
23 | group: edge
24 | cache:
25 | directories:
26 | - $HOME/.m2
27 | notifications:
28 | webhooks:
29 | urls:
30 | - https://webhooks.gitter.im/e/6e9d7b10030f609a46cc
31 | on_success: change # options: [always|never|change] default: always
32 | on_failure: always # options: [always|never|change] default: always
33 | on_start: never # options: [always|never|change] default: always
34 |
--------------------------------------------------------------------------------
/CODE_OF_CONDUCT.md:
--------------------------------------------------------------------------------
1 | # Contributor Covenant Code of Conduct
2 |
3 | ## Our Pledge
4 |
5 | In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, nationality, personal appearance, race, religion, or sexual identity and orientation.
6 |
7 | ## Our Standards
8 |
9 | Examples of behavior that contributes to creating a positive environment include:
10 |
11 | * Using welcoming and inclusive language
12 | * Being respectful of differing viewpoints and experiences
13 | * Gracefully accepting constructive criticism
14 | * Focusing on what is best for the community
15 | * Showing empathy towards other community members
16 |
17 | Examples of unacceptable behavior by participants include:
18 |
19 | * The use of sexualized language or imagery and unwelcome sexual attention or advances
20 | * Trolling, insulting/derogatory comments, and personal or political attacks
21 | * Public or private harassment
22 | * Publishing others' private information, such as a physical or electronic address, without explicit permission
23 | * Other conduct which could reasonably be considered inappropriate in a professional setting
24 |
25 | ## Our Responsibilities
26 |
27 | Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior.
28 |
29 | Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful.
30 |
31 | ## Scope
32 |
33 | This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers.
34 |
35 | ## Enforcement
36 |
37 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at florian.sellmayr@gmail.com. The project team will review and investigate all complaints, and will respond in a way that it deems appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately.
38 |
39 | Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership.
40 |
41 | ## Attribution
42 |
43 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at [http://contributor-covenant.org/version/1/4][version]
44 |
45 | [homepage]: http://contributor-covenant.org
46 | [version]: http://contributor-covenant.org/version/1/4/
47 |
--------------------------------------------------------------------------------
/CONTRIBUTING.md:
--------------------------------------------------------------------------------
1 | # Contribution Guide
2 |
3 | ## Contributions encouraged
4 |
5 | I'd love to hear from you! If you have a question, bug report, feature request or a pull request, please reach out.
6 |
7 | ## How to reach out
8 |
9 | The preferred way at the moment is to open issues on the [Github Issue Tracker](https://github.com/flosell/lambdacd/issues)
10 |
11 | If you want to contribute improvements to the LambdaCD codebase, open a pull request.
12 |
13 | ## How to open the perfect issue
14 |
15 | * Be specific and as detailed as you feel is necessary to understand the topic
16 | * Provide context (what were you trying to achive, what were you expecting, ...)
17 | * Code samples and logs can be really helpful. Consider [Gists](https://gist.github.com/) or links to other Github repos
18 | for larger pieces.
19 | * If the UI behaves in a strange way, have a look at your browsers development tools. The console and network traffic might give you some insight that's valuable for a bug report.
20 | * If you are reporting a bug, add steps to reproduce it.
21 |
22 | ## How to create the perfect pull request
23 |
24 | * Have a look into the [`README`](README.md#development) for details on how to work with the
25 | code
26 | * Follow the usual best practices for pull requests:
27 | * use a branch,
28 | * make sure you have pulled changes from upstream so that your change is easy to merge
29 | * follow the conventions in the code
30 | * keep a tidy commit history that speaks for itself, consider squashing commits where appropriate
31 | * Run all the tests: `./go test`
32 | * Add tests where possible (UI changes might be very hard to test for limited benefit so I'm more relaxed there)
33 | * Add an entry in [`CHANGELOG.md`](CHANGELOG.md) if you add new features, fix bugs or otherwise change LambdaCD in a way that you want
34 | users to be aware of. The entry goes into the section for the next release (which is the version number indicated in
35 | `project.clj`), usually the top one. If that section doesn't exist yet, add it.
36 |
37 | ## Contributing new features
38 |
39 | If you are building a new feature, consider if this needs to go into the core of LambdaCD. Lots of features
40 | (like support for another version control system, reusable build steps, nicer syntactic sugar, a different user interface
41 | and many others) can easily be maintained as a separate library.
42 | Have a look at [lambdacd-artifacts](https://github.com/flosell/lambdacd-artifacts) or [lambdacd-cctray](https://github.com/flosell/lambdacd-cctray)
43 | as an example. If in doubt, open an issue and ask.
44 |
45 | ## Contributing Documentation
46 |
47 | The main hub for documentation on LambdaCD is in the [wiki](https://github.com/flosell/lambdacd/wiki).
48 | It's writable for everyone so if you have something that's worth knowing for everybody, don't hesitate to add it!
49 |
--------------------------------------------------------------------------------
/Vagrantfile:
--------------------------------------------------------------------------------
1 | # -*- mode: ruby -*-
2 | # vi: set ft=ruby :
3 |
4 | # Vagrantfile API/syntax version. Don't touch unless you know what you're doing!
5 | VAGRANTFILE_API_VERSION = "2"
6 |
7 | Vagrant.configure(VAGRANTFILE_API_VERSION) do |config|
8 | config.vm.box = "hashicorp/precise64"
9 |
10 | config.vm.define :backend_ci do |backend_ci|
11 | backend_ci.vm.provision :shell, inline: 'sudo aptitude update && sudo aptitude install -y openjdk-7-jdk'
12 | backend_ci.vm.hostname = "backend-ci"
13 | backend_ci.vm.network "forwarded_port", guest: 8084, host: 18084
14 | end
15 |
16 | config.vm.define :frontend_ci do |frontend_ci|
17 | frontend_ci.vm.provision :shell, inline: 'sudo aptitude update && sudo aptitude install -y apache2 && sudo chown vagrant:vagrant /var/www'
18 | frontend_ci.vm.hostname = "frontend-ci"
19 | frontend_ci.vm.network "forwarded_port", guest: 80, host: 20080
20 | end
21 |
22 | end
23 |
--------------------------------------------------------------------------------
/ansiparse-externs.js:
--------------------------------------------------------------------------------
1 | function ansiparse(str) {}
2 | ansiparse.foregroundColors = {
3 | "30": {},
4 | "31": {},
5 | "32": {},
6 | "33": {},
7 | "34": {},
8 | "35": {},
9 | "36": {},
10 | "37": {},
11 | "90": {}
12 | }
13 | ansiparse.backgroundColors= {
14 | "40": {},
15 | "41": {},
16 | "42": {},
17 | "43": {},
18 | "44": {},
19 | "45": {},
20 | "46": {},
21 | "47": {}
22 | }
23 | ansiparse.styles = {
24 | "1": {},
25 | "3": {},
26 | "4": {}
27 | }
--------------------------------------------------------------------------------
/doc/FAQ.md:
--------------------------------------------------------------------------------
1 | # Frequently Asked Questions
2 |
3 | ## What is this?
4 | LambdaCD is a Clojure library that gives you the building blocks to write your own build-server.
5 | It's aim is to replace existing CI/CD tools with custom built pipeline services, defined completely in code.
6 |
7 | ## Why do I need this?
8 | Because code is a great way to express what we want! When your build pipeline is in code, you'll get
9 |
10 | * version control
11 | * refactoring
12 | * testing
13 | * reuse
14 | * dependency management
15 | * flexibility
16 | * power
17 |
18 | basically for free!
19 |
20 | ## Can I use this in my project?
21 | This project is still in it's early phase, so don't rely on everything being just perfect out of the box.
22 | But I do know people are using LambdaCD for serious work so it probably can work on your project as well.
23 |
24 | ## How do I do X?
25 |
26 | See [How To](howto.md)
27 |
28 | ## Does it support X?
29 | Probably not.
30 | As mentioned above, LambdaCD is a young project so your favorite feature might be missing. If this is the case, feel
31 | free to reach out or open a ticket so I know what people really need.
32 |
33 | Or even better: build the feature yourself! LambdaCD is meant to be extensible and since everything in your
34 | build-pipeline is code, lots of things should be straightforward to implement as code that runs in your build-step
35 | (e.g. support for another VCS, test result processing, custom control flow, ...).
36 |
37 | ## Can I display build results on my information radiator?
38 |
39 | There is a separate library to expose your build pipeline in cctray.xml format: [lambdacd-cctray](https://github.com/flosell/lambdacd-cctray)
40 | Most build pipeline monitors can read this format so you should be able to plug LambdaCD right in.
41 |
42 | ## Does LambdaCD support more than one pipeline?
43 | Yes, you can run as many pipelines as you wish in one instance of LambdaCD. Just define a second one and initialize
44 | it just like the first one.
45 |
46 |
--------------------------------------------------------------------------------
/doc/basic-clojure.md:
--------------------------------------------------------------------------------
1 | # Basic Clojure
2 |
3 | To try out LambdaCD, here's what you need to know:
4 |
5 | * How to install [Leiningen](http://leiningen.org/#install) (this is the build-tool we are using, like Maven in Java)
6 | * Syntax
7 | * `(foo "bar" 5)`: this executes the function `foo` with the arguments `"bar"` (which is a string) and `5` (an integer)
8 | * `{ :foo "bar" }`: this is a map with a key `:foo` mapping to a value `"bar"`
9 | * `(defn add [a b] (+ a b))`: this defines a function `add` with two parameters `a` and `b` that returns the sum of `a` and `b`
10 |
11 | * You'll also need an editor. [LightTable](http://www.lighttable.com/) is very popular at the moment, but you can really use anything. If you are used to IntelliJ, try out the [Cursive](https://cursiveclojure.com/userguide/)
12 |
13 | ## References
14 |
15 | This will most likely not be enough so here are some places with more detailed infos:
16 |
17 | * http://www.clojurenewbieguide.com/
18 | * http://tryclj.com/
19 | * http://clojure-doc.org/articles/tutorials/introduction.html
20 | * http://www.braveclojure.com/
21 |
--------------------------------------------------------------------------------
/doc/img/lambdacd-logo.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/doc/img/lambdacd-logo.png
--------------------------------------------------------------------------------
/doc/img/pipeline-overview.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/doc/img/pipeline-overview.png
--------------------------------------------------------------------------------
/doc/img/readme-screenshot.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/doc/img/readme-screenshot.png
--------------------------------------------------------------------------------
/env/dev/clj/lambdacd/dev.clj:
--------------------------------------------------------------------------------
1 | (ns ^:no-doc lambdacd.dev
2 | (:require [cemerick.piggieback :as piggieback]
3 | [weasel.repl.websocket :as weasel]
4 | [leiningen.core.main :as lein]))
5 |
6 | (defn browser-repl []
7 | (piggieback/cljs-repl :repl-env (weasel/repl-env :ip "0.0.0.0" :port 9001)))
8 |
9 | (defn start-figwheel []
10 | (future
11 | (print "Starting figwheel.\n")
12 | (lein/-main ["figwheel"])))
13 |
--------------------------------------------------------------------------------
/env/dev/cljs/lambdacd/dev.cljs:
--------------------------------------------------------------------------------
1 | (ns ^:figwheel-no-load lambdacd.dev
2 | (:require [lambdacd.ui-core :as core]
3 | [figwheel.client :as figwheel :include-macros true]
4 | [weasel.repl :as weasel]
5 | [lambdacd.testutils :refer [path]]
6 | [lambdacd.styleguide :as styleguide]
7 | [reagent.core :as r]))
8 |
9 | (enable-console-print!)
10 |
11 | (figwheel/watch-and-reload
12 | :websocket-url "ws://localhost:3449/figwheel-ws"
13 | :jsload-callback (fn []
14 | (r/force-update-all)))
15 |
16 | (defn- contains [s substr]
17 | (not= -1 (.indexOf s substr)))
18 |
19 | (defn initialize-app []
20 | (core/init!))
21 |
22 | (if (contains (path) "styleguide")
23 | (styleguide/initialize-styleguide)
24 | (initialize-app))
25 |
26 |
--------------------------------------------------------------------------------
/env/prod/cljs/lambdacd/prod.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.prod
2 | (:require [lambdacd.ui-core :as core]))
3 |
4 | (core/init!)
5 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "lambdacd",
3 | "devDependencies": {
4 | "autoprefixer": "6.6.0",
5 | "karma": "^6.3.16",
6 | "karma-chrome-launcher": "3.1.0",
7 | "karma-cli": "2.0.0",
8 | "karma-cljs-test": "0.1.0",
9 | "less": "2.7.1",
10 | "postcss-cli": "^7.1.1",
11 | "watch": "^0.13.0"
12 | },
13 | "scripts": {
14 | "build:css": "node_modules/less/bin/lessc src/less/main.less | node_modules/postcss-cli/bin/postcss --use autoprefixer -o resources/public/css/main.css",
15 | "build": "npm run build:css",
16 | "build:watch": "watch 'npm run build:css' src/less"
17 | }
18 | }
19 |
--------------------------------------------------------------------------------
/resources/logback.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
--------------------------------------------------------------------------------
/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/FontAwesome.otf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/FontAwesome.otf
--------------------------------------------------------------------------------
/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/fontawesome-webfont.eot:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/fontawesome-webfont.eot
--------------------------------------------------------------------------------
/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/fontawesome-webfont.ttf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/fontawesome-webfont.ttf
--------------------------------------------------------------------------------
/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/fontawesome-webfont.woff:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/fontawesome-webfont.woff
--------------------------------------------------------------------------------
/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/fontawesome-webfont.woff2:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/css/thirdparty/font-awesome-4.4.0/fonts/fontawesome-webfont.woff2
--------------------------------------------------------------------------------
/resources/public/favicon-16x16.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/favicon-16x16.png
--------------------------------------------------------------------------------
/resources/public/favicon-32x32.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/favicon-32x32.png
--------------------------------------------------------------------------------
/resources/public/favicon-96x96.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/favicon-96x96.png
--------------------------------------------------------------------------------
/resources/public/favicon.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/flosell/lambdacd/f538d4f5f914ba9dad7675b091565b0c0ca3fecb/resources/public/favicon.ico
--------------------------------------------------------------------------------
/resources/public/visualStyleguide.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | LambdaCD
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
--------------------------------------------------------------------------------
/scripts/github-release.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 |
3 | set -e
4 |
5 | # TODO: make sure the following is installed:
6 | # https://github.com/aktau/github-release
7 | # https://github.com/mtdowling/chag
8 | # $GITHUB_TOKEN is set
9 |
10 | SCRIPT_DIR=$(dirname "$0")
11 | cd ${SCRIPT_DIR}/..
12 |
13 | VERSION=$(chag latest)
14 | CHANGELOG=$(chag contents)
15 | USER="flosell"
16 | REPO="lambdacd"
17 |
18 | echo "Publishing Release to GitHub: "
19 | echo "Version ${VERSION}"
20 | echo "${CHANGELOG}"
21 | echo
22 |
23 | github-release release \
24 | --user ${USER} \
25 | --repo ${REPO} \
26 | --tag ${VERSION} \
27 | --name ${VERSION} \
28 | --description "${CHANGELOG}"
29 |
30 | echo "Published release"
--------------------------------------------------------------------------------
/scripts/migrate-to-new-package-structure.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 |
3 | function replaceInClj {
4 | find . -name '*.clj' -print0 | xargs -0 sed -i '' -e "s/$1/$2/g"
5 | }
6 |
7 | replaceInClj 'lambdacd\.manualtrigger' 'lambdacd\.steps\.manualtrigger'
8 | replaceInClj 'lambdacd\.control-flow' 'lambdacd\.steps\.control-flow'
9 | replaceInClj 'lambdacd\.git' 'lambdacd\.steps\.git'
10 | replaceInClj 'lambdacd\.shell' 'lambdacd\.steps\.shell'
11 |
12 | replaceInClj 'lambdacd\.json-model' 'lambdacd\.pipeline-state-persistence'
13 |
14 | replaceInClj 'lambdacd\.presentation([^.])' 'lambdacd\.presentation\.pipeline-structure$1'
15 |
16 | replaceInClj 'lambdacd\.execution' 'lambdacd\.internal\.execution'
17 |
18 | replaceInClj 'lambdacd.pipeline-state' 'lambdacd.internal.pipeline-state'
19 |
20 | replaceInClj 'lambdacd.new-ui' 'lambdacd.ui.new_ui'
21 | replaceInClj 'lambdacd.server' 'lambdacd.ui.ui-server'
--------------------------------------------------------------------------------
/scripts/testwrapper.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 | # pipefail so we can detect the error
3 | set -o pipefail
4 |
5 | # remove last argument, leiningen passes in the message from the compiler...
6 | set -- "${@:1:$(($#-1))}"
7 |
8 | function notify() {
9 | if which osascript > /dev/null; then
10 | if [ "$3" == "error" ]; then
11 | sound="sound name \"Basso\""
12 | fi
13 | osascript -e "display notification \"$2\" with title \"$1\" $sound"
14 | else
15 | echo "$1: $2"
16 | fi
17 | }
18 |
19 | $@ | tee /tmp/testout
20 |
21 | if [ $? -ne 0 ]; then
22 | error="error"
23 | echo "errored"
24 | fi
25 |
26 | notify "Test run" "$(cat /tmp/testout | tail -n 1)" ${error}
--------------------------------------------------------------------------------
/scripts/travis_prebuild.sh:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 |
3 | set -e
4 |
5 | # We have tests that deal with git. They need to have this set to pass
6 | git config --global user.email "you@example.com"
7 | git config --global user.name "Your Name"
8 |
9 | # install latest NPM so npm audit works
10 | npm i npm@latest -g
11 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/core.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.core
2 | "Main entrypoinint into LambdaCD. Provides core functionality to assemble an instance of LambdaCD that can run."
3 | (:use compojure.core)
4 | (:require [lambdacd.internal.default-pipeline-state :as default-pipeline-state]
5 | [lambdacd.event-bus :as event-bus]
6 | [lambdacd.internal.running-builds-tracking :as running-builds-tracking]
7 | [lambdacd.state.internal.pipeline-state-updater :as pipeline-state-updater]
8 | [clojure.tools.logging :as log]
9 | [lambdacd.runners :as runners]
10 | [lambdacd.execution.internal.kill :as kill]
11 | [lambdacd.execution.core :as execution-core]))
12 |
13 | (defn- add-shutdown-sequence! [ctx]
14 | (doto (Runtime/getRuntime)
15 | (.addShutdownHook (Thread. ^Runnable (fn []
16 | (log/info "Shutting down LambdaCD...")
17 | ((:shutdown-sequence (:config ctx)) ctx)))))
18 | ctx)
19 |
20 | (defn default-shutdown-sequence
21 | "Default behavior when shutting down a Pipeline. Kills runnning pipelines, stops runners and internal processes."
22 | [ctx]
23 | (runners/stop-runner ctx)
24 | (kill/kill-all-pipelines ctx)
25 | (pipeline-state-updater/stop-pipeline-state-updater ctx))
26 |
27 | (def ^{:doc "Default configuration if none other is specified"} default-config
28 | {:ms-to-wait-for-shutdown (* 10 1000)
29 | :shutdown-sequence default-shutdown-sequence
30 | :step-updates-per-sec 10
31 | :use-new-event-bus false})
32 |
33 | (defn- initialize-pipeline-state-updater [ctx]
34 | (let [updater (pipeline-state-updater/start-pipeline-state-updater ctx)]
35 | (assoc ctx :pipeline-state-updater updater)))
36 |
37 | (defn assemble-pipeline
38 | "Assemble various internal LambdaCD components into a unit ready to run.
39 |
40 | Returns a map that contains `:context` and `:pipeline-def`"
41 | ([pipeline-def config]
42 | (assemble-pipeline pipeline-def config (default-pipeline-state/new-default-pipeline-state config)))
43 | ([pipeline-def config pipeline-state-component]
44 | (let [context (-> {:config (merge default-config config)}
45 | (event-bus/initialize-event-bus)
46 | (running-builds-tracking/initialize-running-builds-tracking)
47 | (assoc :pipeline-state-component pipeline-state-component)
48 | (assoc :pipeline-def pipeline-def)
49 | (initialize-pipeline-state-updater)
50 | (add-shutdown-sequence!))]
51 | {:context context
52 | :pipeline-def pipeline-def})))
53 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/event_bus.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.event-bus
2 | "Entry-point into the LambdaCD event bus.
3 |
4 | The event-bus exists to decouple communication between various parts of LambdaCD and
5 | allow external libraries to act on or publish events in a LambdaCD instance.
6 |
7 | Usage example:
8 | ```clojure
9 | (let [subscription (subscribe ctx :some-topic)
10 | payloads (only-payload subscription)]
11 | (! result-ch (:payload result))
64 | (recur))))
65 | result-ch))
66 |
67 | (defn unsubscribe
68 | "Unsubscribe from a channel.
69 | Receives the topic we want to unsubscribe from and the subscription channel returned by subscribe."
70 | [ctx topic subscription]
71 | (if (use-new-event-bus? ctx)
72 | (new/unsubscribe ctx topic subscription)
73 | (legacy/unsubscribe ctx topic subscription)))
74 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/event_bus_legacy.clj:
--------------------------------------------------------------------------------
1 | (ns ^:no-doc lambdacd.event-bus-legacy
2 | (:require [clojure.core.async :as async]))
3 |
4 | (defn initialize-event-bus [ctx]
5 | (let [publisher-ch (async/chan)
6 | publication (async/pub publisher-ch :topic)]
7 | (assoc ctx :event-publisher publisher-ch
8 | :event-publication publication)))
9 |
10 | (defmacro publish! [ctx topic payload]
11 | `(async/>! (:event-publisher ~ctx) {:topic ~topic :payload ~payload}))
12 |
13 | (defmacro publish!! [ctx topic payload]
14 | `(async/>!! (:event-publisher ~ctx) {:topic ~topic :payload ~payload}))
15 |
16 | (defn subscribe [ctx topic]
17 | (let [result-ch (async/chan)]
18 | (async/sub (:event-publication ctx) topic result-ch)
19 | result-ch))
20 |
21 | (defn- drain [ch]
22 | (async/go-loop []
23 | (if (async/! (publisher-ch ~ctx ~topic) {:topic ~topic :payload ~payload}))
24 |
25 | (defmacro publish!! [ctx topic payload]
26 | `(async/>!! (publisher-ch ~ctx ~topic) {:topic ~topic :payload ~payload}))
27 |
28 | (defn subscribe [ctx topic]
29 | (let [result-ch (async/chan)]
30 | (async/tap (subscriber-mult ctx topic) result-ch)
31 | result-ch))
32 |
33 | (defn- drain [ch]
34 | (async/go-loop []
35 | (if (async/ (run-pipeline pipeline ctx)
15 | {:status :success
16 | :outputs {[1] {:status :success}
17 | [2] {:status :success
18 | :outputs {[1 2} {:status :success}}
19 | ```"
20 | [pipeline ctx]
21 | (pipeline/run-pipeline pipeline ctx (state/next-build-number ctx) {}))
22 |
23 | (defn retrigger-pipeline
24 | "Retriggers a previous build of the pipeline, starting from a particular step-id.
25 | Returns the full results of the pipeline execution (see run-pipeline for details)"
26 | [pipeline context build-number step-id-to-run next-build-number]
27 | (let [new-ctx (assoc context :retriggered-build-number build-number
28 | :retriggered-step-id step-id-to-run)
29 | initial-build-metadata (or
30 | (state/get-build-metadata new-ctx (:retriggered-build-number new-ctx))
31 | {})]
32 | (pipeline/run-pipeline pipeline new-ctx next-build-number initial-build-metadata)))
33 |
34 | (defn retrigger-pipeline-async
35 | "Retriggers a previous build of the pipeline asynchronously and returning only the build number of the new pipeline-execution."
36 | [pipeline context build-number step-id-to-run]
37 | (let [next-build-number (state/next-build-number context)]
38 | (async/thread
39 | (retrigger-pipeline pipeline context build-number step-id-to-run next-build-number))
40 | next-build-number))
41 |
42 | (defn execute-step
43 | "Execute a single step within a pipeline execution.
44 | Takes the arguments to pass to the step, the ctx and the step-function to call.
45 | Often used when implementing container steps (i.e. steps that call other, child steps)."
46 | ([args ctx step]
47 | (execute-step/execute-step args [ctx step]))
48 | ([args [ctx step]]
49 | (execute-step/execute-step args [ctx step])))
50 |
51 | (defn execute-steps
52 | "Execute a number of steps in a particular way (configured by opts). Usually used when implementing container steps (i.e. steps that call other, child steps).
53 |
54 | Opts:
55 |
56 | * `:step-results-producer` A function that can execute a set of steps and return a step result in the end. Defaults to serial execution
57 | * `:is-killed` An atom with vaule true or false if the parent step needs control over when child steps are killed. Optional
58 | * `:unify-results-fn` A function that takes a collection of step results and returns a single step result that will be the result of the step while it is in progress. Used to control the parent
59 | * `:retrigger-predicate` A function that takes a steps context and the step itself and returns a keyword on what to do when retriggering: `:run` if the step should just run normally, `:rerun` if we rerun a step that ran before or `:mock` if we just mock the steps run by returning the previous result. Defaults to behavior that makes sense of steps run in sequence."
60 | [steps args ctx & opts]
61 | (apply execute-steps/execute-steps steps args ctx opts))
62 |
63 | (defn kill-step
64 | "Send an event to kill a particular step and return immediately."
65 | [ctx build-number step-id]
66 | (kill/kill-step ctx build-number step-id))
67 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/execution/internal/build_metadata.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.build-metadata
2 | (:require [lambdacd.state.core :as state]))
3 |
4 | (defn- validate-metadata [x]
5 | (associative? x))
6 |
7 | (defn add-metadata-atom [ctx initial-metadata]
8 | (let [metadata-atom (atom initial-metadata :validator validate-metadata)]
9 | (state/consume-build-metadata ctx (:build-number ctx) initial-metadata)
10 | (add-watch metadata-atom :update-state (fn [_ _ _ new]
11 | (state/consume-build-metadata ctx (:build-number ctx) new)))
12 | (assoc ctx :build-metadata-atom metadata-atom)))
13 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/execution/internal/execute_steps.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.execute-steps
2 | (:require [lambdacd.event-bus :as event-bus]
3 | [clojure.core.async :as async]
4 | [lambdacd.util.internal.sugar :refer [not-nil?]]
5 | [lambdacd.execution.internal.serial-step-result-producer :refer [serial-step-result-producer]]
6 | [lambdacd.step-id :as step-id]
7 | [lambdacd.execution.internal.kill :as kill]
8 | [lambdacd.execution.internal.retrigger :as retrigger]
9 | [lambdacd.stepstatus.unify :as unify]
10 | [lambdacd.stepresults.merge :as merge]))
11 |
12 | (defn- inherit-message-from-parent? [parent-ctx]
13 | (fn [msg]
14 | (let [msg-step-id (:step-id msg)
15 | parent-step-id (:step-id parent-ctx)
16 | msg-build (:build-number msg)
17 | parent-build (:build-number parent-ctx)
18 | msg-from-child? (step-id/direct-parent-of? parent-step-id msg-step-id)
19 | msg-from-same-build? (= parent-build msg-build)]
20 | (and msg-from-child? msg-from-same-build?))))
21 |
22 |
23 | (defn- to-context-and-step [ctx]
24 | (fn [idx step]
25 | (let [parent-step-id (:step-id ctx)
26 | new-step-id (step-id/child-id parent-step-id (inc idx))
27 | step-ctx (assoc ctx :step-id new-step-id)]
28 | [step-ctx step])))
29 |
30 | (defn contexts-for-steps
31 | "creates contexts for steps"
32 | [steps base-context]
33 | (map-indexed (to-context-and-step base-context) steps))
34 |
35 | (defn- process-inheritance [out-ch step-results-channel unify-results-fn]
36 | (async/go
37 | (let [dropping-output-ch (async/chan (async/sliding-buffer 1))]
38 | (async/pipe dropping-output-ch out-ch)
39 | (loop [results {}]
40 | (if-let [{step-id :step-id
41 | step-result :step-result} (async/! dropping-output-ch new-unified))
47 | (recur new-results))
48 | (async/close! dropping-output-ch))))))
49 |
50 | (defn- call-step-result-producer [step-result-producer]
51 | (fn [step-contexts-and-steps args _]
52 | (let [step-results (step-result-producer args step-contexts-and-steps)]
53 | (reduce merge/merge-two-step-results step-results))))
54 |
55 | (defn- wrap-inheritance [handler unify-results-fn]
56 | (fn [step-contexts-and-steps args ctx]
57 | (let [subscription (event-bus/subscribe ctx :step-result-updated)
58 | children-step-results-channel (->> subscription
59 | (event-bus/only-payload)
60 | (async/filter< (inherit-message-from-parent? ctx)))
61 | _ (process-inheritance (:result-channel ctx) children-step-results-channel unify-results-fn)
62 | result (handler step-contexts-and-steps args ctx)]
63 | (event-bus/unsubscribe ctx :step-result-updated subscription)
64 | result)))
65 |
66 | ; TODO: this should be in a namespace like lambdacd.execution.core?
67 | (defn execute-steps [steps args ctx & {:keys [step-result-producer is-killed unify-results-fn retrigger-predicate]
68 | :or {step-result-producer (serial-step-result-producer)
69 | is-killed (atom false)
70 | unify-results-fn (unify/unify-only-status unify/successful-when-all-successful)
71 | retrigger-predicate retrigger/sequential-retrigger-predicate}}]
72 | (let [handler-chain (-> (call-step-result-producer step-result-producer)
73 | (wrap-inheritance unify-results-fn)
74 | (kill/wrap-execute-steps-with-kill-handling is-killed)
75 | (retrigger/wrap-retrigger-handling retrigger-predicate))
76 | contexts-and-steps (contexts-for-steps (filter not-nil? steps) ctx)]
77 | (handler-chain contexts-and-steps args ctx)))
78 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/execution/internal/pipeline.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.pipeline
2 | (:require [clojure.core.async :as async]
3 | [lambdacd.execution.internal.execute-steps :as execute-steps]
4 | [lambdacd.presentation.pipeline-structure :as pipeline-structure]
5 | [lambdacd.execution.internal.build-metadata :as build-metadata]
6 | [lambdacd.state.core :as state]
7 | [lambdacd.event-bus :as event-bus]))
8 |
9 | (defn run-pipeline [pipeline ctx build-number initial-build-metadata]
10 | (let [runnable-pipeline (map eval pipeline)]
11 | (state/consume-pipeline-structure ctx build-number (pipeline-structure/pipeline-display-representation pipeline))
12 | (event-bus/publish!! ctx :pipeline-started {:build-number build-number})
13 | (let [full-result (execute-steps/execute-steps runnable-pipeline {} (-> ctx
14 | (assoc :result-channel (async/chan (async/dropping-buffer 0)))
15 | (assoc :build-number build-number)
16 | (assoc :step-id [])
17 | (build-metadata/add-metadata-atom initial-build-metadata)))]
18 | (event-bus/publish!! ctx :pipeline-finished (assoc full-result :build-number build-number))
19 | full-result)))
20 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/execution/internal/retrigger.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.retrigger
2 | (:require [lambdacd.state.core :as state]
3 | [lambdacd.step-id :as step-id]
4 | [lambdacd.execution.internal.util :as execution-util]))
5 |
6 |
7 | (defn- publish-child-step-results!! [ctx retriggered-build-number original-build-result]
8 | (->> original-build-result
9 | (filter #(step-id/parent-of? (:step-id ctx) (first %)))
10 | (map #(execution-util/send-step-result!! (assoc ctx :step-id (first %)) (assoc (second %) :retrigger-mock-for-build-number retriggered-build-number)))
11 | (doall)))
12 |
13 | (defn sequential-retrigger-predicate [ctx step]
14 | (let [cur-step-id (:step-id ctx)
15 | retriggered-step-id (:retriggered-step-id ctx)]
16 | (cond
17 | (or
18 | (step-id/parent-of? cur-step-id retriggered-step-id)
19 | (= cur-step-id retriggered-step-id)) :rerun
20 | (step-id/later-than? cur-step-id retriggered-step-id) :run
21 | :else :mock)))
22 |
23 | (defn retrigger-mock-step [retriggered-build-number]
24 | (fn [args ctx]
25 | (let [original-build-result (state/get-step-results ctx retriggered-build-number)
26 | original-step-result (get original-build-result (:step-id ctx))]
27 | (publish-child-step-results!! ctx retriggered-build-number original-build-result)
28 | (assoc original-step-result
29 | :retrigger-mock-for-build-number retriggered-build-number))))
30 |
31 | (defn- clear-retrigger-data [ctx]
32 | (assoc ctx
33 | :retriggered-build-number nil
34 | :retriggered-step-id nil))
35 |
36 | (defn- replace-step-with-retrigger-mock [retrigger-predicate [ctx step]]
37 | (let [retriggered-build-number (:retriggered-build-number ctx)]
38 | (case (retrigger-predicate ctx step)
39 | :rerun [ctx step]
40 | :run [(clear-retrigger-data ctx) step]
41 | :mock [ctx (retrigger-mock-step retriggered-build-number)])))
42 |
43 | (defn- add-retrigger-mocks [retrigger-predicate root-ctx step-contexts]
44 | (if (:retriggered-build-number root-ctx)
45 | (map (partial replace-step-with-retrigger-mock retrigger-predicate) step-contexts)
46 | step-contexts))
47 |
48 | (defn wrap-retrigger-handling [handler retrigger-predicate]
49 | (fn [step-contexts-and-steps args ctx]
50 | (handler (add-retrigger-mocks retrigger-predicate ctx step-contexts-and-steps)
51 | args
52 | ctx)))
53 |
54 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/execution/internal/serial_step_result_producer.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.serial-step-result-producer
2 | (:require [lambdacd.execution.internal.execute-step :as execute-step]
3 | [lambdacd.execution.internal.util :as execution-util]))
4 |
5 | (defn- keep-original-args [old-args step-result]
6 | (merge old-args step-result))
7 |
8 | (defn args-for-subsequent-step [parent-step-args current-step-args execute-step-result]
9 | (->> (first (vals (:outputs execute-step-result)))
10 | (execution-util/keep-globals current-step-args)
11 | (keep-original-args parent-step-args)))
12 |
13 | (defn serial-step-result-producer [& {:keys [stop-predicate] ; TODO: should this be in a public namespace?
14 | :or {stop-predicate execution-util/not-success?}}]
15 | (fn [args s-with-id]
16 | (loop [result ()
17 | remaining-steps-with-id s-with-id
18 | cur-args args]
19 | (if (empty? remaining-steps-with-id)
20 | result
21 | (let [ctx-and-step (first remaining-steps-with-id)
22 | step-result (execute-step/execute-step cur-args ctx-and-step)
23 | new-result (cons step-result result)
24 | new-args (args-for-subsequent-step args cur-args step-result)]
25 | (if (stop-predicate step-result)
26 | new-result
27 | (recur (cons step-result result) (rest remaining-steps-with-id) new-args)))))))
28 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/execution/internal/util.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.util
2 | (:require [lambdacd.event-bus :as event-bus]
3 | [lambdacd.stepresults.merge-resolvers :as merge-resolvers]
4 | [lambdacd.stepresults.merge :as merge]))
5 |
6 | (defn send-step-result!! [{step-id :step-id build-number :build-number :as ctx} step-result]
7 | (let [payload {:build-number build-number
8 | :step-id step-id
9 | :step-result step-result}]
10 | (event-bus/publish!! ctx :step-result-updated payload)))
11 |
12 | (defn not-success? [step-result]
13 | (not= :success (:status step-result)))
14 |
15 | (defn keep-globals [old-args step-result] ; TODO: is this the right place for this function?
16 | (let [existing-globals (:global old-args)
17 | new-globals (:global step-result)
18 | merged-globals (merge existing-globals new-globals)
19 | args-with-old-and-new-globals (assoc step-result :global merged-globals)]
20 | args-with-old-and-new-globals))
21 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/internal/default_pipeline_state.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.internal.default-pipeline-state
2 | "responsible to manage the current state of the pipeline
3 | i.e. what's currently running, what are the results of each step, ..."
4 | (:require [lambdacd.internal.default-pipeline-state-persistence :as persistence]
5 | [clj-time.core :as t]
6 | [lambdacd.state.protocols :as protocols]
7 | [clojure.data :as data]))
8 |
9 | (def clean-pipeline-state {})
10 |
11 | (defn initial-pipeline-state [{home-dir :home-dir}]
12 | (persistence/read-build-state-from home-dir))
13 |
14 | (defn- update-step-result [new-step-result current-step-result]
15 | (let [now (t/now)]
16 | (-> new-step-result
17 | (assoc :most-recent-update-at now)
18 | (assoc :first-updated-at (or (:first-updated-at current-step-result) now))
19 | (merge new-step-result))))
20 |
21 | (defn- update-step-result-in-state [build-number step-id new-step-result current-state]
22 | (update-in current-state [build-number step-id] #(update-step-result new-step-result %)))
23 |
24 | (defn- truncate-build-history [home-dir max-builds state]
25 | (let [new-state (->> state
26 | (sort-by key >)
27 | (take max-builds)
28 | (into {}))
29 | [only-in-old _ _] (data/diff (set (keys state)) (set (keys new-state)))]
30 | (persistence/clean-up-old-builds home-dir only-in-old)
31 | new-state))
32 |
33 | (defn- most-recent-build-number-in-state [pipeline-state]
34 | (if-let [current-build-number (last (sort (keys pipeline-state)))]
35 | current-build-number
36 | 0))
37 |
38 | (defrecord DefaultPipelineState [state-atom structure-atom build-metadata-atom home-dir max-builds]
39 | protocols/PipelineStructureConsumer
40 | (consume-pipeline-structure [self build-number pipeline-structure-representation]
41 | (swap! structure-atom #(assoc % build-number pipeline-structure-representation))
42 | (persistence/write-build-data-edn home-dir build-number pipeline-structure-representation "pipeline-structure.edn"))
43 | protocols/PipelineStructureSource
44 | (get-pipeline-structure [self build-number]
45 | (get @structure-atom build-number))
46 | protocols/BuildMetadataConsumer
47 | (consume-build-metadata [self build-number metadata]
48 | (swap! build-metadata-atom #(assoc % build-number metadata))
49 | (persistence/write-build-data-edn home-dir build-number metadata "build-metadata.edn"))
50 | protocols/BuildMetadataSource
51 | (get-build-metadata [self build-number]
52 | (get @build-metadata-atom build-number))
53 |
54 | protocols/StepResultUpdateConsumer
55 | (consume-step-result-update [self build-number step-id step-result]
56 | (let [new-state (swap! state-atom #(->> %
57 | (update-step-result-in-state build-number step-id step-result)
58 | (truncate-build-history home-dir max-builds)))]
59 | (persistence/write-build-history home-dir build-number new-state)))
60 |
61 | protocols/QueryStepResultsSource
62 | (get-step-results [self build-number]
63 | (get @state-atom build-number))
64 | protocols/NextBuildNumberSource
65 | (next-build-number [self]
66 | (inc (most-recent-build-number-in-state @state-atom)))
67 | protocols/QueryAllBuildNumbersSource
68 | (all-build-numbers [self]
69 | (-> @state-atom
70 | (keys)
71 | (sort))))
72 |
73 | (defn new-default-pipeline-state [config & {:keys [initial-state-for-testing]}]
74 | (let [home-dir (:home-dir config)
75 | state-atom (atom (or initial-state-for-testing (initial-pipeline-state config)))
76 | structure-atom (atom (persistence/read-normal-build-data-from home-dir "pipeline-structure.edn"))
77 | build-metadata-atom (atom (persistence/read-normal-build-data-from home-dir "build-metadata.edn"))
78 | max-builds (or (:max-builds config) Integer/MAX_VALUE)
79 | instance (->DefaultPipelineState state-atom structure-atom build-metadata-atom home-dir max-builds)]
80 | instance))
81 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/internal/default_pipeline_state_persistence.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.internal.default-pipeline-state-persistence
2 | "stores the current build history on disk"
3 | (:import (java.util.regex Pattern)
4 | (org.joda.time DateTime)
5 | (java.util Date))
6 | (:require [clojure.string :as str]
7 | [lambdacd.util.internal.sugar :as sugar]
8 | [clojure.java.io :as io]
9 | [clj-time.coerce :as c]
10 | [clojure.edn :as edn]
11 | [clojure.walk :as walk]
12 | [me.raynes.fs :as fs]
13 | [clojure.tools.logging :as log]))
14 |
15 | (defn convert-if-instance [c f]
16 | (fn [x]
17 | (if (instance? c x)
18 | (f x)
19 | x)))
20 |
21 | (defn clj-times->dates [m]
22 | (walk/postwalk (convert-if-instance DateTime c/to-date) m))
23 |
24 | (defn dates->clj-times [m]
25 | (walk/postwalk (convert-if-instance Date c/to-date-time) m))
26 |
27 | (defn- formatted-step-id [step-id]
28 | (str/join "-" step-id))
29 |
30 | (defn- unformat-step-id [formatted-step-id]
31 | (map sugar/parse-int (str/split formatted-step-id (Pattern/compile "-"))))
32 |
33 | (defn- step-result->step-result-with-formatted-step-ids [[k v]]
34 | {:step-id (formatted-step-id k) :step-result v})
35 |
36 | (defn- pipeline-state->formatted-step-ids [pipeline-state]
37 | (map step-result->step-result-with-formatted-step-ids pipeline-state))
38 |
39 | (defn- step-result-with-formatted-step-ids->step-result [{step-result :step-result step-id :step-id}]
40 | {(unformat-step-id step-id) step-result})
41 |
42 | (defn- formatted-step-ids->pipeline-state [m]
43 | (into {} (map step-result-with-formatted-step-ids->step-result m)))
44 |
45 | (defn find-build-number-in-path [path]
46 | (second (re-find #"build-(\d+)" (str path))))
47 |
48 | (defn- build-state-path [dir]
49 | (io/file dir "build-state.edn"))
50 |
51 | (defn- write-build-edn [path build]
52 | (let [serializable-build (clj-times->dates (pipeline-state->formatted-step-ids build))
53 | state-as-edn-string (pr-str serializable-build)]
54 | (spit path state-as-edn-string)))
55 |
56 | (defn- build-dirs [home-dir]
57 | (let [dir (io/file home-dir)
58 | home-contents (file-seq dir)
59 | directories-in-home (filter #(.isDirectory %) home-contents)]
60 | directories-in-home))
61 |
62 | (defn- build-dir [home-dir build-number]
63 | (let [result (str home-dir "/" "build-" build-number)]
64 | (.mkdirs (io/file result))
65 | result))
66 |
67 | (defn write-build-history [home-dir build-number new-state]
68 | (if home-dir
69 | (let [dir (build-dir home-dir build-number)
70 | edn-path (build-state-path dir)
71 | build (get new-state build-number)]
72 | (write-build-edn edn-path build))))
73 |
74 | (defn file-exists? [f]
75 | (.exists f))
76 |
77 | (defn write-build-data-edn [home-dir build-number pipeline-data filename]
78 | (let [f (io/file (build-dir home-dir build-number) filename)]
79 | (spit f (pr-str pipeline-data))))
80 |
81 | (defn- read-edn-file [path]
82 | (if (file-exists? path)
83 | (edn/read-string (slurp path))))
84 |
85 | (defn- build-files [home-dir filename]
86 | (map #(io/file % filename) (build-dirs home-dir)))
87 |
88 | (defn- process-build-data-file [f post-processor]
89 | (if-let [build-number-str (find-build-number-in-path f)]
90 | (post-processor (read-edn-file f) (sugar/parse-int build-number-str))
91 | (log/debug f "doesn't seem to contain a valid build number, skipping")))
92 |
93 | (defn- read-and-process-data-files [home-dir filename post-processor]
94 | (->> (build-files home-dir filename)
95 | (map #(process-build-data-file % post-processor))
96 | (into {})))
97 |
98 | (defn- post-process-build-state-edn [data build-number]
99 | (if data
100 | {build-number (formatted-step-ids->pipeline-state (dates->clj-times data))}))
101 |
102 | (defn- post-process-pipeline-structure-edn [data build-number]
103 | {build-number (or data :fallback)})
104 |
105 | (defn read-normal-build-data-from [home-dir filename]
106 | (read-and-process-data-files home-dir filename post-process-pipeline-structure-edn))
107 |
108 | (defn read-build-state-from [home-dir]
109 | (read-and-process-data-files home-dir "build-state.edn" post-process-build-state-edn))
110 |
111 | (defn clean-up-old-builds [home-dir old-build-numbers]
112 | (doall (map (fn [old-build-number]
113 | (fs/delete-dir (build-dir home-dir old-build-number))) old-build-numbers)))
114 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/internal/running_builds_tracking.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.internal.running-builds-tracking
2 | (:require [lambdacd.event-bus :as event-bus]
3 | [clojure.core.async :as async]))
4 |
5 | (defn- running-step-record [payload]
6 | {:step-id (:step-id payload)
7 | :build-number (:build-number payload)})
8 |
9 | (defn initialize-running-builds-tracking [ctx]
10 | (let [steps-started-subscription (event-bus/subscribe ctx :step-started)
11 | steps-started-payload (event-bus/only-payload steps-started-subscription)
12 |
13 | steps-finished-subscription (event-bus/subscribe ctx :step-finished)
14 | steps-finished-payload (event-bus/only-payload steps-finished-subscription)
15 | started-steps (atom #{})]
16 | (async/go-loop []
17 | (if-let [payload (async/ (let [pipeline-structure (state/get-pipeline-structure ctx build-number)
21 | step-results (state/get-step-results ctx build-number)]
22 | (unified/pipeline-structure-with-step-results pipeline-structure step-results))
23 | [{:name \"in-parallel\"
24 | :type :parallel
25 | :step-id '(1)
26 | :has-dependencies false
27 | :result {:status :running}
28 | :children
29 | [{:name \"do-stuff\"
30 | :type :step
31 | :step-id '(1 1)
32 | :has-dependencies false
33 | :children []
34 | :result {:status :failure
35 | :out \"do stuff failed\"}}]}
36 | {:name \"do-other-stuff\"
37 | :type :step
38 | :step-id '(2 1)
39 | :has-dependencies false
40 | :children []
41 | :result {:status :running
42 | :some-key :some-value}}]}]}]
43 |
44 | ```"
45 | [pipeline-structure step-results]
46 | (map #(unify-step % step-results) pipeline-structure))
47 |
48 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/runners.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.runners
2 | "Runners are what keeps a pipeline going. The start new builds based on some logic,
3 | e.g. when the previous build is finished or (e.g if the first step is a trigger) after the first step is done."
4 | (:require [lambdacd.execution.core :as execution]
5 | [clojure.core.async :as async]
6 | [lambdacd.event-bus :as event-bus]
7 | [clojure.tools.logging :as log]))
8 |
9 | (defn- is-first-step? [step-finished-msg]
10 | (= (:step-id step-finished-msg) [1]))
11 |
12 | (defn- is-not-retriggered? [step-finished-msg]
13 | (and
14 | (not (:retrigger-mock-for-build-number (:final-result step-finished-msg)))
15 | (not (:rerun-for-retrigger step-finished-msg))))
16 |
17 | (def ^:private should-trigger-next-build?
18 | (every-pred is-first-step? is-not-retriggered?))
19 |
20 | (defmacro while-not-stopped
21 | "Execute a runners body until it is stopped from the outside (usually by someone calling `stop-runner`, e.g. on shutdown)."
22 | [ctx & body]
23 | `(let [running# (atom true)]
24 | (async/go
25 | (async/ step
16 | (assoc :pipeline-structure-fallback true)
17 | (annotate-children))))
18 |
19 | (defn- annotated-fallback-structure [ctx]
20 | (let [current-structure (pipeline-structure/pipeline-display-representation (:pipeline-def ctx))]
21 | (map annotated-step current-structure)))
22 |
23 | (defn- stored-structure-or-fallback [ctx build-number]
24 | (let [stored-structure (protocols/get-pipeline-structure (state-component ctx) build-number)]
25 | (if (= :fallback stored-structure)
26 | (annotated-fallback-structure ctx)
27 | stored-structure)))
28 |
29 | (defn- stored-metadata-or-fallback [ctx build-number]
30 | (let [stored-metadata (protocols/get-build-metadata (state-component ctx) build-number)]
31 | (if (= :fallback stored-metadata)
32 | {}
33 | stored-metadata)))
34 |
35 | ; -------------------------------------------------------------------------
36 |
37 | (defn consume-step-result-update
38 | "Update a step-result in the state"
39 | [ctx build-number step-id step-result]
40 | (let [component (state-component ctx)]
41 | (if (satisfies? protocols/StepResultUpdateConsumer component)
42 | (protocols/consume-step-result-update component build-number step-id step-result))))
43 |
44 | (defn consume-pipeline-structure
45 | "Update the pipeline structure in the state"
46 | [ctx build-number pipeline-structure-representation]
47 | (let [component (state-component ctx)]
48 | (if (satisfies? protocols/PipelineStructureConsumer component)
49 | (protocols/consume-pipeline-structure component build-number pipeline-structure-representation))))
50 |
51 | (defn consume-build-metadata
52 | "Update build metdata in the state"
53 | [ctx build-number metadata]
54 | (let [component (state-component ctx)]
55 | (if (satisfies? protocols/BuildMetadataConsumer component)
56 | (protocols/consume-build-metadata component build-number metadata))))
57 |
58 | (defn next-build-number
59 | "Returns the build number for the next build"
60 | [ctx]
61 | (let [component (state-component ctx)]
62 | (if (satisfies? protocols/NextBuildNumberSource component)
63 | (protocols/next-build-number component))))
64 |
65 | (defn all-build-numbers
66 | "Returns all existing build numbers"
67 | [ctx]
68 | (let [component (state-component ctx)]
69 | (if (satisfies? protocols/QueryAllBuildNumbersSource component)
70 | (protocols/all-build-numbers component))))
71 |
72 | (defn get-step-results
73 | "Returns a map from step-ids to step-results"
74 | [ctx build-number]
75 | (dead-steps-marking/mark-dead-steps ctx build-number
76 | (let [component (state-component ctx)]
77 | (if (satisfies? protocols/QueryStepResultsSource component)
78 | (protocols/get-step-results component build-number)))))
79 |
80 | (defn get-step-result
81 | "Returns a map containing the result of one step"
82 | [ctx build-number step-id]
83 | (get (get-step-results ctx build-number)
84 | step-id))
85 |
86 | (defn get-pipeline-structure
87 | "Returns a map describing the structure of the pipeline"
88 | [ctx build-number]
89 | (let [component (state-component ctx)]
90 | (if (satisfies? protocols/PipelineStructureSource component)
91 | (stored-structure-or-fallback ctx build-number))))
92 |
93 | (defn get-build-metadata
94 | "Returns a map describing metadata of a build"
95 | [ctx build-number]
96 | (let [component (state-component ctx)]
97 | (if (satisfies? protocols/BuildMetadataSource component)
98 | (stored-metadata-or-fallback ctx build-number)
99 | {})))
100 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/state/internal/dead_steps_marking.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.state.internal.dead-steps-marking
2 | (:require [lambdacd.internal.running-builds-tracking :as running-builds-tracking]
3 | [lambdacd.stepstatus.predicates :as predicates]))
4 |
5 | (defn- old-status-or-dead [ctx build-number step-id status]
6 | (if (and (not (running-builds-tracking/is-running? ctx build-number step-id))
7 | (predicates/is-active? status))
8 | :dead
9 | status))
10 |
11 | (defn- mark-dead-step [ctx build-number [step-id step-result]]
12 | [step-id (update step-result :status #(old-status-or-dead ctx build-number step-id %))])
13 |
14 | (defn mark-dead-steps [ctx build-number step-results]
15 | (if step-results
16 | (->> step-results
17 | (map #(mark-dead-step ctx build-number %1))
18 | (into {}))))
19 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/state/internal/pipeline_state_updater.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.state.internal.pipeline-state-updater
2 | (:require [clojure.tools.logging :as log]
3 | [clojure.core.async :as async]
4 | [lambdacd.event-bus :as event-bus]
5 | [lambdacd.state.core :as state]
6 | [lambdacd.util.internal.async :as async-util]))
7 |
8 | (defn start-pipeline-state-updater [ctx]
9 | (let [step-updates-channel (async-util/buffered
10 | (event-bus/only-payload
11 | (event-bus/subscribe ctx :step-result-updated)))
12 | stop-updater-channel (event-bus/only-payload
13 | (event-bus/subscribe ctx :stop-pipeline-state-updater))]
14 | (async/go-loop []
15 | (if-let [[step-result-update ch] (async/alts! [step-updates-channel stop-updater-channel])]
16 | (when (not= stop-updater-channel ch)
17 | (let [step-result (:step-result step-result-update)
18 | build-number (:build-number step-result-update)
19 | step-id (:step-id step-result-update)]
20 | (state/consume-step-result-update ctx build-number step-id step-result)
21 | (event-bus/publish! ctx :step-result-update-consumed step-result-update)
22 | (recur)))))))
23 |
24 | (defn stop-pipeline-state-updater [ctx]
25 | (log/info "Shutting down pipeline state updater...")
26 | (event-bus/publish!! ctx :stop-pipeline-state-updater {})
27 | (async/ (count a) (count b))
42 | (> x y))))
43 |
44 | (defn before?
45 | "Returns true if for two steps, the step with id b is executed after a in the pipeline."
46 | [a b]
47 | (and
48 | (not= a b)
49 | (not (later-than? a b))))
50 |
51 | (defn child-id
52 | "Returns a step id for the `child-number`th child of the step with id `parent-step-id`."
53 | [parent-step-id child-number]
54 | (cons child-number parent-step-id))
55 |
56 | (defn root-step-id?
57 | "Returns true if the step-id belongs to a root-step, i.e. a step with no parents."
58 | [step-id]
59 | (= 1 (count step-id)))
60 |
61 | (defn root-step-id-of
62 | "Returns the id of the root-parent of the step with the given id."
63 | [step-id]
64 | (last step-id))
65 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/stepresults/flatten.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepresults.flatten
2 | "Functions to convert a nested step result and transform it into a flat list")
3 |
4 | (defn flatten-step-result-outputs
5 | "Takes a nested step-result map (like those returned by a step or sent in a:pipeline-finished event)
6 | and converts it into a flat map of step results where every step is accessible with its step-id:
7 | ```clojure
8 | > (flatten-step-result-outputs {[1] {:status :success}
9 | [2] {:status :success
10 | :outputs {[1 2] {:status :success :step [1 2]}}}})
11 | {[1] {:status :success}
12 | [2] {:status :success
13 | :outputs {[1 2] {:status :success :step [1 2]}}}
14 | [1 2] {:status :success :step [1 2]}}
15 | ```"
16 | [outputs]
17 | (into {}
18 | (for [[k v] outputs]
19 | (if (:outputs v)
20 | (assoc (flatten-step-result-outputs (:outputs v)) k v)
21 | {k v}))))
22 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/stepresults/merge.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepresults.merge
2 | "Functions that can help merge several step results into one"
3 | (:require [lambdacd.stepresults.merge-resolvers :as merge-resolvers]
4 | [lambdacd.util.internal.map :as map-utils]))
5 |
6 | (defn merge-step-results
7 | "Takes a list of step results (e.g. whats in the `:outputs` key of a nesting step-result)
8 | and merges it into one step result with the help of a function that can merge two step results:
9 |
10 | ```clojure
11 | > (merge-step-results [{:status :success}
12 | {:foo :bar}
13 | {:foo :baz}]
14 | merge)
15 | {:status :success
16 | :foo :baz}
17 | ```"
18 | [step-results merge-two-results-fn]
19 | (reduce merge-two-results-fn {} step-results))
20 |
21 |
22 | (defn- resolve-first-matching [resolvers]
23 | (fn [k v1 v2]
24 | (->> resolvers
25 | (map #(% k v1 v2))
26 | (filter (complement nil?))
27 | (first))))
28 |
29 | (defn merge-two-step-results
30 | "Takes two step results and merges them:
31 |
32 | ```clojure
33 | > (merge-two-step-results {:status :failure
34 | :m {:a :b}
35 | :s \"a\"}
36 | {:status :success
37 | :m {:b :c}
38 | :s \"b\"})
39 | {:status :failure
40 | :m {:a :b
41 | :b :c}
42 | :s \"b\"}
43 | ```
44 |
45 | Optionally, `merge-two-step-results` takes a list of functions to customize how to resolve conflicts.
46 | Resolver-functions take the key where the conflict occurred and the two values and a merged result or nil if they can't merge the conflict.
47 | If one resolver can't resolve a conflict, the next one in the list is tried."
48 | [a b & {:keys [resolvers]
49 | :or {resolvers [merge-resolvers/status-resolver
50 | merge-resolvers/merge-nested-maps-resolver
51 | merge-resolvers/combine-to-list-resolver
52 | merge-resolvers/second-wins-resolver]}}]
53 | (map-utils/merge-with-k-v (resolve-first-matching resolvers) a b))
54 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/stepresults/merge_resolvers.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepresults.merge-resolvers
2 | "Contains functions that can act as resolvers in merge-two-step-results
3 | by returning a merged result of two values if they match or nil if they don't."
4 | (:require [clojure.string :as s]))
5 |
6 | (defn- choose-last-or-not-success
7 | ([s1 s2]
8 | (if (= s1 :success)
9 | s2
10 | (if (= s2 :success)
11 | s1
12 | s2))))
13 |
14 | (defn merge-nested-maps-resolver
15 | "Resolver that merges two given maps with the default clojure `merge`."
16 | [_ v1 v2]
17 | (when (and (map? v1) (map? v2))
18 | (merge v1 v2)))
19 |
20 | (defn status-resolver
21 | "Resolver that resolves only the :status key with the `last-or-not-success` function."
22 | [k v1 v2]
23 | (when (= k :status)
24 | (choose-last-or-not-success v1 v2)))
25 |
26 | (defn second-wins-resolver
27 | "Resolver that always returns the second (usually newer) value."
28 | [_ _ v2]
29 | v2)
30 |
31 | (defn combine-to-list-resolver
32 | "Resolver that concatenates two list values or a value onto an existing list."
33 | [_ v1 v2]
34 | (cond
35 | (and (coll? v1) (coll? v2)) (into v1 v2)
36 | (coll? v1) (merge v1 v2)
37 | :else nil))
38 |
39 | (defn join-output-resolver
40 | "Resolver that joins two strings in the :out key with newlines."
41 | [k v1 v2]
42 | (when (and (= :out k)
43 | (string? v1)
44 | (string? v2))
45 | (s/join "\n" [v1 v2])))
46 |
47 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/steps/manualtrigger.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.steps.manualtrigger
2 | "Build step that waits for manual user interaction.
3 |
4 | Example:
5 | ```clojure
6 | > (wait-for-manual-trigger args ctx) ; Blocks, but setting `:trigger-id` in step-result to a random UUID
7 | > (post-id ctx trigger-id trigger-parameters) ; Returns immediately, unblocks the waiting manual trigger
8 | ```
9 | "
10 | (:require [clojure.core.async :as async]
11 | [clojure.tools.logging :as log]
12 | [lambdacd.event-bus :as event-bus]
13 | [lambdacd.stepsupport.killable :as killable])
14 | (:import (java.util UUID)))
15 |
16 | (defn post-id
17 | "Entrypoint for UI and others to release a waiting trigger identified by an ID."
18 | [ctx id trigger-parameters]
19 | (log/info "received parameterized trigger with id " id " with data " trigger-parameters)
20 | (event-bus/publish!! ctx :manual-trigger-received {:trigger-id id
21 | :trigger-parameters trigger-parameters}))
22 |
23 | (defn- wait-for-trigger-event-while-not-killed [ctx trigger-events expected-trigger-id]
24 | (loop []
25 | (let [[result _] (async/alts!! [trigger-events
26 | (async/timeout 1000)] :priority true)]
27 | (killable/if-not-killed ctx
28 | (if (and result (= expected-trigger-id (:trigger-id result)))
29 | (assoc (:trigger-parameters result) :status :success)
30 | (recur))))))
31 |
32 | (defn ^{:display-type :manual-trigger} wait-for-manual-trigger
33 | "Build step that waits for someone to trigger a build manually, usually by clicking a button in a UI that supports it."
34 | [_ ctx & _]
35 | (let [trigger-id (str (UUID/randomUUID))
36 | result-ch (:result-channel ctx)
37 | subscription (event-bus/subscribe ctx :manual-trigger-received)
38 | trigger-events (event-bus/only-payload subscription)
39 | _ (async/>!! result-ch [:trigger-id trigger-id])
40 | _ (async/>!! result-ch [:status :waiting])
41 | _ (async/>!! result-ch [:out (str "Waiting for trigger...")])
42 | wait-result (wait-for-trigger-event-while-not-killed ctx trigger-events trigger-id)
43 | _ (event-bus/unsubscribe ctx :manual-trigger-received subscription)]
44 | wait-result))
45 |
46 | (defn parameterized-trigger
47 | "Same as `wait-for-manual-trigger` but also sets metadata that instructs a supporting UI to ask the user for parameters
48 | that will be sent and returned.
49 |
50 | Example:
51 | ```clojure
52 | > (parameterized-trigger {:version {:desc \"version to deploy\"}} ctx) ; blocks until post-id is called
53 | {:status :success
54 | :version {:version \"some-version\"}}
55 | > (post-id ctx trigger-id {:version \"some-version\"})
56 | ```
57 | "
58 |
59 | [parameter-config ctx]
60 | (async/>!! (:result-channel ctx) [:parameters parameter-config])
61 | (wait-for-manual-trigger nil ctx))
62 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/steps/shell.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.steps.shell
2 | "Build step to run scripts in a separate shell process. Needs `bash` to run."
3 | (:require [clojure.java.io :as io]
4 | [clojure.string :as string]
5 | [me.raynes.conch.low-level :as sh]
6 | [clojure.core.async :as async]
7 | [lambdacd.util.internal.temp :as temp-util]
8 | [lambdacd.stepsupport.output :as output])
9 | (:import (java.util UUID)
10 | (java.io IOException)
11 | (com.jezhumble.javasysmon JavaSysMon)))
12 |
13 |
14 | (defn- exit-code->status [exit-code was-killed]
15 | (cond
16 | was-killed :killed
17 | (zero? exit-code) :success
18 | :default :failure))
19 |
20 | (defn- kill [was-killed-indicator proc ctx]
21 | (let [pid (.pid proc)]
22 | (reset! was-killed-indicator true)
23 | (async/>!! (:result-channel ctx) [:processed-kill true])
24 | (.destroy proc)
25 | (.killProcessTree (JavaSysMon.) pid false)))
26 |
27 | (defn- add-kill-handling [ctx proc was-killed watch-ref]
28 | (let [is-killed (:is-killed ctx)]
29 | (dosync
30 | (if @is-killed
31 | (kill was-killed proc ctx)
32 | (add-watch is-killed watch-ref (fn [_ _ _ new]
33 | (if new
34 | (kill was-killed proc ctx))))))))
35 |
36 | (defn- safe-read-line [reader]
37 | (try
38 | (.readLine reader)
39 | (catch IOException e nil)))
40 |
41 | (defn- read-and-print-shell-output [proc-result]
42 | (let [out-reader (io/reader (:out proc-result))]
43 | (loop []
44 | (let [line (safe-read-line out-reader)]
45 | (when line
46 | (println line)
47 | (recur))))))
48 |
49 | (defn- execte-shell-command [cwd shell-script ctx env]
50 | (let [x (sh/proc "bash" "-e" shell-script
51 | :dir cwd
52 | :env env
53 | :redirect-err true)
54 | proc (:process x)
55 | was-killed (atom false)
56 | kill-switch (:is-killed ctx)
57 | watch-ref (UUID/randomUUID)
58 | _ (add-kill-handling ctx proc was-killed watch-ref)
59 | out (read-and-print-shell-output x)
60 | exit-code (sh/exit-code x)
61 | status (exit-code->status exit-code @was-killed)]
62 | (remove-watch kill-switch watch-ref)
63 | {:exit exit-code :status status :out out}))
64 |
65 | (defn bash
66 | "step that executes commands in a bash. arguments are the working-directory and at least one command to execute
67 | returns stdout and stderr as :out value, the exit code as :exit and succeeds if exit-code was 0"
68 | [ctx cwd & optional-env-and-commands]
69 | (let [temp-file (temp-util/create-temp-file)
70 | env-or-first-command (first optional-env-and-commands)
71 | env (if (map? env-or-first-command) env-or-first-command {})
72 | commands (if (map? env-or-first-command) (rest optional-env-and-commands) optional-env-and-commands)
73 | command-lines (string/join "\n" commands)]
74 | (spit temp-file command-lines)
75 | (temp-util/with-temp temp-file
76 | (output/capture-output ctx
77 | (execte-shell-command cwd temp-file ctx env)))))
78 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/stepstatus/predicates.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepstatus.predicates
2 | "Predicates over step status.")
3 |
4 | (defn is-active?
5 | "Returns true if the status indicates that the step is currently doing something as opposed to being finished."
6 | [status]
7 | (contains? #{:running :waiting} status))
8 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/stepstatus/unify.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepstatus.unify
2 | "Functions that implement logic to summarize a list of statuses into a single status.
3 | Commonly used in combination with `unify-only-status` as a `:unify-results-fn` to generate the status of a parent step from the statuses of child steps.
4 | These functions might return `:unknown` if a combination of statuses does not make sense to their scenario."
5 | (:require [lambdacd.util.internal.map :as map-util]))
6 |
7 | (defn- all [statuses status]
8 | (every? #(= % status) statuses))
9 |
10 | (defn- one-in [statuses status]
11 | (map-util/contains-value? status statuses))
12 |
13 | (defn successful-when-one-successful
14 | "Summarizes the given statuses optimistically, e.g. returns `:success` if even one status is success or `:running` as long as a single status is `:running`.
15 |
16 | Used for scenarios where we don't expect all steps to succeed, e.g. the `either` control-flow."
17 | [statuses]
18 | (cond
19 | (all statuses :failure) :failure
20 | (all statuses :killed) :killed
21 | (one-in statuses :success) :success
22 | (one-in statuses :running) :running
23 | (one-in statuses :waiting) :waiting
24 | :else :unknown))
25 |
26 | (defn successful-when-all-successful
27 | "Summarizes the given statuses pessimistically, e.g. returns `:success` only if all statuses were success and `:failure` if only a single status is `:failure`.
28 |
29 | Used for scenarios where we expect all steps to succeeed, e.g. `in-parallel` control-flow. Also used as the default in `execute-steps`."
30 | [statuses]
31 | (cond
32 | (one-in statuses :running) :running
33 | (one-in statuses :waiting) :waiting
34 | (one-in statuses :failure) :failure
35 | (all statuses :success) :success
36 | :else :unknown))
37 |
38 | (defn unify-only-status
39 | "Converts a function that can unify statuses into a unify-results-fn suitable for execute-steps"
40 | [unify-status-fn]
41 | (fn [step-results]
42 | {:status (unify-status-fn (->> step-results
43 | (vals)
44 | (map :status)))}))
45 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/stepsupport/killable.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepsupport.killable
2 | "Functions that help in adding the ability for a step to be killed."
3 | (:require [clojure.core.async :as async]))
4 |
5 | (defn killed?
6 | "Returns true if the step was killed."
7 | [ctx]
8 | @(:is-killed ctx))
9 |
10 | (defmacro if-not-killed
11 | "Executes the given body unless the step was killed. If killed, sets the status accordingly.
12 |
13 | Example:
14 | ```clojure
15 | (loop []
16 | (if-not-killed ctx
17 | (if (should-stop-waiting?)
18 | {:status :success}
19 | (recur))))
20 | ```"
21 | [ctx & body]
22 | `(if (killed? ~ctx)
23 | (do
24 | (async/>!! (:result-channel ~ctx) [:status :killed])
25 | {:status :killed})
26 | ~@body))
27 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/stepsupport/metadata.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepsupport.metadata
2 | "Functions that support build steps in dealing with metadata")
3 |
4 | (defn assoc-build-metadata!
5 | "Like `assoc` but for the build-metadata. Adds or replaces key-value pairs in the build metadata map."
6 | [ctx & kvs]
7 | (swap! (:build-metadata-atom ctx) #(apply assoc % kvs)))
8 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/stepsupport/output.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepsupport.output
2 | "Functions and macros that simplify dealing with a steps user readable output (`:out`). Two approaches are provided:
3 | The _printer_ approach that gives full control over what will be provided as output and the `capture-output`-approach that just redirects all stdout."
4 | (:require [clojure.core.async :as async])
5 | (:import (java.io Writer StringWriter)))
6 |
7 | (defn set-output
8 | "Reset the steps output to the given value."
9 | [ctx msg]
10 | (async/>!! (:result-channel ctx) [:out msg]))
11 |
12 | (defn- append-output [msg]
13 | (fn [old-output]
14 | (str old-output msg "\n")))
15 |
16 | ; ------- PRINTER -------
17 |
18 | (defn new-printer
19 | "Returns a datastructure to collect output (to be used with `print-to-output` and `printed-output`).
20 |
21 | Example:
22 | ```clojure
23 | > (let [printer (new-printer)]
24 | (print-to-output ctx printer \"Hello\")
25 | (print-to-output ctx printer \"World\")
26 | (printed-output printer))
27 | \"Hello\\nWorld\\n\"
28 | ```"
29 | []
30 | (atom ""))
31 |
32 |
33 | (defn print-to-output
34 | "Appends the steps output with the given message (see `new-printer` for an example)"
35 | [ctx printer msg]
36 | (let [new-out (swap! printer (append-output msg))]
37 | (set-output ctx new-out)))
38 |
39 | (defn printed-output
40 | "Get the output accumulated in previous `print-to-output` calls (see `new-printer` for an example)"
41 | [printer]
42 | @printer)
43 |
44 | ; ------- END PRINTER -------
45 |
46 | (defn ^:no-doc writer-to-ctx
47 | ; not part of the public interface, just public for the macro
48 | [ctx]
49 | (let [buf (StringWriter.)]
50 | {:writer (proxy [Writer] []
51 | (write [& [x ^Integer off ^Integer len]]
52 | (cond
53 | (number? x) (.append buf (char x))
54 | (not off) (.append buf x)
55 | ; the CharSequence overload of append takes an *end* idx, not length!
56 | (instance? CharSequence x) (.append buf ^CharSequence x (int off) (int (+ len off)))
57 | :else (do
58 | (.append buf (String. ^chars x) off len))))
59 | (flush []
60 | (set-output ctx (.toString (.getBuffer buf)))))
61 | :buffer (.getBuffer buf)}))
62 |
63 | (defmacro capture-output
64 | "Redirect build steps stdout to its `:out` channel by rebinding clojure-stdout.
65 | If the result of the given body is a map (like a step-result), it automatically prepends the collected stdout to `:out`.
66 | Example:
67 | ```clojure
68 | > (capture-output (some-ctx)
69 | (println \"Hello\")
70 | (println \"World\")
71 | {:status :success
72 | :out \"From Step\"})
73 | {:status :success, :out \"Hello\\nWorld\\n\\nFrom Step\"}
74 | ```
75 | "
76 | [ctx & body]
77 | `(let [{x# :writer
78 | buffer# :buffer} (writer-to-ctx ~ctx)
79 | body-result# (binding [*out* x#]
80 | (do ~@body))]
81 | (if (associative? body-result#)
82 | (update body-result# :out #(if (nil? %) (str buffer#) (str buffer# "\n" % ))))))
83 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/ui/api.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.ui.api
2 | "REST-API into the current state, structure and history of the pipeline for use by the UI."
3 | (:require [lambdacd.presentation.unified :as unified]
4 | [ring.util.response :as resp]
5 | [clojure.string :as string]
6 | [ring.middleware.json :as ring-json]
7 | [lambdacd.presentation.pipeline-state :as state-presentation]
8 | [lambdacd.execution.core :as execution]
9 | [lambdacd.steps.manualtrigger :as manualtrigger]
10 | [clojure.walk :as w]
11 | [compojure.core :refer [routes GET POST]]
12 | [lambdacd.state.core :as state]
13 | [lambdacd.util.internal.sugar :as sugar]
14 | [lambdacd.ui.internal.util :as ui-util]))
15 |
16 | (defn- build-infos [ctx build-number-str]
17 | (let [build-number (sugar/parse-int build-number-str)
18 | pipeline-structure (state/get-pipeline-structure ctx build-number)
19 | step-results (state/get-step-results ctx build-number)]
20 | (if (and pipeline-structure step-results)
21 | (ui-util/json (unified/pipeline-structure-with-step-results pipeline-structure step-results))
22 | (resp/not-found (str "build " build-number-str " does not exist")))))
23 |
24 | (defn- to-internal-step-id [dash-seperated-step-id]
25 | (map sugar/parse-int (string/split dash-seperated-step-id #"-")))
26 |
27 | (defn rest-api
28 | "Returns a ring-handler offering a rest-api for the UI."
29 | [{pipeline-def :pipeline-def ctx :context}]
30 | (ring-json/wrap-json-params
31 | (routes
32 | (GET "/builds/" [] (ui-util/json (state-presentation/history-for ctx)))
33 | (GET "/builds/:buildnumber/" [buildnumber] (build-infos ctx buildnumber))
34 | (POST "/builds/:buildnumber/:step-id/retrigger" [buildnumber step-id]
35 | (let [new-buildnumber (execution/retrigger-pipeline-async pipeline-def ctx (sugar/parse-int buildnumber) (to-internal-step-id step-id))]
36 | (ui-util/json {:build-number new-buildnumber})))
37 | (POST "/builds/:buildnumber/:step-id/kill" [buildnumber step-id]
38 | (do
39 | (execution/kill-step ctx (sugar/parse-int buildnumber) (to-internal-step-id step-id))
40 | "OK"))
41 | (POST "/dynamic/:id" {{id :id} :params data :json-params} (do
42 | (manualtrigger/post-id ctx id (w/keywordize-keys data))
43 | (ui-util/json {:status :success}))))))
44 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/ui/core.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.ui.core
2 | (:require [lambdacd.ui.ui-page :as ui-page]
3 | [compojure.route :as route]
4 | [lambdacd.ui.api :as api]
5 | [compojure.core :refer [routes GET context]]))
6 |
7 | (defn ui-for
8 | "Returns a ring-handler offering the LambdaCD API including resources, HTML and API."
9 | ([pipeline]
10 | (routes
11 | (context "/api" [] (api/rest-api pipeline))
12 | (route/resources "/" {:root "public"})
13 | (GET "/" [] (ui-page/ui-page pipeline)))))
14 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/ui/internal/util.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.ui.internal.util
2 | (:require [clj-time.format :as f]
3 | [cheshire.generate :as chg]
4 | [cheshire.core :as ch])
5 | (:import (org.joda.time DateTime)
6 | (com.fasterxml.jackson.core JsonGenerator)))
7 |
8 | (def iso-formatter (f/formatters :date-time))
9 |
10 | (chg/add-encoder DateTime (fn [v ^JsonGenerator jsonGenerator] (.writeString jsonGenerator ^String (f/unparse iso-formatter v))))
11 |
12 | (defn to-json [v] (ch/generate-string v))
13 |
14 | (defn json [data]
15 | {:headers { "Content-Type" "application/json;charset=UTF-8"}
16 | :body (to-json data)
17 | :status 200 })
18 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/ui/ui_page.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.ui.ui-page
2 | (:require [hiccup.core :as h]
3 | [hiccup.page :as p]
4 | [hiccup.element :as e]
5 | [lambdacd.ui.internal.util :as ui-utils]))
6 |
7 | (defn- css-includes
8 | []
9 | (list
10 | (p/include-css "css/thirdparty/normalize.css")
11 | (p/include-css "css/main.css")
12 | (p/include-css "css/thirdparty/font-awesome-4.4.0/css/font-awesome.min.css")))
13 |
14 | (defn- js-includes []
15 | (p/include-js "js-gen/app.js"))
16 |
17 | (defn- favicon []
18 | (list
19 | [:link {:rel "icon" :type "image/png" :sizes "32x32" :href "favicon-32x32.png"}]
20 | [:link {:rel "icon" :type "image/png" :sizes "96x96" :href "favicon-96x96.png"}]
21 | [:link {:rel "icon" :type "image/png" :sizes "16x16" :href "favicon-16x16.png"}]))
22 |
23 | (defn- app-placeholder []
24 | [:div {:id "app"}])
25 |
26 | ; -----------------------------------------------------------------------------
27 |
28 | (defn- title [pipeline-name]
29 | (if pipeline-name
30 | [:title (str pipeline-name " - LambdaCD")]
31 | [:title "LambdaCD"]))
32 |
33 | (defn- header [pipeline-name]
34 | [:div {:class "app__header"}
35 | [:a {:href "/"}
36 | [:h1 {:class "app__header__lambdacd"} "LambdaCD"]]
37 | (if pipeline-name
38 | [:span {:class "app__header__pipeline-name"} pipeline-name])])
39 |
40 | (defn- ui-config [ui-config]
41 | (e/javascript-tag
42 | (str "lambdacd_ui_config=" (ui-utils/to-json
43 | (or ui-config {})))))
44 |
45 | (defn ui-page
46 | "Returns the HTML document containing the LambdaCD UI."
47 | [pipeline]
48 | (let [pipeline-name (get-in pipeline [:context :config :name])
49 | ui-config-data (get-in pipeline [:context :config :ui-config])]
50 | (h/html
51 | [:html
52 | [:head
53 | (title pipeline-name)
54 | (favicon)
55 | (css-includes)
56 | (ui-config ui-config-data)]
57 | [:body
58 | [:div {:class "app l-horizontal"}
59 | (header pipeline-name)
60 | (app-placeholder)]
61 | (js-includes)]])))
62 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/util/internal/async.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.async
2 | (:require [clojure.core.async :as async]))
3 |
4 | (defn buffered [ch]
5 | (let [result-ch (async/chan 100)]
6 | (async/pipe ch result-ch)))
7 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/util/internal/bash.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.bash
2 | (:require [clojure.tools.logging :as log]
3 | [clojure.java.shell :as jsh]
4 | [clojure.string :as string]))
5 |
6 | (defn bash
7 | [cwd & commands]
8 | (let [combined-command (str "bash -c '" (string/join " && " commands) "' 2>&1") ;; very hacky but it does the job of redirecting stderr to stdout
9 | result (jsh/sh "bash" "-c" combined-command :dir cwd)]
10 | (log/debug (str "executed " combined-command " in " cwd " with result " result))
11 | result))
12 |
13 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/util/internal/coll.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.coll)
2 |
3 | (defn fill [coll length filler]
4 | (let [missing (- length (count coll))]
5 | (concat coll (replicate missing filler))))
6 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/util/internal/exceptions.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.exceptions
2 | (:require [clojure.repl :as repl])
3 | (:import (java.io StringWriter)))
4 |
5 |
6 | (defmacro with-err-str
7 | [& body]
8 | `(let [s# (new StringWriter)]
9 | (binding [*err* s#]
10 | ~@body
11 | (str s#))))
12 |
13 | (defn stacktrace-to-string [e]
14 | (with-err-str (repl/pst e)))
15 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/util/internal/map.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.map)
2 |
3 | (defn put-if-not-present [m k v]
4 | (if (contains? m k)
5 | m
6 | (assoc m k v)))
7 |
8 | (defn contains-value? [v coll]
9 | (some #(= % v) coll))
10 |
11 | (defn merge-with-k-v [f & maps]
12 | (when (some identity maps)
13 | (let [merge-entry (fn [m e]
14 | (let [k (key e) v (val e)]
15 | (if (contains? m k)
16 | (assoc m k (f k (get m k) v))
17 | (assoc m k v))))
18 | merge2 (fn [m1 m2]
19 | (reduce merge-entry (or m1 {}) (seq m2)))]
20 | (reduce merge2 maps))))
21 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/util/internal/sugar.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.sugar)
2 |
3 | (def not-nil? (complement nil?))
4 | (defn parse-int [int-str]
5 | (Integer/parseInt int-str))
6 |
--------------------------------------------------------------------------------
/src/clj/lambdacd/util/internal/temp.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.temp
2 | (:require [clojure.java.io :as io]
3 | [me.raynes.fs :as fs])
4 | (:import (java.nio.file.attribute FileAttribute)
5 | (java.nio.file Files LinkOption)))
6 |
7 | (defn- no-file-attributes []
8 | (into-array FileAttribute []))
9 |
10 |
11 | (def temp-prefix "lambdacd")
12 |
13 | (defn create-temp-dir
14 | ([]
15 | (str (Files/createTempDirectory temp-prefix (no-file-attributes))))
16 | ([parent]
17 | (str (Files/createTempDirectory (.toPath (io/file parent)) temp-prefix (into-array FileAttribute [])))))
18 |
19 |
20 | (defn create-temp-file []
21 | (str (Files/createTempFile temp-prefix "" (no-file-attributes))))
22 |
23 | (defmacro with-temp
24 | "evaluates the body, then deletes the given file or directory.
25 | returns the result of the evaluation of the body"
26 | [f & body]
27 | `(try
28 | ~@body
29 | (finally
30 | (fs/delete-dir ~f LinkOption/NOFOLLOW_LINKS))))
31 |
--------------------------------------------------------------------------------
/src/cljs/lambdacd/ajax.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.ajax
2 | (:require
3 | [ajax.core :as ac]
4 | [cljs.core.async :as async]))
5 |
6 | (defn GET [url]
7 | (let [ch (async/chan 1)]
8 | (ac/GET url {:handler (fn [response]
9 | (async/put! ch {:type :success :response response})
10 | (async/close! ch))
11 | :error-handler (fn [response]
12 | (async/put! ch {:type :failure :response response})
13 | (async/close! ch))
14 | :keywords? true
15 | :response-format :json})
16 | ch))
17 |
18 | (defn POST [url data handler]
19 | (ac/POST url {:format :json
20 | :params data
21 | :handler handler}))
--------------------------------------------------------------------------------
/src/cljs/lambdacd/api.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.api
2 | (:require [lambdacd.ajax :as ajax]
3 | [lambdacd.route :as route])
4 | (:import goog.History))
5 |
6 | (defn get-build-history []
7 | (let [result (ajax/GET "api/builds/")]
8 | result))
9 |
10 | (defn get-build-state [build-number]
11 | (let [result (ajax/GET (str "api/builds/" build-number "/"))]
12 | result))
13 |
14 | (defn- nop [response])
15 |
16 | (defn- confirm-triggered [response])
17 |
18 | (defn- after-retriggered [response]
19 | (let [build-number (get response "build-number")]
20 | (route/set-build-number build-number)))
21 |
22 |
23 | (defn trigger [trigger-id data]
24 | (ajax/POST (str "api/dynamic/" trigger-id) data confirm-triggered))
25 |
26 | (defn retrigger [build-number step-id]
27 | (ajax/POST (str "api/builds/" build-number "/" step-id "/retrigger") {} after-retriggered))
28 |
29 | (defn kill [build-number step-id]
30 | (ajax/POST (str "api/builds/" build-number "/" step-id "/kill") {} nop))
--------------------------------------------------------------------------------
/src/cljs/lambdacd/commons.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.commons)
2 |
3 | (defn loading-screen []
4 | [:div {:key "loading-screen" :class "app__loading-screen"}
5 | [:span "Loading..."]])
6 |
--------------------------------------------------------------------------------
/src/cljs/lambdacd/console_output_processor.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.console-output-processor
2 | (:require [clojure.string :as s]
3 | [cljsjs.ansiparse]))
4 |
5 | (defn- process-carriage-returns [line]
6 | (->> (clojure.string/split line "\r")
7 | reverse
8 | (reduce (fn [final-line previous-chunk]
9 | (str final-line (subs previous-chunk (count final-line)))) "")))
10 |
11 | (defn- process-backspaces [s]
12 | (s/join
13 | (reverse
14 | (loop [[x & xs] (chars s)
15 | result (list)]
16 | (cond
17 | (nil? x) result
18 | (= "\b" x) (recur xs (rest result))
19 | :else (recur xs (conj result x)))))))
20 |
21 | (defn clean-up-text [s]
22 | (->> (s/split-lines s)
23 | (map process-carriage-returns)
24 | (map process-backspaces)
25 | (s/join "\n")))
26 |
27 | (defn- de-ansify [s]
28 | (if (= "" s)
29 | [{:text s}]
30 | (js->clj (js/ansiparse s) :keywordize-keys true)))
31 |
32 | (defn split-fragments-on-newline [fragment]
33 | (cond
34 | (= "\n" (:text fragment)) [:newline]
35 | (= "" (:text fragment)) [fragment]
36 | :else (->> (s/split-lines (:text fragment))
37 | (map #(assoc fragment :text %))
38 | (interpose :newline))))
39 |
40 | (defn- partition-by-newline [c]
41 | (let [by-k #(not= :newline %)]
42 | (filter #(not= [:newline] %)
43 | (partition-by by-k c))))
44 |
45 |
46 | (defn process-ascii-escape-characters [s]
47 | (->> (clean-up-text s)
48 | (de-ansify)
49 | (mapcat split-fragments-on-newline)
50 | (partition-by-newline)))
--------------------------------------------------------------------------------
/src/cljs/lambdacd/history.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.history
2 | (:require [reagent.core :as reagent :refer [atom]]
3 | [goog.events :as events]
4 | [re-frame.core :as re-frame]
5 | [lambdacd.db :as db]
6 | [goog.history.EventType :as EventType]
7 | [cljs.core.async :as async]
8 | [lambdacd.utils :as utils]
9 | [lambdacd.api :as api]
10 | [lambdacd.pipeline :as pipeline]
11 | [lambdacd.commons :as commons]
12 | [lambdacd.route :as route]
13 | [lambdacd.time :as time]
14 | [lambdacd.state :as state]
15 | [goog.string :as gstring]
16 | [clojure.string :as s]))
17 |
18 | (defn- status-icon [status]
19 | (case status
20 | "failure" "fa fa-times failure-red"
21 | "success" "fa fa-check success-green"
22 | "running" "fa fa-cog fa-spin running-blue"
23 | "waiting" "fa fa-pause waiting-yellow"
24 | "killed" "fa fa-bug"
25 | "dead" "fa fa-bug"
26 | "fa fa-question"))
27 |
28 | (defn- icon [class]
29 | [:div {:class "history--item--status-icon history--item--line--item" } [:i {:class class}]])
30 |
31 |
32 | (defn- has-metadata? [build-metadata]
33 | (and build-metadata
34 | (not= {} build-metadata)))
35 |
36 | (defn- build-label [build-number {build-label :human-readable-build-label}]
37 | (if build-label
38 | (str build-label " (#" build-number ")")
39 | (str "Build " build-number)))
40 |
41 | (defn history-item-component [active-build-number
42 | {build-number :build-number
43 | status :status
44 | first-updated-at :first-updated-at
45 | retriggered :retriggered
46 | duration-in-seconds :duration-in-sec
47 | build-metadata :build-metadata}]
48 | [:li {:key build-number :class (str "history--item" (if (= build-number active-build-number) " history--item--active"))}
49 | [:a {:href (route/for-build-number build-number) :class "history--item--container"}
50 | [:div {:class "history--item--line"}
51 | [icon (status-icon status)]
52 | [:h3 {:class "history--item--line--item" } (build-label build-number build-metadata)]]
53 | [:div {:class "history--item--line"}
54 | [icon "fa fa-play"]
55 | [:p {:class "history--item--line--item" } (if first-updated-at
56 | (str "Started: " (time/format-ago first-updated-at))
57 | "Not started yet")]]
58 | [:div {:class "history--item--line"}
59 | [icon "fa fa-clock-o"]
60 | [:p {:class "history--item--line--item" } (if-not (zero? duration-in-seconds)
61 | (str "Duration: " (time/format-duration-long
62 | duration-in-seconds))
63 | "Duration: 0sec")]]
64 | (if (has-metadata? build-metadata)
65 | [:div {:class "history--item--line tooltip"}
66 | [icon "fa fa-info-circle"]
67 | [:p {:class "history--item--line--item"} "Metadata"]
68 | [:span [:pre (utils/pretty-print-map build-metadata)]]])
69 | (if retriggered
70 | [:div {:class "history--item--line"}
71 | [icon "fa fa-repeat"]
72 | [:p {:class "history--item--line--item" } (str "Retriggered #" retriggered)]])]])
73 |
74 | (defn build-history-renderer [history active-build-number]
75 | [:div {:id "builds" :class "app__history history l-horizontal"}
76 | [:h2 {:key "history-builds"} "Builds"]
77 | (if-not (nil? history)
78 | (let [history-to-display (sort-by :build-number > history)]
79 | [:ul {:key "history-items"} (map #(history-item-component active-build-number %) history-to-display)])
80 | (commons/loading-screen))])
81 |
82 | (defn build-history-component []
83 | (let [active-build-number (re-frame/subscribe [::db/build-number])
84 | history (re-frame/subscribe [::db/history])]
85 | (fn []
86 | (build-history-renderer @history @active-build-number))))
87 |
--------------------------------------------------------------------------------
/src/cljs/lambdacd/logic.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.logic
2 | (:require-macros [cljs.core.async.macros :refer [go go-loop]])
3 | (:require [lambdacd.utils :as utils]
4 | [cljs.core.async :as async]
5 | [re-frame.core :as re-frame]
6 | [lambdacd.db :as db]
7 | [lambdacd.api :as api]))
8 |
9 | (def poll-frequency 1000)
10 |
11 | (defn start-ticker []
12 | (go-loop []
13 | (let [update-in-progress? @(re-frame/subscribe [::db/update-in-progress?])]
14 | (when-not update-in-progress?
15 | (re-frame/dispatch [::tick]))
16 | (async/ s1
46 | (js/moment)
47 | (.fromNow))))
--------------------------------------------------------------------------------
/src/cljs/lambdacd/ui_core.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.ui-core
2 | (:require-macros [cljs.core.async.macros :refer [go go-loop]])
3 | (:require
4 | [reagent.core :as reagent :refer [atom]]
5 | [lambdacd.utils :refer [classes]]
6 | [lambdacd.pipeline :as pipeline]
7 | [lambdacd.route :as route]
8 | [lambdacd.history :as history]
9 | [lambdacd.commons :as commons]
10 | [re-frame.core :as re-frame]
11 | [lambdacd.output :as output]
12 | [lambdacd.logic :as logic]
13 | [lambdacd.db :as db]))
14 |
15 | (defn current-build-header-component [build-number]
16 | [:h2 {:key "build-header"} (str "Current Build " build-number)])
17 |
18 | (defn current-build-component [build-state-atom build-number pipeline-component output-component header-component]
19 | (if-not (nil? @build-state-atom)
20 | [:div {:id "currentBuild" :class "app__current-build l-horizontal"}
21 | [header-component build-number]
22 | [pipeline-component]
23 | [output-component]]
24 | [commons/loading-screen]))
25 |
26 | (defn wired-current-build-component [build-state-atom build-number]
27 | (current-build-component build-state-atom build-number pipeline/pipeline-component output/output-component current-build-header-component))
28 |
29 | (defn root [build-number-atom state connection-state history-component current-build-component]
30 | (let [build-number @build-number-atom
31 | container-classes (if (= @connection-state :lost)
32 | ["app" "l-horizontal" "app--connection-lost"]
33 | ["app" "l-horizontal"] )]
34 | [:div {:class (classes container-classes)}
35 | [:div {:class "l-vertical app__content"}
36 | [history-component]
37 | [current-build-component state build-number]]]))
38 |
39 | (defn init! []
40 | (re-frame/dispatch-sync [::db/initialize-db (js->clj js/lambdacd_ui_config :keywordize-keys true)])
41 | (let [state-atom (re-frame/subscribe [::db/pipeline-state])
42 | build-number-atom (re-frame/subscribe [::db/build-number])
43 | connection-state (re-frame/subscribe [::db/connection-state])]
44 | (logic/start-ticker)
45 | (route/hook-browser-navigation!)
46 | ; #' is necessary so that fighweel can update: https://github.com/reagent-project/reagent/issues/94
47 | (reagent/render-component [#'root build-number-atom state-atom connection-state history/build-history-component wired-current-build-component] (.getElementById js/document "app"))))
48 |
--------------------------------------------------------------------------------
/src/cljs/lambdacd/utils.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.utils
2 | (:require [cljs.core.async :as async]
3 | [clojure.string :as string]
4 | [clojure.walk :as walk]))
5 |
6 | (defn click-handler [handler]
7 | (fn [evt]
8 | (handler)
9 | (.stopPropagation evt)))
10 |
11 | (defn append-components [a b]
12 | (vec (concat a b)))
13 |
14 | (defn classes [& cs]
15 | (if (vector? (first cs))
16 | (apply string/join " " cs)
17 | (string/join " " cs)))
18 |
19 | ; from clojure.walk/stringify-keys but fixes keywords with slashes and renders them as :kw
20 |
21 | (defn stringify-keys [m]
22 | (let [f (fn [[k v]] (if (keyword? k) [(str k) v] [k v]))]
23 | (walk/postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m)))
24 |
25 | (defn pretty-print-map [m]
26 | (-> m
27 | (stringify-keys)
28 | (clj->js)
29 | (js/JSON.stringify nil 2)))
30 |
--------------------------------------------------------------------------------
/src/less/_variables.less:
--------------------------------------------------------------------------------
1 | // Colors:
2 |
3 |
4 | @base-red: rgba(206, 64, 75, 1);
5 | @base-orange: rgba(221, 158, 90, 1);
6 | @base-violet: rgba(53, 26, 91, 1);
7 | @base-blue: rgba(44, 125, 165, 1);
8 | @base-green: darken(rgba(169, 219, 149, 1),20%);
9 |
10 | @base-foreground-opacity: 0.7;
11 | @base-foreground-color: rgba(0, 0, 0, @base-foreground-opacity);
12 | @border-color: lighten(@base-foreground-color,20%);
13 | @foreground-color: @base-foreground-color;
14 |
15 | @history-background-color: rgba(0,0,0,0.1);
16 | @header-background-color: @history-background-color;
17 |
18 |
19 | @step-running-color: @base-blue;
20 | @step-waiting-color: @base-orange;
21 | @step-success-color: @base-green;
22 | @step-failure-color: @base-red;
23 | @step-killed-color: lightgrey;
24 | @step-nostatus-color: white;
25 |
26 | @tooltip-background: white;
27 | @tooltip-border: grey;
28 |
--------------------------------------------------------------------------------
/src/less/app.less:
--------------------------------------------------------------------------------
1 | @import "_variables";
2 |
3 | .app {
4 | min-height:100%;
5 | min-width:100%;
6 | }
7 |
8 | .app__content {
9 | flex: 1;
10 | }
11 |
12 | .app--connection-lost * {
13 | opacity: 0.8;
14 | }
15 |
16 | .app__history {
17 | background-color: @history-background-color;;
18 | flex-shrink: 0;
19 | flex-basis: 210px;
20 | width: 210px;
21 | flex-grow: 0;
22 | }
23 |
24 | .app__header {
25 | background-color: @header-background-color;
26 |
27 | padding-left: 0.5em;
28 |
29 | letter-spacing: 0.1em;
30 | }
31 |
32 | .app__header__lambdacd {
33 | display: inline;
34 | }
35 |
36 | .app__header__pipeline-name {
37 | margin-left: 5px;
38 | }
39 |
40 | .app__current-build {
41 | padding-left: 10px;
42 | flex:2;
43 | }
44 |
45 | .app__loading-screen {
46 | width: 100%;
47 | display: flex;
48 | justify-content: center;
49 | align-items: center;
50 | }
51 |
52 | .warning-icon {
53 | padding-top: 5px;
54 | padding-bottom: 5px;
55 | padding-right: 5px;
56 | }
57 |
58 | .warning {
59 | color: @base-orange;
60 | }
61 |
--------------------------------------------------------------------------------
/src/less/history.less:
--------------------------------------------------------------------------------
1 | @import "_variables";
2 |
3 |
4 | .history h2 {
5 | padding-left:.5em;
6 | }
7 |
8 | .history--item:nth-child(1) {
9 | border-top: thin @border-color solid;
10 | }
11 |
12 | .history--item--active {
13 | font-weight: bold;
14 | }
15 |
16 | .history--item {
17 | padding-top: 5px;
18 | padding-bottom: 5px;
19 | padding-right:10px;
20 | padding-left:.5em;
21 | display:flex;
22 | border-bottom: thin @border-color solid;
23 | }
24 |
25 | .history--item--container {
26 | display:flex;
27 | flex-direction:column;
28 | }
29 |
30 | .history--item--status-icon {
31 | padding-right:5px;
32 | padding-left:5px;
33 | padding-top:5px;
34 | opacity: @base-foreground-opacity;
35 | }
36 |
37 | .history--item--line {
38 | display: inline-block;
39 | }
40 |
41 | .history--item--line--item {
42 | display: inline;
43 | }
--------------------------------------------------------------------------------
/src/less/layout.less:
--------------------------------------------------------------------------------
1 | .l-horizontal {
2 | display: flex;
3 | flex-direction: column;
4 | }
5 |
6 | .l-vertical {
7 | display: flex;
8 | flex-direction: row;
9 | }
10 |
--------------------------------------------------------------------------------
/src/less/main.less:
--------------------------------------------------------------------------------
1 | @import "_variables";
2 |
3 | @import "resets";
4 | @import "layout";
5 | @import "app";
6 | @import "history";
7 | @import "pipeline";
8 | @import "step-results";
9 | @import "tooltip";
10 |
11 | // Misc:
12 | .details-container ul {
13 | padding-left: 40px;
14 | }
15 |
16 | .details-container a {
17 | text-decoration: underline;
18 | }
19 |
20 | .success-green {
21 | color: @step-success-color
22 | }
23 |
24 | .running-blue {
25 | color: @step-running-color
26 | }
27 |
28 | .waiting-yellow {
29 | color: @step-waiting-color
30 | }
31 |
32 | .failure-red {
33 | color: @step-failure-color
34 | }
35 |
--------------------------------------------------------------------------------
/src/less/pipeline.less:
--------------------------------------------------------------------------------
1 | @import "_variables";
2 |
3 | .pipeline__step-container {
4 | display:-ms-flexbox;
5 | display:-webkit-box;
6 | display:-webkit-flex;
7 | display:flex;
8 | }
9 |
10 | .pipeline__step-container--sequential {
11 | flex-direction: row;
12 | }
13 |
14 | .pipeline__step-container--parallel {
15 | flex-direction: column;
16 | }
17 |
18 | .pipeline__step-container {
19 | overflow-x: auto;
20 | overflow-y: hidden;
21 | }
22 |
23 | .pipeline__step {
24 | display:-ms-flexbox;
25 | display:-webkit-box;
26 | display:-webkit-flex;
27 | display:flex;
28 |
29 | flex-shrink:0;
30 | margin-left:10px;
31 | border: thin black solid;
32 | }
33 |
34 | .pipeline__step--running {
35 | background:@step-running-color;
36 | }
37 | .pipeline__step--waiting {
38 | background: @step-waiting-color;
39 | }
40 | .pipeline__step--success {
41 | background: @step-success-color;
42 | }
43 | .pipeline__step--failure {
44 | background: @step-failure-color;
45 | }
46 | .pipeline__step--killed {
47 | background: @step-killed-color;
48 | }
49 | .pipeline__step--dead {
50 | background: @step-killed-color;
51 | }
52 | .pipeline__step--no-status {
53 | background: @step-nostatus-color;
54 | }
55 |
56 | .step-link--active {
57 | font-weight: bold;
58 | }
59 |
60 | .pipeline__step__action-button {
61 | margin-left:5px;
62 | margin-right:5px;
63 | cursor:pointer;
64 | }
65 |
66 | .pipeline__step__action-button--disabled {
67 | opacity: 0.5;
68 | cursor: not-allowed;
69 | }
70 |
71 | .pipeline__controls {
72 | list-style-type: none;
73 | flex-direction: row;
74 | display: flex;
75 | }
76 |
77 | .pipeline__controls__control {
78 | padding-left: 3px;
79 | padding-right: 3px;
80 | cursor: hand;
81 | }
82 |
83 | .pipeline__controls__control--disabled {
84 | opacity: 0.5;
85 | }
86 | .pipeline__controls__control--active {
87 | font-weight: bold;
88 | }
89 |
--------------------------------------------------------------------------------
/src/less/resets.less:
--------------------------------------------------------------------------------
1 | @import "_variables";
2 |
3 | ul,ol {
4 | /* reset browser default */
5 | padding-left:0;
6 | margin-top:0;
7 | }
8 |
9 | html {
10 | box-sizing: border-box;
11 | }
12 | *, *:before, *:after {
13 | box-sizing: inherit;
14 | }
15 |
16 | pre {
17 | word-break: break-word;
18 | word-wrap: break-word;
19 | white-space: pre-wrap;
20 | margin:0;
21 | }
22 |
23 | .step-link {
24 | color: inherit;
25 | text-decoration: none;
26 | }
27 |
28 | @import url(https://fonts.googleapis.com/css?family=Titillium+Web:400,200,200italic,300,300italic,400italic,600,600italic,700,700italic,900);
29 | body {
30 | font-family: 'Titillium Web', sans-serif;
31 | color: @foreground-color;
32 | font-size: 14px;
33 | }
34 |
35 | a {
36 | text-decoration: none;
37 | color: @foreground-color;
38 | }
39 |
40 | h2 {
41 | margin-top: 0.5em;
42 | margin-bottom: 0.5em;
43 | }
44 |
45 | h1 {
46 | margin-top: 0.25em;
47 | margin-bottom: 0.25em;
48 | }
--------------------------------------------------------------------------------
/src/less/step-results.less:
--------------------------------------------------------------------------------
1 | .step-results__raw-step-results {
2 | margin-top: 1em;
3 | }
4 |
5 | .console-output__line {
6 | min-height: 16px; // to make sure empty newlines are displayed
7 | }
8 |
9 | .console-output__line--bold {
10 | font-weight: bold;
11 | }
12 | .console-output__line--italic {
13 | font-style: italic;
14 | }
15 | .console-output__line--underline {
16 | text-decoration: underline;
17 | }
18 | .console-output__line--fg-red {
19 | color: red;
20 | }
21 | .console-output__line--bg-red {
22 | background-color: red;
23 | }
24 | .console-output__line--fg-black {
25 | color: black;
26 | }
27 | .console-output__line--bg-black {
28 | background-color: black;
29 | }
30 | .console-output__line--fg-green {
31 | color: green;
32 | }
33 | .console-output__line--bg-green {
34 | background-color: green;
35 | }
36 | .console-output__line--fg-yellow {
37 | color: yellow;
38 | }
39 | .console-output__line--bg-yellow {
40 | background-color: yellow;
41 | }
42 | .console-output__line--fg-blue {
43 | color: blue;
44 | }
45 | .console-output__line--bg-blue {
46 | background-color: blue;
47 | }
48 | .console-output__line--fg-magenta {
49 | color: magenta;
50 | }
51 | .console-output__line--bg-magenta {
52 | background-color: magenta;
53 | }
54 | .console-output__line--fg-cyan {
55 | color: cyan;
56 | }
57 | .console-output__line--bg-cyan {
58 | background-color: cyan;
59 | }
60 | .console-output__line--fg-white {
61 | color: white;
62 | }
63 | .console-output__line--bg-white {
64 | background-color: white;
65 | }
66 | .console-output__line--fg-grey {
67 | color: grey;
68 | }
69 | .console-output__line--bg-grey {
70 | background-color: grey;
71 | }
72 |
73 |
74 |
75 |
--------------------------------------------------------------------------------
/src/less/tooltip.less:
--------------------------------------------------------------------------------
1 | div.tooltip {
2 | outline: none;
3 | }
4 |
5 | div.tooltip strong {
6 | line-height: 30px;
7 | }
8 |
9 | div.tooltip:hover {
10 | text-decoration: none;
11 | }
12 |
13 | div.tooltip span {
14 | z-index: 10;
15 | display: none;
16 | padding: 14px 20px;
17 | margin-top: -30px;
18 | margin-left: 28px;
19 | line-height: 16px;
20 | }
21 |
22 | div.tooltip:hover span {
23 | display: inline;
24 | position: absolute;
25 | border: 1px solid @tooltip-border;
26 | background: @tooltip-background;
27 | }
28 |
29 | div.tooltip span {
30 | box-shadow: 5px 5px 8px #CCC;
31 | }
32 |
--------------------------------------------------------------------------------
/suppression.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
7 | ^re-frame:re-frame:.*$
8 | cpe:/a:git_project:git
9 |
10 |
11 |
14 | ^re-frame:re-frame:.*$
15 | cpe:/a:git:git
16 |
17 |
18 |
21 | ^com\.google\.javascript:closure-compiler-unshaded:.*$
22 | cpe:/a:google:google_apps
23 |
24 |
25 |
28 | ^com\.google\.javascript:closure-compiler-unshaded:.*$
29 | cpe:/a:google:gmail
30 |
31 |
32 |
35 | CVE-2020-8910
36 |
37 |
38 |
41 | CVE-2020-5234
42 |
43 |
44 |
47 | CVE-2020-13956
48 |
49 |
50 |
53 | CVE-2020-8908
54 |
55 |
56 |
59 | CVE-2020-36448
60 |
61 |
62 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/core_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.core-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.core :refer :all]))
4 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/example/pipeline_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.example.steps-test
2 | (:require [clojure.test :refer [deftest testing is]]
3 | [conjure.core :as c]
4 | [lambdacd.steps.git :as git]
5 | [todopipeline.steps :as steps]
6 | [todopipeline.pipeline :as pipeline]
7 | [lambdacd.steps.shell :as shell]
8 | [lambdacd.execution.core :as execution]
9 | [lambdacd.testsupport.data :refer [some-ctx]]))
10 |
11 | (deftest todopipeline-test
12 | (testing "a successful pipeline run" ; this isn't a particularly interesting test but it's a start
13 | (c/stubbing [git/wait-with-details {:status :success}
14 | shell/bash {:status :success
15 | :exit 0}]
16 | (is (= :success (:status (execution/run-pipeline pipeline/pipeline-def (some-ctx)))))
17 | (is (c/verify-called-once-with-args shell/bash )))))
18 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/example/steps_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.example.steps-test
2 | (:require [clojure.test :refer [deftest testing is]]
3 | [conjure.core :as c]
4 | [lambdacd.steps.git :as git]
5 | [todopipeline.steps :as steps]))
6 |
7 | ; testing a simple build step
8 | (deftest wait-for-frontend-repo-test
9 | (testing "that it returns the most recent frontend sha and head for the backend"
10 | (c/stubbing [git/wait-with-details {:revision "some-revision"
11 | :status :success}]
12 | (is (= {:status :success
13 | :frontend-revision "some-revision"
14 | :backend-revision "HEAD"
15 | :revision "some-revision"}
16 | (steps/wait-for-frontend-repo nil nil))))))
--------------------------------------------------------------------------------
/test/clj/lambdacd/execution/internal/build_metadata_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.build-metadata-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.execution.internal.build-metadata :refer :all]
4 | [lambdacd.testsupport.data :refer [some-ctx some-ctx-with]]
5 | [shrubbery.core :refer [mock received?]]
6 | [lambdacd.state.protocols :as state-protocols]))
7 |
8 |
9 | (defn swap-metadata! [ctx f]
10 | (swap! (:build-metadata-atom ctx) f))
11 |
12 | (defn get-metadata [ctx]
13 | @(:build-metadata-atom ctx))
14 |
15 | (def some-build-number 42)
16 |
17 | (deftest build-metadata-test
18 | (testing "that metadata is configured with the initial value"
19 | (is (= {:initial :metadata} (get-metadata (add-metadata-atom (some-ctx) {:initial :metadata})))))
20 | (testing "that changing metadata fails if the new value is not a map"
21 | (let [ctx (add-metadata-atom (some-ctx) {})]
22 | (is (thrown? Exception (swap-metadata! ctx (constantly "some-string"))))))
23 | (testing "that we can get and update metadata"
24 | (let [ctx (add-metadata-atom (some-ctx) {})]
25 | (swap-metadata! ctx #(assoc % :some :metadata))
26 | (is (= {:some :metadata} (get-metadata ctx)))))
27 | (testing "that build metadata updates are being consumed by the state component"
28 | (let [state-component (mock state-protocols/BuildMetadataConsumer)
29 | ctx (add-metadata-atom (some-ctx-with :pipeline-state-component state-component
30 | :build-number some-build-number) {})]
31 | (swap-metadata! ctx #(assoc % :some :metadata))
32 | (is (received? state-component state-protocols/consume-build-metadata [some-build-number {:some :metadata}])))))
33 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/execution/internal/pipeline_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.pipeline-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.execution.internal.pipeline :refer :all]
4 | [lambdacd.testsupport.data :refer [some-ctx some-ctx-with]]
5 | [shrubbery.core :refer [mock received?]]
6 | [lambdacd.state.protocols :as state-protocols]
7 | [lambdacd.util.internal.sugar :refer [not-nil?]]
8 | [lambdacd.testsupport.test-util :refer [events-for
9 | slurp-chan]]
10 | [lambdacd.presentation.pipeline-structure :as pipeline-structure]
11 | [lambdacd.event-bus :as event-bus])
12 | (:import (clojure.lang Atom)))
13 |
14 | (defn step-pipeline
15 | "creates a pipeline structure with only the given step"
16 | [step]
17 | `(~step))
18 |
19 | (defn some-step [args ctx]
20 | {:status :success
21 | :step 1})
22 | (defn some-other-step [args ctx]
23 | {:status :success
24 | :step 2})
25 |
26 | (defn some-step-expecting-a-build-number [args ctx]
27 | (assert (not-nil? (:build-number ctx)))
28 | {:status :success})
29 |
30 | (defn some-step-expecting-build-metadata-atom [args ctx]
31 | (assert (instance? Atom (:build-metadata-atom ctx)))
32 | {:status :success})
33 |
34 | (def some-pipeline
35 | `(some-step
36 | some-other-step))
37 |
38 | (def some-build-number 1)
39 |
40 | (deftest run-pipeline-test
41 | (testing "that it executes the whole pipeline"
42 | (is (= {:status :success
43 | :outputs {[1] {:status :success
44 | :step 1}
45 | [2] {:status :success
46 | :step 2}}}
47 | (run-pipeline some-pipeline (some-ctx) some-build-number {}))))
48 | (testing "that it writes the pipeline structure into state"
49 | (let [state-component (mock state-protocols/PipelineStructureConsumer
50 | state-protocols/StepResultUpdateConsumer)
51 | expected-structure (pipeline-structure/pipeline-display-representation some-pipeline)]
52 | (run-pipeline some-pipeline (some-ctx-with :pipeline-state-component state-component) some-build-number {})
53 | (is (received? state-component state-protocols/consume-pipeline-structure [some-build-number expected-structure]))))
54 | (testing "that it sends events about the pipeline starting and stopping"
55 | (let [ctx (some-ctx-with :build-number nil) ; the ctx doesn't have a build number yet, that's why we pass it in
56 | started-events (events-for :pipeline-started ctx)
57 | stopped-events (events-for :pipeline-finished ctx)]
58 | (run-pipeline some-pipeline ctx some-build-number {})
59 | (is (= [{:build-number some-build-number}] (slurp-chan started-events)))
60 | (is (= [{:build-number some-build-number
61 | :status :success
62 | :outputs {[1] {:status :success
63 | :step 1}
64 | [2] {:status :success
65 | :step 2}}}] (slurp-chan stopped-events)))))
66 | (testing "that it passes the build-number on to steps"
67 | (is (= :success (:status (run-pipeline (step-pipeline `some-step-expecting-a-build-number) (some-ctx) some-build-number {})))))
68 | (testing "that it passes a build-metadata atom to steps"
69 | (is (= :success (:status (run-pipeline (step-pipeline `some-step-expecting-build-metadata-atom) (some-ctx) some-build-number {}))))))
70 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/execution/internal/util_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.execution.internal.util-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.execution.internal.util :refer :all]))
4 |
5 |
6 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/internal/running_builds_tracking_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.internal.running-builds-tracking-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.internal.running-builds-tracking :refer :all]
4 | [lambdacd.testsupport.data :refer [some-ctx some-ctx-with]]
5 | [lambdacd.testsupport.test-util :refer [wait-for]]
6 | [lambdacd.event-bus :as event-bus]))
7 |
8 | (deftest running-builds-tracker
9 | (testing "that it adds running builds and step-ids when steps start runnning and removes them if they stop"
10 | (let [ctx (initialize-running-builds-tracking (some-ctx))]
11 |
12 | (event-bus/publish!! ctx :step-started {:step-id [1] :build-number 1})
13 | (event-bus/publish!! ctx :step-started {:step-id [2 2] :build-number 2})
14 |
15 | (wait-for (= 2 (count @(:started-steps ctx))))
16 |
17 | (is (is-running? ctx 1 [1]))
18 | (is (is-running? ctx 2 [2 2]))
19 | (is (not (is-running? ctx 3 [1])))
20 | (is (not (is-running? ctx 1 [2])))
21 |
22 | (is (= #{{:step-id [1] :build-number 1}
23 | {:step-id [2 2] :build-number 2}} @(:started-steps ctx)))
24 |
25 | (event-bus/publish!! ctx :step-finished {:step-id [2 2] :build-number 2 :final-result {:foo :bar}})
26 |
27 | (wait-for (= 1 (count @(:started-steps ctx))))
28 |
29 | (is (= #{{:step-id [1] :build-number 1}} @(:started-steps ctx)))
30 | (is (is-running? ctx 1 [1]))
31 | (is (not (is-running? ctx 2 [2 2]))))))
32 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/presentation/unified_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.presentation.unified-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.presentation.unified :refer :all]
4 | [lambdacd.steps.control-flow :refer [in-parallel in-cwd]]))
5 |
6 | (defn do-stuff [] {})
7 | (defn do-other-stuff [] {})
8 |
9 | (def foo-pipeline
10 | `((in-parallel
11 | (in-cwd do-stuff)
12 | (in-cwd do-other-stuff))))
13 |
14 |
15 | (def foo-pipeline-build-state
16 | {'(1) {:status :running}
17 | '(1 1 1) {:status :failure
18 | :out "do stuff failed"}
19 | '(1 2 1) {:status :running
20 | :some-key :some-value}})
21 |
22 | (def expected-unified-foo-pipeline-presentation
23 | [{:name "in-parallel"
24 | :type :parallel
25 | :step-id '(1)
26 | :has-dependencies false
27 | :result {:status :running}
28 | :children
29 | [{:name "in-cwd"
30 | :type :container
31 | :step-id '(1 1)
32 | :has-dependencies false
33 | :result {}
34 | :children [{:name "do-stuff"
35 | :type :step
36 | :step-id '(1 1 1)
37 | :has-dependencies false
38 | :children []
39 | :result {:status :failure
40 | :out "do stuff failed"}}]}
41 | {:name "in-cwd"
42 | :type :container
43 | :step-id '(2 1)
44 | :has-dependencies false
45 | :result {}
46 | :children [{:name "do-other-stuff"
47 | :type :step
48 | :step-id '(1 2 1)
49 | :has-dependencies false
50 | :children []
51 | :result {:status :running :some-key :some-value}}]}]}])
52 |
53 | (def foo-pipeline-structure
54 | [{:name "in-parallel"
55 | :type :parallel
56 | :step-id '(1)
57 | :has-dependencies false
58 | :children
59 | [{:name "in-cwd"
60 | :type :container
61 | :step-id '(1 1)
62 | :has-dependencies false
63 | :children [{:name "do-stuff"
64 | :type :step
65 | :step-id '(1 1 1)
66 | :has-dependencies false
67 | :children []}]}
68 | {:name "in-cwd"
69 | :type :container
70 | :step-id '(2 1)
71 | :has-dependencies false
72 | :result {}
73 | :children [{:name "do-other-stuff"
74 | :type :step
75 | :step-id '(1 2 1)
76 | :has-dependencies false
77 | :children []}]}]}])
78 |
79 | (deftest unified-presentation-test
80 | (testing "that we can merge structure and state to a unified view on a pipeline-run"
81 | (testing "call with build-result"
82 | (is (= expected-unified-foo-pipeline-presentation (pipeline-structure-with-step-results foo-pipeline-structure foo-pipeline-build-state))))))
83 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/runners_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.runners-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.runners :refer :all]
4 | [lambdacd.testsupport.test-util :refer [start-waiting-for get-or-timeout wait-for]]
5 | [lambdacd.testsupport.data :refer [some-ctx]]
6 | [lambdacd.event-bus :as event-bus]))
7 |
8 | (deftest while-not-stopped-test
9 | (testing "that it can be stopped"
10 | (let [ctx (some-ctx)
11 | running (atom false)
12 | handle (start-waiting-for (while-not-stopped ctx (reset! running true)))]
13 | (wait-for @running)
14 | ; we expect it doesn't stop
15 | (is (= {:status :timeout} (get-or-timeout handle :timeout 500)))
16 | ; we stop it
17 | (stop-runner ctx)
18 | ; it stops
19 | (is (not= {:status :timeout} (get-or-timeout handle :timeout 200)))
20 | ; check that it's idempotent
21 | (stop-runner ctx))))
--------------------------------------------------------------------------------
/test/clj/lambdacd/smoketest/pipeline.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.smoketest.pipeline
2 | (:require [lambdacd.steps.control-flow :refer [in-parallel]]
3 | [lambdacd.smoketest.steps :refer :all]
4 | [lambdacd.util.internal.temp :as temp-util]))
5 |
6 | (def pipeline-def
7 | `(
8 | lambdacd.steps.manualtrigger/wait-for-manual-trigger
9 | wait-for-some-repo
10 | (with-some-repo
11 | read-some-value-from-repo)
12 | (in-parallel
13 | increment-counter-by-three
14 | increment-counter-by-two
15 | use-global-value)
16 | lambdacd.steps.manualtrigger/wait-for-manual-trigger))
17 |
18 | (def config
19 | {:home-dir (temp-util/create-temp-dir)})
20 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/smoketest/smoke_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.smoketest.smoke-test
2 | (:require [lambdacd.smoketest.steps :as steps]
3 | [org.httpkit.server :as http-kit]
4 | [org.httpkit.client :as http]
5 | [clojure.test :refer :all]
6 | [clojure.data.json :as json]
7 | [lambdacd.smoketest.pipeline :as pipeline]
8 | [lambdacd.util.internal.bash :as bash-util]
9 | [lambdacd.core :as core]
10 | [lambdacd.runners :as runners]
11 | [lambdacd.ui.core :as ui-core]))
12 |
13 | (def url-base "http://localhost:3000")
14 | (defn- test-server [handler]
15 | (http-kit/run-server handler {:port 3000}))
16 |
17 | (defn- server-status []
18 | (:status (deref (http/get (str url-base "/api/builds/1/")))))
19 |
20 | (defn- nth-build [n]
21 | (let [response (deref (http/get (str url-base "/api/builds/" n "/")))
22 | data (:body response)]
23 | (if (= 200 (:status response))
24 | (json/read-str data)
25 | (throw (Exception. (str "Unexpected status code: " (:status response) response))))))
26 |
27 | (defn- first-build []
28 | (nth-build 1))
29 | (defn- second-build []
30 | (nth-build 2))
31 |
32 |
33 | (defn- manual-trigger []
34 | (get (first (first-build)) "result"))
35 |
36 | (defn- manual-trigger-state []
37 | (get (manual-trigger) "status"))
38 |
39 | (defn- manual-trigger-id []
40 | (get (manual-trigger) "trigger-id"))
41 |
42 | (defn- in-parallel-step-result [build]
43 | (get (nth build 3) "result"))
44 |
45 | (defn- in-parallel-status [build]
46 | (get (in-parallel-step-result build) "status"))
47 |
48 | (defn- post-empty-json-to [url]
49 | (:status (deref (http/post
50 | url
51 | {:body "{}" :headers { "Content-Type" "application/json"}}))))
52 |
53 | (defn- trigger-manual-trigger []
54 | (post-empty-json-to (str (str url-base "/api/dynamic/") (manual-trigger-id))))
55 |
56 |
57 | (defn- retrigger-increment-counter-by-three []
58 | (post-empty-json-to (str url-base "/api/builds/1/4/retrigger")))
59 |
60 | (defn wait-a-bit []
61 | (Thread/sleep 2000)) ; TODO: make more robust, wait for something specific
62 |
63 | (defmacro with-server [server & body]
64 | `(let [server# ~server]
65 | (try
66 | ~@body
67 | (finally (server#)))))
68 |
69 | (defn- create-test-repo-at [dir]
70 | (bash-util/bash dir
71 | "git init"
72 | "touch foo"
73 | "git add -A"
74 | "git commit -m \"some message\""))
75 |
76 | (defn- commit [dir]
77 | (bash-util/bash dir
78 | "echo \"world\" > foo"
79 | "git add -A"
80 | "git commit -m \"some message\""))
81 |
82 | (deftest ^:smoke smoke-test
83 | (testing "that we can run a pipeline"
84 | (create-test-repo-at steps/some-repo-location)
85 | (let [pipeline (core/assemble-pipeline pipeline/pipeline-def pipeline/config)]
86 | (runners/start-one-run-after-another pipeline)
87 | (with-server (test-server (ui-core/ui-for pipeline))
88 | (is (= 200 (server-status)))
89 | (is (= "waiting" (manual-trigger-state)))
90 | (is (= 200 (trigger-manual-trigger)))
91 | (wait-a-bit)
92 | (is (= "success" (manual-trigger-state)))
93 | (commit steps/some-repo-location)
94 | (wait-a-bit)
95 | (is (= 5 @steps/some-counter))
96 | (is (= "world\n" @steps/some-value-read-from-git-repo))
97 | (is (= "hello world\n" @steps/the-global-value))
98 | (is (= "success" (in-parallel-status (first-build))))
99 | (is (= 200 (retrigger-increment-counter-by-three)))
100 | (wait-a-bit)
101 | (is (= "success" (in-parallel-status (second-build))))
102 | (is (= 10 @steps/some-counter))))))
103 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/smoketest/steps.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.smoketest.steps
2 | (:require [lambdacd.steps.git :as git]
3 | [lambdacd.util.internal.temp :as temp-util]))
4 |
5 | (defn do-stuff [& _]
6 | (println "foobar"))
7 |
8 | (def some-counter (atom 0))
9 |
10 | (def some-value-read-from-git-repo
11 | (atom nil))
12 |
13 | (def the-global-value (atom nil))
14 |
15 | (def some-repo-location
16 | (temp-util/create-temp-dir))
17 | (def some-repo-uri
18 | (str "file://" some-repo-location))
19 |
20 | (defn increment-counter-by-two [& _]
21 | (swap! some-counter #(+ 2 %1))
22 | {:status :success})
23 |
24 | (defn increment-counter-by-three [& _]
25 | (swap! some-counter #(+ 3 %1))
26 | {:status :success})
27 |
28 | (defn wait-for-some-repo [_ ctx]
29 | (git/wait-with-details ctx some-repo-uri "master" :ms-between-polls 100))
30 |
31 | (defn ^{:display-type :container} with-some-repo [& steps]
32 | (git/with-git some-repo-uri steps))
33 |
34 | (defn read-some-value-from-repo [{cwd :cwd} & _]
35 | (let [the-value (swap! some-value-read-from-git-repo (fn [_] (slurp (str cwd "/foo"))))]
36 | {:status :success :global {:value-from-repo the-value}}))
37 |
38 | (defn use-global-value [{{v :value-from-repo} :global} & _]
39 | (let [hello-global (str "hello " v)]
40 | (swap! the-global-value (constantly hello-global))
41 | {:status :success}))
42 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/state/internal/dead_steps_marking_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.state.internal.dead-steps-marking-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.state.internal.dead-steps-marking :refer :all]
4 | [lambdacd.testsupport.data :refer [some-ctx-with]]))
5 |
6 | (deftest mark-dead-steps-test
7 | (testing "that active steps that don't show up in active build step tracking are marked as dead"
8 | (let [ctx (some-ctx-with :started-steps (atom #{{:step-id [2]
9 | :build-number 1}}))]
10 | (is (= {[1] {:status :dead}
11 | [2] {:status :running}}
12 | (mark-dead-steps ctx 1 {[1] {:status :running}
13 | [2] {:status :running}})))
14 | (is (= {[1] {:status :dead}
15 | [2] {:status :dead}}
16 | (mark-dead-steps ctx 2 {[1] {:status :running}
17 | [2] {:status :running}})))))
18 | (testing "that inactive steps that don't show up in active build step tracking are left as they were"
19 | (let [ctx (some-ctx-with :started-steps (atom #{}))]
20 | (is (= {[1] {:status :success}
21 | [2] {:status :failure}}
22 | (mark-dead-steps ctx 1 {[1] {:status :success}
23 | [2] {:status :failure}})))))
24 | (testing "that it preserves incoming nils"
25 | (let [ctx (some-ctx-with :started-steps (atom #{}))]
26 | (is (= nil (mark-dead-steps ctx 1 nil))))))
27 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/state/internal/pipeline_state_updater_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.state.internal.pipeline-state-updater-test
2 | (:use [lambdacd.testsupport.test-util])
3 | (:refer-clojure :exclude [alias update])
4 | (:require [clojure.test :refer :all]
5 | [lambdacd.state.internal.pipeline-state-updater :refer :all]
6 | [lambdacd.state.protocols :as protocols]
7 | [lambdacd.testsupport.test-util :as tu]
8 | [lambdacd.testsupport.data :refer [some-ctx-with some-ctx]]
9 | [lambdacd.event-bus :as event-bus]))
10 |
11 | (deftest pipeline-state-updater-test
12 | (testing "that we tap into the event bus update the pipeline state with its information"
13 | (let [updates (atom [])
14 | pipeline-state (reify protocols/StepResultUpdateConsumer
15 | (consume-step-result-update [self build-number step-id step-result]
16 | (swap! updates #(conj %1 [build-number step-id step-result]))))
17 | ctx (some-ctx-with :pipeline-state-component pipeline-state)]
18 |
19 | (event-bus/publish!! ctx :step-result-updated {:build-number 1 :step-id [1 2] :step-result {:status :running}})
20 | (event-bus/publish!! ctx :step-result-updated {:build-number 2 :step-id [1 2] :step-result {:status :success}})
21 | (event-bus/publish!! ctx :step-result-updated {:build-number 1 :step-id [1 2] :step-result {:status :running :foo :bar}})
22 |
23 | (wait-for (= 3 (count @updates)))
24 | (is (= [[1 [1 2] {:status :running}]
25 | [2 [1 2] {:status :success}]
26 | [1 [1 2] {:status :running :foo :bar}]] @updates))))
27 | (testing "that after a step result is consumed, an event is sent to inform about this"
28 | (let [updates (atom [])
29 | pipeline-state (reify protocols/StepResultUpdateConsumer
30 | (consume-step-result-update [self build-number step-id step-result]
31 | (swap! updates #(conj %1 [build-number step-id step-result]))))
32 | ctx (some-ctx-with :pipeline-state-component pipeline-state)
33 | consume-events (event-bus/only-payload
34 | (event-bus/subscribe ctx :step-result-update-consumed))
35 | update-event {:build-number 1 :step-id [1 2] :step-result {:status :running}}]
36 |
37 | (event-bus/publish!! ctx :step-result-updated update-event)
38 |
39 | (is (= [update-event] (slurp-chan-with-size 1 consume-events)))))
40 | (testing "shutdown behavior"
41 | (testing "that the pipeline-state-updater can be stopped with a message on the event bus"
42 | (let [pipeline-state (reify protocols/StepResultUpdateConsumer
43 | (consume-step-result-update [_ _ _ _]
44 | (throw (Exception. "no update expected"))))
45 | ctx (some-ctx-with :pipeline-state-component pipeline-state)
46 | updater-finished-ch (start-pipeline-state-updater ctx)]
47 | (tu/call-with-timeout 1000 (stop-pipeline-state-updater (assoc ctx :pipeline-state-updater updater-finished-ch)))
48 | (is (not= {:status :timeout} (tu/get-or-timeout updater-finished-ch :timeout 1000)))))
49 | (testing "that stopping is idempotent"
50 | (let [pipeline-state (reify protocols/StepResultUpdateConsumer
51 | (consume-step-result-update [_ _ _ _]
52 | (throw (Exception. "no update expected"))))
53 | ctx (some-ctx-with :pipeline-state-component pipeline-state)
54 | updater-finished-ch (start-pipeline-state-updater ctx)]
55 | (tu/call-with-timeout 1000 (stop-pipeline-state-updater (assoc ctx :pipeline-state-updater updater-finished-ch)))
56 | (tu/call-with-timeout 1000 (stop-pipeline-state-updater (assoc ctx :pipeline-state-updater updater-finished-ch)))
57 | (is (not= {:status :timeout} (tu/get-or-timeout updater-finished-ch :timeout 1000)))
58 | (tu/call-with-timeout 1000 (stop-pipeline-state-updater (assoc ctx :pipeline-state-updater updater-finished-ch)))))))
59 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/step_id_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.step-id-test
2 | (:use [lambdacd.testsupport.test-util])
3 | (:require [clojure.test :refer :all]
4 | [lambdacd.step-id :refer :all]))
5 |
6 | (deftest later-or-before-test
7 | (testing "that [2] is after [1]"
8 | (is (later-than? [2] [1]))
9 | (is (not (before? [2] [1])))
10 | (is (not (later-than? [1] [2])))
11 | (is (before? [1] [2])))
12 | (testing "that [2] is after a child of [1]"
13 | (is (later-than? [2] [1 1]))
14 | (is (not (before? [2] [1 1] )))
15 | (is (later-than? [2] [2 1]))
16 | (is (not (before? [2] [2 1])))
17 | (is (not (later-than? [1 1] [2])))
18 | (is (before? [1 1] [2])))
19 | (testing "that a child of [2] is after a child of [1]"
20 | (is (later-than? [1 2] [1 1]))
21 | (is (not (before? [1 2] [1 1])))
22 | (is (later-than? [1 2] [1 1 1]))
23 | (is (not (before? [1 2] [1 1 1])))
24 | (is (later-than? [1 1 2] [1 1]))
25 | (is (not (later-than? [1 1] [1 1 2]))))
26 | (testing "that a child of [1] is after [1]"
27 | (is (later-than? [1 1] [1]))
28 | (is (not (later-than? [1] [1 1]))))
29 | (testing "that a step-id is not after or before itself"
30 | (is (not (later-than? [1 1] [1 1])))
31 | (is (not (before? [1 1] [1 1]))))
32 | (testing "that [3 2] is not before [2 2]"
33 | (is (not (before? [3 2] [2 2])))
34 | (is (later-than? [3 2] [2 2]))))
35 |
36 | (deftest parent-relationship-test
37 | (testing "you need a common postfix to be a parent of something"
38 | (is (not (parent-of? [1] [1])))
39 | (is (parent-of? [1] [2 1]))
40 | (is (not (parent-of? [2 1] [1])))
41 | (is (parent-of? [2] [2 2]))
42 | (is (not (parent-of? [2 2] [2])))
43 | (is (parent-of? [2] [1 2 2]))
44 | (is (not (parent-of? [1 2 2] [2])))
45 | (is (not (parent-of? [1] [2 2 2])))))
46 |
47 | (deftest direct-parent-test
48 | (testing "a direct child relationship"
49 | (is (not (direct-parent-of? [1] [1])))
50 | (is (direct-parent-of? [1] [2 1]))
51 | (is (not (direct-parent-of? [2 1] [1]))))
52 | (testing "recursive child relationship"
53 | (is (not (direct-parent-of? [2] [1 2 2])))))
54 |
55 | (deftest root-step-id?-test
56 | (testing "that a root-step has a step-id with only one digit, i.e. it has no parent"
57 | (is (root-step-id? [1]))
58 | (is (not (root-step-id? [1 1])))))
59 |
60 | (deftest root-step-id-test
61 | (testing "that root-step-id is the last element of the step id"
62 | (is (= 1 (root-step-id-of [1])))
63 | (is (= 1 (root-step-id-of [3 2 1])))))
--------------------------------------------------------------------------------
/test/clj/lambdacd/stepresults/flatten_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepresults.flatten-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.stepresults.flatten :refer :all]))
4 |
5 | (deftest flatten-step-result-outputs-test
6 | (testing "that it works"
7 | (is (= {[1] {:status :success}
8 | [2] {:status :success
9 | :outputs {[1 2] {:status :success :step [1 2]}}}
10 | [1 2] {:status :success :step [1 2]}}
11 | (flatten-step-result-outputs {[1] {:status :success}
12 | [2] {:status :success
13 | :outputs {[1 2] {:status :success :step [1 2]}}}})))))
14 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/stepresults/merge_resolvers_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepresults.merge-resolvers-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.stepresults.merge-resolvers :refer :all]
4 | [lambdacd.stepresults.merge-resolvers :as merge-resolvers]
5 | [lambdacd.testsupport.test-util :refer [with-private-fns]]))
6 |
7 | (deftest some-key :k)
8 |
9 | (deftest join-output-resolver-test
10 | (testing "that :out gets resolved by joining strings with newlines"
11 | (is (= "foo\nbar" (join-output-resolver :out "foo" "bar"))))
12 | (testing "that other keys don't resolve"
13 | (is (= nil (join-output-resolver :other-key "foo" "bar"))))
14 | (testing "that outs that arent strings don't resolve"
15 | (is (= nil (join-output-resolver :other-key 1 "bar")))
16 | (is (= nil (join-output-resolver :other-key "foo" :bar)))))
17 |
18 | (deftest merge-nested-maps-resolver-test
19 | (testing "that it returns nil if one of the two inputs is not a map"
20 | (is (= nil (merge-nested-maps-resolver some-key {} "x")))
21 | (is (= nil (merge-nested-maps-resolver some-key :x {} ))))
22 | (testing "that it merges to maps"
23 | (is (= {:foo :bar
24 | :bar :baz} (merge-nested-maps-resolver some-key
25 | {:foo :bar}
26 | {:bar :baz}))))
27 | (testing "that it's not a deep merge, the second one wins"
28 | (is (= {:nested {:bar :baz}} (merge-nested-maps-resolver some-key
29 | {:nested {:foo :bar}}
30 | {:nested {:bar :baz}})))))
31 |
32 | (with-private-fns [lambdacd.stepresults.merge-resolvers [choose-last-or-not-success]]
33 | (deftest choose-last-or-not-success-test
34 | (testing "everything not success wins over success"
35 | (is (= :success (choose-last-or-not-success :success :success)))
36 | (is (= :failure (choose-last-or-not-success :success :failure)))
37 | (is (= :failure (choose-last-or-not-success :failure :success)))
38 | (is (= :unknown (choose-last-or-not-success :unknown :success))))
39 | (testing "that if none of the two is success, choose the latter"
40 | (is (= :unknown (choose-last-or-not-success :failure :unknown)))
41 | (is (= :failure (choose-last-or-not-success :unknown :failure))))))
42 |
43 | (deftest status-resolver-test
44 | (testing "that it returns nil if the key to be merged is not status"
45 | (is (= nil (status-resolver :hello :success :failure))))
46 | (testing "that it delegates if it is a status"
47 | (with-redefs [merge-resolvers/choose-last-or-not-success (fn [s1 s2] (str s1 s2))]
48 | (is (= ":success:failure" (status-resolver :status :success :failure))))))
49 |
50 | (deftest second-wins-resolver-test
51 | (testing "that it always returns the second argument"
52 | (is (= 2 (second-wins-resolver some-key 1 2)))
53 | (is (= 1 (second-wins-resolver some-key 2 1)))
54 | (is (= nil (second-wins-resolver some-key 2 nil)))))
55 |
56 | (deftest combine-to-list-resolver-test
57 | (testing "that it concatenates two lists"
58 | (is (= [1 2 3 4] (combine-to-list-resolver some-key [1 2] [3 4]))))
59 | (testing "that it does stuff if only the first one is a list"
60 | (is (= [1 2 "test"] (combine-to-list-resolver some-key [1 2] "test")))) ; TODO: stuff
61 | (testing "that it returns nil if the first one is not a list"
62 | (is (= nil (combine-to-list-resolver some-key nil [3 4])))))
63 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/stepresults/merge_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.stepresults.merge-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.stepresults.merge :refer :all]
4 | [conjure.core :as c]))
5 |
6 | (defn some-resolver [_ _ _] nil)
7 | (defn some-other-resolver [_ _ _])
8 | (defn some-third-resolver [_ _ _])
9 |
10 | (defn some-merge-fn [map-a map-b]
11 | (assoc (merge map-a map-b)
12 | :something :extra))
13 |
14 | (deftest merge-step-results-test
15 | (testing "that it can merge a list of step results"
16 | (is (= {:status :success
17 | :foo :bar
18 | :bar :baz
19 | :something :extra}
20 | (merge-step-results [{:status :success}
21 | {:foo :bar}
22 | {:bar :baz}]
23 | some-merge-fn))))
24 | (testing "that later things overwrite earlier things"
25 | (is (= {:status :success
26 | :foo :baz}
27 | (merge-step-results [{:status :success}
28 | {:foo :bar}
29 | {:foo :baz}]
30 | merge))))
31 | (testing "that an empty list merges to an empty result"
32 | (is (= {}
33 | (merge-step-results [] merge)))))
34 |
35 |
36 | (deftest merge-two-step-results-test
37 | (testing "that it merges two steps and resolves conflicts using the passed resolvers"
38 | (testing "conflictless merging"
39 | (is (= {:foo "hello" :bar "world"} (merge-two-step-results {:foo "hello"} {:bar "world"}
40 | :resolvers []))))
41 | (testing "using the resolvers"
42 | (testing "the resolver gets called"
43 | (c/stubbing [some-resolver :resolved]
44 | (is (= {:foo :resolved} (merge-two-step-results {:foo :bar} {:foo :baz}
45 | :resolvers [some-resolver])))
46 | (c/verify-called-once-with-args some-resolver :foo :bar :baz)))
47 | (testing "that the first matching resolver wins"
48 | (c/stubbing [some-resolver nil
49 | some-other-resolver :resolved
50 | some-third-resolver :also-resolved]
51 | (is (= {:foo :resolved} (merge-two-step-results {:foo :bar} {:foo :baz}
52 | :resolvers [some-resolver some-other-resolver some-third-resolver])))))
53 | (testing "that conflicts will become nil if no resolver is matching"
54 | (is (= {:foo nil} (merge-two-step-results {:foo :bar} {:foo :baz}
55 | :resolvers [some-resolver])))
56 | (is (= {:foo nil} (merge-two-step-results {:foo :bar} {:foo :baz}
57 | :resolvers []))))))
58 | (testing "defaults"
59 | (testing "that it merges statuses, maps and in doubt, the last wins"
60 | (is (= {:status :failure
61 | :m {:a :b
62 | :b :c}
63 | :s "b"}
64 | (merge-two-step-results {:status :failure
65 | :m {:a :b}
66 | :s "a"}
67 | {:status :success
68 | :m {:b :c}
69 | :s "b"}))))))
70 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/steps/manualtrigger_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.steps.manualtrigger-test
2 | (:require [clojure.test :refer :all]
3 | [clojure.core.async :as async]
4 | [lambdacd.steps.manualtrigger :refer :all]
5 | [lambdacd.testsupport.test-util :refer :all]
6 | [lambdacd.testsupport.data :refer :all]))
7 |
8 | (deftest manualtrigger-test
9 | (testing "that the trigger is released after it was notified by something"
10 | (let [result-channel (async/chan 100)
11 | ctx (some-ctx-with :result-channel result-channel)
12 | trigger-id-ch (start-waiting-for-result :trigger-id result-channel)
13 | waiting-ch (start-waiting-for (wait-for-manual-trigger {} ctx))
14 | trigger-id (async/ {:initial-pipeline-state {} ;; only used to assemble pipeline-state, not in real life
16 | :step-id [42]
17 | :build-number 10
18 | :result-channel (async/chan (async/dropping-buffer 100))
19 | :pipeline-state-component nil ;; set later
20 | :config config
21 | :is-killed (atom false)
22 | :_out-acc (atom "")
23 | :started-steps (atom #{})})))
24 |
25 | (defn- add-pipeline-state-component [template]
26 | (if (nil? (:pipeline-state-component template))
27 | (assoc template :pipeline-state-component
28 | (default-pipeline-state/new-default-pipeline-state (:config template) :initial-state-for-testing (:initial-pipeline-state template)))
29 | template))
30 |
31 | (defn run-pipeline-state-updater [ctx]
32 | (if (:pipeline-state-component ctx)
33 | (pipeline-state-updater/start-pipeline-state-updater ctx))
34 | ctx)
35 |
36 | (defn some-ctx []
37 | (-> (some-ctx-template)
38 | (add-pipeline-state-component)
39 | (event-bus/initialize-event-bus)
40 | (run-pipeline-state-updater)))
41 |
42 | (defn some-ctx-with [& args]
43 | (as-> (some-ctx-template) $
44 | (apply assoc $ args)
45 | (add-pipeline-state-component $)
46 | (event-bus/initialize-event-bus $)
47 | (run-pipeline-state-updater $)))
48 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/testsupport/matchers.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.testsupport.matchers)
2 |
3 | (defn map-containing [expected m]
4 | (and (every? (set (keys m)) (keys expected))
5 | (every? #(= (m %)(expected %)) (keys expected))))
6 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/testsupport/matchers_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.testsupport.matchers-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.testsupport.matchers :refer :all]))
4 |
5 |
6 | (deftest map-containing?-test
7 | (testing "that it matches when the key-value pairs of the expected map are in the actual map"
8 | (is (= true (map-containing {:foo :bar } {:foo :bar})))
9 | (is (= true (map-containing {:foo :bar } {:foo :bar :x :y})))
10 | (is (= false (map-containing {:foo :bar :x :y} {:foo :bar })))
11 | (is (= true (map-containing { } {:foo :bar :x :y})))
12 | (is (= false (map-containing { :hello :world } {:foo :bar :hello :joe})))
13 | (is (= false (map-containing { :foo :bar } {:something-nested { :foo :bar }})))
14 | ))
15 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/testsupport/noop_pipeline_state.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.testsupport.noop-pipeline-state
2 | (:require [lambdacd.state.protocols :as protocols]))
3 |
4 | (defrecord NoOpPipelineState []
5 | protocols/StepResultUpdateConsumer
6 | (consume-step-result-update [self build-number step-id step-result])
7 | protocols/PipelineStructureConsumer
8 | (consume-pipeline-structure [self build-number pipeline-structure-representation])
9 | protocols/NextBuildNumberSource
10 | (next-build-number [self] (throw (IllegalStateException. "not supported by NoOpPipelineState")))
11 | protocols/QueryAllBuildNumbersSource
12 | (all-build-numbers [self] (throw (IllegalStateException. "not supported by NoOpPipelineState")))
13 | protocols/QueryStepResultsSource
14 | (get-step-results [self build-number] (throw (IllegalStateException. "not supported by NoOpPipelineState")))
15 | protocols/PipelineStructureSource
16 | (get-pipeline-structure [self build-number] (throw (IllegalStateException. "not supported by NoOpPipelineState"))))
17 |
18 | (defn new-no-op-pipeline-state []
19 | (->NoOpPipelineState))
20 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/testsupport/reporter.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.testsupport.reporter
2 | "A few reporters to improve test-failure reporting"
3 | (:require [clojure.test :as t]))
4 |
5 |
6 |
7 | (defn pass-fail [b]
8 | (if b
9 | :pass
10 | :fail))
11 |
12 | (defmethod t/assert-expr '.endsWith [msg form]
13 | `(t/do-report {:type (pass-fail ~form) :expected (str "A string ending with `" ~(nth form 2) "`") :actual ~(second form) :message ~msg}))
14 | (defmethod t/assert-expr '.startsWith [msg form]
15 | `(t/do-report {:type (pass-fail ~form) :expected (str "A starting with `" ~(nth form 2) "`") :actual ~(second form) :message ~msg}))
16 |
17 |
18 | (defmethod t/assert-expr 'map-containing [msg form]
19 | `(t/do-report {:type (pass-fail ~form) :expected (str "A map containing " ~(nth form 1)) :actual ~(nth form 2) :message ~msg}))
20 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/testsupport/test_util_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.testsupport.test-util-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.testsupport.test-util :refer :all]
4 | [clojure.core.async :as async]))
5 |
6 | (defn some-function-changing-an-atom [a]
7 | (reset! a "hello")
8 | (reset! a "world"))
9 |
10 | (defn some-step-taking-50ms [arg & _]
11 | (Thread/sleep 50)
12 | {:foo :bar})
13 |
14 |
15 | (deftest atom-history-test
16 | (testing "that we can record the history of an atom"
17 | (let [some-atom (atom "")]
18 | (is (= ["hello" "world"]
19 | (atom-history-for some-atom (some-function-changing-an-atom some-atom)))))))
20 |
21 | (deftest history-for-test
22 | (testing "that we can record the history of an atom"
23 | (let [some-atom (atom "")
24 | history-atom (history-for-atom some-atom)]
25 | (some-function-changing-an-atom some-atom)
26 | (is (= ["hello" "world"]
27 | @history-atom)))))
28 |
29 | (deftest timing-test
30 | (testing "that my-time more or less accurately measures the execution time of a step"
31 | (is (close? 10 50 (my-time (some-step-taking-50ms {}))))))
32 |
33 | (deftest without-keys-test
34 | (testing "that we can get rid of key-value pairs in a nested map"
35 | (is (= {:a {:b {:foo :bar} :d {:bar :baz}}} (without-key {:a {:b {:c 1 :foo :bar} :d {:c 2 :bar :baz}}} :c)))))
36 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/ui/internal/util_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.ui.internal.util-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.ui.internal.util :refer :all]))
4 |
5 | (deftest json-test
6 | (testing "that a proper ring-json-response is returned"
7 | (is (= {:body "{\"hello\":\"world\"}"
8 | :headers {"Content-Type" "application/json;charset=UTF-8"}
9 | :status 200} (json { :hello :world })))))
10 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/util/internal/bash_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.bash-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.util.internal.bash :refer [bash]]
4 | [clojure.java.io :as io]
5 | [lambdacd.util.internal.temp :as temp-util]))
6 |
7 | (deftest bash-util-test
8 | (testing "that it executes something on the bash"
9 | (let [cwd (temp-util/create-temp-dir)]
10 | (is (= {:out "helloworld\n"
11 | :err ""
12 | :exit 1} (bash cwd
13 | "touch some-file"
14 | "echo helloworld"
15 | "exit 1")))
16 | (is (.exists (io/file cwd "some-file"))))))
17 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/util/internal/coll_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.coll-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.util.internal.coll :refer :all]))
4 |
5 | (deftest fill-test
6 | (testing "that we can fill up a sequence to a certain length"
7 | (is (= [1 2 3 -1 -1] (fill [1 2 3] 5 -1))))
8 | (testing "that a collection is left just as it was if it is already longer than the desired length"
9 | (is (= [1 2 3] (fill [1 2 3] 2 -1)))
10 | (is (= [1 2 3] (fill [1 2 3] 3 -1)))))
11 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/util/internal/exceptions_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.exceptions-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.util.internal.exceptions :refer [stacktrace-to-string]]))
4 |
5 | (deftest stacktrace-to-string-test
6 | (testing "that we can convert an exception into a proper string"
7 | (let [result (stacktrace-to-string (Exception. "some error"))]
8 | (is (.contains result "some error"))
9 | (is (.contains result "exceptions_test.clj")))))
10 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/util/internal/map_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.map-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.util.internal.map :refer :all]
4 | [conjure.core :as c]))
5 |
6 | (deftest put-if-not-present-test
7 | (testing "that it adds a value to a map only of no value exists for this key"
8 | (is (= {:foo :bar} (put-if-not-present {:foo :bar} :foo :baz)))
9 | (is (= {:foo :baz} (put-if-not-present {} :foo :baz)))
10 | (is (= {:a :b :foo :baz} (put-if-not-present {:a :b} :foo :baz)))))
11 |
12 | (defn some-function [k v1 v2]
13 | (str k v1 v2))
14 |
15 | (deftest merge-with-k-v-test
16 | (testing "that conflicts get passed to the passed function"
17 | (c/mocking [some-function]
18 | (merge-with-k-v some-function {:foo 1} {:foo 2})
19 | (c/verify-first-call-args-for some-function :foo 1 2)))
20 | (testing "a merge"
21 | (is (= {:foo ":foo12" :a 1 :b 2} (merge-with-k-v some-function {:foo 1 :a 1} {:foo 2 :b 2})))))
22 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/util/internal/sugar_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.sugar-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.util.internal.sugar :refer :all]))
4 |
5 | (deftest not-nil-test
6 | (testing "that nil is nil and not nil is not nil"
7 | (is (not-nil? 1))
8 | (is (not (not-nil? nil)))))
9 | (deftest parse-int-test
10 | (testing "that we can parse integers"
11 | (is (= 42 (parse-int "42")))
12 | (is (= -1 (parse-int "-1")))
13 | (is (thrown? NumberFormatException (parse-int "foo")))))
14 |
15 |
--------------------------------------------------------------------------------
/test/clj/lambdacd/util/internal/temp_test.clj:
--------------------------------------------------------------------------------
1 | (ns lambdacd.util.internal.temp-test
2 | (:require [clojure.test :refer :all]
3 | [lambdacd.util.internal.temp :refer :all]
4 | [clojure.java.io :as io]
5 | [me.raynes.fs :as fs]))
6 |
7 | (deftest create-temp-dir-test
8 | (testing "creating in default tmp folder"
9 | (testing "that we can create a temp-directory"
10 | (is (fs/exists? (io/file (create-temp-dir)))))
11 | (testing "that it is writable"
12 | (is (fs/mkdir (io/file (create-temp-dir) "hello")))))
13 | (testing "creating in a defined parent directory"
14 | (testing "that it is a child of the parent directory"
15 | (let [parent (create-temp-dir)]
16 | (is (= parent (.getParent (io/file (create-temp-dir parent)))))))))
17 |
18 | (defn- throw-if-not-exists [f]
19 | (if (not (fs/exists? f))
20 | (throw (IllegalStateException. (str f " does not exist")))
21 | "some-value-from-function"))
22 |
23 | (deftest with-temp-test
24 | (testing "that a tempfile is deleted after use"
25 | (let [f (create-temp-file)]
26 | (is (= "some-value-from-function" (with-temp f (throw-if-not-exists f))))
27 | (is (not (fs/exists? f)))))
28 | (testing "that a tempfile is deleted when body throws"
29 | (let [f (create-temp-file)]
30 | (is (thrown? Exception (with-temp f (throw (Exception. "oh no!")))))
31 | (is (not (fs/exists? f)))))
32 | (testing "that a temp-dir is deleted after use"
33 | (let [d (create-temp-dir)]
34 | (fs/touch (fs/file d "somefile"))
35 |
36 | (is (= "some-value-from-function" (with-temp d (throw-if-not-exists d))))
37 |
38 | (is (not (fs/exists? (fs/file d "somefile"))))
39 | (is (not (fs/exists? d)))))
40 | (testing "that it can deal with circular symlinks"
41 | (let [f (create-temp-dir)]
42 | (is (= "some-value-from-function"
43 | (with-temp f (let [link-parent (io/file f "foo" "bar")]
44 | (fs/mkdirs link-parent)
45 | (fs/sym-link (io/file link-parent "link-to-the-start") f)
46 | "some-value-from-function"
47 | ))))
48 | (is (not (fs/exists? f))))))
49 |
--------------------------------------------------------------------------------
/test/cljs/lambdacd/dom_utils.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.dom-utils
2 | (:require
3 | [dommy.core :as dommy]
4 | [dommy.core :refer-macros [sel sel1 by-tag]]))
5 |
6 | (defn fire!
7 | "Creates an event of type `event-type`, optionally having
8 | `update-event!` mutate and return an updated event object,
9 | and fires it on `node`.
10 | Only works when `node` is in the DOM"
11 | [node event-type & [update-event!]]
12 | (let [update-event! (or update-event! identity)]
13 | (if (.-createEvent js/document)
14 | (let [event (.createEvent js/document "Event")]
15 | (.initEvent event (name event-type) true true)
16 | (.dispatchEvent node (update-event! event)))
17 | (.fireEvent node (str "on" (name event-type))
18 | (update-event! (.createEventObject js/document))))))
19 |
20 |
21 |
22 | (defn found-in [div re]
23 | (let [res (.-innerHTML div)]
24 | (if (re-find re res)
25 | true
26 | (do (println "Not found: " res)
27 | false))))
28 |
29 | (defn not-found-in [div re]
30 | (let [res (.-innerHTML div)]
31 | (if (not (re-find re res))
32 | true
33 | (do (println "found: " res)
34 | false))))
35 |
36 | (defn having-class [classname elem]
37 | (if (dommy/has-class? elem classname)
38 | true
39 | (do (println "expected " elem " to have class " classname)
40 | false)))
41 |
42 | (defn containing-link-to [div href]
43 | (->> (map #(dommy/attr % :href) (by-tag div :a))
44 | (some #(= href %))))
45 |
46 | (defn containing-preformatted-text [div re]
47 | (found-in (first (by-tag div :pre)) re))
48 |
49 | (defn containing-ordered-list [elem]
50 | (not (empty? (sel elem :ol))))
51 |
52 | (defn containing-unordered-list [elem]
53 | (not (empty? (sel elem :ul))))
54 |
55 | (defn having-data [name value elem]
56 | (= value (dommy/attr elem (str "data-" name))))
57 |
58 | (defn after-click [atom elem]
59 | (fire! elem :click)
60 | @atom)
--------------------------------------------------------------------------------
/test/cljs/lambdacd/history_test.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.history-test
2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]]
3 | [lambdacd.dom-utils :as dom]
4 | [dommy.core :refer-macros [sel sel1]]
5 | [lambdacd.history :as history]
6 | [lambdacd.testutils :as tu]))
7 |
8 | (deftest history-test-cljs
9 | (testing "that the history contains all the builds"
10 | (tu/with-mounted-component
11 | [:div (history/build-history-renderer
12 | [{:build-number 1} {:build-number 3}] 1)]
13 | (fn [c div]
14 | (is (dom/found-in div #"Builds"))
15 | (is (dom/found-in div #"Build 1"))
16 | (is (dom/found-in div #"Build 3")))))
17 | (testing "that the history contains all the builds"
18 | (tu/with-mounted-component
19 | [:div (history/build-history-renderer
20 | [{:build-number 1} {:build-number 3}] 1)]
21 | (fn [c div]
22 | (is (dom/found-in div #"Builds"))
23 | (is (dom/found-in div #"Build 1"))
24 | (is (dom/found-in div #"Build 3")))))
25 | (testing "that the history displays the duration of a build"
26 | (tu/with-mounted-component
27 | [:div (history/build-history-renderer
28 | [{:build-number 1
29 | :duration-in-sec 75}] 1)]
30 | (fn [c div]
31 | (is (dom/found-in div #"1min 15sec")))))
32 | (testing "that the history displays build status icons"
33 | (tu/with-mounted-component
34 | [:div (history/build-history-renderer
35 | [{:build-number 1 :status "some-status-not-known"}
36 | {:build-number 2 :status "failure"}
37 | {:build-number 3 :status "success"}
38 | {:build-number 4 :status "running"}
39 | {:build-number 5 :status "waiting"}] 1)]
40 | (fn [c div]
41 | (is (dom/found-in div #"fa-question"))
42 | (is (dom/found-in div #"fa-times"))
43 | (is (dom/found-in div #"fa-check"))
44 | (is (dom/found-in div #"fa-cog"))
45 | (is (dom/found-in div #"fa-pause")))))
46 | (testing "that we can display metadata"
47 | (tu/with-mounted-component
48 | [:div (history/build-history-renderer
49 | [{:build-number 1
50 | :build-metadata {:some-metadata "foo"}}] 1)]
51 | (fn [c div]
52 | (is (dom/found-in div #"Metadata"))
53 | (is (dom/found-in div #"some-metadata"))
54 | (is (dom/found-in div #"foo")))))
55 | (testing "that metadata is not shown if none exists"
56 | (tu/with-mounted-component
57 | [:div (history/build-history-renderer
58 | [{:build-number 1}] 1)]
59 | (fn [c div]
60 | (is (dom/not-found-in div #"Metadata")))))
61 | (testing "that we render a loading-screen if no history is definde"
62 | (tu/with-mounted-component
63 | [:div
64 | (history/build-history-renderer nil 1)]
65 | (fn [c div]
66 | (is (dom/found-in div #"Builds"))
67 | (is (dom/found-in div #"Loading"))))))
68 |
--------------------------------------------------------------------------------
/test/cljs/lambdacd/logic_test.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.logic-test
2 | (:require
3 | [cljs.test :refer-macros [deftest is testing run-tests]]
4 | [lambdacd.testdata :refer [some-build-step with-name with-type with-output with-children with-step-id]]
5 | [lambdacd.testutils :refer [contains-value?]]
6 | [reagent.core :as r]
7 | [re-frame.core :as re-frame]
8 | [lambdacd.logic :as logic]))
9 |
10 | (defn mock-fn []
11 | (let [received-args (atom [])]
12 | (with-meta (fn [& args]
13 | (swap! received-args #(conj % (vec args))))
14 | {:received-args received-args})))
15 |
16 | (defn received-args [mock]
17 | @(:received-args (meta mock)))
18 |
19 | (defn has-received? [mock expected-arg]
20 | (let [received (received-args mock)
21 | result (contains-value? expected-arg received)]
22 | (is result (str received " does not contain " expected-arg))))
23 |
24 | (defn has-not-received? [mock expected-arg]
25 | (let [received (received-args mock)
26 | result (contains-value? expected-arg received)]
27 | (is (not result) (str received " does contain " expected-arg))))
28 |
29 | (def some-db {:displayed-build-number 42})
30 |
31 | (deftest on-tick-test
32 | (testing "that a tick dispatches update-history"
33 | (with-redefs [re-frame/dispatch (mock-fn)]
34 | (logic/on-tick some-db nil)
35 | (is (has-received? re-frame/dispatch [[::logic/start-update-history]]))))
36 | (testing "that a tick dispatches update-pipeline-state"
37 | (with-redefs [re-frame/dispatch (mock-fn)]
38 | (logic/on-tick some-db nil)
39 | (has-received? re-frame/dispatch [[::logic/start-update-pipeline]])))
40 | (testing "that a tick doesn't dispatch update-pipeline-state if no build-number is set"
41 | (with-redefs [re-frame/dispatch (mock-fn)]
42 | (logic/on-tick (assoc some-db :displayed-build-number nil) nil)
43 | (has-not-received? re-frame/dispatch [[::logic/start-update-pipeline]])))
44 | (testing "that a tick doesn't dispatch start-update-history if history update is in progress"
45 | (with-redefs [re-frame/dispatch (mock-fn)]
46 | (logic/on-tick {:update-in-progress? true} nil)
47 | (has-not-received? re-frame/dispatch [[::logic/tick]])))
48 | ;; TODO: start-update-history is a event-fx not event-db, it returns dispatch array. Need to extend testing helpers.
49 | #_(testing "that a start-update-history dispatches update-history"
50 | (with-redefs [re-frame/dispatch (mock-fn)]
51 | (re-frame/dispatch [::logic/start-update-history])
52 | (has-received? re-frame/dispatch [[::logic/update-history]]))))
53 |
--------------------------------------------------------------------------------
/test/cljs/lambdacd/route_test.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.route-test
2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]]
3 | [dommy.core :refer-macros [sel sel1]]
4 | [re-frame.core :as re-frame]
5 | [lambdacd.db :as db]
6 | [lambdacd.route :as route]))
7 |
8 | ; FIXME: clean up mocking!
9 |
10 | (defn mock-dispatch [step-id-atom]
11 | (fn [[event-id data]]
12 | (if (= ::db/step-id-updated event-id)
13 | (reset! step-id-atom data))))
14 |
15 | (deftest dispatch-route-test
16 | (testing "that a route with a build-number sets the build-number correctly"
17 | (let [build-number-atom (atom nil)
18 | step-id-to-display (atom nil)
19 | state-atom (atom nil)]
20 | (with-redefs [re-frame/dispatch (mock-dispatch step-id-to-display)]
21 | (is (= { :routing :ok } (route/dispatch-route "/builds/3")))
22 | #_(is (= 3 @build-number-atom)))))
23 | (testing "that an route with a build-number sets the displayed step-id back to nil"
24 | (let [step-id-to-display (atom "something")
25 | state-atom (atom nil)]
26 | (with-redefs [re-frame/dispatch (mock-dispatch step-id-to-display)]
27 | (route/dispatch-route "/builds/3")
28 | (is (= nil @step-id-to-display)))))
29 | (testing "that an route with a build-number resets the build-state so that we don't get a half-ready display until the new state is loaded"
30 | (let [step-id-to-display (atom "something")
31 | state-atom (atom "some-state")]
32 | (route/dispatch-route "/builds/3")
33 | #_(is (= nil @state-atom))))
34 | (testing "that an route with a build-number and step-id sets both"
35 | (let [build-number-atom (atom nil)
36 | step-id-to-display (atom "something")
37 | state-atom (atom nil)]
38 | (with-redefs [re-frame/dispatch (mock-dispatch step-id-to-display)]
39 | (is (= { :routing :ok } (route/dispatch-route "/builds/3/2-1-3")))
40 | #_(is (= 3 @build-number-atom))
41 | (is (= [2 1 3] @step-id-to-display)))))
42 | (testing "that an invalid route leaves the atom alone and returns a path to redirect to"
43 | (let [build-number-atom (atom nil)
44 | step-id-to-display (atom nil)
45 | state-atom (atom nil)]
46 | (with-redefs [re-frame/dispatch (fn [[_ build-number]]
47 | (reset! build-number-atom build-number))]
48 | (is (= {:routing :failed } (route/dispatch-route "/i/dont/know")))
49 | (is (= nil @build-number-atom))
50 | (is (= nil @step-id-to-display))))))
51 |
52 |
53 | (deftest build-route
54 | (testing "that we can create a decent route to a build"
55 | (is (= "#/builds/42" (route/for-build-number 42))))
56 | (testing "that we can create a route pointing to a particular step and build"
57 | (is (= "#/builds/42/3-2-1" (route/for-build-and-step-id 42 [3 2 1])))))
58 |
--------------------------------------------------------------------------------
/test/cljs/lambdacd/runner.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.runner
2 | (:require [doo.runner :refer-macros [doo-tests]]
3 | [lambdacd.history-test]
4 | [lambdacd.output-test]
5 | [lambdacd.pipeline-test]
6 | [lambdacd.route-test]
7 | [lambdacd.state-test]
8 | [lambdacd.time-test]
9 | [lambdacd.ui-core-test]
10 | [lambdacd.db-test]
11 | [lambdacd.logic-test]
12 | [lambdacd.console-output-processor-test]))
13 |
14 | (doo-tests 'lambdacd.history-test
15 | 'lambdacd.output-test
16 | 'lambdacd.pipeline-test
17 | 'lambdacd.route-test
18 | 'lambdacd.state-test
19 | 'lambdacd.time-test
20 | 'lambdacd.ui-core-test
21 | 'lambdacd.db-test
22 | 'lambdacd.logic-test
23 | 'lambdacd.console-output-processor-test)
24 |
--------------------------------------------------------------------------------
/test/cljs/lambdacd/state_test.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.state-test
2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]]
3 | [dommy.core :refer-macros [sel sel1]]
4 | [lambdacd.testdata :refer [some-build-step with-step-id with-status with-children]]
5 | [lambdacd.state :as state]))
6 |
7 | (def cwd-child-a
8 | {:name "do-stuff"
9 | :step-id [1 1 1]
10 | :children []})
11 | (def cwd-child-b
12 | {:name "do-other-stuff"
13 | :step-id [1 2 1]
14 | :result {:status :running :some-key :some-value}
15 | :children []})
16 |
17 | (def parallel-child-a
18 | {:name "in-cwd"
19 | :step-id [1 1]
20 | :children [cwd-child-a]})
21 |
22 | (def parallel-child-b
23 | {:name "in-cwd"
24 | :step-id [2 1]
25 | :children [cwd-child-b]})
26 |
27 | (def root-step
28 | {:name "in-parallel"
29 | :step-id [1]
30 | :children
31 | [parallel-child-a
32 | parallel-child-b]})
33 | (def root-step2
34 | {:name "some-step"
35 | :step-id [2]
36 | :children
37 | []})
38 |
39 | (def step-with-running-children
40 | (-> some-build-step
41 | (with-step-id [1])
42 | (with-status "running")
43 | (with-children [(-> some-build-step
44 | (with-step-id [1 1])
45 | (with-status "failure"))
46 | (-> some-build-step
47 | (with-step-id [2 1])
48 | (with-status "running"))])))
49 | (def waiting-step
50 | (-> some-build-step
51 | (with-step-id [1])
52 | (with-status "waiting")))
53 |
54 | (def some-pipeline-state [root-step root-step2])
55 |
56 | (def flattened-pipeline-state
57 | [root-step parallel-child-a cwd-child-a parallel-child-b cwd-child-b root-step2])
58 |
59 | (deftest flatten-test
60 | (testing "that we can flatten a pipeline-state-representation"
61 | (is (= flattened-pipeline-state (into [] (state/flatten-state some-pipeline-state))))))
62 |
63 | (deftest get-by-step-id-test
64 | (testing "that we can find a step by it's id even if it's nested"
65 | (is (= cwd-child-b (state/find-by-step-id some-pipeline-state [1 2 1])))))
66 |
67 | (deftest is-active-test
68 | (testing "that running steps are active"
69 | (is (= true (state/is-active? (-> some-build-step
70 | (with-status "running"))))))
71 | (testing "that waiting steps are active"
72 | (is (= true (state/is-active? (-> some-build-step
73 | (with-status "waiting"))))))
74 | (testing "that finished steps are inactive"
75 | (is (= false (state/is-active? (-> some-build-step
76 | (with-status "success")))))
77 | (is (= false (state/is-active? (-> some-build-step
78 | (with-status "failure")))))
79 | (is (= false (state/is-active? (-> some-build-step
80 | (with-status "killed"))))))
81 | (testing "that steps with undefined state are inactive"
82 | (is (= false (state/is-active? (-> some-build-step
83 | (with-status nil)))))))
--------------------------------------------------------------------------------
/test/cljs/lambdacd/testdata.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.testdata
2 | (:require [lambdacd.time :as time]
3 | [cljs-time.core :as t]))
4 |
5 | (def time-start (t/now))
6 | (def time-after-ten-sec (t/plus time-start (t/seconds 10)))
7 |
8 | (def some-build-step-id [1 2 3])
9 | (def some-build-step
10 | {:name "some-step"
11 | :type "step"
12 | :step-id some-build-step-id
13 | :children []
14 | :result {:status "success"
15 | :out "hello world"
16 | :first-updated-at (time/unparse-time time-start)
17 | :most-recent-update-at (time/unparse-time time-after-ten-sec)}})
18 |
19 | (defn with-name [step name]
20 | (assoc step :name name))
21 |
22 | (defn with-step-id [step step-id]
23 | (assoc step :step-id step-id))
24 |
25 | (defn with-type [step name]
26 | (assoc step :type name))
27 |
28 | (defn with-output [step output]
29 | (assoc step :result {:status "success" :out output}))
30 |
31 | (defn with-children [step children]
32 | (assoc step :children children))
33 |
34 | (defn with-most-recent-update [step ts]
35 | (assoc-in step [:result :most-recent-update-at] ts))
36 |
37 | (defn with-first-update-at [step ts]
38 | (assoc-in step [:result :first-updated-at] ts))
39 |
40 | (defn with-status [step status]
41 | (assoc-in step [:result :status] status))
42 |
43 | (defn with-trigger-id [step trigger-id]
44 | (assoc-in step [:result :trigger-id] trigger-id))
--------------------------------------------------------------------------------
/test/cljs/lambdacd/testutils.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.testutils
2 | (:require [reagent.core :as reagent :refer [atom]]))
3 |
4 | (def isClient (not (nil? (try (.-document js/window)
5 | (catch js/Object e nil)))))
6 |
7 | (defn add-test-div [name]
8 | (let [doc js/document
9 | body (.-body js/document)
10 | div (.createElement doc "div")]
11 | (.appendChild body div)
12 | div))
13 |
14 | (defn with-mounted-component [comp f]
15 | (when isClient
16 | (let [div (add-test-div "_testreagent")]
17 | (let [comp (reagent/render-component comp div #(f comp div))]
18 | (reagent/unmount-component-at-node div)
19 | (reagent/flush)
20 | (.removeChild (.-body js/document) div)))))
21 |
22 | (defn path []
23 | (.-pathname (.-location js/window)))
24 |
25 | (defn query []
26 | (.-search (.-location js/window)))
27 |
28 | (defn contains-value? [v coll]
29 | (some #(= % v) coll))
30 |
31 | ; mocking
32 |
33 | (defn mock-subscriptions [values]
34 | (fn [[q] _]
35 | (atom (q values))))
--------------------------------------------------------------------------------
/test/cljs/lambdacd/time_test.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.time-test
2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]]
3 | [dommy.core :refer-macros [sel sel1]]
4 | [cljs-time.core :as cljs-time]
5 | [cljs-time.extend] ; this makes equality-comparisons work
6 | [lambdacd.time :as time]))
7 |
8 |
9 | (deftest parse-time-test
10 | (testing "that we can parse a properly formatted time-string"
11 | (is (= (cljs-time/date-time 2015 5 16 19 36 20 214) (time/parse-time "2015-05-16T19:36:20.214Z"))))
12 | (testing "that it returns epoch if no date is given"
13 | (is (= (cljs-time/epoch) (time/parse-time nil)))))
14 |
15 |
16 | (deftest seconds-between-two-timestamps
17 | (testing "that if one of the timestamps is nil, it evaluates to 0 seconds"
18 | (is (= 0 (time/seconds-between-two-timestamps
19 | nil
20 | (cljs-time/date-time 2015 5 16 19 36 0 0))))
21 | (is (= 0 (time/seconds-between-two-timestamps
22 | (cljs-time/date-time 2015 5 16 19 36 0 0)
23 | nil))))
24 | (testing "that the same timestamp is 0 seconds apart"
25 | (is (= 0 (time/seconds-between-two-timestamps
26 | (cljs-time/date-time 2015 5 16 19 36 0 0)
27 | (cljs-time/date-time 2015 5 16 19 36 0 0)))))
28 | (testing "that we can calculate the difference when the two timestamps are only seconds away from each other"
29 | (is (= 3 (time/seconds-between-two-timestamps
30 | (cljs-time/date-time 2015 5 16 19 36 00)
31 | (cljs-time/date-time 2015 5 16 19 36 03)))))
32 | (testing "that we can calculate the difference when the two timestamps a few minutes from each other"
33 | (is (= 123 (time/seconds-between-two-timestamps
34 | (cljs-time/date-time 2015 5 16 19 36 00)
35 | (cljs-time/date-time 2015 5 16 19 38 03)))))
36 | (testing "that optionally, we can also pass in timestamps as strings as they come from json"
37 | (is (= 60 (time/seconds-between-two-timestamps
38 | "2015-05-16T19:35:00.000Z"
39 | (cljs-time/date-time 2015 5 16 19 36 0 0))))
40 | (is (= 15 (time/seconds-between-two-timestamps
41 | (cljs-time/date-time 2015 5 16 19 36 0 0)
42 | "2015-05-16T19:36:15.000Z")))))
43 |
44 | (deftest format-duration-long
45 | (testing "that we can format the duration between two timestamps"
46 | (is (= "10sec" (time/format-duration-long
47 | 10)))
48 | (is (= "1min 15sec" (time/format-duration-long
49 | 75)))
50 | (is (= "3h 15sec" (time/format-duration-long
51 | (+ 15 (* 3 60 60)))))))
52 |
53 | (deftest format-duration-short
54 | (testing "that we can format the duration between two timestamps"
55 | (is (= "00:10" (time/format-duration-short
56 | 10)))
57 | (is (= "01:15" (time/format-duration-short
58 | 75)))
59 | (is (= "03:00:15" (time/format-duration-short
60 | (+ 15 (* 3 60 60)))))))
61 |
--------------------------------------------------------------------------------
/test/cljs/lambdacd/ui_core_test.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.ui-core-test
2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]]
3 | [lambdacd.dom-utils :as dom]
4 | [dommy.core :refer-macros [sel sel1]]
5 | [lambdacd.ui-core :as core]
6 | [re-frame.core :as re-frame]
7 | [lambdacd.db :as db]
8 | [lambdacd.testutils :as tu :refer [mock-subscriptions]]))
9 |
10 | (deftest current-build-component-test
11 | (testing "a normally rendered pipeline"
12 | (with-redefs [re-frame/subscribe (mock-subscriptions {::db/current-step-result {:name "do-other-stuff"
13 | :step-id [0 1 2]
14 | :result {:status "success" :out "hello from successful step"}
15 | :children []}
16 | ::db/current-build-number 3
17 | ::db/step-id [0 1 2]})]
18 | (tu/with-mounted-component
19 | [:div
20 | (core/wired-current-build-component (atom []) 3)]
21 | (fn [c div]
22 | (is (dom/found-in div #"Current Build 3"))
23 | (is (dom/found-in div #"Output"))))))
24 | (testing "a pipeline view without data"
25 | (tu/with-mounted-component
26 | (core/wired-current-build-component (atom nil) 3)
27 | (fn [c div]
28 | (is (dom/found-in div #"Loading..."))))))
29 |
30 |
--------------------------------------------------------------------------------
/test/cljs/lambdacd/utils_test.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.utils-test
2 | (:require [cljs.test :refer-macros [deftest is testing run-tests]]
3 | [lambdacd.utils :as utils]))
4 |
5 | (deftest stringify-keys-test
6 | (testing "that keywords in maps are properly stringified for rendering"
7 | (is (= { ":foo" 42} (utils/stringify-keys {:foo 42}))))
8 | (testing "that strange keywords with namespaces are supported (#100)"
9 | (is (= { ":refs/heads/master" "some-sha"} (utils/stringify-keys { (keyword "refs/heads/master") "some-sha" })))))
10 |
--------------------------------------------------------------------------------
/visual-styleguide/src/cljs/lambdacd/styleguide.cljs:
--------------------------------------------------------------------------------
1 | (ns lambdacd.styleguide
2 | (:require [lambdacd.testutils :refer [query]]
3 | [lambdacd.testcases :as testcases]
4 | [reagent.core :as reagent]
5 | [re-frame.core :as re-frame]))
6 |
7 | (defn render [component]
8 | (reagent/render-component component (.getElementById js/document "content")))
9 |
10 | (defn- testcase [query]
11 | (second (re-find #"testcase=([^&]+)" query)))
12 |
13 | (defn- initialize-styleguide-overview []
14 | (render [:div
15 | [:h1 "Testcases"]
16 | [:ul
17 | (for [testcase testcases/tc]
18 | [:li
19 | [:a {:href (str "?testcase=" (:id testcase))} (:id testcase)]])]]))
20 |
21 | (defn- initialize-testcase [testcase-id]
22 | (let [testcases-by-id (group-by :id testcases/tc)
23 | testcase (first (get testcases-by-id testcase-id))
24 | component (:component testcase)
25 | data (:data testcase)]
26 | (if data
27 | (with-redefs [re-frame/subscribe data]
28 | (render component)))
29 | (render component)))
30 |
31 | (defn initialize-styleguide []
32 | (let [testcase (testcase (query))]
33 | (if testcase
34 | (initialize-testcase testcase)
35 | (initialize-styleguide-overview))))
--------------------------------------------------------------------------------