Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use http protocol to connect to localhost #121

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions lib/aws.mli
Original file line number Diff line number Diff line change
Expand Up @@ -285,6 +285,10 @@ module Util : sig
val option_all : 'a option list -> 'a list option
(** If all values in list are Some v, produce Some (list_filter_opt
list), else produce None. *)

val string_starts_with : string -> string -> bool
(** Judges whether s starts with prefix.
It is ported from stdlib in OCaml 4.13. *)
end

(** This module contains the V2 and V4 Authorization header AWS signature algorithm. *)
Expand Down
6 changes: 4 additions & 2 deletions lib/endpoints.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2049,5 +2049,7 @@ let endpoint_of svc_name region =
| _ -> None
let url_of svc_name region =
match endpoint_of svc_name region with
| Some var -> Some ("https://" ^ var)
| None -> None
| Some var when Util.string_starts_with "localhost" var ->
Some "http://localhost:8000"
| Some var -> Some (String.concat "" ["https://"; var])
| None -> None
12 changes: 12 additions & 0 deletions lib/util.ml
Original file line number Diff line number Diff line change
Expand Up @@ -37,3 +37,15 @@ let rec option_all = function
| [] -> Some []
| Some v :: xs -> option_bind (option_all xs) (fun rest -> Some (v :: rest))
| None :: _ -> None

let string_starts_with prefix s =
let open String in
let len_s = length s and len_pre = length prefix in
let rec aux i =
if i = len_pre
then true
else if unsafe_get s i <> unsafe_get prefix i
then false
else aux (i + 1)
in
len_s >= len_pre && aux 0
22 changes: 19 additions & 3 deletions src/endpoint_gen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,10 +54,26 @@ let write_url_of =
(fun2
"svc_name"
"region"
(matchoption
(match_
(app2 "endpoint_of" (ident "svc_name") (ident "region"))
(app1 "Some" (app2 "^" (str "https://") (ident "var")))
(ident "None"))))
[ (let some_v = "var" in
casearm
(lid "Some")
(Some (pvar some_v))
~guard:(app2 "Util.string_starts_with" (str "localhost") (ident some_v))
(app1 "Some" (str "http://localhost:8000")))
; (let some_v = "var" in
casearm
(lid "Some")
(Some (pvar some_v))
(app1
"Some"
(app2
"String.concat"
(str "")
(list [ ident some_v; str "https://" ]))))
; casearm (lid "None") None (ident "None")
])))

let main input outdir =
log "Start processing endpoints";
Expand Down
10 changes: 8 additions & 2 deletions src/syntax.ml
Original file line number Diff line number Diff line change
Expand Up @@ -258,6 +258,12 @@ let withty _nm0 nm1 =
(* if cond then thn else els *)
let ifthen cond thn els = Exp.ifthenelse cond thn (Some els)

let match_ = Exp.match_

let casearm ?guard lid pat body = Exp.case (Pat.construct lid pat) ?guard body

let pvar v = Pat.var (strloc v)

(* match exp with | Constructor -> body | Constructor -> body ... *)
let matchvar exp branches =
Exp.match_
Expand All @@ -266,14 +272,14 @@ let matchvar exp branches =

(* match exp with | "String" -> body ... | _ -> els ... *)
let matchstrs exp branches els =
Exp.match_
match_
exp
(List.map (fun (nm, body) -> Exp.case (Pat.constant (Const.string nm)) body) branches
@ [ Exp.case (Pat.any ()) els ])

(* match exp with | Some var -> some_body | None -> none_body *)
let matchoption exp some_body none_body =
Exp.match_
match_
exp
[ Exp.case (construct (lid "Some") (Some (Pat.var (strloc "var")))) some_body
; Exp.case (construct (lid "None") None) none_body
Expand Down
Loading