├── .gitignore ├── .ocamlformat ├── .travis.yml ├── CHANGES.md ├── CODE_OF_CONDUCT.md ├── LICENSE.md ├── README.md ├── bin ├── dune ├── maintenant.ml └── maintenant.mli ├── dune-project ├── lib ├── client.ml ├── client.mli ├── deployment.ml ├── deployment.mli ├── dune ├── error.ml ├── error.mli ├── let.ml ├── let.mli ├── route.ml ├── route.mli ├── scale.ml └── scale.mli ├── test ├── dune ├── test_all.ml ├── test_all.mli ├── test_client.ml ├── test_client.mli ├── test_deployment.ml └── test_deployment.mli ├── zeit.descr └── zeit.opam /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.install 3 | .merlin 4 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | break-cases=all 2 | break-infix=fit-or-vertical 3 | field-space=loose 4 | margin=79 5 | parens-tuple=always 6 | sequence-style=terminator 7 | type-decl=sparse 8 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | services: 4 | - docker 5 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh 6 | script: bash ./.travis-docker.sh 7 | env: 8 | global: 9 | - PACKAGE=zeit 10 | - DISTRO=alpine-3.7 11 | matrix: 12 | - OCAML_VERSION=4.04 13 | - OCAML_VERSION=4.05 14 | - OCAML_VERSION=4.06 15 | - OCAML_VERSION=4.07 16 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | v0.1.0 2018-09-19 2 | ================= 3 | 4 | Initial release. 5 | -------------------------------------------------------------------------------- /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 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, sex characteristics, gender identity and expression, 9 | level of experience, education, socio-economic status, nationality, personal 10 | appearance, race, religion, or sexual identity and orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at `me AT emillon DOT org`. All 59 | complaints will be reviewed and investigated and will result in a response that 60 | is deemed necessary and appropriate to the circumstances. The project team is 61 | obligated to maintain confidentiality with regard to the reporter of an incident. 62 | Further details of specific enforcement policies may be posted separately. 63 | 64 | Project maintainers who do not follow or enforce the Code of Conduct in good 65 | faith may face temporary or permanent repercussions as determined by other 66 | members of the project's leadership. 67 | 68 | ## Attribution 69 | 70 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, 71 | available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html 72 | 73 | [homepage]: https://www.contributor-covenant.org 74 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright 2018 Etienne Millon 2 | 3 | Redistribution and use in source and binary forms, with or without modification, 4 | are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 14 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 15 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 16 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 17 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 18 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 19 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 20 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 22 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Zeit - deploy to Δ now 2 | 3 | This library is a client for the [Zeit API](https://zeit.co/api), in particular 4 | to deploy code to . 5 | 6 | It contains a small example binary that implements a subset of the official 7 | Node client. 8 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (public_name maintenant) 3 | (libraries cmdliner zeit) 4 | (preprocess (pps ppx_let)) 5 | ) 6 | -------------------------------------------------------------------------------- /bin/maintenant.ml: -------------------------------------------------------------------------------- 1 | let run t = 2 | match Lwt_main.run t with 3 | | Ok x -> 4 | x 5 | | Error e -> 6 | failwith (Zeit.Error.to_string e) 7 | 8 | 9 | let run_list_deployments token = 10 | let open Zeit.Let.Lwt_result in 11 | let client = Zeit.Client.make ~token () in 12 | run 13 | (let%map deployments = Zeit.Client.list_deployments client in 14 | List.iter (Format.printf "%a%!\n" Zeit.Deployment.pp) deployments) 15 | 16 | 17 | let run_deploy_sample token name = 18 | let index_html = "

Hello, world!

" in 19 | let client = Zeit.Client.make ~token () in 20 | let open Zeit.Let.Lwt_result in 21 | run 22 | (let%bind sha1 = Zeit.Client.post_file client index_html in 23 | let file = ("index.html", sha1, String.length index_html) in 24 | let%map deploy = 25 | Zeit.Client.create_deployment client ~name ~files:[file] 26 | in 27 | print_endline @@ Zeit.Deployment.Api_responses.show_create_result deploy) 28 | 29 | 30 | let arg_token = 31 | let open Cmdliner.Arg in 32 | let env = env_var "MAINTENANT_TOKEN" in 33 | let info = info ~env ["token"] in 34 | required (opt (some string) None info) 35 | 36 | 37 | let arg_name = 38 | let open Cmdliner.Arg in 39 | let info = info ["name"] in 40 | required (opt (some string) None info) 41 | 42 | 43 | let help = 44 | let open Cmdliner.Term in 45 | (ret (const (`Help (`Auto, None))), info "maintenant") 46 | 47 | 48 | let list_deployments = 49 | let open Cmdliner.Term in 50 | ( const run_list_deployments $ arg_token 51 | , info ~doc:"List all deployments" "list" ) 52 | 53 | 54 | let deploy_sample = 55 | let open Cmdliner.Term in 56 | ( const run_deploy_sample $ arg_token $ arg_name 57 | , info ~doc:"Deploy a sample project" "deploy-sample" ) 58 | 59 | 60 | let () = 61 | let open Cmdliner.Term in 62 | exit @@ eval_choice help [list_deployments; deploy_sample] 63 | -------------------------------------------------------------------------------- /bin/maintenant.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/emillon/ocaml-zeit/cdcdd0b155d406d1b8c8947e3c620527c3c9ecf7/bin/maintenant.mli -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.2) 2 | (name zeit) 3 | -------------------------------------------------------------------------------- /lib/client.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { token : string 3 | ; host : string 4 | ; cohttp_call : 5 | Cohttp.Code.meth 6 | -> Cohttp.Header.t 7 | -> Uri.t 8 | -> body:string 9 | -> (Cohttp.Response.t * Cohttp_lwt.Body.t) Lwt.t } 10 | 11 | let default_cohttp_call meth headers uri ~body = 12 | let body = Cohttp_lwt.Body.of_string body in 13 | Cohttp_lwt_unix.Client.call meth ~headers ~body uri 14 | 15 | 16 | let make ?(cohttp_call = default_cohttp_call) ~token () = 17 | {token; host = "api.zeit.co"; cohttp_call} 18 | 19 | 20 | let uri client route = 21 | Uri.make ~scheme:"https" ~host:client.host ~path:(Route.path route) () 22 | 23 | 24 | let request ~client ?(extra_headers = []) meth route body = 25 | let open Let.Lwt in 26 | let base_header = 27 | Cohttp.Header.init_with "Authorization" ("Bearer " ^ client.token) 28 | in 29 | let headers = Cohttp.Header.add_list base_header extra_headers in 30 | let%map resp, body = 31 | client.cohttp_call meth headers (uri client route) ~body 32 | in 33 | let code = 34 | Cohttp.Code.code_of_status (Cohttp_lwt_unix.Response.status resp) 35 | in 36 | if Cohttp.Code.is_success code then Ok body else Error Error.Http_error 37 | 38 | 39 | let parse_and_convert s of_yojson = 40 | Lwt.return 41 | @@ 42 | match Yojson.Safe.from_string s with 43 | | exception Yojson.Json_error _ -> 44 | Error Error.Json_error 45 | | json -> ( 46 | match of_yojson json with 47 | | Ok _ as r -> 48 | r 49 | | Error _ -> 50 | Error Error.Deserialization_error ) 51 | 52 | 53 | let body_to_string body = 54 | let open Let.Lwt in 55 | let%map s = Cohttp_lwt.Body.to_string body in 56 | Ok s 57 | 58 | 59 | let list_deployments client = 60 | let open Let.Lwt_result in 61 | let%bind cohttp_body = request ~client `GET Deployment_list "" in 62 | let%bind body = body_to_string cohttp_body in 63 | parse_and_convert body Deployment.Api_responses.list_result_of_yojson 64 | 65 | 66 | let post_file client s = 67 | let open Let.Lwt_result in 68 | let sha1 = Digestif.SHA1.to_hex @@ Digestif.SHA1.digest_string s in 69 | let file_size = string_of_int @@ String.length s in 70 | let extra_headers = 71 | [ ("Content-Length", file_size) 72 | ; ("Content-Type", "application/octet-stream") 73 | ; ("x-now-digest", sha1) 74 | ; ("x-now-size", file_size) ] 75 | in 76 | let%map _ : Cohttp_lwt.Body.t = 77 | request ~client ~extra_headers `POST Post_file s 78 | in 79 | sha1 80 | 81 | 82 | type file = string * string * int 83 | 84 | type file_repr = 85 | { file : string 86 | ; sha : string 87 | ; size : int } 88 | [@@deriving to_yojson] 89 | 90 | let file_to_yojson (file, sha, size) = file_repr_to_yojson {file; sha; size} 91 | 92 | type create_deployment_body = 93 | { name : string 94 | ; public : bool 95 | ; deploymentType : string 96 | ; files : file list } 97 | [@@deriving to_yojson] 98 | 99 | let create_deployment client ~name ~files = 100 | let open Let.Lwt_result in 101 | let body = {name; public = true; deploymentType = "STATIC"; files} in 102 | let encoded_body = 103 | Yojson.Safe.to_string @@ create_deployment_body_to_yojson body 104 | in 105 | let%bind (cohttp_body : Cohttp_lwt.Body.t) = 106 | request ~client ~extra_headers:[] `POST Create_deployment encoded_body 107 | in 108 | let%bind body = body_to_string cohttp_body in 109 | parse_and_convert body Deployment.Api_responses.create_result_of_yojson 110 | -------------------------------------------------------------------------------- /lib/client.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val make : 4 | ?cohttp_call:( Cohttp.Code.meth 5 | -> Cohttp.Header.t 6 | -> Uri.t 7 | -> body:string 8 | -> (Cohttp.Response.t * Cohttp_lwt.Body.t) Lwt.t) 9 | -> token:string 10 | -> unit 11 | -> t 12 | 13 | val list_deployments : t -> (Deployment.t list, Error.t) result Lwt.t 14 | 15 | val post_file : t -> string -> (string, Error.t) result Lwt.t 16 | 17 | val create_deployment : 18 | t 19 | -> name:string 20 | -> files:(string * string * int) list 21 | -> (Deployment.Api_responses.create_result, Error.t) result Lwt.t 22 | -------------------------------------------------------------------------------- /lib/deployment.ml: -------------------------------------------------------------------------------- 1 | module Creator = struct 2 | type t = string [@@deriving eq, show] 3 | 4 | let _ = show 5 | 6 | type repr = {uid : string} [@@deriving of_yojson] 7 | 8 | let of_yojson json = 9 | let open Let.Json in 10 | let%map {uid} = repr_of_yojson json in 11 | uid 12 | end 13 | 14 | type t = 15 | { uid : string 16 | ; name : string 17 | ; url : string 18 | ; created : int64 19 | ; type_ : string [@key "type"] 20 | ; creator : Creator.t 21 | ; instanceCount : unit option [@default None] 22 | ; scale : Scale.t option 23 | ; state : string option [@default None] } 24 | [@@deriving eq, show, of_yojson] 25 | 26 | module Api_responses = struct 27 | type list_result = t list 28 | 29 | type list_result_repr = {deployments : t list} [@@deriving of_yojson] 30 | 31 | let list_result_of_yojson json = 32 | let open Let.Json in 33 | let%map {deployments} = list_result_repr_of_yojson json in 34 | deployments 35 | 36 | 37 | type create_result = 38 | { deploymentId : string 39 | ; url : string 40 | ; readyState : string } 41 | [@@deriving eq, show, of_yojson] 42 | end 43 | -------------------------------------------------------------------------------- /lib/deployment.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | { uid : string 3 | ; name : string 4 | ; url : string 5 | ; created : int64 6 | ; type_ : string 7 | ; creator : string 8 | ; instanceCount : unit option 9 | ; scale : Scale.t option 10 | ; state : string option } 11 | [@@deriving eq, show] 12 | 13 | module Api_responses : sig 14 | type list_result = t list [@@deriving of_yojson] 15 | 16 | type create_result = 17 | { deploymentId : string 18 | ; url : string 19 | ; readyState : string } 20 | [@@deriving eq, show, of_yojson] 21 | end 22 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name zeit) 3 | (libraries 4 | cohttp-lwt-unix 5 | digestif.ocaml 6 | lwt 7 | ppx_deriving_yojson.runtime 8 | uri 9 | yojson 10 | ) 11 | (preprocess (pps ppx_deriving.std ppx_deriving_yojson ppx_let)) 12 | (flags :standard -w -39) 13 | ) 14 | -------------------------------------------------------------------------------- /lib/error.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | Http_error 3 | | Json_error 4 | | Deserialization_error 5 | [@@deriving eq, show] 6 | 7 | let to_string = function 8 | | Http_error -> 9 | "HTTP error" 10 | | Json_error -> 11 | "JSON error" 12 | | Deserialization_error -> 13 | "Deserialization error" 14 | -------------------------------------------------------------------------------- /lib/error.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | | Http_error 3 | | Json_error 4 | | Deserialization_error 5 | [@@deriving eq, show] 6 | 7 | val to_string : t -> string 8 | -------------------------------------------------------------------------------- /lib/let.ml: -------------------------------------------------------------------------------- 1 | module Json = struct 2 | module Let_syntax = struct 3 | let map ~f x = Ppx_deriving_yojson_runtime.( >|= ) x f 4 | end 5 | end 6 | 7 | module Lwt_result = struct 8 | module Let_syntax = struct 9 | let bind ~f x = 10 | Lwt.bind x (function 11 | | Ok y -> 12 | f y 13 | | Error e -> 14 | Lwt.return_error e ) 15 | 16 | 17 | let map ~f x = 18 | Lwt.map 19 | (function 20 | | Ok y -> 21 | Ok (f y) 22 | | Error _ as e -> 23 | e) 24 | x 25 | end 26 | end 27 | 28 | module Lwt = struct 29 | module Let_syntax = struct 30 | let bind ~f x = Lwt.bind x f 31 | 32 | let map ~f x = Lwt.map f x 33 | end 34 | end 35 | -------------------------------------------------------------------------------- /lib/let.mli: -------------------------------------------------------------------------------- 1 | module Json : sig 2 | module Let_syntax : sig 3 | val map : f:('a -> 'b) -> ('a, string) result -> ('b, string) result 4 | end 5 | end 6 | 7 | module Lwt_result : sig 8 | module Let_syntax : sig 9 | val bind : 10 | f:('a -> ('b, Error.t) result Lwt.t) 11 | -> ('a, Error.t) result Lwt.t 12 | -> ('b, Error.t) result Lwt.t 13 | 14 | val map : 15 | f:('a -> 'b) -> ('a, Error.t) result Lwt.t -> ('b, Error.t) result Lwt.t 16 | end 17 | end 18 | 19 | module Lwt : sig 20 | module Let_syntax : sig 21 | val bind : f:('a -> 'b Lwt.t) -> 'a Lwt.t -> 'b Lwt.t 22 | 23 | val map : f:('a -> 'b) -> 'a Lwt.t -> 'b Lwt.t 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /lib/route.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | Deployment_list 3 | | Post_file 4 | | Create_deployment 5 | 6 | let path = function 7 | | Deployment_list -> 8 | "/v2/now/deployments" 9 | | Post_file -> 10 | "/v2/now/files" 11 | | Create_deployment -> 12 | "/v3/now/deployments" 13 | -------------------------------------------------------------------------------- /lib/route.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | | Deployment_list 3 | | Post_file 4 | | Create_deployment 5 | 6 | val path : t -> string 7 | -------------------------------------------------------------------------------- /lib/scale.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | { current : int 3 | ; min : int 4 | ; max : int } 5 | [@@deriving eq, show, of_yojson] 6 | -------------------------------------------------------------------------------- /lib/scale.mli: -------------------------------------------------------------------------------- 1 | type t = 2 | { current : int 3 | ; min : int 4 | ; max : int } 5 | [@@deriving eq, show, of_yojson] 6 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_all) 3 | (libraries oUnit zeit mock-ounit) 4 | (preprocess (pps ppx_deriving.std ppx_let)) 5 | ) 6 | -------------------------------------------------------------------------------- /test/test_all.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let suite = "zeit" >::: [Test_deployment.suite; Test_client.suite] 4 | 5 | let () = run_test_tt_main suite 6 | -------------------------------------------------------------------------------- /test/test_all.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/emillon/ocaml-zeit/cdcdd0b155d406d1b8c8947e3c620527c3c9ecf7/test/test_all.mli -------------------------------------------------------------------------------- /test/test_client.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let cases = ( >::: ) 4 | 5 | module Cohttp_mock = struct 6 | let call mock meth headers uri ~body = 7 | Mock.call mock (meth, headers, uri, body) 8 | 9 | 10 | let configure mock ~status ~body = 11 | Mock.configure mock 12 | (Mock.return (Lwt.return (Cohttp.Response.make ~status (), body))) 13 | 14 | 15 | let equal_meth a b = 16 | String.equal 17 | (Cohttp.Code.string_of_method a) 18 | (Cohttp.Code.string_of_method b) 19 | 20 | 21 | let pp_meth fmt m = 22 | Format.pp_print_string fmt (Cohttp.Code.string_of_method m) 23 | 24 | 25 | let equal_cohttp_header a b = 26 | [%eq: (string * string) list] (Cohttp.Header.to_list a) 27 | (Cohttp.Header.to_list b) 28 | 29 | 30 | let pp_cohttp_header fmt h = 31 | Format.pp_print_string fmt (Cohttp.Header.to_string h) 32 | 33 | 34 | let pp_uri fmt u = Format.pp_print_string fmt (Uri.to_string u) 35 | 36 | let assert_called_once_with ~ctxt ~expected_meth ~expected_headers 37 | ~expected_uri ~expected_body mock = 38 | let expected_args = 39 | (expected_meth, expected_headers, expected_uri, expected_body) 40 | in 41 | Mock_ounit.assert_called_once_with ~ctxt 42 | ~cmp:[%eq: meth * cohttp_header * Uri.t * string] 43 | ~printer:[%show: meth * cohttp_header * uri * string] expected_args mock 44 | end 45 | 46 | let case_lwt s l = s >:: fun ctxt -> Lwt_main.run (l ctxt) 47 | 48 | let with_client k ~ctxt ~status ~body ~expected_meth ~expected_extra_headers 49 | ~expected_uri ~expected_body = 50 | let token = "TOKEN" in 51 | let expected_headers = 52 | Cohttp.Header.of_list 53 | (("Authorization", "Bearer " ^ token) :: expected_extra_headers) 54 | in 55 | let mock = Mock.make ~name:"cohttp_call" in 56 | Cohttp_mock.configure mock ~status ~body; 57 | let cohttp_call = Cohttp_mock.call mock in 58 | let client = Zeit.Client.make ~cohttp_call ~token () in 59 | let result = k client in 60 | Cohttp_mock.assert_called_once_with ~ctxt ~expected_meth ~expected_headers 61 | ~expected_uri:(Uri.of_string expected_uri) 62 | ~expected_body mock; 63 | result 64 | 65 | 66 | let test_list_deployments = 67 | let test ?(status = `OK) ?(body = "") ~expected () ctxt = 68 | let body = Cohttp_lwt.Body.of_string body in 69 | with_client ~ctxt ~status ~body ~expected_meth:`GET 70 | ~expected_extra_headers:[] ~expected_body:"" 71 | ~expected_uri:"https://api.zeit.co/v2/now/deployments" (fun client -> 72 | let open Zeit.Let.Lwt in 73 | let%map got = Zeit.Client.list_deployments client in 74 | assert_equal ~ctxt 75 | ~cmp:[%eq: (Zeit.Deployment.t list, Zeit.Error.t) result] 76 | ~printer:[%show: (Zeit.Deployment.t list, Zeit.Error.t) result] 77 | expected got ) 78 | in 79 | cases "list_deployments" 80 | [ case_lwt "HTTP error" 81 | (test ~status:`Unauthorized ~expected:(Error Http_error) ()) 82 | ; case_lwt "JSON error" (test ~expected:(Error Json_error) ()) 83 | ; case_lwt "Deserialization error" 84 | (test ~body:"{}" ~expected:(Error Deserialization_error) ()) 85 | ; case_lwt "OK" (test ~body:"{\"deployments\":[]}" ~expected:(Ok []) ()) 86 | ] 87 | 88 | 89 | let test_post_file = 90 | let test ~contents ~expected_size ~expected_sha1 ~expected ctxt = 91 | let expected_extra_headers = 92 | [ ("Content-Type", "application/octet-stream") 93 | ; ("Content-Length", expected_size) 94 | ; ("x-now-digest", expected_sha1) 95 | ; ("x-now-size", expected_size) ] 96 | in 97 | let body = Cohttp_lwt.Body.empty in 98 | with_client ~ctxt ~body ~expected_meth:`POST ~expected_extra_headers 99 | ~expected_uri:"https://api.zeit.co/v2/now/files" ~expected_body:contents 100 | (fun client -> 101 | let open Zeit.Let.Lwt in 102 | let%map got = Zeit.Client.post_file client contents in 103 | assert_equal ~ctxt ~cmp:[%eq: (string, Zeit.Error.t) result] 104 | ~printer:[%show: (string, Zeit.Error.t) result] expected got ) 105 | in 106 | let contents = "hello" in 107 | let contents_sha1 = "aaf4c61ddcc5e8a2dabede0f3b482cd9aea9434d" in 108 | let expected_size = "5" in 109 | let expected_sha1 = contents_sha1 in 110 | cases "post_file" 111 | [ case_lwt "OK" 112 | (test ~contents ~status:`OK ~expected_size ~expected_sha1 113 | ~expected:(Ok contents_sha1)) 114 | ; case_lwt "HTTP error" 115 | (test ~contents ~status:`Unauthorized ~expected_size ~expected_sha1 116 | ~expected:(Error Http_error)) ] 117 | 118 | 119 | let test_create_deployment = 120 | let test ~name ~files ~body ~expected ~expected_body_json ctxt = 121 | let expected_body = Yojson.Safe.to_string expected_body_json in 122 | with_client ~ctxt ~status:`OK ~body 123 | (fun client -> 124 | let open Zeit.Let.Lwt in 125 | let%map got = Zeit.Client.create_deployment client ~name ~files in 126 | assert_equal ~ctxt 127 | ~cmp: 128 | [%eq: 129 | ( Zeit.Deployment.Api_responses.create_result 130 | , Zeit.Error.t ) 131 | result] 132 | ~printer: 133 | [%show: 134 | ( Zeit.Deployment.Api_responses.create_result 135 | , Zeit.Error.t ) 136 | result] expected got ) 137 | ~expected_meth:`POST ~expected_extra_headers:[] 138 | ~expected_uri:"https://api.zeit.co/v3/now/deployments" ~expected_body 139 | in 140 | let name = "my-instant-deployment" in 141 | let file_name = "index.html" in 142 | let file_sha = "9d8b952309b28f468919f4a585e18b63a14457f2" in 143 | let file_size = 161 in 144 | let file = (file_name, file_sha, file_size) in 145 | let deploymentId = "ID" in 146 | let url = "URL" in 147 | let readyState = "READYSTATE" in 148 | let create_result = 149 | {Zeit.Deployment.Api_responses.deploymentId; url; readyState} 150 | in 151 | let create_result_body = 152 | Cohttp_lwt.Body.of_string 153 | @@ Yojson.Safe.to_string 154 | @@ `Assoc 155 | [ ("deploymentId", `String deploymentId) 156 | ; ("url", `String url) 157 | ; ("readyState", `String readyState) ] 158 | in 159 | cases "create_deployment" 160 | [ case_lwt "OK" 161 | (test ~name ~files:[file] ~body:create_result_body 162 | ~expected:(Ok create_result) 163 | ~expected_body_json: 164 | (`Assoc 165 | [ ("name", `String name) 166 | ; ("public", `Bool true) 167 | ; ("deploymentType", `String "STATIC") 168 | ; ( "files" 169 | , `List 170 | [ `Assoc 171 | [ ("file", `String file_name) 172 | ; ("sha", `String file_sha) 173 | ; ("size", `Int file_size) ] ] ) ])) ] 174 | 175 | 176 | let suite = 177 | cases "client" 178 | [test_list_deployments; test_post_file; test_create_deployment] 179 | -------------------------------------------------------------------------------- /test/test_client.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /test/test_deployment.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let cases = ( >::: ) 4 | 5 | let case = ( >:: ) 6 | 7 | let test_list_result_of_yojson = 8 | let test json expected ctxt = 9 | let got = Zeit.Deployment.Api_responses.list_result_of_yojson json in 10 | assert_equal ~ctxt ~cmp:[%eq: (Zeit.Deployment.t list, string) result] 11 | ~printer:[%show: (Zeit.Deployment.t list, string) result] expected got 12 | in 13 | let name = "NAME" in 14 | let creator = "CREATOR" in 15 | let uid1 = "U1" in 16 | let uid2 = "U2" in 17 | let url1 = "UU1.XX.YY" in 18 | let url2 = "UU2.XX.YY" in 19 | let deployment1 = 20 | { Zeit.Deployment.uid = uid1 21 | ; name 22 | ; url = url1 23 | ; created = 1L 24 | ; type_ = "STATIC" 25 | ; creator 26 | ; instanceCount = None 27 | ; scale = None 28 | ; state = None } 29 | in 30 | let deployment2 = 31 | { Zeit.Deployment.uid = uid2 32 | ; name 33 | ; url = url2 34 | ; created = 2L 35 | ; state = Some "BUILDING" 36 | ; instanceCount = None 37 | ; type_ = "DOCKER" 38 | ; creator 39 | ; scale = Some {current = 0; min = 0; max = 10} } 40 | in 41 | let json_ok = 42 | `Assoc 43 | [ ( "deployments" 44 | , `List 45 | [ `Assoc 46 | [ ("uid", `String uid1) 47 | ; ("name", `String name) 48 | ; ("url", `String url1) 49 | ; ("created", `Int 1) 50 | ; ("type", `String "STATIC") 51 | ; ("creator", `Assoc [("uid", `String creator)]) 52 | ; ("instanceCount", `Null) 53 | ; ("scale", `Null) ] 54 | ; `Assoc 55 | [ ("uid", `String uid2) 56 | ; ("name", `String name) 57 | ; ("url", `String url2) 58 | ; ("created", `Int 2) 59 | ; ("state", `String "BUILDING") 60 | ; ("type", `String "DOCKER") 61 | ; ("creator", `Assoc [("uid", `String creator)]) 62 | ; ( "scale" 63 | , `Assoc 64 | [("current", `Int 0); ("min", `Int 0); ("max", `Int 10)] 65 | ) ] ] ) ] 66 | in 67 | cases "list_deployment_response_of_yojson" 68 | [case "ok" (test json_ok (Ok [deployment1; deployment2]))] 69 | 70 | 71 | let suite = 72 | cases "deployment" [cases "api_responses" [test_list_result_of_yojson]] 73 | -------------------------------------------------------------------------------- /test/test_deployment.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | -------------------------------------------------------------------------------- /zeit.descr: -------------------------------------------------------------------------------- 1 | Client for the Zeit API and now.sh 2 | -------------------------------------------------------------------------------- /zeit.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: "Etienne Millon " 3 | authors: "Etienne Millon " 4 | homepage: "https://github.com/emillon/ocaml-zeit" 5 | bug-reports: "https://github.com/emillon/ocaml-zeit/issues" 6 | license: "BSD-2" 7 | dev-repo: "https://github.com/emillon/ocaml-zeit.git" 8 | doc: "https://emillon.github.io/ocaml-zeit/doc" 9 | build: [ 10 | ["dune" "subst"] {pinned} 11 | ["dune" "build" "-p" name "-j" jobs] 12 | ] 13 | build-test: [ 14 | ["dune" "runtest" "-p" name "-j" jobs] 15 | ] 16 | depends: [ 17 | "cohttp-lwt-unix" 18 | "digestif" 19 | "dune" {build & >= "1.2.0"} 20 | "mock-ounit" {test} 21 | "ounit" {test} 22 | "ppx_deriving" 23 | "ppx_deriving_yojson" 24 | "ppx_let" 25 | ] 26 | --------------------------------------------------------------------------------