Source file service_endpoints_query.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
open! Core
open! Import
let to_request = Service_endpoints_common.to_request
let of_response endpoints =
let loc = !Ast_helper.default_loc in
let body =
Endpoint.cases endpoints ~f:(fun endpoint ->
let error_of_xml =
Service_endpoints_common.make_error_expression ~loc ~label:"error_of_xml" endpoint
in
match Endpoint.in_result_module endpoint "of_xml" with
| None -> [%expr return (Ok ())]
| Some of_xml ->
[%expr
match resp with
| Error err -> handle_error err [%e error_of_xml]
| Ok resp ->
Awsm.Http.Response.body_to_string state resp
>>= fun xmls ->
let xml = Awsm.Xml.parse_response xmls in
return (Ok ([%e of_xml] xml))])
|> Ast_helper.Exp.match_ [%expr endpoint]
in
[%stri
let of_response
(type s i o e)
(state : s Awsm.Http.Monad.t)
(endpoint : (i, o, e) t)
resp
: ( (o, [ `AWS of e | `Transport of Awsm.Http.Io.Error.call ]) result, s )
Awsm.Http.Monad.app
=
let ( >>= ) = state.Awsm.Http.Monad.bind in
let return = state.Awsm.Http.Monad.return in
let handle_error err error_of_xml =
let generic_error () = return (Error (`Transport err)) in
match err with
| `Too_many_redirects -> generic_error ()
| `Bad_response { Awsm.Http.Io.Error.code; body; x_amzn_error_type = _ } -> (
match error_of_xml, code >= 400 && code <= 599 with
| None, _ | _, false -> generic_error ()
| Some error_of_xml, true -> (
match Awsm.Xml.parse_response body with
| `Data _ -> generic_error ()
| `El (((_, "ErrorResponse"), _), _) as error_response_xml -> (
let error_xml = Awsm.Xml.child_exn error_response_xml "Error" in
try
let error_code =
match Awsm.Xml.child_exn error_xml "Code" with
| `Data error_code -> error_code
| `El (_, children) ->
List.map children ~f:(function
| `Data s -> s
| `El _ -> "")
|> Core.String.concat ~sep:""
in
return
(Error (`AWS (error_of_xml (Core.String.strip error_code) error_xml)))
with
| Failure _ -> generic_error ())
| `El _ -> generic_error ()))
in
[%e body]
;;]
;;
let%expect_test "of_response" =
[ Endpoint.create_test "Name1" ~result_module:(Some "ResultModule1")
; Endpoint.create_test "Name2" ~result_module:(Some "ResultModule2")
; Endpoint.create_test "Name3" ~result_module:None
]
|> of_response
|> List.return
|> Util.structure_to_string
|> printf "%s%!";
[%expect
{|
let of_response (type s) (type i) (type o) (type e)
(state : s Awsm.Http.Monad.t) (endpoint : (i, o, e) t) resp =
(let (>>=) = state.Awsm.Http.Monad.bind in
let return = state.Awsm.Http.Monad.return in
let handle_error err error_of_xml =
let generic_error () = return (Error (`Transport err)) in
match err with
| `Too_many_redirects -> generic_error ()
| `Bad_response
{ Awsm.Http.Io.Error.code = code; body; x_amzn_error_type = _ } ->
(match (error_of_xml, ((code >= 400) && (code <= 599))) with
| (None, _) | (_, false) -> generic_error ()
| (Some error_of_xml, true) ->
(match Awsm.Xml.parse_response body with
| `Data _ -> generic_error ()
| `El (((_, "ErrorResponse"), _), _) as error_response_xml ->
let error_xml =
Awsm.Xml.child_exn error_response_xml "Error" in
(try
let error_code =
match Awsm.Xml.child_exn error_xml "Code" with
| `Data error_code -> error_code
| `El (_, children) ->
(List.map children
~f:(function | `Data s -> s | `El _ -> ""))
|> (Core.String.concat ~sep:"") in
return
(Error
(`AWS
(error_of_xml (Core.String.strip error_code)
error_xml)))
with | Failure _ -> generic_error ())
| `El _ -> generic_error ())) in
match endpoint with
| Name1 ->
(match resp with
| Error err -> handle_error err None
| Ok resp ->
(Awsm.Http.Response.body_to_string state resp) >>=
((fun xmls ->
let xml = Awsm.Xml.parse_response xmls in
return (Ok (ResultModule1.of_xml xml)))))
| Name2 ->
(match resp with
| Error err -> handle_error err None
| Ok resp ->
(Awsm.Http.Response.body_to_string state resp) >>=
((fun xmls ->
let xml = Awsm.Xml.parse_response xmls in
return (Ok (ResultModule2.of_xml xml)))))
| Name3 -> return (Ok ()) : ((o,
[ `AWS of e
| `Transport of Awsm.Http.Io.Error.call ])
result,
s) Awsm.Http.Monad.app) |}]
;;
let make_structure_for_protocol _service _metadata data =
[ to_request data; of_response data ]
;;