fewd/src/fd_ws.erl

% @doc websockets
%
% ref: https://datatracker.ietf.org/doc/html/rfc6455
-module(fd_ws).

-export_type([
    opcode/0,
    frame/0,
    ws_msg/0
]).

-export([
    handshake/1,
    recv/2,
    send/2,
    pong/1, pong/2
]).

-include("http.hrl").

-type request()  :: #request{}.
-type response() :: #response{}.
-type tcp_error() :: closed
                   | {timeout, RestData :: binary() | erlang:iovec()}
                   | inet:posix().

-define(MAX_PAYLOAD_SIZE, (1 bsl 63)).

%% Frames
%% https://datatracker.ietf.org/doc/html/rfc6455#section-5.2

-type opcode() :: continuation
                | text
                | binary
                | close
                | ping
                | pong.

-record(frame,
        {fin            = none :: none | boolean(),
         rsv            = none :: none | <<_:3>>,
         opcode         = none :: none | opcode(),
         mask           = none :: none | boolean(),
         payload_length = none :: none | non_neg_integer(),
         masking_key    = none :: none | <<>> | <<_:32>>,
         payload        = none :: none | binary()}).

-type frame() :: #frame{}.


%% porcelain messages

-type ws_msg() :: {text,   Payload :: iodata()}
                | {binary, Payload :: iodata()}
                | {close,  Payload :: iodata()}
                | {ping,   Payload :: iodata()}
                | {pong,   Payload :: iodata()}.



-spec handshake(Req) -> Result
    when Req              :: request(),
         Result           :: {ok, ClientProtocols, ClientExtensions, DraftResponse}
                           | {error, Reason},
         ClientProtocols  :: [binary()],
         ClientExtensions :: binary(),
         DraftResponse    :: response(),
         Reason           :: any().
% @doc
% This mostly just validates that all the 't's have been dotted and 'i's have
% been crossed.
%
% given an HTTP request:
%
% - if it is NOT a valid websocket handshake request, error
% - if it IS a valid websocket handshake request, form an initial candidate
%   response record with the following fields:
%
%       code    = 101
%       slogan  = "Switching Protocols"
%       headers = [{"Sec-WebSocket-Accept", ChallengeResponse},
%                  {"Connection",           "Upgrade"},
%                  {"Upgrade",              "websocket"}].
%
% YOU are responsible for dealing with any cookie logic, authentication logic,
% validating the Origin field, implementing cross-site-request-forgery, adding
% the retarded web date, rendering the response, sending it over the socket,
% etc.
%
% The returned ClientExtensions is the result of joining the
% <<"sec-websocket-extensions">> fields with ", "
%
% quoth section 9.1: https://datatracker.ietf.org/doc/html/rfc6455#section-9.1
%
% > Note that like other HTTP header fields, this header field MAY be
% > split or combined across multiple lines.  Ergo, the following are
% > equivalent:
% >
% >       Sec-WebSocket-Extensions: foo
% >       Sec-WebSocket-Extensions: bar; baz=2
% >
% > is exactly equivalent to
% >
% >       Sec-WebSocket-Extensions: foo, bar; baz=2
%
% Nobody actually uses extensions, so how you choose to parse this is on you.

handshake(R = #request{method = get, headers = Hs}) ->
    %% downcase the headers because have to match on them
    handshake2(R#request{headers = casefold_headers(Hs)});
handshake(_) ->
    {error, bad_method}.



-spec casefold_headers(Headers) -> DowncaseHeaders
    when Headers         :: [{Key, Value}],
         Key             :: binary(),
         Value           :: binary(),
         DowncaseHeaders :: [{LowercaseKey, Value}],
         LowercaseKey    :: binary().
% @private
% casefold all the keys in the header because they're case insensitive

casefold_headers(Headers) ->
    Downcase =
        fun({K, V}) ->
            NewKey = unicode:characters_to_binary(string:casefold(K)),
            {NewKey, V}
        end,
    lists:map(Downcase, Headers).



-spec handshake2(DowncaseReq) -> Result
    when DowncaseReq      :: request(),
         Result           :: {ok, ClientProtocols, ClientExtensions, DraftResponse}
                           | {error, Reason},
         ClientProtocols  :: [binary()],
         ClientExtensions :: binary(),
         DraftResponse    :: response(),
         Reason           :: any().
% @private
% we may assume (WMA) method=get and headers have all been downcased

handshake2(#request{headers = DowncaseHeaders}) ->
    % headers MUST contain fields:
    % sec-websocket-key:     _          % arbitrary
    % sec-websocket-version: 13         % must be EXACTLY 13
    % connection:            Upgrade    % must include the token "Upgrade"
    % upgrade:               websocket  % must include the token "websocket"
    MapHeaders         = maps:from_list(DowncaseHeaders),
    ClientProtocols    = client_protocols(MapHeaders),
    ClientExtensions   = client_extensions(DowncaseHeaders),
    MaybeResponseToken = validate_headers(MapHeaders),
    case MaybeResponseToken of
        {ok, ResponseToken} ->
            DraftResponse =
                 #response{code = 101,
                           slogan = "Switching Protocols",
                           headers = [{"Sec-WebSocket-Accept", ResponseToken},
                                      {"Connection",           "Upgrade"},
                                      {"Upgrade",              "websocket"}]},
            {ok, ClientProtocols,
                 ClientExtensions,
                 DraftResponse};
        Error ->
            Error
    end.



-spec client_protocols(Headers) -> Protocols
    when Headers   :: [{binary(), binary()}],
         Protocols :: [binary()].
% @private
% needs to loop through all the headers and unfuck multiline bullshit

client_protocols(FuckedHeaders) ->
    unfuck_protocol_string(FuckedHeaders, []).

unfuck_protocol_string([{<<"sec-websocket-protocol">>, Part} | Rest], Acc) ->
    unfuck_protocol_string(Rest, [Part | Acc]);
unfuck_protocol_string([_ | Rest], Acc) ->
    unfuck_protocol_string(Rest, Acc);
unfuck_protocol_string([], PartsRev) ->
    Parts  = lists:reverse(PartsRev),
    % have to join everything together and then re-split
    CSVBin = unicode:characters_to_binary(lists:join(", ", Parts)),
    % after the surgery
    TrannyParts = string:split(CSVBin, ",", all),
    % trim the parts
    JewParts = lists:map(fun circumcise/1, TrannyParts),
    JewParts.



-spec client_extensions(Headers) -> binary()
    when Headers    :: [{Key, Val}],
         Key        :: binary(),
         Val        :: binary().
% @private
% quoth section 9.1: https://datatracker.ietf.org/doc/html/rfc6455#section-9.1
%
% > Note that like other HTTP header fields, this header field MAY be
% > split or combined across multiple lines.  Ergo, the following are
% > equivalent:
% >
% >       Sec-WebSocket-Extensions: foo
% >       Sec-WebSocket-Extensions: bar; baz=2
% >
% > is exactly equivalent to
% >
% >       Sec-WebSocket-Extensions: foo, bar; baz=2
%
% basically have to go through the entire proplist of headers, and if it
% matches <<"sec-websocket-extensions">>, then csv its value to the thing
% @end


client_extensions(DowncaseHeaders) ->
    unfuck_extensions_string(DowncaseHeaders, []).


unfuck_extensions_string([{<<"sec-websocket-extensions">>, Part} | Rest], Acc) ->
    unfuck_extensions_string(Rest, [Part | Acc]);
unfuck_extensions_string([_ | Rest], Acc) ->
    unfuck_extensions_string(Rest, Acc);
unfuck_extensions_string([], PartsRev) ->
    % in the example above, PartsRev = [<<"bar; baz=2">>, <<"foo">>],
    % so need to reverse and then join with commas
    circumcise(lists:join(<<", ">>, lists:reverse(PartsRev))).



-spec circumcise(unicode:chardata()) -> binary().
% @private delete leading/trailing whitespace then convert to binary

circumcise(String) ->
    unicode:characters_to_binary(string:trim(String)).



-spec validate_headers(HeadersMap) -> Result
    when HeadersMap    :: #{Key :: binary() := Val :: binary()},
         Result        :: {ok, ResponseToken}
                        | {error, Reason},
         ResponseToken :: binary(),
         Reason        :: any().
% @private
% validate:
%   Upgrade: websocket
%   Connection: Upgrade
%   Sec-WebSocket-Version: 13

validate_headers(#{<<"sec-websocket-key">>     := ChallengeToken,
                   <<"sec-websocket-version">> := WS_Vsn,
                   <<"connection">>            := Connection,
                   <<"upgrade">>               := Upgrade}) ->
    BadUpgrade    = bad_upgrade(Upgrade),
    BadConnection = bad_connection(Connection),
    BadVersion    = bad_version(WS_Vsn),
    if
        BadUpgrade    -> {error, {bad_upgrade, Upgrade}};
        BadConnection -> {error, {bad_connection, Connection}};
        BadVersion    -> {error, {bad_version, WS_Vsn}};
        true          -> {ok, response_token(ChallengeToken)}
    end;
validate_headers(_) ->
    {error, bad_request}.



-spec bad_upgrade(binary()) -> true | false.
% @private string must include "websocket" as a token

bad_upgrade(Str) ->
    case string:find(Str, "websocket") of
        nomatch -> true;
        _       -> false
    end.



-spec bad_connection(binary()) -> true | false.
% @private string must include "Upgrade" as a token

bad_connection(Str) ->
    case string:find(Str, "Upgrade") of
        nomatch -> true;
        _       -> false
    end.



-spec bad_version(binary()) -> true | false.
% @private version must be EXACTLY <<"13">>

bad_version(<<"13">>) -> false;
bad_version(_)        -> true.



-spec response_token(binary()) -> binary().
% @doc
% Quoth the RFC:
%
% >    Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
% >
% > For this header field, the server has to take the value (as present
% > in the header field, e.g., the base64-encoded [RFC4648] version minus
% > any leading and trailing whitespace) and concatenate this with the
% > Globally Unique Identifier (GUID, [RFC4122]) "258EAFA5-E914-47DA-
% > 95CA-C5AB0DC85B11" in string form, which is unlikely to be used by
% > network endpoints that do not understand the WebSocket Protocol.  A
% > SHA-1 hash (160 bits) [FIPS.180-3], base64-encoded (see Section 4 of
% > [RFC4648]), of this concatenation is then returned in the server's
% > handshake.
% >
% >  Concretely, if as in the example above, the |Sec-WebSocket-Key|
% >  header field had the value "dGhlIHNhbXBsZSBub25jZQ==", the server
% >  would concatenate the string "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
% >  to form the string "dGhlIHNhbXBsZSBub25jZQ==258EAFA5-E914-47DA-95CA-
% >  C5AB0DC85B11".  The server would then take the SHA-1 hash of this,
% >  giving the value 0xb3 0x7a 0x4f 0x2c 0xc0 0x62 0x4f 0x16 0x90 0xf6
% >  0x46 0x06 0xcf 0x38 0x59 0x45 0xb2 0xbe 0xc4 0xea.  This value is
% >  then base64-encoded (see Section 4 of [RFC4648]), to give the value
% >  "s3pPLMBiTxaQ9kYGzzhZRbK+xOo=".  This value would then be echoed in
% >  the |Sec-WebSocket-Accept| header field.

response_token(ChallengeToken) when is_binary(ChallengeToken) ->
    MagicString  = <<"258EAFA5-E914-47DA-95CA-C5AB0DC85B11">>,
    ConcatString = <<ChallengeToken/binary, MagicString/binary>>,
    Sha1         = crypto:hash(sha, ConcatString),
    base64:encode(Sha1).



-spec recv(Socket, Received) -> Result
    when Socket    :: gen_tcp:socket(),
         Received  :: binary(),
         Result    :: {ok, Message, Frames, Remainder}
                    | {error, Reason},
         Message   :: ws_msg(),
         Frames    :: [frame()],
         Remainder :: binary(),
         Reason    :: any().
% @doc
% Equivalent to recv(Socket, Received, [])

recv(Sock, Recv) ->
    recv(Sock, Recv, []).



-spec recv(Socket, Received, Frames) -> Result
    when Socket    :: gen_tcp:socket(),
         Received  :: binary(),
         Frames    :: [frame()],
         Result    :: {ok, Message, NewFrames, Remainder}
                    | {error, Reason},
         Message   :: ws_msg(),
         NewFrames :: Frames,
         Remainder :: binary(),
         Reason    :: any().
% @doc
% Equivalent to recv(Socket, Received, [])

recv(Sock, Received, Frames) ->
    case maybe_pop_msg(Frames) of
        {ok, Message, NewFrames} ->
            {ok, Message, NewFrames, Received};
        incomplete ->
            case recv_frame(#frame{}, Sock, Received) of
                {ok, Frame, NewReceived} ->
                    NewFrames = [Frame | Frames],
                    recv(Sock, NewReceived, NewFrames);
                Error ->
                    Error
            end;
        Error ->
            Error
    end.


-spec maybe_pop_msg(Frames) -> Result
    when Frames    :: [frame()],
         Result    :: {ok, Message, NewFrames}
                    | incomplete
                    | {error, Reason},
         Message   :: ws_msg(),
         NewFrames :: Frames,
         Reason    :: any().
% @private
% try to parse the stack of frames into a single message
%
% ignores RSV bits
% @end

maybe_pop_msg([]) ->
    incomplete;
% case 1: control frames
% note that maybe_control_msg checks that the fin bit is true
%
% meaning if the client sends a malicious control frame with fin=false, that
% error will be caught in maybe_control_msg
maybe_pop_msg([Frame = #frame{opcode = ControlOpcode} | Frames])
        when (ControlOpcode =:= close)
             orelse (ControlOpcode =:= ping)
             orelse (ControlOpcode =:= pong) ->
    case maybe_control_msg(Frame) of
        {ok, Msg} -> {ok, Msg, Frames};
        Error     -> Error
    end;
% case 2: messages
% finished message in a single frame, just pull here
maybe_pop_msg([Frame = #frame{fin         = true,
                              opcode      = DataOpcode,
                              mask        = Mask,
                              masking_key = Key,
                              payload     = Payload}
              | Rest])
        when DataOpcode =:= text; DataOpcode =:= binary ->
    case maybe_unmask(Frame, Mask, Key, Payload) of
        {ok, Unmasked} ->
            Message = {DataOpcode, Unmasked},
            {ok, Message, Rest};
        Error ->
            Error
    end;
% end of a long message
maybe_pop_msg(Frames = [#frame{fin    = true,
                               opcode = continuation} | _]) ->
    maybe_long_data_msg(Frames);
% unfinished message, say we need more
maybe_pop_msg([#frame{fin    = false,
                      opcode = continuation}
               | _]) ->
    incomplete;
% wtf... this case should be impossible
maybe_pop_msg([Frame | _]) ->
    {error, {wtf_frame, Frame}}.



-spec maybe_long_data_msg(Frames) -> Result
    when Frames    :: [frame()],
         Result    :: {ok, Message, NewFrames}
                    | {error, Reason},
         Message   :: ws_msg(),
         NewFrames :: Frames,
         Reason    :: any().
% @private
% assumes:
% 1. top of stack is a finished frame
% 2. top opcode is continuation
% 3. the stack corresponds to a linear sequence of frames all corresponding to
%    one message, until we get to the leading frame of the message, which must
%    have opcode text|binary
%
%    the reason we can make this assumption is because anterior in the call
%    chain is recv/3, which eagerly consumes control messages
%
%    meaning if we encounter a control frame in the middle here, we can assume
%    there is some sort of bug
%
% TODO: I am NOT enforcing that the data message consumes the entire stack of
% frames. Given that the context here is eager consumption, this might be a
% point of enforcement. Need to think about this.
% @end

maybe_long_data_msg(Frames) ->
    mldm(Frames, Frames, <<>>).


% general case: decode the payload in this frame
mldm(OrigFrames, [Frame | Rest], Acc) ->
    Opcode  = Frame#frame.opcode,
    Mask    = Frame#frame.mask,
    Key     = Frame#frame.masking_key,
    Payload = Frame#frame.payload,
    case maybe_unmask(Frame, Mask, Key, Payload) of
        {ok, Unmasked} ->
            NewAcc = <<Unmasked/binary, Acc/binary>>,
            case Opcode of
                continuation -> mldm(OrigFrames, Rest, NewAcc);
                text         -> {ok, {text, NewAcc}, Rest};
                binary       -> {ok, {binary, NewAcc}, Rest};
                _            -> {error, {illegal_data_frame, Frame, OrigFrames, Acc}}
            end;
        Error ->
            Error
    end;
% out of frames
mldm(OrigFrames, [], Acc) ->
    {error, {no_start_frame, Acc, OrigFrames}}.



-spec maybe_control_msg(Frame) -> Result
    when Frame   :: frame(),
         Result  :: {ok, Message}
                  | {error, Reason},
         Message :: ws_msg(),
         Reason  :: any().
% @private
% assume the frame is a control frame, validate it, and unmask the payload
%
% TODO: this doesn't enforce that messages from the client HAVE to be masked,
% which strictly speaking is part of the protocol.

maybe_control_msg(F = #frame{fin            = true,
                             opcode         = Opcode,
                             mask           = Mask,
                             payload_length = Len,
                             masking_key    = Key,
                             payload        = Payload})
        when ((Opcode =:= close) orelse (Opcode =:= ping) orelse (Opcode =:= pong))
             andalso (Len =< 125) ->
    case maybe_unmask(F, Mask, Key, Payload) of
        {ok, UnmaskedPayload} ->
            Msg = {Opcode, UnmaskedPayload},
            {ok, Msg};
        Error ->
            Error
    end;
maybe_control_msg(F) ->
    {error, {illegal_frame, F}}.



-spec maybe_unmask(Frame, Mask, Key, Payload) -> Result
    when Frame    :: frame(),
         Mask     :: boolean(),
         Key      :: <<>> | <<_:32>>,
         Payload  :: binary(),
         Result   :: {ok, Unmasked}
                   | {error, Reason},
         Unmasked :: binary(),
         Reason   :: any().
% @private
% unmask the payload
% @end

% eliminate invalid pairs of {mask, masking_key}
maybe_unmask(_, true,  <<Key:4/bytes>>, Payload) -> {ok, mask_unmask(Key, Payload)};
maybe_unmask(_, false, <<>>,            Payload) -> {ok, Payload};
maybe_unmask(F, true,  <<>>,            _)       -> {error, {illegal_frame, F}};
maybe_unmask(F, false, <<_:4/bytes>>,   _)       -> {error, {illegal_frame, F}}.


%% invertible
%% see: https://datatracker.ietf.org/doc/html/rfc6455#section-5.3
mask_unmask(Key = <<_:4/bytes>>, Payload) ->
    mu(Key, Key, Payload, <<>>).

% essentially this is a modular zipWith xor of the masking key with the payload
mu(Key, <<KeyByte:8, KeyRest/binary>>, <<PayloadByte:8, PayloadRest/binary>>, Acc) ->
    NewByte = KeyByte bxor PayloadByte,
    NewAcc  = <<Acc/binary, NewByte:8>>,
    mu(Key, KeyRest, PayloadRest, NewAcc);
% this is the case where we need to refresh the active key
mu(Key, <<>>, Payload, Acc) ->
    mu(Key, Key, Payload, Acc);
% done
mu(_, _, <<>>, Acc) ->
    Acc.



-spec recv_frame(Parsed, Socket, Received) -> Result
    when Parsed    :: frame(),
         Socket    :: gen_tcp:socket(),
         Received  :: bitstring(),
         Result    :: {ok, frame(), Remainder}
                    | {error, Reason},
         Remainder :: bitstring(),
         Reason    :: any().
% @private
% parse a single frame off the socket
% @end

%% frame: 1 bit
recv_frame(Frame = #frame{fin = none}, Sock, <<FinBit:1, Rest/bits>>) ->
    NewFin =
        case FinBit of
            0 -> false;
            1 -> true
        end,
    NewFrame = Frame#frame{fin = NewFin},
    recv_frame(NewFrame, Sock, Rest);
recv_frame(Frame = #frame{fin = none}, Sock, Received = <<>>) ->
    recv_frame_await(Frame, Sock, Received);
%% rsv: 3 bits
recv_frame(Frame = #frame{rsv = none}, Sock, <<RSV:3/bits, Rest/bits>>) ->
    NewFrame = Frame#frame{rsv = RSV},
    recv_frame(NewFrame, Sock, Rest);
recv_frame(Frame = #frame{rsv = none}, Sock, Received) ->
    recv_frame_await(Frame, Sock, Received);
%% opcode: 4 bits
recv_frame(Frame = #frame{opcode = none}, Sock, <<OpcodeInt:4, Rest/bits>>) ->
    Opcode =
        case OpcodeInt of
            0  -> continuation;
            1  -> text;
            2  -> binary;
            8  -> close;
            9  -> ping;
            10 -> pong;
            _  -> bad_opcode
        end,
    case Opcode of
        bad_opcode ->
            {error, {bad_opcode, OpcodeInt}};
        _ ->
            NewFrame = Frame#frame{opcode = Opcode},
            recv_frame(NewFrame, Sock, Rest)
    end;
recv_frame(Frame = #frame{opcode = none}, Sock, Received) ->
    recv_frame_await(Frame, Sock, Received);
%% mask: 1 bit
recv_frame(Frame = #frame{mask = none}, Sock, <<MaskBit:1, Rest/bits>>) ->
    NewMask =
        case MaskBit of
            0 -> false;
            1 -> true
        end,
    NewFrame = Frame#frame{mask = NewMask},
    recv_frame(NewFrame, Sock, Rest);
recv_frame(Frame = #frame{mask = none}, Sock, Received = <<>>) ->
    recv_frame_await(Frame, Sock, Received);
%% payload length: variable (yay)
% first case: short length 0..125
recv_frame(Frame = #frame{payload_length = none}, Sock, <<Len:7, Rest/bits>>) when Len =< 125 ->
    NewFrame = Frame#frame{payload_length = Len},
    recv_frame(NewFrame, Sock, Rest);
% second case: 126 -> 2 bytes to follow
recv_frame(Frame = #frame{payload_length = none}, Sock, <<126:7, Len:16, Rest/bits>>) ->
    NewFrame = Frame#frame{payload_length = Len},
    recv_frame(NewFrame, Sock, Rest);
% third case: 127 -> 8 bytes to follow
% bytes must start with a 0 bit
recv_frame(_Frame = #frame{payload_length = none}, _Sock, <<127:7, 1:1, _/bits>>) ->
    {error, {illegal_frame, "payload length >= 1 bsl 63"}};
% 127, next is a legal length, continue
recv_frame(Frame = #frame{payload_length = none}, Sock, <<127:7, Len:64, Rest/bits>>) ->
    NewFrame = Frame#frame{payload_length = Len},
    recv_frame(NewFrame, Sock, Rest);
% otherwise wait
recv_frame(Frame = #frame{payload_length = none}, Sock, Received) ->
    recv_frame_await(Frame, Sock, Received);
%% masking key: 0 or 4 bits
% not expecting a masking key, fill in that field here
recv_frame(Frame = #frame{mask = false, masking_key = none}, Sock, Received) ->
    NewFrame = Frame#frame{masking_key = <<>>},
    recv_frame(NewFrame, Sock, Received);
% expecting one
recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, <<Key:4/bytes, Rest/bits>>) ->
    NewFrame = Frame#frame{masking_key = Key},
    recv_frame(NewFrame, Sock, Rest);
% not found
recv_frame(Frame = #frame{mask = true, masking_key = none}, Sock, Received) ->
    recv_frame_await(Frame, Sock, Received);
%% payload
recv_frame(Frame = #frame{payload_length = Len, payload = none}, Sock, Received) when is_integer(Len) ->
    case Received of
        % we have enough bytes
        <<Payload:Len/bytes, Rest/bits>> ->
            FinalFrame = Frame#frame{payload = Payload},
            {ok, FinalFrame, Rest};
        % we do not have enough bytes
        _ ->
            recv_frame_await(Frame, Sock, Received)
    end.



%% factoring this out into a function to reduce repetition
recv_frame_await(Frame, Sock, Received) ->
    case inet:setopts(Sock, [{active, once}]) of
        ok ->
            receive
                {tcp, Sock, Bin}          -> recv_frame(Frame, Sock, <<Received/bits, Bin/binary>>);
                {tcp_closed, Sock}        -> {error, tcp_closed};
                {tcp_error, Sock, Reason} -> {error, {tcp_error, Reason}}
            after 3000 ->
                {error, timeout}
            end;
        {error, Reason} ->
            {error, {inet, Reason}}
    end.



-spec send(Socket, Payload) -> Result
    when Socket   :: gen_tcp:socket(),
         Payload  :: iodata(),
         Result   :: ok
                   | {error, Reason},
         Reason   :: closed | {timeout, RestData} | inet:posix(),
         RestData :: binary() | erlang:iovec().
% @doc
% FIXME: this should be sending a message, not an arbitrary payload
%
% send binary data over Socket. handles frame nonsense
%
% types the payload as bytes
%
% max payload size is 2^63 - 1 bytes
% @end

send(Socket, Payload) ->
    BPayload = unicode:characters_to_binary(Payload),
    Frame = payload_to_frame(BPayload),
    send_frame(Socket, Frame).


payload_to_frame(Payload) when byte_size(Payload) < ?MAX_PAYLOAD_SIZE ->
    #frame{fin            = true,
           opcode         = binary,
           mask           = false,
           payload_length = byte_size(Payload),
           masking_key    = none,
           payload        = Payload}.



-spec send_frame(Sock, Frame) -> Result
    when Sock     :: gen_tcp:socket(),
         Frame    :: frame(),
         Result   :: ok
                   | {error, Reason},
         Reason   :: tcp_error().
% @private
% send a frame on the socket
% @end

send_frame(Sock, Frame) ->
    Binary = render_frame(Frame),
    gen_tcp:send(Sock, Binary).



-spec render_frame(Frame) -> Binary
    when Frame  :: frame(),
         Binary :: binary().
% @private
% render a frame
%
% TODO: this doesn't check/do masking
%
% This is a non-issue as long as this is only used for rendering messages sent
% from server to client (unmasked per protocol). However, for debugging
% purposes, a user of this library might want to test how frames render with
% masking. This functionality is not currently supported, but is a planned
% addition in the future.
% @end

render_frame(#frame{fin            = Fin,
                    opcode         = Opcode,
                    payload_length = Len,
                    payload        = Payload}) ->
    BFin =
        case Fin of
            true  -> <<1:1>>;
            false -> <<0:1>>
        end,
    BRSV = <<0:3>>,
    BOpcode =
        case Opcode of
            continuation -> << 0:1>>;
            text         -> << 1:1>>;
            binary       -> << 2:1>>;
            close        -> << 8:1>>;
            ping         -> << 9:1>>;
            pong         -> <<10:1>>
        end,
    BMask = <<0:1>>,
    BPayloadLength = render_payload_length(Len),
    <<BFin/bits,
      BRSV/bits,
      BOpcode/bits,
      BMask/bits,
      BPayloadLength/bits,
      Payload/bits>>.



-spec render_payload_length(non_neg_integer()) -> binary().
% @private
% > Payload length:  7 bits, 7+16 bits, or 7+64 bits
% >
% >    The length of the "Payload data", in bytes: if 0-125, that is the
% >    payload length.  If 126, the following 2 bytes interpreted as a
% >    16-bit unsigned integer are the payload length.  If 127, the
% >    following 8 bytes interpreted as a 64-bit unsigned integer (the
% >    most significant bit MUST be 0) are the payload length.  Multibyte
% >    length quantities are expressed in network byte order.  Note that
% >    in all cases, the minimal number of bytes MUST be used to encode
% >    the length, for example, the length of a 124-byte-long string
% >    can't be encoded as the sequence 126, 0, 124.  The payload length
% >    is the length of the "Extension data" + the length of the
% >    "Application data".  The length of the "Extension data" may be
% >    zero, in which case the payload length is the length of the
% >    "Application data".

render_payload_length(Len) when 0 =< Len, Len =< 125 ->
    <<Len:7>>;
render_payload_length(Len) when 126 =< Len, Len =< 2#1111_1111_1111_1111 ->
    <<126:7, Len:16>>;
render_payload_length(Len) when (1 bsl 16) =< Len, Len < ?MAX_PAYLOAD_SIZE ->
    <<127:7, Len:64>>.



-spec pong(Socket) ->  Result
    when Socket   :: gen_tcp:socket(),
         Result   :: ok
                   | {error, Reason},
         Reason   :: closed | {timeout, RestData} | inet:posix(),
         RestData :: binary() | erlang:iovec().

pong(Sock) ->
    pong(Sock, <<>>).



-spec pong(Socket, Payload) ->  Result
    when Socket   :: gen_tcp:socket(),
         Payload  :: binary(),
         Result   :: ok
                   | {error, Reason},
         Reason   :: closed | {timeout, RestData} | inet:posix(),
         RestData :: binary() | erlang:iovec().

pong(Sock, Payload) when is_binary(Payload), byte_size(Payload) < ?MAX_PAYLOAD_SIZE ->
    Frame = #frame{fin            = true,
                   opcode         = pong,
                   payload_length = byte_size(Payload),
                   payload        = Payload},
    send_frame(Sock, Frame).