|
| 1 | +open Devkit |
| 2 | +open Result |
| 3 | + |
| 4 | +let default_api_path = [ "api"; "8" ] |
| 5 | + |
| 6 | +type url = { |
| 7 | + base : string; |
| 8 | + path : string list; |
| 9 | +} |
| 10 | + |
| 11 | +type nginx = { |
| 12 | + base_url : string; |
| 13 | + additional_headers : string list; |
| 14 | + api_path : string list; |
| 15 | +} |
| 16 | + |
| 17 | +let string_of_url url = Printf.sprintf "%s/%s" url.base (String.concat "/" url.path) |
| 18 | + |
| 19 | +let endpoints_cache = Hashtbl.create 100 |
| 20 | + |
| 21 | +let pp_endpoints_cache () = Hashtbl.iter (fun k _v -> Printf.printf "%s\n" k) endpoints_cache |
| 22 | + |
| 23 | +let add_endpoint url = Hashtbl.replace endpoints_cache url None |
| 24 | + |
| 25 | +let update_endpoint url terminal_val = Hashtbl.replace endpoints_cache url (Some terminal_val) |
| 26 | + |
| 27 | +let create ?(additional_headers = []) ?(api_path = default_api_path) base_url = |
| 28 | + { base_url; additional_headers; api_path } |
| 29 | + |
| 30 | +type resp_error = |
| 31 | + | MethodDisabled |
| 32 | + | UnknownVersion |
| 33 | + | UpstreamNotFound |
| 34 | + | UpstreamStatic |
| 35 | + | Other of int |
| 36 | + |
| 37 | +type nginx_response = |
| 38 | + | Upstream of Nginx_t.upstream |
| 39 | + | Endpoints of Nginx_t.endpoints |
| 40 | + | ErrorObj of Nginx_t.error_obj |
| 41 | + | Nginx of Nginx_t.nginx |
| 42 | + | Peer_state of Nginx_t.peer_state |
| 43 | + | Ssl of Nginx_t.ssl |
| 44 | + | Success |
| 45 | + | Upstreams of Nginx_t.upstream list |
| 46 | + | UpstreamServer of Nginx_t.upstream_server |
| 47 | + |
| 48 | +type 't r = ('t, string) result Lwt.t |
| 49 | + |
| 50 | +module ReqErr : Map.OrderedType = struct |
| 51 | + type t = string * int |
| 52 | + let compare (fn1, code1) (fn2, code2) = |
| 53 | + match String.compare fn1 fn2 with |
| 54 | + | 0 -> Int.compare code1 code2 |
| 55 | + | c -> c |
| 56 | +end |
| 57 | + |
| 58 | +module ErrsMap = Map.Make (ReqErr) |
| 59 | + |
| 60 | +let _errs_map = ErrsMap.empty |
| 61 | + |
| 62 | +let return_generic_response url ?body code parse str = |
| 63 | + let body_str = |
| 64 | + match body with |
| 65 | + | None -> "" |
| 66 | + | Some (`Raw (_ct, str)) -> str |
| 67 | + | _ -> "" |
| 68 | + in |
| 69 | + if code >= 200 && code < 300 then Lwt.return (Ok (parse str)) |
| 70 | + else Lwt.return (Error (Printf.sprintf "unsuccessful request %s: [%s] (HTTP code: %d): %s" url body_str code str)) |
| 71 | + |
| 72 | +let do_api8 verb ng path ?body parse_resp = |
| 73 | + let nm = Printf.sprintf "%s %s" (Web.string_of_http_action verb) (String.concat ":" path) in |
| 74 | + let url = string_of_url { base = ng.base_url; path = ng.api_path @ path } in |
| 75 | + let body = Option.map (fun v -> `Raw ("application/json", v)) body in |
| 76 | + match%lwt Web.http_request_lwt' ~headers:ng.additional_headers ?body verb url with |
| 77 | + | `Ok (code, str) -> |
| 78 | + (try return_generic_response url ?body code parse_resp str |
| 79 | + with exn -> Lwt.return (Error (Printf.sprintf "error\n calling %s - %s" nm (Printexc.to_string exn)))) |
| 80 | + | `Error _ as e -> Lwt.fail_with (Printf.sprintf "error calling %s - %s" nm (Web.show_result e)) |
| 81 | + |
| 82 | +let do_api8_del_req ng path parse_resp = do_api8 `DELETE ng path parse_resp |
| 83 | + |
| 84 | +let do_api8_get_req ng path parse_resp = do_api8 `GET ng path parse_resp |
| 85 | + |
| 86 | +let do_api8_patch_req ng path body parse_resp = do_api8 `PATCH ng path ~body parse_resp |
| 87 | + |
| 88 | +let do_api8_post_req ng path body parse_resp = do_api8 `POST ng path ~body parse_resp |
| 89 | + |
| 90 | +let endpoints ng path = do_api8_get_req ng path (fun str -> Nginx_j.endpoints_of_string str) |
| 91 | + |
| 92 | +let endpoints_cache_size () = Hashtbl.length endpoints_cache |
| 93 | + |
| 94 | +let upd_all_endpoints ng = |
| 95 | + let rec upd_aux path = |
| 96 | + match%lwt endpoints ng path with |
| 97 | + | Ok l -> |
| 98 | + update_endpoint (string_of_url { base = ng.base_url; path = [ "api"; "8" ] @ path }) false; |
| 99 | + Lwt_list.iter_s upd_aux |
| 100 | + (List.map |
| 101 | + (fun i -> |
| 102 | + let np = path @ [ i ] in |
| 103 | + add_endpoint (string_of_url { base = ng.base_url; path = [ "api"; "8" ] @ np }); |
| 104 | + np) |
| 105 | + l) |
| 106 | + | _ -> Lwt.return_unit |
| 107 | + in |
| 108 | + let%lwt res = upd_aux [] in |
| 109 | + Lwt.return (Ok res) |
| 110 | + |
| 111 | +let nginx ng = do_api8_get_req ng [ "nginx" ] (fun str -> Nginx_j.nginx_of_string str) |
| 112 | + |
| 113 | +module Upstream = struct |
| 114 | + type t = Nginx_t.upstream |
| 115 | + type upstream_id = string |
| 116 | + |
| 117 | + let upstream_id (str : string) = str |
| 118 | + |
| 119 | + (* val list : nginx -> t list r *) |
| 120 | + |
| 121 | + (** Fetch a list of all upstreams configured *) |
| 122 | + let list ng = |
| 123 | + do_api8_get_req ng [ "http"; "upstreams" ] (fun resp -> List.map snd (Nginx_j.upstream_collection_of_string resp)) |
| 124 | + |
| 125 | + (* val get : nginx -> upstream_id -> t r *) |
| 126 | + |
| 127 | + (** Fetch state and configuration of the given upstream *) |
| 128 | + let get ng upstr_id = |
| 129 | + do_api8_get_req ng [ "http"; "upstreams"; upstr_id ] (fun (str : string) -> Nginx_j.upstream_of_string str) |
| 130 | + |
| 131 | + (* val reset : nginx -> upstream_id -> unit r *) |
| 132 | + |
| 133 | + (** Reset statistics of the given upstream *) |
| 134 | + let reset ng upstr_id = do_api8_del_req ng [ "http"; "upstreams"; upstr_id ] (Fun.const ()) |
| 135 | + |
| 136 | + module Server = struct |
| 137 | + type t = Nginx_t.upstream_server |
| 138 | + type server_id = int |
| 139 | + |
| 140 | + let server_id id : int = id |
| 141 | + |
| 142 | + (* val list : nginx -> upstream_id -> t list r *) |
| 143 | + |
| 144 | + (** Fetch a list of all upstreams configured *) |
| 145 | + let list ng upstr_id = |
| 146 | + do_api8_get_req ng [ "http"; "upstreams"; upstr_id; "servers" ] Nginx_j.upstream_server_list_of_string |
| 147 | + |
| 148 | + (* val add : nginx -> upstream_id -> t -> unit r *) |
| 149 | + |
| 150 | + (** Add a server to upstream server_list *) |
| 151 | + let add ng upstr_id srv = |
| 152 | + do_api8_post_req ng |
| 153 | + [ "http"; "upstreams"; upstr_id; "servers" ] |
| 154 | + (Nginx_j.string_of_upstream_server_new srv) |
| 155 | + Nginx_j.upstream_server_of_string |
| 156 | + |
| 157 | + (* val get : nginx -> upstream_id -> server_id -> t r *) |
| 158 | + |
| 159 | + (** Fetch status and configuration of the given server *) |
| 160 | + let get ng upstr_id srv = |
| 161 | + do_api8_get_req ng |
| 162 | + [ "http"; "upstreams"; upstr_id; "servers"; string_of_int srv ] |
| 163 | + (fun str -> Nginx_j.upstream_server_of_string str) |
| 164 | + |
| 165 | + (* val remove : nginx -> upstream_id -> server_id -> unit r *) |
| 166 | + |
| 167 | + (** Remove the server from the upstream group *) |
| 168 | + let remove ng upstr_id srv_id = |
| 169 | + do_api8_del_req ng [ "http"; "upstreams"; upstr_id; "servers"; string_of_int srv_id ] (Fun.const ()) |
| 170 | + |
| 171 | + let update ng upstr_id srv_id conf = |
| 172 | + do_api8_patch_req ng |
| 173 | + [ "https"; "upstreams"; upstr_id; "servers"; string_of_int srv_id ] |
| 174 | + (Yojson.Basic.to_string conf) (Fun.const ()) |
| 175 | + end |
| 176 | +end |
0 commit comments