1-----------------------------------------------------------------------
2--  util-http-clients-web -- HTTP Clients with AWS implementation
3--  Copyright (C) 2011, 2012 Stephane Carrez
4--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
5--
6--  Licensed under the Apache License, Version 2.0 (the "License");
7--  you may not use this file except in compliance with the License.
8--  You may obtain a copy of the License at
9--
10--      http://www.apache.org/licenses/LICENSE-2.0
11--
12--  Unless required by applicable law or agreed to in writing, software
13--  distributed under the License is distributed on an "AS IS" BASIS,
14--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15--  See the License for the specific language governing permissions and
16--  limitations under the License.
17-----------------------------------------------------------------------
18
19with AWS.Headers.Set;
20with AWS.Client;
21with AWS.Messages;
22with Util.Log.Loggers;
23package body Util.Http.Clients.Web is
24
25   Log   : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Web", Util.Log.ERROR_LEVEL);
26
27   Manager : aliased AWS_Http_Manager;
28
29   --  ------------------------------
30   --  Register the Http manager.
31   --  ------------------------------
32   procedure Register is
33   begin
34      Default_Http_Manager := Manager'Access;
35   end Register;
36
37   function To_Status (Code : in AWS.Messages.Status_Code) return Natural;
38
39   function To_Status (Code : in AWS.Messages.Status_Code) return Natural is
40      use AWS.Messages;
41   begin
42      case Code is
43         when S100 =>
44            return 100;
45         when S101 =>
46            return 101;
47         when S102 =>
48            return 102;
49         when S200 =>
50            return 200;
51         when S201 =>
52            return 201;
53         when S203 =>
54            return 203;
55         when S204 =>
56            return 204;
57         when S205 =>
58            return 205;
59         when S206 =>
60            return 206;
61         when S207 =>
62            return 207;
63         when S300 =>
64            return 300;
65         when S301 =>
66            return 301;
67         when S302 =>
68            return 302;
69         when S303 =>
70            return 303;
71         when S304 =>
72            return 304;
73         when S305 =>
74            return 305;
75         when S307 =>
76            return 307;
77         when S400 =>
78            return 400;
79         when S401 =>
80            return 401;
81         when S402 =>
82            return 402;
83         when S403 =>
84            return 403;
85         when S404 =>
86            return 404;
87         when S405 =>
88            return 405;
89         when S406 =>
90            return 406;
91         when S407 =>
92            return 407;
93         when S408 =>
94            return 408;
95         when S409 =>
96            return 409;
97         when S410 =>
98            return 410;
99         when S411 =>
100            return 411;
101         when S412 =>
102            return 412;
103         when S413 =>
104            return 413;
105         when S414 =>
106            return 414;
107         when S415 =>
108            return 415;
109         when S416 =>
110            return 416;
111         when S417 =>
112            return 417;
113         when S422 =>
114            return 422;
115         when S423 =>
116            return 423;
117         when S424 =>
118            return 424;
119         when S500 =>
120            return 500;
121         when S501 =>
122            return 501;
123         when S502 =>
124            return 502;
125         when S503 =>
126            return 503;
127         when S504 =>
128            return 504;
129         when S505 =>
130            return 505;
131         when S507 =>
132            return 507;
133         when others =>
134            return 500;
135      end case;
136   end To_Status;
137
138   procedure Create (Manager  : in AWS_Http_Manager;
139                     Http     : in out Client'Class) is
140      pragma Unreferenced (Manager);
141   begin
142      Http.Delegate := new AWS_Http_Request;
143   end Create;
144
145
146   procedure Do_Get (Manager  : in AWS_Http_Manager;
147                     Http     : in Client'Class;
148                     URI      : in String;
149                     Reply    : out Response'Class) is
150      pragma Unreferenced (Manager);
151
152      Req     : constant AWS_Http_Request_Access
153        := AWS_Http_Request'Class (Http.Delegate.all)'Access;
154      Rep     : constant AWS_Http_Response_Access := new AWS_Http_Response;
155   begin
156      Log.Info ("Get {0}", URI);
157
158      Reply.Delegate := Rep.all'Access;
159      Rep.Data       := AWS.Client.Get (URL => URI, Headers => Req.Headers);
160   end Do_Get;
161
162
163   procedure Do_Post (Manager  : in AWS_Http_Manager;
164                      Http     : in Client'Class;
165                      URI      : in String;
166                      Data     : in String;
167                      Reply    : out Response'Class) is
168      pragma Unreferenced (Manager);
169
170      Req     : constant AWS_Http_Request_Access
171        := AWS_Http_Request'Class (Http.Delegate.all)'Access;
172      Rep     : constant AWS_Http_Response_Access := new AWS_Http_Response;
173   begin
174      Log.Info ("Post {0}", URI);
175
176      Reply.Delegate := Rep.all'Access;
177      Rep.Data       := AWS.Client.Post (URL => URI, Data => Data, Headers => Req.Headers);
178   end Do_Post;
179
180   --  ------------------------------
181   --  Returns a boolean indicating whether the named request header has already
182   --  been set.
183   --  ------------------------------
184   function Contains_Header (Http : in AWS_Http_Request;
185                             Name : in String) return Boolean is
186   begin
187      raise Program_Error with "Contains_Header is not implemented";
188      return False;
189   end Contains_Header;
190
191   --  Returns the value of the specified request header as a String. If the request
192   --  did not include a header of the specified name, this method returns null.
193   --  If there are multiple headers with the same name, this method returns the
194   --  first head in the request. The header name is case insensitive. You can use
195   --  this method with any response header.
196   overriding
197   function Get_Header (Request : in AWS_Http_Request;
198                        Name    : in String) return String is
199   begin
200      return "";
201   end Get_Header;
202
203   --  ------------------------------
204   --  Sets a request header with the given name and value. If the header had already
205   --  been set, the new value overwrites the previous one. The containsHeader
206   --  method can be used to test for the presence of a header before setting its value.
207   --  ------------------------------
208   overriding
209   procedure Set_Header (Http  : in out AWS_Http_Request;
210                         Name  : in String;
211                         Value : in String) is
212   begin
213      AWS.Headers.Set.Add (Http.Headers, Name, Value);
214   end Set_Header;
215
216   --  ------------------------------
217   --  Adds a request header with the given name and value.
218   --  This method allows request headers to have multiple values.
219   --  ------------------------------
220   overriding
221   procedure Add_Header (Http  : in out AWS_Http_Request;
222                         Name  : in String;
223                         Value : in String) is
224   begin
225      AWS.Headers.Set.Add (Http.Headers, Name, Value);
226   end Add_Header;
227
228   --  Iterate over the request headers and executes the <b>Process</b> procedure.
229   overriding
230   procedure Iterate_Headers (Request : in AWS_Http_Request;
231                              Process : not null access
232                                procedure (Name  : in String;
233                                           Value : in String)) is
234   begin
235      null;
236   end Iterate_Headers;
237
238   --  ------------------------------
239   --  Returns a boolean indicating whether the named response header has already
240   --  been set.
241   --  ------------------------------
242   function Contains_Header (Reply : in AWS_Http_Response;
243                             Name  : in String) return Boolean is
244   begin
245      return AWS.Response.Header (Reply.Data, Name) /= "";
246   end Contains_Header;
247
248   --  ------------------------------
249   --  Returns the value of the specified response header as a String. If the response
250   --  did not include a header of the specified name, this method returns null.
251   --  If there are multiple headers with the same name, this method returns the
252   --  first head in the request. The header name is case insensitive. You can use
253   --  this method with any response header.
254   --  ------------------------------
255   function Get_Header (Reply  : in AWS_Http_Response;
256                        Name   : in String) return String is
257   begin
258      return AWS.Response.Header (Reply.Data, Name);
259   end Get_Header;
260
261   --  Sets a message header with the given name and value. If the header had already
262   --  been set, the new value overwrites the previous one. The containsHeader
263   --  method can be used to test for the presence of a header before setting its value.
264   overriding
265   procedure Set_Header (Reply    : in out AWS_Http_Response;
266                         Name     : in String;
267                         Value    : in String) is
268   begin
269      null;
270   end Set_Header;
271
272   --  Adds a request header with the given name and value.
273   --  This method allows request headers to have multiple values.
274   overriding
275   procedure Add_Header (Reply   : in out AWS_Http_Response;
276                         Name    : in String;
277                         Value   : in String) is
278   begin
279      null;
280   end Add_Header;
281
282   --  Iterate over the response headers and executes the <b>Process</b> procedure.
283   overriding
284   procedure Iterate_Headers (Reply   : in AWS_Http_Response;
285                              Process : not null access
286                                procedure (Name  : in String;
287                                           Value : in String)) is
288   begin
289      null;
290   end Iterate_Headers;
291
292   --  ------------------------------
293   --  Get the response body as a string.
294   --  ------------------------------
295   function Get_Body (Reply : in AWS_Http_Response) return String is
296   begin
297      return AWS.Response.Message_Body (Reply.Data);
298   end Get_Body;
299
300   --  Get the response status code.
301   overriding
302   function Get_Status (Reply : in AWS_Http_Response) return Natural is
303   begin
304      return To_Status (AWS.Response.Status_Code (Reply.Data));
305   end Get_Status;
306
307end Util.Http.Clients.Web;
308