diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,7 @@ +# Changelog for dhall-fly + +## 0.1.0 + +* Support for dhall-concourse 0.2.2 + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Akshay Mankar (c) 2019 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Akshay Mankar nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +# dhall-fly [![Build Status](https://travis-ci.org/akshaymankar/dhall-fly.svg?branch=master)](https://travis-ci.org/akshaymankar/dhall-fly) + +Tool to read concourse config written using [dhall-concourse](https://github.com/akshaymankar/dhall-concourse). + +## Installation + +1. Install stack: https://docs.haskellstack.org/en/stable/README/ +1. Clone this repository **recursively** +1. Run `stack install` in the repository. This will install `dhall-fly` binary in `~/.local/bin`. + +## Usage + +```bash +fly -t set-pipeline -c <(dhall-fly <<< '/path/to/pipeline.dhall') +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,16 @@ +module Main where + +import Data.Aeson.Yaml (encode) +import Dhall (auto, input) +import Dhall.JSON (omitNull) +import Fly.Types (Job) +import Fly.Yaml (dhallToYaml) + +import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Data.Text.IO (getContents) + +main :: IO () +main = do + stdin <- Data.Text.IO.getContents + jobs <- input auto stdin :: IO [Job] + LBS.putStrLn $ encode $ omitNull $ dhallToYaml jobs diff --git a/dhall-concourse/README.md b/dhall-concourse/README.md new file mode 100644 --- /dev/null +++ b/dhall-concourse/README.md @@ -0,0 +1,77 @@ +# Dhall Concourse +Concourse types and helpers in dhall. + +**Note:** A lot of this README is inspired (some of it copied) from the [dhall-kubernetes README](https://github.com/dhall-lang/dhall-kubernetes/blob/master/README.md), so thanks to the authors! + +Dhall Concourse provides Dhall bindings for Concourse, so you can generate concourse pipelines from Dhall expressions. This will let you easily typecheck, template and modularize your Concourse pipelines. + +## Why do I need this? + +There are a lot of issues one could face while building any non-trivial pipeline. Few of them could be: +1. Pipeline yaml becomes very big and unmanageable +2. Same set of jobs are required to be run in different environments +3. Same set of hooks but with slight changes in all jobs. E.g. slack notifications, releasing resources on failure, etc. + +Most common way to deal with these have been to use a templating language like erb, but it gets very messy very fast. We can do a lot better. + +Dhall solves all of this, being a programming language with builtin templating, all while being non-Turing complete, strongly typed and [strongly normalizing](https://en.wikipedia.org/wiki/Normalization_property_(abstract_rewriting)) (i.e.: reduces everything to a normal form, no matter how much abstraction you build), so saving you from the _"oh-noes-I-made-my-config-in-code-and-now-its-too-abstract"_ nightmare. + +For a Dhall Tutorial, see the [readme of the project](https://github.com/dhall-lang/dhall-lang), or the [full tutorial](http://hackage.haskell.org/package/dhall-1.17.0/docs/Dhall-Tutorial.html). + +## Usage + +To use dhall-concourse you need to install [dhall-fly](https://github.com/akshaymankar/dhall-fly#installation). + +## Defining a pipeline + +### Example 1: Hello World + +This dhall expression will create a pipeline with one job, which would have one task. The task would run in a busybox container and echo "Hello Dhall". + +```dhall +let Concourse = + https://raw.githubusercontent.com/akshaymankar/dhall-concourse/0.2.1/package.dhall sha256:afc1f4a27ac5a1f4746065ee2e318041698cc9bb57096aa4f0d4d665f44a6ef2 + +let Prelude = + https://prelude.dhall-lang.org/v11.1.0/package.dhall sha256:99462c205117931c0919f155a6046aec140c70fb8876d208c7c77027ab19c2fa + +let busyboxImage = + Concourse.schemas.ImageResource::{ + , type = "docker-image" + , source = Some (toMap { repository = Prelude.JSON.string "busybox" }) + } + +let job = + Concourse.schemas.Job::{ + , name = "hello" + , plan = + [ Concourse.helpers.taskStep + Concourse.schemas.TaskStep::{ + , task = "hello" + , config = + Concourse.Types.TaskSpec.Config + Concourse.schemas.TaskConfig::{ + , image_resource = Some busyboxImage + , run = + Concourse.schemas.TaskRunConfig::{ + , path = "bash" + , args = Some [ "-c", "echo Hello Dhall" ] + } + } + } + ] + } + +in [ job ] +``` + +To set the pipeline, run this command: + +``` +fly -t set-pipeline -p hello-dhall -c <(dhall-fly + +in BasicStep diff --git a/dhall-concourse/types/CustomResourceType.dhall b/dhall-concourse/types/CustomResourceType.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/CustomResourceType.dhall @@ -0,0 +1,9 @@ +{ name : Text +, type : Text +, source : Optional ./JSONObject.dhall +, privileged : Optional Bool +, params: Optional ./JSONObject.dhall +, check_every: Optional Text +, tags : Optional Text +, unique_version_history: Optional Bool +} diff --git a/dhall-concourse/types/GetStep.dhall b/dhall-concourse/types/GetStep.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/GetStep.dhall @@ -0,0 +1,12 @@ +let Resource = ./Resource.dhall + +in { get : Optional Text + , resource : Resource + , params : Optional ./JSONObject.dhall + , version : Optional ./GetVersion.dhall + , passed : Optional (List Text) + , trigger : Optional Bool + , tags : Optional (List Text) + , timeout : Optional Text + , attempts : Optional Natural + } diff --git a/dhall-concourse/types/GetVersion.dhall b/dhall-concourse/types/GetVersion.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/GetVersion.dhall @@ -0,0 +1,1 @@ +< Latest : Text | Every : Text | SpecificVersion : List ./TextTextPair.dhall > diff --git a/dhall-concourse/types/ImageResource.dhall b/dhall-concourse/types/ImageResource.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/ImageResource.dhall @@ -0,0 +1,5 @@ +{ type : Text +, source : Optional (./JSONObject.dhall) +, params : Optional (./JSONObject.dhall) +, version : Optional (List ./TextTextPair.dhall) +} diff --git a/dhall-concourse/types/InParallelConfig.dhall b/dhall-concourse/types/InParallelConfig.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/InParallelConfig.dhall @@ -0,0 +1,2 @@ + λ(Step : Type) +→ { steps : List Step, limit : Optional Natural, fail_fast : Optional Bool } diff --git a/dhall-concourse/types/InParallelStep.dhall b/dhall-concourse/types/InParallelStep.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/InParallelStep.dhall @@ -0,0 +1,4 @@ + λ(Step : Type) +→ let InParallelConfig = ./InParallelConfig.dhall Step + + in < Steps : List Step | Config : InParallelConfig > diff --git a/dhall-concourse/types/JSONObject.dhall b/dhall-concourse/types/JSONObject.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/JSONObject.dhall @@ -0,0 +1,3 @@ +let Prelude = ../lib/prelude.dhall + +in List { mapKey : Text, mapValue : Prelude.JSON.Type } diff --git a/dhall-concourse/types/Job.dhall b/dhall-concourse/types/Job.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/Job.dhall @@ -0,0 +1,19 @@ +let Step = ./Step.dhall + +in { name : Text + , old_name : Optional Text + , plan : List Step + , serial : Optional Bool + , build_log_retention : + Optional ./JobBuildLogRetention.dhall + , build_logs_to_retain : Optional Natural + , serial_groups : Optional (List Text) + , max_in_flight : Optional Natural + , public : Optional Bool + , disable_manual_trigger : Optional Bool + , interruptible : Optional Bool + , on_success : Optional Step + , on_failure : Optional Step + , on_abort : Optional Step + , ensure : Optional Step + } diff --git a/dhall-concourse/types/JobBuildLogRetention.dhall b/dhall-concourse/types/JobBuildLogRetention.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/JobBuildLogRetention.dhall @@ -0,0 +1,1 @@ +{ days : Optional Natural, builds : Optional Natural } diff --git a/dhall-concourse/types/PutStep.dhall b/dhall-concourse/types/PutStep.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/PutStep.dhall @@ -0,0 +1,11 @@ +let Resource = ./Resource.dhall + +in { put : Optional Text + , resource : Resource + , inputs : Optional (List Text) + , params : Optional ./JSONObject.dhall + , get_params : Optional ./JSONObject.dhall + , tags : Optional (List Text) + , timeout : Optional Text + , attempts : Optional Natural + } diff --git a/dhall-concourse/types/Resource.dhall b/dhall-concourse/types/Resource.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/Resource.dhall @@ -0,0 +1,10 @@ +{ name : Text +, type : ./ResourceType.dhall +, icon : Optional Text +, source : Optional ./JSONObject.dhall +, version : Optional (List ./TextTextPair.dhall) +, check_every : Optional Text +, tags : Optional (List Text) +, public: Optional Bool +, webhook_token : Optional Text +} diff --git a/dhall-concourse/types/ResourceType.dhall b/dhall-concourse/types/ResourceType.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/ResourceType.dhall @@ -0,0 +1,5 @@ +let CustomResourceType = ./CustomResourceType.dhall + +let ResourceType = < Custom : CustomResourceType | InBuilt : Text > + +in ResourceType diff --git a/dhall-concourse/types/Step.dhall b/dhall-concourse/types/Step.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/Step.dhall @@ -0,0 +1,6 @@ +let Step = + ∀(Step : Type) + → ./StepConstructors.dhall Step + → Step + +in Step diff --git a/dhall-concourse/types/StepConstructors.dhall b/dhall-concourse/types/StepConstructors.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/StepConstructors.dhall @@ -0,0 +1,11 @@ +let StepHooks = ./StepHooks.dhall + +in λ(Step : Type) + → { get : ./GetStep.dhall → StepHooks Step → Step + , put : ./PutStep.dhall → StepHooks Step → Step + , task : ./TaskStep.dhall → StepHooks Step → Step + , aggregate : List Step → StepHooks Step → Step + , in_parallel : ./InParallelStep.dhall Step → StepHooks Step → Step + , do : List Step → StepHooks Step → Step + , try : Step → StepHooks Step → Step + } diff --git a/dhall-concourse/types/StepHooks.dhall b/dhall-concourse/types/StepHooks.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/StepHooks.dhall @@ -0,0 +1,9 @@ +let StepHooks = + λ(Step : Type) + → { on_success : Optional Step + , on_failure : Optional Step + , on_abort : Optional Step + , ensure : Optional Step + } + +in StepHooks diff --git a/dhall-concourse/types/TaskCache.dhall b/dhall-concourse/types/TaskCache.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TaskCache.dhall @@ -0,0 +1,1 @@ +{ path : Text } diff --git a/dhall-concourse/types/TaskConfig.dhall b/dhall-concourse/types/TaskConfig.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TaskConfig.dhall @@ -0,0 +1,10 @@ +{ platform : Text +, run : ./TaskRunConfig.dhall +, image_resource : Optional ./ImageResource.dhall +, rootfs_uri : Optional Text +, container_limits : Optional ./TaskContainerLimits.dhall +, inputs : Optional (List ./TaskInput.dhall) +, outputs : Optional (List ./TaskOutput.dhall) +, caches : Optional (List ./TaskCache.dhall) +, params : Optional (List { mapKey : Text, mapValue : Optional Text }) +} diff --git a/dhall-concourse/types/TaskContainerLimits.dhall b/dhall-concourse/types/TaskContainerLimits.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TaskContainerLimits.dhall @@ -0,0 +1,1 @@ +{ cpu : Optional Natural, memory : Optional Natural } diff --git a/dhall-concourse/types/TaskInput.dhall b/dhall-concourse/types/TaskInput.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TaskInput.dhall @@ -0,0 +1,1 @@ +{ name : Text, path : Optional Text, optional : Optional Bool } diff --git a/dhall-concourse/types/TaskOutput.dhall b/dhall-concourse/types/TaskOutput.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TaskOutput.dhall @@ -0,0 +1,1 @@ +{ name : Text, path : Optional Text } diff --git a/dhall-concourse/types/TaskRunConfig.dhall b/dhall-concourse/types/TaskRunConfig.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TaskRunConfig.dhall @@ -0,0 +1,5 @@ +{ path : Text +, args : Optional (List Text) +, dir : Optional Text +, user : Optional Text +} diff --git a/dhall-concourse/types/TaskSpec.dhall b/dhall-concourse/types/TaskSpec.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TaskSpec.dhall @@ -0,0 +1,1 @@ +< File : Text | Config : ./TaskConfig.dhall > diff --git a/dhall-concourse/types/TaskStep.dhall b/dhall-concourse/types/TaskStep.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TaskStep.dhall @@ -0,0 +1,12 @@ +{ task : Text +, config : ./TaskSpec.dhall +, privileged : Optional Bool +, vars : Optional ./JSONObject.dhall +, params : Optional (List ./TextTextPair.dhall) +, image : Optional Text +, input_mapping : Optional (List ./TextTextPair.dhall) +, output_mapping : Optional (List ./TextTextPair.dhall) +, tags : Optional (List Text) +, timeout : Optional Text +, attempts : Optional Natural +} diff --git a/dhall-concourse/types/TextTextPair.dhall b/dhall-concourse/types/TextTextPair.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/TextTextPair.dhall @@ -0,0 +1,1 @@ +{ mapKey : Text, mapValue : Text } diff --git a/dhall-concourse/types/package.dhall b/dhall-concourse/types/package.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/types/package.dhall @@ -0,0 +1,26 @@ +{ BasicStep = ./BasicStep.dhall +, CustomResourceType = ./CustomResourceType.dhall +, GetStep = ./GetStep.dhall +, GetVersion = ./GetVersion.dhall +, ImageResource = ./ImageResource.dhall +, InParallelConfig = ./InParallelConfig.dhall +, InParallelStep = ./InParallelStep.dhall +, Job = ./Job.dhall +, JobBuildLogRetention = ./JobBuildLogRetention.dhall +, JSONObject = ./JSONObject.dhall +, PutStep = ./PutStep.dhall +, Resource = ./Resource.dhall +, ResourceType = ./ResourceType.dhall +, Step = ./Step.dhall +, StepConstructors = ./StepConstructors.dhall +, StepHooks = ./StepHooks.dhall +, TaskConfig = ./TaskConfig.dhall +, TaskInput = ./TaskInput.dhall +, TaskOutput = ./TaskOutput.dhall +, TaskCache = ./TaskCache.dhall +, TaskContainerLimits = ./TaskContainerLimits.dhall +, TaskRunConfig = ./TaskRunConfig.dhall +, TaskStep = ./TaskStep.dhall +, TaskSpec = ./TaskSpec.dhall +, TextTextPair = ./TextTextPair.dhall +} diff --git a/dhall-concourse/utils/resourcesFromJobs.dhall b/dhall-concourse/utils/resourcesFromJobs.dhall new file mode 100644 --- /dev/null +++ b/dhall-concourse/utils/resourcesFromJobs.dhall @@ -0,0 +1,76 @@ +let Prelude = ../lib/prelude.dhall + +let Types = ../types/package.dhall + +let Resource = Types.Resource + +let StepHooks = Types.StepHooks + +let catOptionals + : ∀(x : Type) → List (Optional x) → List x + = λ(x : Type) + → λ(os : List (Optional x)) + → Prelude.List.fold + (Optional x) + os + (List x) + (λ(a : Optional x) → λ(l : List x) → Prelude.Optional.toList x a # l) + ([] : List x) + +let resourcesFromStepHooks + : StepHooks (List Resource) → List Resource + = λ(h : StepHooks (List Resource)) + → let listOfListOfResources = + catOptionals + (List Resource) + [ h.ensure, h.on_success, h.on_failure, h.on_abort ] + + in Prelude.List.concat Resource listOfListOfResources + +let resourcesFromGetStep + : Types.GetStep → StepHooks (List Resource) → List Resource + = λ(g : Types.GetStep) + → λ(h : StepHooks (List Resource)) + → [ g.resource ] # resourcesFromStepHooks h + +let resourcesFromPutStep + : Types.PutStep → StepHooks (List Resource) → List Resource + = λ(p : Types.PutStep) + → λ(h : StepHooks (List Resource)) + → [ p.resource ] # resourcesFromStepHooks h + +let resourcesFromTaskStep + : Types.TaskStep → StepHooks (List Resource) → List Resource + = λ(_ : Types.TaskStep) + → λ(h : StepHooks (List Resource)) + → resourcesFromStepHooks h + +let resourcesFromAggregateOrDo + : List (List Resource) → StepHooks (List Resource) → List Resource + = λ(rs : List (List Resource)) + → λ(h : StepHooks (List Resource)) + → Prelude.List.concat Resource rs # resourcesFromStepHooks h + +let resourcesFromTry + : List Resource → StepHooks (List Resource) → List Resource + = λ(rs : List Resource) + → λ(h : StepHooks (List Resource)) + → rs # resourcesFromStepHooks h + +let resourcesFromStep = + λ(s : Types.Step) + → s + (List Resource) + resourcesFromGetStep + resourcesFromPutStep + resourcesFromTaskStep + resourcesFromAggregateOrDo + resourcesFromAggregateOrDo + resourcesFromTry + +let resourcesFromJob = + λ(j : Types.Job) + → Prelude.List.concatMap Types.Step Resource resourcesFromStep j.plan + +in Prelude.List.concatMap Types.Job Resource resourcesFromJob + : List Types.Job → List Resource diff --git a/dhall-fly.cabal b/dhall-fly.cabal new file mode 100644 --- /dev/null +++ b/dhall-fly.cabal @@ -0,0 +1,164 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 34a102125b5ca6677a5bc0feae708c3b5f1137b172bb562d0b770ad6367e6e12 + +name: dhall-fly +version: 0.1.0 +synopsis: Translate concourse config from Dhall to YAML +description: Please see the README on GitHub at +category: Concourse, YAML, JSON, Dhall +homepage: https://github.com/akshaymankar/dhall-fly#readme +bug-reports: https://github.com/akshaymankar/dhall-fly/issues +author: Akshay Mankar +maintainer: itsakshaymankar@gmail.com +copyright: Akshay Mankar +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + dhall-concourse/defaults/CustomResourceType.dhall + dhall-concourse/defaults/GetStep.dhall + dhall-concourse/defaults/ImageResource.dhall + dhall-concourse/defaults/Job.dhall + dhall-concourse/defaults/package.dhall + dhall-concourse/defaults/PutStep.dhall + dhall-concourse/defaults/Resource.dhall + dhall-concourse/defaults/StepHooks.dhall + dhall-concourse/defaults/TaskConfig.dhall + dhall-concourse/defaults/TaskRunConfig.dhall + dhall-concourse/defaults/TaskStep.dhall + dhall-concourse/helpers/aggregateStep.dhall + dhall-concourse/helpers/doStep.dhall + dhall-concourse/helpers/getStep.dhall + dhall-concourse/helpers/inParallelStep.dhall + dhall-concourse/helpers/inParallelStepSimple.dhall + dhall-concourse/helpers/package.dhall + dhall-concourse/helpers/putStep.dhall + dhall-concourse/helpers/taskStep.dhall + dhall-concourse/helpers/tryStep.dhall + dhall-concourse/lib/prelude.dhall + dhall-concourse/package.dhall + dhall-concourse/README.md + dhall-concourse/schemas/CustomResourceType.dhall + dhall-concourse/schemas/GetStep.dhall + dhall-concourse/schemas/ImageResource.dhall + dhall-concourse/schemas/Job.dhall + dhall-concourse/schemas/package.dhall + dhall-concourse/schemas/PutStep.dhall + dhall-concourse/schemas/Resource.dhall + dhall-concourse/schemas/StepHooks.dhall + dhall-concourse/schemas/TaskConfig.dhall + dhall-concourse/schemas/TaskRunConfig.dhall + dhall-concourse/schemas/TaskStep.dhall + dhall-concourse/types/BasicStep.dhall + dhall-concourse/types/CustomResourceType.dhall + dhall-concourse/types/GetStep.dhall + dhall-concourse/types/GetVersion.dhall + dhall-concourse/types/ImageResource.dhall + dhall-concourse/types/InParallelConfig.dhall + dhall-concourse/types/InParallelStep.dhall + dhall-concourse/types/Job.dhall + dhall-concourse/types/JobBuildLogRetention.dhall + dhall-concourse/types/JSONObject.dhall + dhall-concourse/types/package.dhall + dhall-concourse/types/PutStep.dhall + dhall-concourse/types/Resource.dhall + dhall-concourse/types/ResourceType.dhall + dhall-concourse/types/Step.dhall + dhall-concourse/types/StepConstructors.dhall + dhall-concourse/types/StepHooks.dhall + dhall-concourse/types/TaskCache.dhall + dhall-concourse/types/TaskConfig.dhall + dhall-concourse/types/TaskContainerLimits.dhall + dhall-concourse/types/TaskInput.dhall + dhall-concourse/types/TaskOutput.dhall + dhall-concourse/types/TaskRunConfig.dhall + dhall-concourse/types/TaskSpec.dhall + dhall-concourse/types/TaskStep.dhall + dhall-concourse/types/TextTextPair.dhall + dhall-concourse/utils/resourcesFromJobs.dhall + test/data/custom-resource-type.dhall + test/data/in-built-resource-type.dhall + test/data/resource.dhall + +source-repository head + type: git + location: https://github.com/akshaymankar/dhall-fly + +library + exposed-modules: + Fly.Internal.AesonOrphans + Fly.Internal.DhallOrphans + Fly.Internal.DhallWithPrefix + Fly.Types + Fly.Yaml + other-modules: + Paths_dhall_fly + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + aeson >=1.4.5.0 + , aeson-casing >=0.2.0.0 + , base >=4.7 && <5 + , dhall >=1.27.0 && <1.28 + , scientific >=0.3.6.2 + , text >=1.2.3.1 + , transformers >=0.5.6.2 + , unordered-containers >=0.2.10.0 + , vector >=0.12.0.3 + default-language: Haskell2010 + +executable dhall-fly + main-is: Main.hs + other-modules: + Paths_dhall_fly + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + aeson >=1.4.5.0 + , aeson-casing >=0.2.0.0 + , aeson-yaml >=1.0.3.0 + , base >=4.7 && <5 + , bytestring >=0.10.8.2 + , dhall >=1.27.0 && <1.28 + , dhall-fly + , dhall-json >=1.5.0 && <1.6 + , scientific >=0.3.6.2 + , text >=1.2.3.1 + , transformers >=0.5.6.2 + , unordered-containers >=0.2.10.0 + , vector >=0.12.0.3 + default-language: Haskell2010 + +test-suite dhall-fly-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Fly.InterpretSpec + Paths_dhall_fly + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + aeson >=1.4.5.0 + , aeson-casing >=0.2.0.0 + , base >=4.7 && <5 + , dhall >=1.27.0 && <1.28 + , dhall-fly + , hspec + , scientific >=0.3.6.2 + , text >=1.2.3.1 + , transformers >=0.5.6.2 + , unordered-containers >=0.2.10.0 + , vector >=0.12.0.3 + default-language: Haskell2010 diff --git a/src/Fly/Internal/AesonOrphans.hs b/src/Fly/Internal/AesonOrphans.hs new file mode 100644 --- /dev/null +++ b/src/Fly/Internal/AesonOrphans.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Fly.Internal.AesonOrphans where + +import Data.Aeson +import Data.HashMap.Strict as M +import Data.Text + +instance {-# OVERLAPPING #-} ToJSON (HashMap Text Text) where + toJSON theMap = + object (toPairs $ M.toList theMap) + where toPairs [] = [] + toPairs ((key, value):xs) = (key .= value) : toPairs xs + +instance {-# OVERLAPPING #-} ToJSON (HashMap Text (Maybe Text)) where + toJSON theMap = + object (toPairs $ M.toList theMap) + where toPairs [] = [] + toPairs ((key, value):xs) = (key .= value) : toPairs xs + + diff --git a/src/Fly/Internal/DhallOrphans.hs b/src/Fly/Internal/DhallOrphans.hs new file mode 100644 --- /dev/null +++ b/src/Fly/Internal/DhallOrphans.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Fly.Internal.DhallOrphans where + +import Data.Aeson +import Data.Scientific (fromFloatDigits) +import Dhall +import Dhall.Core +import Dhall.TH + +import qualified Data.Vector as V + +instance FromDhall Value where + autoWith _ = Dhall.Type{..} where + expected = $(staticDhallExpression "let Prelude = ./dhall-concourse/lib/prelude.dhall in Prelude.JSON.Type") + extract (Lam _ (Const Dhall.Core.Type) + (Lam _ _ x)) = extractJSONFromApps x + extract x = extractJSONFromApps x + extractJSONFromApps (App (Field (Var (V _ 0)) "bool") (BoolLit b)) = pure $ Data.Aeson.Bool b + extractJSONFromApps (App (Field (Var (V _ 0)) "string") (TextLit (Chunks _ t))) = pure $ String t + extractJSONFromApps (App (Field (Var (V _ 0)) "number") (DoubleLit n)) = pure $ Number $ fromFloatDigits $ getDhallDouble n + extractJSONFromApps (App (Field (Var (V _ 0)) "object") o) = Object <$> Dhall.extract auto o + extractJSONFromApps (App (Field (Var (V _ 0)) "array") a) = Array . V.fromList <$> Dhall.extract auto a + extractJSONFromApps (Field (Var (V _ 0)) "null") = pure Null + extractJSONFromApps t = typeError expected t + diff --git a/src/Fly/Internal/DhallWithPrefix.hs b/src/Fly/Internal/DhallWithPrefix.hs new file mode 100644 --- /dev/null +++ b/src/Fly/Internal/DhallWithPrefix.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +module Fly.Internal.DhallWithPrefix where + +import Control.Monad.Trans.State.Strict +import Data.Aeson +import Data.Aeson.Casing +import Data.Text +import Dhall +import GHC.Generics + +newtype FromDhallWithPrefix a = FromDhallWithPrefix a + +instance (Generic a, GenericFromDhall (Rep a)) => FromDhall (FromDhallWithPrefix a) where + autoWith opts = + let modifier = pack . fieldLabelModifier (aesonPrefix snakeCase) . unpack + in FromDhallWithPrefix <$> fmap GHC.Generics.to (evalState (genericAutoWith opts{fieldModifier = modifier}) 1) diff --git a/src/Fly/Types.hs b/src/Fly/Types.hs new file mode 100644 --- /dev/null +++ b/src/Fly/Types.hs @@ -0,0 +1,317 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} +module Fly.Types where + +import Data.Aeson hiding (Result) +import Data.Aeson.Casing +import Data.Aeson.TH +import Data.HashMap.Strict +import Data.Maybe (fromMaybe) +import Dhall +import Dhall.Core +import Dhall.TH +import Fly.Internal.AesonOrphans () +import Fly.Internal.DhallOrphans () +import Fly.Internal.DhallWithPrefix + +import qualified Data.HashMap.Strict as M + +data CustomResourceType = CustomResourceType { crtName :: Text + , crtType :: Text + , crtSource :: Maybe (HashMap Text Value) + , crtPrivileged :: Maybe Bool + , crtParams :: Maybe (HashMap Text Value) + , crtCheckEvery :: Maybe Text + , crtTags :: Maybe Text + , crtUniqueVersionHistory :: Maybe Bool + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix CustomResourceType + +data ResourceType = ResourceTypeInBuilt Text + | ResourceTypeCustom CustomResourceType + deriving (Show, Generic, Eq) + +instance FromDhall ResourceType where + autoWith _ = Dhall.union ( ( ResourceTypeInBuilt <$> constructor "InBuilt" strictText) + <> ( ResourceTypeCustom <$> constructor "Custom" auto )) + +data Resource = Resource { resourceName :: Text + , resourceType :: ResourceType + , resourceIcon :: Maybe Text + , resourcePublic :: Maybe Bool + , resourceSource :: Maybe (HashMap Text Value) + , resourceVersion :: Maybe (HashMap Text Text) + , resourceCheckEvery :: Maybe Text + , resourceTags :: Maybe [Text] + , resourceWebhookToken :: Maybe Text} + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix Resource + +instance ToJSON Resource where + toJSON x = case genericToJSON (aesonPrefix snakeCase) x of + Object m -> Object $ M.insert "type" (resourceTypeValue $ resourceType x) m + v -> error ("Expected " ++ show v ++ "to be Object") + where + resourceTypeValue (ResourceTypeInBuilt t) = String t + resourceTypeValue (ResourceTypeCustom t) = String $ crtName t + +data TaskRunConfig = TaskRunConfig { trcPath :: Text + , trcArgs :: Maybe [Text] + , trcDir :: Maybe Text + , trcUser :: Maybe Text + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix TaskRunConfig + +data TaskImageResource = TaskImageResource { tirType :: Text + , tirSource :: Maybe (HashMap Text Value) + , tirParams :: Maybe (HashMap Text Value) + , tirVersion :: Maybe (HashMap Text Text) + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix TaskImageResource + +data TaskInput = TaskInput { tiName :: Text + , tiPath :: Maybe Text + , tiOptional :: Maybe Bool + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix TaskInput + +data TaskOutput = TaskOutput { toName :: Text, toPath :: Maybe Text } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix TaskOutput + +newtype TaskCache = TaskCache { taskcachePath :: Text} + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix TaskCache + +data TaskContainerLimits = TaskContainerLimits { tclCpu :: Maybe Natural + , tclMemory :: Maybe Natural} + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix TaskContainerLimits + +data TaskConfig = TaskConfig { tcPlatform :: Text + , tcRun :: TaskRunConfig + , tcImageResource :: Maybe TaskImageResource + , tcRootfsUri :: Maybe Text + , tcInputs :: Maybe [TaskInput] + , tcOutputs :: Maybe [TaskOutput] + , tcCaches :: Maybe [TaskCache] + , tcParams :: Maybe (HashMap Text (Maybe Text)) + , tcContainerLimits :: Maybe TaskContainerLimits + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix TaskConfig + +data TaskSpec = TaskSpecFile Text | TaskSpecConfig TaskConfig + deriving (Show, Generic, Eq) + +instance FromDhall TaskSpec where + autoWith _ = Dhall.union ((TaskSpecFile <$> constructor "File" strictText) + <> (TaskSpecConfig <$> constructor "Config" auto)) + +instance ToJSON TaskSpec where + toJSON (TaskSpecFile f) = object [ "file" .= f ] + toJSON (TaskSpecConfig c) = object [ "config" .= c ] + +data GetVersion = GetVersionLatest + | GetVersionEvery + | GetVersionSpecific (HashMap Text Text) + deriving (Show, Generic, Eq) + +instance ToJSON GetVersion where + toJSON GetVersionLatest = String "latest" + toJSON GetVersionEvery = String "every" + toJSON (GetVersionSpecific v) = toJSON v + +instance FromDhall GetVersion where + autoWith _ = Dhall.union ((GetVersionLatest <$ constructor "Latest" strictText) + <> (GetVersionEvery <$ constructor "Every" strictText) + <> (GetVersionSpecific <$> constructor "SpecificVersion" auto)) + +data GetStep = GetStep { getGet :: Maybe Text + , getResource :: Resource + , getParams :: Maybe (HashMap Text Value) + , getVersion :: Maybe GetVersion + , getPassed :: Maybe [Text] + , getTrigger :: Maybe Bool + , getTags :: Maybe [Text] + , getTimeout :: Maybe Text + , getAttempts :: Maybe Natural + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix GetStep + +instance ToJSON GetStep where + toJSON GetStep{..} = object [ "get" .= fromMaybe (resourceName getResource) getGet + , "resource" .= toJSON (resourceName getResource <$ getGet) + , "params" .= getParams + , "version" .= getVersion + , "passed" .= getPassed + , "trigger" .= getTrigger + , "tags" .= getTags + , "timeout" .= getTimeout + , "attempts" .= getAttempts + ] + +data PutStep = PutStep { putPut :: Maybe Text + , putResource :: Resource + , putParams :: Maybe (HashMap Text Value) + , putGetParams :: Maybe (HashMap Text Value) + , putTags :: Maybe [Text] + , putTimeout :: Maybe Text + , putAttempts :: Maybe Natural + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix PutStep + +instance ToJSON PutStep where + toJSON PutStep{..} = object [ "put" .= fromMaybe (resourceName putResource) putPut + , "resource" .= toJSON (resourceName putResource <$ putPut) + , "params" .= putParams + , "get_params" .= putGetParams + ] + +data TaskStep = TaskStep { taskTask :: Text + , taskConfig :: TaskSpec + , taskPrivileged :: Maybe Bool + , taskParams :: Maybe (HashMap Text Text) + , taskImage :: Maybe Text + , taskInputMapping :: Maybe (HashMap Text Text) + , taskOutputMapping :: Maybe (HashMap Text Text) + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix TaskStep + +instance ToJSON TaskStep where + toJSON t@TaskStep{..} = + case genericToJSON (aesonPrefix snakeCase) t of + Object o1 -> + case toJSON taskConfig of + Object o2 -> Object (M.delete "config" o1 `M.union` o2) + v -> error ("Expected " ++ show v ++ "to be Object") + v -> error ("Expected " ++ show v ++ "to be Object") + +data InParallelStep = InParallelSteps {ipSteps :: [Step]} + | InParallelStepConfig {ipConfig :: InParallelConfig} + deriving (Show, Generic, Eq) + +inParallelSteps :: InParallelStep -> [Step] +inParallelSteps (InParallelSteps steps ) = steps +inParallelSteps (InParallelStepConfig InParallelConfig{..}) = ipcSteps + +instance ToJSON InParallelStep where + toJSON (InParallelSteps steps) = toJSON steps + toJSON (InParallelStepConfig cfg) = toJSON cfg + +instance FromDhall InParallelStep where + autoWith _ = Dhall.union ((InParallelSteps <$> constructor "Steps" auto) + <> (InParallelStepConfig <$> constructor "Config" auto)) + +data InParallelConfig = InParallelConfig { ipcSteps :: [Step] + , ipcLimit :: Maybe Natural + , ipcFailFast :: Maybe Bool + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix InParallelConfig + +data Step = Get { stepGet :: GetStep, stepHooks :: StepHooks } + | Put { stepPut :: PutStep, stepHooks :: StepHooks } + | Task { stepTask :: TaskStep, stepHooks :: StepHooks } + | Aggregate { aggregatedSteps :: [Step], stepHooks :: StepHooks } + | InParallel { stepInParallel :: InParallelStep, stepHooks :: StepHooks } + | Do { doSteps :: [Step], stepHooks :: StepHooks } + | Try { tryStep :: Step, stepHooks :: StepHooks } + deriving (Show, Generic, Eq) + +instance FromDhall Step where + autoWith _ = Dhall.Type{..} where + expected = $(staticDhallExpression "./dhall-concourse/types/Step.dhall") + extract (Lam _ _ --Step + (Lam _ _ --Constructors + c)) = extractStepFromConstructors c + extract x = extractStepFromConstructors x -- While recursing, only the constructor applications are available + extractStepFromConstructors (App (App (Field (Var (V _ 0)) "get") s) hooks) = buildStep Get s hooks + extractStepFromConstructors (App (App (Field (Var (V _ 0)) "put") s) hooks) = buildStep Put s hooks + extractStepFromConstructors (App (App (Field (Var (V _ 0)) "task") s) hooks) = buildStep Task s hooks + extractStepFromConstructors (App (App (Field (Var (V _ 0)) "aggregate") s) hooks) = buildStep Aggregate s hooks + extractStepFromConstructors (App (App (Field (Var (V _ 0)) "do") s) hooks) = buildStep Do s hooks + extractStepFromConstructors (App (App (Field (Var (V _ 0)) "try") s) hooks) = buildStep Try s hooks + extractStepFromConstructors (App (App (Field (Var (V _ 0)) "in_parallel") + (App (Field (Union _) "Steps") s)) hooks) = buildStep (InParallel . InParallelSteps ) s hooks + extractStepFromConstructors (App (App (Field (Var (V _ 0)) "in_parallel") + (App (Field (Union _) "Config") s)) hooks) = buildStep (InParallel . InParallelStepConfig ) s hooks + extractStepFromConstructors t = typeError expected t + buildStep f x y = f <$> Dhall.extract auto x <*> Dhall.extract auto y + +mergeHooks :: ToJSON a => a -> StepHooks -> Value +mergeHooks step hooks = case toJSON step of + Object o1 -> case toJSON hooks of + Object o2 -> Object (o1 `M.union` o2) + v -> error ("Expected " ++ show v ++ "to be Object") + v -> error ("Expected " ++ show v ++ "to be Object") + +instance ToJSON Step where + toJSON (Get g h) = mergeHooks g h + toJSON (Put p h) = mergeHooks p h + toJSON (Task t h) = mergeHooks t h + toJSON (Aggregate steps h) = mergeHooks (object ["aggregate" .= steps]) h + toJSON (Do steps h) = mergeHooks (object ["do" .= steps]) h + toJSON (Try step h) = mergeHooks (object ["try" .= step]) h + toJSON (InParallel cfg h) = mergeHooks (object ["in_parallel" .= cfg]) h + +data StepHooks = StepHooks { hookOnSuccess :: Maybe Step + , hookOnFailure :: Maybe Step + , hookOnAbort :: Maybe Step + , hookEnsure :: Maybe Step + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix StepHooks + +data JobBuildLogRetention = JobBuildLogRetention { jblrDays :: Maybe Natural + , jblrBuilds :: Maybe Natural + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix JobBuildLogRetention + +data Job = Job { jobName :: Text + , jobOldName :: Maybe Text + , jobPlan :: [Step] + , jobSerial :: Maybe Bool + , jobBuildLogRetention :: Maybe JobBuildLogRetention + , jobBuildLogsToRetain :: Maybe Natural + , jobSerialGroups :: Maybe [Text] + , jobMaxInFlight :: Maybe Natural + , jobPublic :: Maybe Bool + , jobDisableManualTrigger :: Maybe Bool + , jobInterruptible :: Maybe Bool + , jobOnSuccess :: Maybe Step + , jobOnFailure :: Maybe Step + , jobOnAbort :: Maybe Step + , jobEnsure :: Maybe Step + } + deriving (Show, Generic, Eq) + deriving FromDhall via FromDhallWithPrefix Job + +$(deriveToJSON (aesonPrefix snakeCase) ''CustomResourceType) +$(deriveToJSON (aesonPrefix snakeCase){sumEncoding = UntaggedValue} ''ResourceType) +$(deriveToJSON (aesonPrefix snakeCase) ''TaskRunConfig) +$(deriveToJSON (aesonPrefix snakeCase) ''TaskImageResource) +$(deriveToJSON (aesonPrefix snakeCase) ''TaskInput) +$(deriveToJSON (aesonPrefix snakeCase) ''TaskOutput) +$(deriveToJSON (aesonPrefix snakeCase) ''TaskCache) +$(deriveToJSON (aesonPrefix snakeCase) ''TaskConfig) +$(deriveToJSON (aesonPrefix snakeCase) ''TaskContainerLimits) +$(deriveToJSON (aesonPrefix snakeCase) ''InParallelConfig) +$(deriveToJSON (aesonPrefix snakeCase) ''StepHooks) +$(deriveToJSON (aesonPrefix snakeCase) ''JobBuildLogRetention) +$(deriveToJSON (aesonPrefix snakeCase) ''Job) diff --git a/src/Fly/Yaml.hs b/src/Fly/Yaml.hs new file mode 100644 --- /dev/null +++ b/src/Fly/Yaml.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Fly.Yaml where + +import Data.Aeson +import Data.List (nub) +import Data.Maybe (catMaybes) +import Fly.Types + +customResourceTypes :: [ResourceType] -> [ResourceType] +customResourceTypes [] = [] +customResourceTypes (ResourceTypeInBuilt _ : rts) = customResourceTypes rts +customResourceTypes (x : rts) = x : customResourceTypes rts + +getResourcesFromHooks :: StepHooks -> [Resource] +getResourcesFromHooks StepHooks{..} = + concatMap getResourcesFromStep + $ catMaybes [hookOnSuccess, hookOnFailure, hookOnAbort, hookEnsure] + +getResourcesFromStep :: Step -> [Resource] +getResourcesFromStep s = + stepResources s ++ getResourcesFromHooks (Fly.Types.stepHooks s) + where + stepResources (Get GetStep{..} _) = [getResource] + stepResources (Put PutStep{..} _) = [putResource] + stepResources (Task _ _) = [] + stepResources (Aggregate steps _) = getResourcesFromSteps steps + stepResources (Do steps _) = getResourcesFromSteps steps + stepResources (Try step _) = getResourcesFromStep step + stepResources (InParallel inParallel _) = + getResourcesFromSteps $ inParallelSteps inParallel + +getResourcesFromSteps :: [Step] -> [Resource] +getResourcesFromSteps = concatMap getResourcesFromStep + +getResourcesFromJob :: Job -> [Resource] +getResourcesFromJob Job{..} = + getResourcesFromSteps + $ jobPlan ++ catMaybes [ jobOnSuccess, jobOnFailure, jobOnAbort, jobEnsure ] + +dhallToYaml :: [Job] -> Value +dhallToYaml jobs = + let resources = nub $ concatMap getResourcesFromJob jobs + resourceTypes = nub $ customResourceTypes $ map Fly.Types.resourceType resources + in object [ "resource_types" .= resourceTypes + , "resources" .= resources + , "jobs" .= jobs + ] diff --git a/test/Fly/InterpretSpec.hs b/test/Fly/InterpretSpec.hs new file mode 100644 --- /dev/null +++ b/test/Fly/InterpretSpec.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Fly.InterpretSpec where + +import Test.Hspec + +import Data.Aeson +import Data.HashMap.Strict +import Dhall +import Fly.Types + +spec :: Spec +spec = do + describe "Fly.Interpret" $ do + describe "Interpret ResourceType" $ do + it "should interpret in built resource type" $ do + resourceType <- input auto "./test/data/in-built-resource-type.dhall" + resourceType `shouldBe` ResourceTypeInBuilt "git" + + it "should interpret custom resource type" $ do + resourceType <- input auto "./test/data/custom-resource-type.dhall" + resourceType `shouldBe` boshDeploymentResourceType + + describe "Interpret Resource" $ do + it "should interpret a git resource" $ do + resource <- input auto "./test/data/resource.dhall" + resource `shouldBe` gitKuboCI + + describe "Interpret TaskConfig" $ do + it "should interpret a File task" $ do + task <- input auto "./dhall-concourse/defaults/TaskConfig.dhall" + task `shouldBe` defaultTaskConfig + +boshDeploymentResourceType = ResourceTypeCustom (CustomResourceType{..}) where + crtName = "bosh-deployment" + crtType = "docker-image" + crtSource = pure $ fromList [ ("repository", String "cloudfoundry/bosh-deployment-resource") + , ("tag", String "latest") + ] + crtPrivileged = Nothing + crtParams = Nothing + crtCheckEvery = Nothing + crtTags = Nothing + crtUniqueVersionHistory = Nothing + +gitKuboCI = Resource{..} where + resourceName = "git-kubo-ci" + resourceType = ResourceTypeInBuilt "git" + resourceCheckEvery = Nothing + resourceParams = Nothing + resourceSource = Just $ fromList [ "privateKey" .= "((git-ssh-key.private_key))" + , "uri" .= "git@github.com:cloudfoundry-incubator/kubo-ci" + , "branch" .= "master" + ] + resourceTags = Nothing + resourceVersion = Nothing + resourceWebhookToken = Nothing + resourceIcon = Nothing + resourcePublic = Nothing + +defaultTaskRunConfig = TaskRunConfig{..} where + trcPath = "CHANGEME" + trcArgs = Nothing + trcDir = Nothing + trcUser = Nothing + +defaultTaskConfig = TaskConfig{..} where + tcPlatform = "linux" + tcRun = defaultTaskRunConfig + tcCaches = Nothing + tcImageResource = Nothing + tcInputs = Nothing + tcOutputs = Nothing + tcParams = Nothing + tcRootfsUri = Nothing + tcContainerLimits = Nothing diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/data/custom-resource-type.dhall b/test/data/custom-resource-type.dhall new file mode 100644 --- /dev/null +++ b/test/data/custom-resource-type.dhall @@ -0,0 +1,19 @@ +let Concourse = ../../dhall-concourse/package.dhall + +let Prelude = ../../dhall-concourse/lib/prelude.dhall + +let JSON = Prelude.JSON + +in Concourse.Types.ResourceType.Custom + Concourse.schemas.CustomResourceType::{ + , name = "bosh-deployment" + , type = "docker-image" + , source = + Some + ( toMap + { repository = + JSON.string "cloudfoundry/bosh-deployment-resource" + , tag = JSON.string "latest" + } + ) + } diff --git a/test/data/in-built-resource-type.dhall b/test/data/in-built-resource-type.dhall new file mode 100644 --- /dev/null +++ b/test/data/in-built-resource-type.dhall @@ -0,0 +1,3 @@ +let Concourse = ../../dhall-concourse/package.dhall + +in Concourse.Types.ResourceType.InBuilt "git" diff --git a/test/data/resource.dhall b/test/data/resource.dhall new file mode 100644 --- /dev/null +++ b/test/data/resource.dhall @@ -0,0 +1,19 @@ +let Concourse = ../../dhall-concourse/package.dhall + +let Prelude = ../../dhall-concourse/lib/prelude.dhall + +let JSON = Prelude.JSON + +in Concourse.schemas.Resource::{ + , name = "git-kubo-ci" + , type = ./in-built-resource-type.dhall + , source = + Some + ( toMap + { privateKey = JSON.string "((git-ssh-key.private_key))" + , uri = + JSON.string "git@github.com:cloudfoundry-incubator/kubo-ci" + , branch = JSON.string "master" + } + ) + }