Add end-to-end HTTPS tests

README.md

@@ -93,11 +93,11 @@ ok
   </tr>
   <tr>
     <td>protocol</td>
-    <td>shackle_socket | shackle_tcp</td>
-    <td>shackle_tcp</td>
-    <td>shackle transport for http pools (shackle_socket runs on the
-    socket NIF and needs OTP 28+); https pools always use
-    shackle_ssl</td>
+    <td>shackle_socket | shackle_ssl | shackle_ssl_socket |
+    shackle_tcp</td>
+    <td>shackle_tcp (http) / shackle_ssl (https)</td>
+    <td>shackle transport; the socket variants run on the socket NIF
+    and need OTP 28+</td>
   </tr>
   <tr>
     <td>reconnect</td>

include/buoy.hrl

@@ -48,7 +48,8 @@
                          {max_requests, pos_integer() | infinity} |
                          {pool_size, pos_integer()} |
                          {pool_strategy, random | round_robin} |
-                         {protocol, shackle_socket | shackle_tcp} |
+                         {protocol, shackle_socket | shackle_ssl |
+                                    shackle_ssl_socket | shackle_tcp} |
                          {reconnect, boolean()} |
                          {reconnect_time_max, pos_integer() | infinity} |
                          {reconnect_time_min, pos_integer()} |

test/buoy_http_server.erl

@@ -7,6 +7,14 @@
 ]).
 
 -define(PORT, 8080).
+-define(PORT_SSL, 8443).
+-define(LISTEN_OPTIONS, [
+    binary,
+    {active, false},
+    {backlog, 128},
+    {packet, http_bin},
+    {reuseaddr, true}
+]).
 
 %% public
 connection_count() ->
@@ -17,7 +25,9 @@ start() ->
     Pid = spawn(fun () -> init(Self) end),
     receive
         {Pid, started} ->
-            {ok, Pid}
+            {ok, Pid};
+        {Pid, {error, Reason}} ->
+            {error, Reason}
     after 5000 ->
         {error, timeout}
     end.
@@ -27,82 +37,128 @@ stop() ->
         undefined ->
             ok;
         Pid ->
+            Ref = monitor(process, Pid),
             exit(Pid, kill),
-            ok
+            receive
+                {'DOWN', Ref, process, Pid, _} ->
+                    ok
+            end
     end.
 
 %% private
 init(Parent) ->
-    register(?MODULE, self()),
-    persistent_term:put({?MODULE, connections}, counters:new(1, [])),
-    {ok, LSocket} = gen_tcp:listen(?PORT, [
-        binary,
-        {active, false},
-        {backlog, 128},
-        {packet, http_bin},
-        {reuseaddr, true}
-    ]),
-    Parent ! {self(), started},
-    accept(LSocket).
+    try
+        register(?MODULE, self()),
+        persistent_term:put({?MODULE, connections}, counters:new(1, [])),
+        {ok, _} = application:ensure_all_started(ssl),
+        {ok, LSocket} = listen(gen_tcp, ?PORT, ?LISTEN_OPTIONS),
+        %% the default pkix_test_data key (secp112r2, sha1) is not
+        %% negotiable by a modern TLS client
+        KeyOpts = [{key, {namedCurve, secp256r1}}, {digest, sha256}],
+        SslOptions = public_key:pkix_test_data(#{root => KeyOpts,
+            peer => KeyOpts}),
+        {ok, LSocketSsl} = listen(ssl, ?PORT_SSL,
+            ?LISTEN_OPTIONS ++ SslOptions),
+        spawn_link(fun () -> accept_ssl(LSocketSsl) end),
+        Parent ! {self(), started},
+        accept(LSocket)
+    catch
+        Class:Error:Stacktrace ->
+            Parent ! {self(), {error, {Class, Error, Stacktrace}}}
+    end.
+
+%% the previous fixture's ports can linger briefly after its death:
+%% ERTS releases them asynchronously once the DOWN signal fires
+listen(Transport, Port, Options) ->
+    listen(Transport, Port, Options, 50).
+
+listen(Transport, Port, Options, Retries) ->
+    case Transport:listen(Port, Options) of
+        {ok, LSocket} ->
+            {ok, LSocket};
+        {error, eaddrinuse} when Retries > 0 ->
+            timer:sleep(10),
+            listen(Transport, Port, Options, Retries - 1);
+        {error, _} = E ->
+            E
+    end.
 
 accept(LSocket) ->
     {ok, Socket} = gen_tcp:accept(LSocket),
     counters:add(persistent_term:get({?MODULE, connections}), 1, 1),
     Pid = spawn_link(fun () ->
-        receive go -> connection(Socket) end
+        receive go -> connection(gen_tcp, Socket) end
     end),
     ok = gen_tcp:controlling_process(Socket, Pid),
     Pid ! go,
     accept(LSocket).
 
-connection(Socket) ->
-    case gen_tcp:recv(Socket, 0) of
+accept_ssl(LSocket) ->
+    {ok, TSocket} = ssl:transport_accept(LSocket),
+    counters:add(persistent_term:get({?MODULE, connections}), 1, 1),
+    Pid = spawn_link(fun () ->
+        receive
+            go ->
+                case ssl:handshake(TSocket) of
+                    {ok, Socket} ->
+                        connection(ssl, Socket);
+                    {error, _} ->
+                        ok
+                end
+        end
+    end),
+    ok = ssl:controlling_process(TSocket, Pid),
+    Pid ! go,
+    accept_ssl(LSocket).
+
+connection(Transport, Socket) ->
+    case recv(Transport, Socket, 0) of
         {ok, {http_request, Method, {abs_path, Path}, _Version}} ->
-            ContentLength = headers(Socket, 0),
-            Body = body(Socket, ContentLength),
-            respond(Socket, Method, Path, Body),
-            connection(Socket);
+            ContentLength = headers(Transport, Socket, 0),
+            Body = body(Transport, Socket, ContentLength),
+            respond(Transport, Socket, Method, Path, Body),
+            connection(Transport, Socket);
         {ok, _} ->
-            gen_tcp:close(Socket);
+            close(Transport, Socket);
         {error, _} ->
-            gen_tcp:close(Socket)
+            close(Transport, Socket)
     end.
 
-headers(Socket, ContentLength) ->
-    case gen_tcp:recv(Socket, 0) of
+headers(Transport, Socket, ContentLength) ->
+    case recv(Transport, Socket, 0) of
         {ok, {http_header, _, 'Content-Length', _, Value}} ->
-            headers(Socket, binary_to_integer(Value));
+            headers(Transport, Socket, binary_to_integer(Value));
         {ok, {http_header, _, _, _, _}} ->
-            headers(Socket, ContentLength);
+            headers(Transport, Socket, ContentLength);
         {ok, http_eoh} ->
             ContentLength
     end.
 
-body(_Socket, 0) ->
+body(_Transport, _Socket, 0) ->
     <<>>;
-body(Socket, ContentLength) ->
-    ok = inet:setopts(Socket, [{packet, raw}]),
-    {ok, Body} = gen_tcp:recv(Socket, ContentLength),
-    ok = inet:setopts(Socket, [{packet, http_bin}]),
+body(Transport, Socket, ContentLength) ->
+    ok = setopts(Transport, Socket, [{packet, raw}]),
+    {ok, Body} = recv(Transport, Socket, ContentLength),
+    ok = setopts(Transport, Socket, [{packet, http_bin}]),
     Body.
 
-respond(Socket, Method, <<"/1">>, _Body) ->
-    reply(Socket, Method, <<"Hello world!">>);
-respond(Socket, Method, <<"/2">>, _Body) ->
-    reply(Socket, Method, binary:copy(<<"Hello world!">>, 1000));
-respond(Socket, Method, <<"/3">>, Body) ->
-    reply(Socket, Method, Body);
-respond(Socket, Method, <<"/4">>, _Body) ->
-    chunked_reply(Socket, Method, [<<"Hello">>, <<" world!">>]);
-respond(Socket, Method, <<"/5">>, _Body) ->
-    reply(Socket, Method, method(Method)).
+respond(Transport, Socket, Method, <<"/1">>, _Body) ->
+    reply(Transport, Socket, Method, <<"Hello world!">>);
+respond(Transport, Socket, Method, <<"/2">>, _Body) ->
+    reply(Transport, Socket, Method, binary:copy(<<"Hello world!">>, 1000));
+respond(Transport, Socket, Method, <<"/3">>, Body) ->
+    reply(Transport, Socket, Method, Body);
+respond(Transport, Socket, Method, <<"/4">>, _Body) ->
+    chunked_reply(Transport, Socket, Method, [<<"Hello">>, <<" world!">>]);
+respond(Transport, Socket, Method, <<"/5">>, _Body) ->
+    reply(Transport, Socket, Method, method(Method)).
 
 method(Method) when is_atom(Method) ->
     atom_to_binary(Method, utf8);
 method(Method) when is_binary(Method) ->
     Method.
 
-reply(Socket, Method, Body) ->
+reply(Transport, Socket, Method, Body) ->
     Headers = [
         <<"HTTP/1.1 200 OK\r\n">>,
         <<"Connection: Keep-Alive\r\n">>,
@@ -112,12 +168,12 @@ reply(Socket, Method, Body) ->
     ],
     case Method of
         'HEAD' ->
-            ok = gen_tcp:send(Socket, Headers);
+            ok = send(Transport, Socket, Headers);
         _ ->
-            ok = gen_tcp:send(Socket, [Headers, Body])
+            ok = send(Transport, Socket, [Headers, Body])
     end.
 
-chunked_reply(Socket, Method, Chunks) ->
+chunked_reply(Transport, Socket, Method, Chunks) ->
     Headers = [
         <<"HTTP/1.1 200 OK\r\n">>,
         <<"Connection: Keep-Alive\r\n">>,
@@ -126,9 +182,29 @@ chunked_reply(Socket, Method, Chunks) ->
     ],
     case Method of
         'HEAD' ->
-            ok = gen_tcp:send(Socket, Headers);
+            ok = send(Transport, Socket, Headers);
         _ ->
             Encoded = [[integer_to_binary(byte_size(Chunk), 16), <<"\r\n">>,
                 Chunk, <<"\r\n">>] || Chunk <- Chunks],
-            ok = gen_tcp:send(Socket, [Headers, Encoded, <<"0\r\n\r\n">>])
+            ok = send(Transport, Socket, [Headers, Encoded, <<"0\r\n\r\n">>])
     end.
+
+close(gen_tcp, Socket) ->
+    gen_tcp:close(Socket);
+close(ssl, Socket) ->
+    ssl:close(Socket).
+
+recv(gen_tcp, Socket, Length) ->
+    gen_tcp:recv(Socket, Length);
+recv(ssl, Socket, Length) ->
+    ssl:recv(Socket, Length).
+
+send(gen_tcp, Socket, Data) ->
+    gen_tcp:send(Socket, Data);
+send(ssl, Socket, Data) ->
+    ssl:send(Socket, Data).
+
+setopts(gen_tcp, Socket, Opts) ->
+    inet:setopts(Socket, Opts);
+setopts(ssl, Socket, Opts) ->
+    ssl:setopts(Socket, Opts).