1%%% -*- erlang -*-
2%%%
3%%% This file is part of hackney released under the Apache 2 license.
4%%% See the NOTICE for more information.
5%%%
6
7-module(hackney).
8
9-export([connect/1, connect/2, connect/3, connect/4,
10         close/1,
11         request_info/1,
12         location/1,
13         request/1, request/2, request/3, request/4, request/5,
14         send_request/2, send_request/3,
15         start_response/1,
16         cookies/1,
17         send_body/2, finish_send_body/1,
18         send_multipart_body/2,
19         body/1, body/2, skip_body/1,
20         stream_body/1,
21         stream_multipart/1,
22         skip_multipart/1,
23         controlling_process/2,
24         cancel_request/1,
25         setopts/2]).
26
27-export([redirect_location/1]).
28
29-export([stream_next/1,
30         stop_async/1,
31         pause_stream/1,
32         resume_stream/1]).
33
34-define(METHOD_TPL(Method),
35  -export([Method/1, Method/2, Method/3, Method/4])).
36-include("hackney_methods.hrl").
37
38-include("hackney.hrl").
39-include("hackney_lib.hrl").
40-include("hackney_internal.hrl").
41
42
43-type url() :: #hackney_url{} | binary().
44-export_type([url/0]).
45
46-opaque client() :: #client{}.
47-export_type([client/0]).
48
49-type client_ref() :: term().
50-export_type([client_ref/0]).
51
52connect(URL) ->
53  connect(URL, []).
54
55connect(#hackney_url{}=URL, Options) ->
56  #hackney_url{transport=Transport,
57    host=Host,
58    port=Port} = URL,
59  connect(Transport, Host, Port, Options);
60connect(URL, Options) when is_binary(URL) orelse is_list(URL) ->
61  connect(hackney_url:parse_url(URL), Options).
62
63%% @doc connect a socket and create a client state.
64connect(Transport, Host, Port) ->
65  hackney_connect:connect(Transport, Host, Port, []).
66
67connect(Transport, Host, Port, Options) ->
68  hackney_connect:connect(Transport, Host, Port, Options).
69
70%% @doc Assign a new controlling process <em>Pid</em> to <em>Client</em>.
71-spec controlling_process(client_ref(), pid())
72    -> ok | {error, closed | not_owner | atom()}.
73controlling_process(Ref, Pid) ->
74  hackney_manager:controlling_process(Ref, Pid).
75
76%% @doc Extract raw informations from the client context
77%% This feature can be useful when you want to create a simple proxy, rerouting
78%% on the headers and the status line and continue to forward the connection for example.
79%%
80%% return: `{ResponseState, Transport, Socket, Buffer} | {error, Reason}'
81%% <ul>
82%% <li>`Response': waiting_response, on_status, on_headers, on_body</li>
83%% <li>`Transport': The current transport module</li>
84%% <li>`Socket': the current socket</li>
85%% <li>`Buffer': Data fetched but not yet processed</li>
86%% </ul>
87-spec cancel_request(client_ref()) ->
88  {ok, {atom(), inet:socket(), binary(), hackney_response:response_state()}}
89  | {error, term()}.
90cancel_request(Ref) ->
91  hackney_manager:cancel_request(Ref).
92
93%% @doc set client options.
94%% Options are:
95%% - `async': to fetch the response asynchronously
96%% - `{async, once}': to receive the response asynchronously once time.
97%% To receive the next message use the function `hackney:stream_next/1'.
98%% - `{stream_to, pid()}': to set the pid where the messages of an
99%% asynchronous response will be sent.
100%% - `{follow_redirect, bool()}' : if true a redirection will be
101%% followed when the response is received synchronously
102%% - `{force_redirect, bool()}' : if true a 301/302 redirection will be
103%% followed even on POST.
104%% - `{max_redirect, integer()}' the maximum number of redirections that
105%% will be followed
106-spec setopts(client_ref(), list()) -> ok.
107setopts(Ref, Options) ->
108  hackney_manager:get_state(Ref, fun(State) ->
109    State2 = parse_options(Options, State),
110    hackney_manager:update_state(Ref, State2)
111                                 end).
112
113%% @doc close the client
114close(Ref) ->
115  hackney_connect:close(Ref).
116
117
118%% @doc get request info
119-spec request_info(client_ref()) -> list().
120request_info(Ref) ->
121  hackney_manager:get_state(Ref, fun(State) ->
122    #client{transport=Transport,
123      socket=Socket,
124      method=Method} = State,
125
126    Location = hackney_request:location(State),
127
128    [{method, Method},
129      {location, Location},
130      {transport, Transport},
131      {socket, Socket}]
132                                 end).
133
134%% @doc return the requested location
135-spec location(client_ref()) -> binary().
136location(Ref) ->
137  hackney_manager:get_state(Ref, fun(State) ->
138    hackney_request:location(State)
139                                 end).
140
141
142%% @doc make a request
143-spec request(url()|binary()|list())
144    -> {ok, integer(), list(), client_ref()}
145  | {ok, integer(), list()}
146  | {error, term()}.
147request(URL) ->
148  request(get, URL).
149
150%% @doc make a request
151-spec request(term(), url()|binary()|list())
152    -> {ok, integer(), list(), client_ref()}
153  | {ok, integer(), list()}
154  | {error, term()}.
155request(Method, URL) ->
156  request(Method, URL, [], <<>>, []).
157
158%% @doc make a request
159-spec request(term(), url()|binary()|list(), list())
160    -> {ok, integer(), list(), client_ref()}
161  | {ok, integer(), list()}
162  | {error, term()}.
163request(Method, URL, Headers) ->
164  request(Method, URL, Headers, <<>>, []).
165
166%% @doc make a request
167-spec request(term(), url()|binary()|list(), list(), term())
168    -> {ok, integer(), list(), client_ref()}
169  | {ok, integer(), list()}
170  | {error, term()}.
171request(Method, URL, Headers, Body) ->
172  request(Method, URL, Headers, Body, []).
173
174%% @doc make a request
175%%
176%% Args:
177%% <ul>
178%% <li><strong>Method</strong>>: method used for the request (get, post,
179%% ...)</li>
180%% <li><strong>Url</strong>: full url of the request</li>
181%% <li><strong>Headers</strong> Proplists </li>
182%% <li><strong>Body</strong>:
183%%      <ul>
184%%      <li>{form, [{K, V}, ...]}: send a form url encoded</li>
185%%      <li>{multipart, [{K, V}, ...]}: send a form using multipart</li>
186%%      <li>{file, "/path/to/file"}: to send a file</li>
187%%      <li>Bin: binary or iolist</li>
188%%      </ul>
189%%  </li>
190%%  <li><strong>Options:</strong> `[{connect_options, connect_options(),
191%%  {ssl_options, ssl_options()}, Others]'</li>
192%%      <li>`connect_options()': The default connect_options are
193%%      `[binary, {active, false}, {packet, raw}])'. For valid options
194%%      see the gen_tcp options.</li>
195%%
196%%      <li>`ssl_options()': See the ssl options from the ssl
197%%      module.</li>
198%%
199%%      <li>`with_body': when this option is passed the body is returned
200%%      directly. The response is `{ok, Status, Headers, Body}'</li>
201%%      <li>`max_body': sets maximum allowed size of the body if
202%%      with_body is true</li>
203%%      <li>`async': receive the response asynchronously
204%%      The function return {ok, StreamRef}.
205%%      When {async, once} is used the response will be received only once. To
206%%      receive the other messages use the function
207%%      `hackney:stream_next/1'
208%%      </li>
209%%      <li>`{path_encode_fun, fun()}': function used to encode the path. if
210%%      not set it will use `hackney_url:pathencode/1' the function takes the
211%%      binary path as entry and return a new encoded path.</li>
212%%
213%%      <li>`{stream_to, pid()}': If async is true or once, the response
214%%      messages will be sent to this PID.</li>
215%%
216%%      <li>`{cookie, list() | binary()}' : to set a cookie or a
217%%      list of cookies.</li>
218%%
219%%      <li><em>Others options are</em>:
220%%      <ul>
221%%          <li>`{follow_redirect, boolean}': false by default, follow a
222%%          redirection</li>
223%%          <li>`{max_redirect, integer}': 5 by default, the maximum of
224%%          redirection for a request</li>
225%%          <li>`{force_redirect, boolean}': false by default, to force the
226%%          redirection even on POST</li>
227%%          <li>`{proxy, proxy_options()}': to connect via a proxy.</li>
228%%          <li>`insecure': to perform "insecure" SSL connections and
229%%          transfers without checking the certificate</li>
230%%          <li>`{connect_timeout, infinity | integer()}': timeout used when
231%%          establishing a connection, in milliseconds. Default is 8000</li>
232%%          <li>`{recv_timeout, infinity | integer()}': timeout used when
233%%          receiving a connection. Default is 5000</li>
234%%      </ul>
235%%
236%%      <blockquote>Note: if the response is async, only
237%%      `follow_redirect' is take in consideration for the redirection.
238%%      If a valid redirection happen you receive the messages:
239%%      <ul>
240%%        <li>`{redirect, To, Headers'}</li>
241%%        <li>`{see_other, To, Headers}' for status 303 POST requests.</li>
242%%      </ul></blockquote>
243%%
244%%      </li>
245%%
246%%      <li>`proxy_options()':  options to connect by a proxy:
247%%      <p><ul>
248%%          <li>binary(): url to use for the proxy. Used for basic HTTP
249%%          proxy</li>
250%%          <li>{Host::binary(), Port::binary}: Host and port to connect,
251%%          for HTTP proxy</li>
252%%          <li>{socks5, Host::binary(), Port::binary()}: Host and Port
253%%          to connect to a socks5 proxy.</li>
254%%          <li>{connect, Host::binary(), Port::binary()}: Host and Port
255%%          to connect to an HTTP tunnel.</li>
256%%      </ul></p>
257%%      </li>
258%%  </ul>
259%%
260%%  <bloquote>Note: instead of doing `hackney:request(Method, ...)' you can
261%%  also do `hackney:Method(...)' if you prefer to use the REST
262%%  syntax.</bloquote>
263%%
264%%  Return:
265%%  <ul>
266%%  <li><code>{ok, ResponseStatus, ResponseHeaders}</code>: On HEAD
267%%  request if the response succeeded.</li>
268%%  <li><code>{ok, ResponseStatus, ResponseHeaders, Ref}</code>: when
269%%  the response succeeded. The request reference is used later to
270%%  retrieve the body.</li>
271%%  <li><code>{ok, Ref}</code> Return the request reference when you
272%%  decide to stream the request. You can use the returned reference to
273%%  stream the request body and continue to handle the response.</li>
274%%  <li><code>{error, {closed, PartialBody}}</code> A body was expected but
275%%  instead the remote closed the response after sending the headers.
276%%  Equivalent to the curl  message <code>no chunk, no close, no size.
277%%  Assume close to signal end</code>. </li>
278%%  <li><code>{error, term()}</code> other errors.</li>
279%%  </ul>
280-spec request(term(), url() | binary() | list(), list(), term(), list())
281    -> {ok, integer(), list(), client_ref()}
282  | {ok, integer(), list()}
283  | {ok, client_ref()}
284  | {error, term()}.
285request(Method, #hackney_url{}=URL0, Headers0, Body, Options0) ->
286  PathEncodeFun = proplists:get_value(path_encode_fun, Options0,
287    fun hackney_url:pathencode/1),
288
289
290  %% normalize the url encoding
291  URL = hackney_url:normalize(URL0, PathEncodeFun),
292
293  ?report_trace("request", [{method, Method},
294    {url, URL},
295    {headers, Headers0},
296    {body, Body},
297    {options, Options0}]),
298
299  #hackney_url{transport=Transport,
300    host = Host,
301    port = Port,
302    user = User,
303    password = Password} = URL,
304
305  Options = case User of
306              <<>> ->
307                Options0;
308              _ ->
309                lists:keystore(basic_auth, 1, Options0,
310                  {basic_auth, {User, Password}})
311            end,
312
313  Headers1 = hackney_headers_new:new(Headers0),
314
315  case maybe_proxy(Transport, Host, Port, Options) of
316    {ok, Ref, AbsolutePath} ->
317      Request = make_request(
318                  Method, URL, Headers1, Body, Options, AbsolutePath
319                 ),
320      send_request(Ref, Request);
321    {ok, Ref} ->
322      Request = make_request(
323                  Method, URL, Headers1, Body, Options, false
324                 ),
325      send_request(Ref, Request);
326    Error ->
327      Error
328  end;
329request(Method, URL, Headers, Body, Options)
330  when is_binary(URL) orelse is_list(URL) ->
331  request(Method, hackney_url:parse_url(URL), Headers, Body, Options).
332
333
334%% @doc send a request using the current client state and pass new
335%% options to it.
336send_request(Ref, Req, Options) ->
337  ok = setopts(Ref, Options),
338  send_request(Ref, Req).
339
340%% @doc send a request using the current client state
341send_request(Ref, Req) when is_reference(Ref) ->
342  case hackney_manager:get_state(Ref) of
343    req_not_found ->
344      {error, closed};
345    #client{} = State ->
346      send_request(State, Req)
347  end;
348send_request(#client{response_state=done}=Client0 ,
349  {Method, Path, Headers, Body}) ->
350  Client = Client0#client{response_state=start, body_state=waiting},
351  send_request(Client, {Method, Path, Headers, Body});
352
353send_request(Client0, {Method, Path, Headers, Body}=Req) ->
354  case hackney_connect:maybe_connect(Client0) of
355    {ok, Client} ->
356      case {Client#client.response_state, Client#client.body_state} of
357        {start, waiting} ->
358          Resp = hackney_request:perform(
359                   Client, {Method, Path, hackney_headers_new:new(Headers), Body}
360                  ),
361          ?report_trace("got response", [{response, Resp}, {client, Client}]),
362          Reply = maybe_redirect(Resp, Req),
363          reply_response(Reply, Client);
364        _ ->
365          ?report_trace("invalid state", [{client, Client}]),
366          reply_response({error, invalide_state}, Client)
367      end;
368    Error ->
369      ?report_trace("response error", [{error, Error}, {client, Client0}]),
370      reply_response(Error, Client0)
371  end.
372
373%% @doc send the request body until eob. It's issued after sending a request using
374%% the `request' and `send_request' functions.
375-spec send_body(client_ref(), term()) -> ok | {error, term()}.
376send_body(Ref, Body) ->
377  hackney_manager:get_state(Ref, fun(State) ->
378    Reply = hackney_request:stream_body(Body, State),
379    reply(Reply, State)
380                                 end).
381
382finish_send_body(Ref) ->
383  hackney_manager:get_state(Ref, fun(State) ->
384    Reply = hackney_request:end_stream_body(State),
385    reply(Reply, State)
386                                 end).
387
388
389%% @doc send a multipart body until eof
390%% Possible value are :
391%% <ul>
392%% <li>`eof': end the multipart request</li>
393%% <li>`{file, Path}': to stream a file</li>
394%% <li>`{file, Path, ExtraHeaders}': to stream a file</li>
395%% <li>`{data, Name, Content}': to send a full part</li>
396%% <li>`{data, Name, Content, ExtraHeaders}': to send a full part</li>
397%% <li>`{part, Name, Len}': to start sending a part with a known length in a streaming
398%% fashion</li>
399%% <li>`{part, Name, Len, ExtraHeader}': to start sending a part in a streaming
400%% fashion</li>
401%% <li>`{part, Name}': to start sending a part without length in a streaming
402%% fashion</li>
403%% <li>`{part, Name, ExtraHeader}': to start sending a part without
404%% lengthin a streaming  fashion</li>
405%% <li>`{part_bin, Bin}': To send part of part</li>
406%% <li>`{part, eof}': To notify the end of the part </li>
407%% <li>`{mp_mixed, Name, MixedBoundary}': To notify we start a part with a a mixed
408%% multipart content</li>
409%% <li>`{mp_mixed_eof, MixedBoundary}': To notify we end a part with a a mixed
410%% multipart content</li>
411%% </ul>
412%%
413%% Note: You can calculate the full length of a multipart stream using
414%% the function `hackney_multipart:len_mp_stream/2' .
415-spec send_multipart_body(client_ref(), term()) -> ok | {error, term()}.
416send_multipart_body(Ref, Body) ->
417  hackney_manager:get_state(Ref, fun(State) ->
418    Reply = hackney_request:stream_multipart(Body, State),
419    reply(Reply, State)
420                                 end).
421
422%% @doc start a response.
423%% Useful if you stream the body by yourself. It will fetch the status
424%% and headers of the response. and return
425-spec start_response(client_ref())
426    -> {ok, integer(), list(), client_ref()} | {ok, client_ref()} | {error, term()}.
427start_response(Ref) ->
428  hackney_manager:get_state(Ref, fun(State) ->
429    Reply = hackney_response:start_response(State),
430    reply_response(Reply, State)
431                                 end).
432
433%% return all parsed cookies from the response headers.
434-spec cookies(list()) -> list().
435cookies(Headers) ->
436  lists:foldl(fun({K, V}, Acc) ->
437                  case hackney_bstr:to_lower(K) of
438                    <<"set-cookie">> ->
439                      case hackney_cookie:parse_cookie(V) of
440                        {error, _} -> Acc;
441                        [{Name, _} | _]=Cookie ->
442                          [{Name, Cookie} | Acc]
443                      end;
444                    _ ->
445                      Acc
446                  end
447              end, [], Headers).
448
449%% @doc Stream the response body.
450-spec stream_body(client_ref())
451    -> {ok, binary()} | done | {error, term()}.
452stream_body(Ref) ->
453  hackney_manager:get_state(Ref, fun(State) ->
454    Reply = hackney_response:stream_body(State),
455    reply(Reply, State)
456                                 end).
457
458%% @doc Stream the response body.
459%%
460%% Return:
461%% <ul>
462%% <li>`{headers, Headers}': the part headers</li>
463%% <li>`{body, Bin}': part of the content</li>
464%% <li>`end_of_part' : end of part</li>
465%% <li>`mp_mixed': notify the beginning of a mixed multipart part</li>
466%% <li>`mp_mixed_eof': notify the end  of a mixed multipart part</li>
467%% <li>`eof': notify the end of the multipart request</li>
468%% </ul>
469-spec stream_multipart(client_ref())
470    -> {headers, list()} | {body, binary()} | eof | end_of_part
471  | {error, term()}.
472stream_multipart(Ref) ->
473  hackney_manager:get_state(Ref, fun(State) ->
474    Reply = hackney_response:stream_multipart(State),
475    mp_reply(Reply, State)
476                                 end).
477
478%% @doc Stream the response body.
479-spec skip_multipart(client_ref()) -> ok | {error, term()}.
480skip_multipart(Ref) ->
481  hackney_manager:get_state(Ref, fun(State) ->
482    Reply = hackney_response:skip_multipart(State),
483    mp_reply(Reply, State)
484                                 end).
485
486%% @doc Return the full body sent with the response.
487-spec body(client_ref()) -> {ok, binary()} | {error, atom()} | {error, {closed, binary()}}.
488body(Ref) ->
489  hackney_manager:get_state(Ref, fun(State) ->
490    Reply = hackney_response:body(State),
491    reply(Reply, State)
492                                 end).
493
494%% @doc Return the full body sent with the response as long as the body
495%% length doesn't go over MaxLength.
496-spec body(client_ref(), non_neg_integer() | infinity)
497    -> {ok, binary()} | {error, atom()} | {error, {closed, binary()}}.
498body(Ref, MaxLength) ->
499  hackney_manager:get_state(Ref, fun(State) ->
500    Reply = hackney_response:body(MaxLength, State),
501    reply(Reply, State)
502                                 end).
503
504
505%% @doc skip the full body. (read all the body if needed).
506-spec skip_body(client_ref()) -> ok | {error, atom()}.
507skip_body(Ref) ->
508  hackney_manager:get_state(Ref, fun(State) ->
509    Reply = hackney_response:skip_body(State),
510    reply(Reply, State)
511                                 end).
512
513
514%% @doc continue to the next stream message. Only use it when
515%% `{async, once}' is set in the client options.
516-spec stream_next(client_ref()) -> ok | {error, req_not_found}.
517stream_next(Ref) ->
518  hackney_manager:with_async_response_pid(Ref, fun(Pid) ->
519    Pid ! {Ref, stream_next},
520    ok
521                                               end).
522
523%% @doc pause a response stream, the stream process will hibernate and
524%% be woken later by the resume function
525-spec pause_stream(client_ref()) -> ok | {error, req_not_found}.
526pause_stream(Ref) ->
527  hackney_manager:with_async_response_pid(Ref, fun(Pid) ->
528    Pid ! {Ref, pause},
529    ok
530                                               end).
531
532%% @doc resume a paused response stream, the stream process will be
533%% awoken
534-spec resume_stream(client_ref()) -> ok | {error, req_not_found}.
535resume_stream(Ref) ->
536  hackney_manager:with_async_response_pid(Ref, fun(Pid) ->
537    Pid ! {Ref, resume},
538    ok
539                                               end).
540
541%% @doc stop to receive asynchronously.
542-spec stop_async(client_ref()) -> ok | {error, req_not_found} | {error, term()}.
543stop_async(Ref) ->
544  hackney_manager:stop_async_response(Ref).
545
546%% internal functions
547%%
548%%
549%%
550host_header(#hackney_url{transport=Transport,netloc=Netloc}, Headers) ->
551  {_, Headers1} = hackney_headers_new:store_new(
552                    <<"Host">>, host_header_encode(Transport, Netloc), Headers
553                   ),
554  Headers1.
555
556host_header_encode(hackney_local_tcp, Netloc) -> hackney_url:urlencode(Netloc);
557host_header_encode(_Transport, Netloc) -> Netloc.
558
559
560make_request(connect, #hackney_url{}=URL, Headers, Body, _, _) ->
561  #hackney_url{host = Host, port = Port}= URL,
562
563  %% place the correct host
564  Headers1 = host_header(URL, Headers),
565
566  Path = iolist_to_binary([Host, ":", integer_to_list(Port)]),
567  {connect, Path, Headers1, Body};
568make_request(Method, #hackney_url{}=URL, Headers0, Body, Options, true) ->
569  %% place the correct host
570  Headers1 = host_header(URL, Headers0),
571
572  FinalPath = hackney_url:unparse_url(URL),
573  Headers = case proplists:get_value(proxy_auth, Options) of
574              undefined -> Headers1;
575              {User, Pwd} ->
576                Credentials = base64:encode(<< User/binary, ":", Pwd/binary >>),
577                hackney_headers_new:store(
578                  <<"Proxy-Authorization">>, <<"Basic ", Credentials/binary>>,
579                  Headers1
580                )
581            end,
582  {Method, FinalPath, Headers, Body};
583make_request(Method, #hackney_url{}=URL, Headers, Body, _, _) ->
584  #hackney_url{path = Path, qs = Query} = URL,
585
586  %% place the correct host
587  Headers1 = host_header(URL, Headers),
588
589  FinalPath = case Query of
590                <<>> ->
591                  Path;
592                _ ->
593                  <<Path/binary, "?", Query/binary>>
594              end,
595  {Method, FinalPath, Headers1, Body}.
596
597
598maybe_proxy(Transport, Host, Port, Options)
599  when is_list(Host), is_integer(Port), is_list(Options) ->
600  case proplists:get_value(proxy, Options) of
601    Url when is_binary(Url) orelse is_list(Url) ->
602      ?report_debug("HTTP proxy request", [{url, Url}]),
603      Url1 = hackney_url:parse_url(Url),
604      #hackney_url{transport = PTransport,
605                   host = ProxyHost,
606                   port = ProxyPort} = hackney_url:normalize(Url1),
607      ProxyAuth = proplists:get_value(proxy_auth, Options),
608      case {Transport, PTransport} of
609        {hackney_ssl, hackney_ssl} -> {error, invalid_proxy_transport};
610        {hackney_ssl, _} ->
611          do_connect(ProxyHost, ProxyPort, ProxyAuth,Transport, Host, Port, Options);
612        _ ->
613          case hackney_connect:connect(Transport, ProxyHost,ProxyPort, Options, true) of
614            {ok, Ref} -> {ok, Ref, true};
615            Error -> Error
616          end
617      end;
618    {ProxyHost, ProxyPort} ->
619      ?report_debug("HTTP proxy request", [{proxy_host, ProxyHost}, {proxy_port, ProxyPort}]),
620      case Transport of
621        hackney_ssl ->
622          ProxyAuth = proplists:get_value(proxy_auth, Options),
623          do_connect(ProxyHost, ProxyPort, ProxyAuth, Transport, Host, Port, Options);
624        _ ->
625          case hackney_connect:connect(Transport, ProxyHost,
626                                       ProxyPort, Options, true) of
627            {ok, Ref} -> {ok, Ref, true};
628            Error -> Error
629          end
630      end;
631    {connect, ProxyHost, ProxyPort} ->
632      ?report_debug("HTTP tunnel request", [{proxy_host, ProxyHost}, {proxy_port, ProxyPort}]),
633      ProxyAuth = proplists:get_value(proxy_auth, Options),
634      do_connect(ProxyHost, ProxyPort, ProxyAuth, Transport, Host, Port, Options);
635    {socks5, ProxyHost, ProxyPort} ->
636      ?report_debug("SOCKS proxy request", [{proxy_host, ProxyHost}, {proxy_port, ProxyPort}]),
637
638      %% create connection options
639      ProxyUser = proplists:get_value(socks5_user, Options),
640      ProxyPass = proplists:get_value(socks5_pass, Options),
641      ProxyResolve = proplists:get_value(socks5_resolve, Options),
642      ConnectOpts0 = proplists:get_value(connect_options, Options, []),
643      ConnectOpts1 = [{socks5_host, ProxyHost},
644                      {socks5_port, ProxyPort},
645                      {socks5_user, ProxyUser},
646                      {socks5_pass, ProxyPass},
647                      {socks5_resolve, ProxyResolve},
648                      {socks5_transport, Transport} | ConnectOpts0],
649
650      %% ssl options?
651      Insecure = proplists:get_value(insecure, Options, false),
652      ConnectOpts2 =  case proplists:get_value(ssl_options, Options) of
653                        undefined ->
654                          [{insecure, Insecure}] ++ ConnectOpts1;
655                        SslOpts ->
656                          [{ssl_options, SslOpts},
657                           {insecure, Insecure}] ++ ConnectOpts1
658                      end,
659
660      Options1 = lists:keystore(connect_options, 1, Options, {connect_options, ConnectOpts2}),
661
662      %% connect using a socks5 proxy
663      hackney_connect:connect(hackney_socks5, Host, Port, Options1, true);
664    _ ->
665      ?report_debug("request without proxy", []),
666      hackney_connect:connect(Transport, Host, Port, Options, true)
667  end.
668
669
670do_connect(ProxyHost, ProxyPort, undefined, Transport, Host, Port, Options) ->
671  do_connect(ProxyHost, ProxyPort, {undefined, <<>>}, Transport, Host, Port, Options);
672do_connect(ProxyHost, ProxyPort, {ProxyUser, ProxyPass}, Transport, Host, Port, Options) ->
673  %% create connection options
674  ConnectOpts = proplists:get_value(connect_options, Options, []),
675  ConnectOpts1 = [{connect_host, Host},
676                  {connect_port, Port},
677                  {connect_transport, Transport},
678                  {connect_user, ProxyUser},
679                  {connect_pass, ProxyPass}| ConnectOpts],
680
681  %% ssl options?
682  Insecure = proplists:get_value(insecure, Options, false),
683  ConnectOpts2 =  case proplists:get_value(ssl_options, Options) of
684                    undefined ->
685                      [{insecure, Insecure}] ++ ConnectOpts1;
686                    SslOpts ->
687                      [{ssl_options, SslOpts},
688                       {insecure, Insecure}] ++ ConnectOpts1
689                  end,
690
691  Options1 = lists:keystore(connect_options, 1, Options, {connect_options, ConnectOpts2}),
692
693  %% connect using a socks5 proxy
694  hackney_connect:connect(hackney_http_connect, ProxyHost, ProxyPort, Options1, true).
695
696
697
698maybe_redirect({ok, _}=Resp, _Req) -> Resp;
699maybe_redirect(
700  {ok, S, _H, #client{headers=Headers, follow_redirect=true, retries=Tries}=Client}=Resp,
701  Req
702 ) when Tries > 0 ->
703  %% check if the given location is an absolute url,
704  %% else return an error.
705  case redirect_location(Headers) of
706    undefined -> Resp;
707    Location ->
708      IsRedirect = lists:member(S, [301, 302, 303, 307]),
709      case IsRedirect of
710        false -> Resp;
711        _ ->
712          URL = absolute_url(Location, Client),
713          maybe_redirect1(URL, Resp, Req)
714      end
715  end;
716maybe_redirect({ok, S, _H, #client{follow_redirect=true}}=Resp, _Req) ->
717  case lists:member(S, [301, 302, 303, 307]) of
718    true ->
719      {error, {max_redirect_overflow, Resp}};
720    false ->
721      Resp
722  end;
723maybe_redirect(Resp, _Req) ->
724  Resp.
725
726
727maybe_redirect1(Location, {ok, S, H, #client{retries=Tries}=Client}=Resp, Req) ->
728  {Method, _Path, Headers, Body} = Req,
729  case lists:member(S, [301, 302, 307]) of
730    true  ->
731      ?report_debug("redirect request", [{location, Location},
732                                         {req, Req},
733                                         {resp, Resp},
734                                         {tries, Tries}]),
735      %% redirect the location if possible. If the method is
736      %% different from  get or head it will return
737      %% `{ok, {maybe_redirect, Status, Headers, Client}}' to let
738      %% the  user make his choice.
739      case lists:member(Method, [get, head]) of
740        true ->
741          NewReq = {Method, Location, Headers, Body},
742          maybe_redirect(redirect(Client#client{retries=Tries-1}, NewReq), Req);
743        false when Client#client.force_redirect =:= true ->
744          NewReq = {Method, Location, Headers, Body},
745          maybe_redirect(redirect(Client#client{retries=Tries-1}, NewReq), Req);
746        false ->
747          {ok, {maybe_redirect, S, H, Client}}
748      end;
749    false when S =:= 303 andalso (Method =:= post orelse
750      Client#client.force_redirect =:= true) ->
751      %% see other. If method is not POST it is
752      %% considered an invalid redirection.
753      ?report_debug("redirect request", [{location, Location},
754                                         {req, Req},
755                                         {resp, Resp},
756                                         {tries, Tries}]),
757
758      NewReq = {get, Location, hackney_headers_new:new(), <<>>},
759      maybe_redirect(redirect(Client#client{retries=Tries-1}, NewReq), Req);
760    false when S =:= 303 ->
761      ?report_debug("invalid redirection", [{location, Location},
762                                            {req, Req},
763                                            {resp, Resp},
764                                            {tries, Tries}]),
765      {error, {invalid_redirection, Resp}};
766    _ ->
767      Resp
768  end.
769
770redirect(Client0, {Method, NewLocation, Headers, Body}) ->
771  %% skip the body
772  {skip, Client} = hackney_response:skip_body(Client0),
773
774  %% close the connection if we don't use a pool
775  RedirectUrl = hackney_url:parse_url(NewLocation),
776  #hackney_url{transport=RedirectTransport,
777               host=RedirectHost,
778               port=RedirectPort}=RedirectUrl,
779
780  #client{transport=Transport,
781          host=Host,
782          port=Port,
783          options=Opts0,
784          follow_redirect=FollowRedirect,
785          max_redirect=MaxRedirect,
786          retries=Tries,
787          redirect=Redirect} = Client,
788
789
790  NewHeaders = case RedirectHost of
791                 Host -> Headers;
792                 _    ->
793                   hackney_headers_new:store(<<"Host">>,
794                                             hackney_bstr:to_binary(RedirectHost),
795                                             Headers)
796               end,
797  RedirectRequest = make_request(Method, RedirectUrl, NewHeaders, Body,
798                                 Client#client.options, false),
799  %% make a request without any redirection
800  Opts = lists:keystore(follow_redirect, 1, Opts0, {follow_redirect, false}),
801  Client1 = hackney_connect:check_or_close(Client),
802
803  %% update the state with the redirect info
804  Client2 = Client1#client{transport=RedirectTransport,
805                           host=RedirectHost,
806                           port=RedirectPort,
807                           options=Opts},
808
809  %% send a request to the new location
810  case send_request(Client2, RedirectRequest) of
811    {ok,  S, H, RedirectRef} when is_reference(RedirectRef) ->
812      RedirectState = hackney_manager:get_state(RedirectRef),
813      RedirectState1 = case Redirect of
814                         nil ->
815                           RedirectState#client{redirect=Redirect,
816                                                follow_redirect=FollowRedirect,
817                                                max_redirect=MaxRedirect,
818                                                retries=Tries,
819                                                options=Opts0};
820                         _ ->
821                           NewRedirect = {Transport, Host, Port, Opts0},
822                           RedirectState#client{redirect=NewRedirect,
823                                                follow_redirect=FollowRedirect,
824                                                max_redirect=MaxRedirect,
825                                                retries=Tries,
826                                                options=Opts0}
827                       end,
828      {ok, S, H, RedirectState1};
829    {ok,  S, H, #client{}=RedirectClient} when Redirect /= nil ->
830      NewClient = RedirectClient#client{redirect=Redirect,
831                                        follow_redirect=FollowRedirect,
832                                        max_redirect=MaxRedirect,
833                                        retries=Tries,
834                                        options=Opts0},
835      {ok, S, H, NewClient};
836    {ok, S, H, #client{}=RedirectClient} ->
837      NewRedirect = {Transport, Host, Port, Opts0},
838      NewClient = RedirectClient#client{redirect=NewRedirect,
839                                        follow_redirect=FollowRedirect,
840                                        max_redirect=MaxRedirect,
841                                        retries=Tries,
842                                        options=Opts0},
843      {ok, S, H, NewClient};
844    Response ->
845      Response
846  end.
847
848redirect_location(Headers) when is_list(Headers) ->
849  redirect_location(hackney_headers_new:from_list(Headers));
850redirect_location(Headers) ->
851  hackney_headers_new:get_value(<<"location">>, Headers).
852
853absolute_url(<<"http://", _Rest/binary >>= URL, _Client) ->
854  URL;
855absolute_url(<<"https://", _Rest/binary >>= URL, _Client) ->
856  URL;
857absolute_url(RelativeUrl, #client{transport=T, host=Host, port=Port,
858  netloc=Netloc, path=Path}) ->
859  Scheme = hackney_url:transport_scheme(T),
860  NewPath = case RelativeUrl of
861              <<"/", _Rest/binary>> ->
862                RelativeUrl;
863              _ ->
864                case binary:part(Path, {size(Path), -1}) of
865                  <<"/">> -> <<Path/binary, RelativeUrl/binary>>;
866                  _       -> <<Path/binary, "/", RelativeUrl/binary>>
867                end
868            end,
869  Parsed = hackney_url:normalize(#hackney_url{scheme=Scheme,
870                                              host=Host,
871                                              port=Port,
872                                              netloc=Netloc,
873                                              path=NewPath}),
874  hackney_url:unparse_url(Parsed).
875
876
877%% handle send response
878reply({ok, Data, NState}, _State) ->
879  maybe_update_req(NState),
880  {ok, Data};
881reply({done, NState}, _State) ->
882  maybe_update_req(NState),
883  done;
884reply({skip, NState}, _State) ->
885  maybe_update_req(NState),
886  ok;
887reply({ok, NState}, _State) ->
888  hackney_manager:update_state(NState),
889  ok;
890reply(Error, State) ->
891  hackney_manager:handle_error(State),
892  Error.
893
894mp_reply({headers, Headers, NState}, _State) ->
895  maybe_update_req(NState),
896  {headers, Headers};
897mp_reply({body, Body, NState}, _State) ->
898  maybe_update_req(NState),
899  {body, Body};
900mp_reply({mp_mixed, NState}, _State) ->
901  maybe_update_req(NState),
902  mp_mixed;
903mp_reply({mp_mixed_eof, NState}, _State) ->
904  maybe_update_req(NState),
905  mp_mixed_eof;
906mp_reply({eof, NState}, _State) ->
907  maybe_update_req(NState),
908  eof;
909mp_reply({end_of_part, NState}, _State) ->
910  maybe_update_req(NState),
911  end_of_part;
912mp_reply({ok, NState}, _State) ->
913  hackney_manager:update_state(NState),
914  ok.
915
916%% response reply
917reply_response({ok, Status, Headers, #client{method= <<"HEAD">>}=NState},
918  _State) ->
919  {skip, NState2} = hackney_response:skip_body(NState),
920  maybe_update_req(NState2),
921  {ok, Status, Headers};
922reply_response(
923  {ok, Status, Headers, #client{request_ref=Ref}=NState}, _State
924 )  when Status =:= 204 orelse Status =:= 304 ->
925  case NState#client.with_body of
926    false ->
927      hackney_manager:update_state(NState#client{clen = 0}),
928      {ok, Status, Headers, Ref};
929    true ->
930      reply_with_body(Status, Headers, NState#client{clen = 0})
931  end;
932reply_response({ok, Status, Headers, #client{request_ref=Ref}=NState}, _State) ->
933  case NState#client.with_body of
934    false ->
935      hackney_manager:update_state(NState),
936      {ok, Status, Headers, Ref};
937    true ->
938      reply_with_body(Status, Headers, NState)
939  end;
940reply_response({ok, #client{request_ref=Ref}=NState}, _State) ->
941  hackney_manager:update_state(NState),
942  {ok, Ref};
943reply_response({ok, Ref}, _State) when is_reference(Ref) ->
944  {ok, Ref};
945reply_response(Error, State) ->
946  hackney_manager:handle_error(State),
947  Error.
948
949
950reply_with_body(Status, Headers, State) ->
951  Reply = case State#client.max_body of
952            undefined -> hackney_response:body(State);
953            MaxBody   -> hackney_response:body(MaxBody, State)
954          end,
955  case reply(Reply, State) of
956    {ok, Body} ->
957      {ok, Status, Headers, Body};
958    Error ->
959      Error
960  end.
961
962
963maybe_update_req(#client{dynamic=true, response_state=done}=State) ->
964  hackney_manager:close_request(State);
965maybe_update_req(State) ->
966  hackney_manager:update_state(State).
967
968
969parse_options([], State) ->
970  State;
971parse_options([async | Rest], State) ->
972  parse_options(Rest, State#client{async=true});
973parse_options([{async, Async} | Rest], State) ->
974  parse_options(Rest, State#client{async=Async});
975parse_options([{stream_to, Pid} | Rest], State) ->
976  parse_options(Rest, State#client{stream_to=Pid});
977parse_options([{follow_redirect, Follow} | Rest], State) ->
978  parse_options(Rest, State#client{follow_redirect=Follow});
979parse_options([{force_redirect, Force} | Rest], State) ->
980  parse_options(Rest, State#client{force_redirect=Force});
981parse_options([{max_redirect, Max} | Rest], State) ->
982  parse_options(Rest, State#client{max_redirect=Max});
983parse_options([dynamic | Rest], State) ->
984  parse_options(Rest, State#client{dynamic=true});
985parse_options([{dynamic, Dynamic} | Rest], State) ->
986  parse_options(Rest, State#client{dynamic=Dynamic});
987parse_options([{with_body, WithBody} | Rest], State) ->
988  parse_options(Rest, State#client{with_body=WithBody});
989parse_options([with_body | Rest], State) ->
990  parse_options(Rest, State#client{with_body=true});
991parse_options([{max_body, MaxBody} | Rest], State) ->
992  parse_options(Rest, State#client{max_body=MaxBody});
993parse_options([_ | Rest], State) ->
994  parse_options(Rest, State).
995
996-define(METHOD_TPL(Method),
997  Method(URL) ->
998  hackney:request(Method, URL)).
999-include("hackney_methods.hrl").
1000
1001-define(METHOD_TPL(Method),
1002  Method(URL, Headers) ->
1003  hackney:request(Method, URL, Headers)).
1004-include("hackney_methods.hrl").
1005
1006
1007-define(METHOD_TPL(Method),
1008  Method(URL, Headers, Body) ->
1009  hackney:request(Method, URL, Headers, Body)).
1010-include("hackney_methods.hrl").
1011
1012-define(METHOD_TPL(Method),
1013  Method(URL, Headers, Body, Options) ->
1014  hackney:request(Method, URL, Headers, Body, Options)).
1015-include("hackney_methods.hrl").
1016