src/hessian.erl

% ---------------------------------------------------------------------------
%   Copyright (C) 2008 0x6e6562
%
%   Licensed under the Apache License, Version 2.0 (the "License");
%   you may not use this file except in compliance with the License.
%   You may obtain a copy of the License at
%
%       http://www.apache.org/licenses/LICENSE-2.0
%
%   Unless required by applicable law or agreed to in writing, software
%   distributed under the License is distributed on an "AS IS" BASIS,
%   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%   See the License for the specific language governing permissions and
%   limitations under the License.
% ---------------------------------------------------------------------------

-module(hessian).

-include("hessian.hrl").

-export([call/5]).
-export([invoke/4]).
-export([decode/2]).
-export([encode/2, encode/3, encode/4, encode/5]).
%% TODO Move the e2cc function to encoding module
-export([erlang_to_camel_case/1]).

%---------------------------------------------------------------------------
% Decoding
%---------------------------------------------------------------------------

% Binaries
decode(<<16#20,Rest/binary>>, State) -> {Rest, <<>>, State};
decode(<<Len:8/unsigned,Rest/binary>>, State) when Len =< 16#2f, 16#20 < Len ->
    _Len = Len - 16#20,
    <<Bin:_Len/binary,_Rest/binary>> = Rest,
    {_Rest, Bin, State};
decode(<<$B,Len:16/unsigned,Bin:Len/binary,Rest/binary>>, State) -> {Rest, Bin, State};
decode(<<$b,Rest/binary>>,State) -> decode(<<$b,Rest/binary>>, [], State);
%% Booleans
decode(<<$T,Rest/binary>>, State) -> {Rest, true, State};
decode(<<$F,Rest/binary>>, State) -> {Rest, false, State};
%% Dates
decode(<<$d,Date:64/unsigned,Rest/binary>>, State) ->
    MegaSecs = Date div ?MegaSeconds,
    Secs = (Date - MegaSecs * ?MegaSeconds) div ?Seconds,
    MicroSecs = (Date - MegaSecs * ?MegaSeconds - Secs * ?Seconds) * ?MicroSeconds,
    {Rest, {MegaSecs, Secs, MicroSecs}, State};
%% Doubles
decode(<<16#67,Rest/binary>>, State)-> {Rest, 0.0, State};
decode(<<16#68,Rest/binary>>, State)-> {Rest, 1.0, State};
decode(<<16#69,Int:8/signed,Rest/binary>>, State)-> {Rest, float(Int), State};
decode(<<16#6a,Int:16/signed,Rest/binary>>, State)-> {Rest, float(Int), State};
%% TODO ask erlang-questions about not being able to match a 32bit float
decode(<<16#6b,Int:32/signed,Rest/binary>>, State)->
    <<Double:64/float>> = <<Int:32,0,0,0,0>>,
    {Rest, Double, State};
decode(<<$D,Double:64/float,Rest/binary>>, State)-> {Rest, Double, State};
%% Ints
decode(<<$I,Int:32/unsigned,Rest/binary>>, State)-> {Rest, Int, State};
decode(<<Int:8,Rest/binary>>, State) when Int >= 16#80, Int =< 16#bf -> {Rest, Int - 16#90, State};
decode(<<B2:8,B1:8,B0:8,Rest/binary>>, State) when B2 >= 16#d0, B2 =< 16#d7 -> {Rest, ((B2 - 16#d4) bsl 16) + (B1 bsl 8) + B0, State};
decode(<<B1:8,B0:8,Rest/binary>>, State) when B1 >= 16#c0, B1 =< 16#cf -> {Rest, ((B1 - 16#c8) bsl 8) + B0, State};
%% Longs
decode(<<$L,Long:64/unsigned,Rest/binary>>, State)-> {Rest, Long, State};
decode(<<16#77,Long:32,Rest/binary>>, State) -> {Rest, Long, State};
decode(<<Long:8,Rest/binary>>, State) when Long >= 16#d8, Long =< 16#ef -> {Rest, Long - 16#e0, State};
decode(<<B2:8,B1:8,B0:8,Rest/binary>>, State) when B2 >= 16#38, B2 =< 16#3f -> {Rest, ((B2 - 16#3c) bsl 16) + (B1 bsl 8) + B0, State};
decode(<<B1:8,B0:8,Rest/binary>>, State) when B1 >= 16#f0, B1 =< 16#ff -> {Rest, ((B1 - 16#f8) bsl 8) + B0, State};
%% Strings
decode(<<0,Rest/binary>>, State) -> {Rest, <<>>, State};
decode(<<Len:8,String:Len/binary,Rest/binary>>, State) when Len < 32 -> {Rest, list_to_binary(xmerl_ucs:from_utf8(String)), State};
decode(<<$S,Len:16/unsigned,String:Len/binary,Rest/binary>>, State) -> {Rest, list_to_binary(xmerl_ucs:from_utf8(String)), State};
decode(<<$s,Rest/binary>>, State) -> decode(<<$s,Rest/binary>>,[], State);
%% Nulls
decode(<<$N,Rest/binary>>, State) -> {Rest, undefined, State};
%% References
decode(<<$R,Ref:32/unsigned,Rest/binary>>, State)-> {ref, Rest, Ref, State};
%% Maps
decode(<<$M,$t,L:16/unsigned,Type:L/binary,Map/binary>>, State) -> decode(map, Map, dict:store(fqn, Type, dict:new()), State);
decode(<<$M,Map/binary>>, State) -> decode(map, Map, dict:new(), State);
%%list ::= V type? length? value* z
%%     ::= v int int value*
%%length     ::= 'l' b3 b2 b1 b0
%%           ::= x6e int
%% Lists
decode(<<$V,$t,L1:16/unsigned,T:L1/binary,$l,L2:32/unsigned,Bin/binary>>, State) -> decode(list, Bin, [], State);
decode(<<$V,$l,L1:32/unsigned,Bin/binary>>, State) -> decode(list, Bin, [], State);
decode(<<$V,16#6e,L1:8,Bin/binary>>, State) -> decode(list, Bin, [], State);
decode(<<$V,16#6e,L1:16,Bin/binary>>, State) -> decode(list, Bin, [], State);
decode(<<$V,$t,L1:16/unsigned,T:L1/binary,Bin/binary>>, State) -> decode(list, Bin, [], State);
decode(<<$V,Bin/binary>>, State) -> decode(list, Bin, [], State);
decode(<<$O,?M,?m,Hash:32/unsigned,$u,$z>>, State0) -> {peer_cannot_resolve,Hash};
decode(<<$O,Hash:32/unsigned,$t,L:16/unsigned,Type:L/binary,Bin/binary>>, State0) ->
    {Rest, TypeDef, State} = decode(type_definition,Type,Bin,State0),
    NewState = type_decoding:hash_store(Hash,TypeDef,State),
    {Rest, {Hash,TypeDef}, NewState};
decode(<<$O,Hash:32/unsigned,Bin/binary>>, State) ->
    ?TYPEDEF(Hash),
    case type_decoding:hash_lookup(Hash, State) of
        {not_found, Hash} ->
            %?LOG(Hash),
            {Bin, {not_found, Hash}, State};
        TypeDef ->
            %?LOG(TypeDef),
            NewState = type_decoding:visit(TypeDef,State),
            {Bin,TypeDef,NewState}
    end;
decode(<<$o,Bin/binary>>, State) ->
    {Rest,Ref,_State} = decode(Bin, State),
    ?INSTANCE(Ref),
    ForeignView = type_decoding:lookup_reference(Ref, _State),
    #type_def{native_type = NativeType,
              foreign_type = ForeignType,
              fieldnames = ForeignFieldNames} = ForeignView,
    NativeView = type_decoding:resolve_native_type(ForeignType,_State),
    Count = count_fields(ForeignView),
    case decode(field, Rest, Count,[], _State) of
        {not_found,Hash} ->
            {not_found,Hash};
        {_Rest,FieldValues, NewState} ->
            Object = type_decoding:project_native_view(ForeignFieldNames,FieldValues,NativeView),
            {_Rest, Object, NewState}
    end;        
%---------------------------------------------------------------------------
% Call and reply decoding
%---------------------------------------------------------------------------
decode(<<$c,?M,?m,$m,L1:16/unsigned,Function:L1/binary,Bin/binary>>, State) ->
    ?START(c, [?M,?m]),
    ?METHOD(Function),
    case decode(list, Bin,[], State) of
        {error, Encoded} ->
            {error, Encoded};
        {not_found, Hash} ->
            {not_found, Hash};    
        {Rest, Arguments, NewState} ->
            [type_decoding:camel_case_to_erlang(Function), Arguments]
    end;
decode(<<$r,?M,?m,$N,$z>>, State) -> ok;
%% TODO The string decoding in the fault decoding is a bit dodgy
%% Also, have a look at the way it is being encoded
decode(<<$r,?M,?m,$f,
         4,"code",L1:8,Code:L1/binary,
         7,"message",L2:8,Message:L2/binary,
         6,"detail",L3:8,Detail:L3/binary,$z>>, State) ->
    {error, list_to_atom(binary_to_list(Message)) };
decode(<<$r,?M,?m,Args/binary>>, State) ->
    case decode(Args,[], State) of
        {<<>>, Decoded,_State} ->
            case lists:dropwhile(fun is_type_def/1, Decoded) of
                [Value] ->
                    Value;
                [H|T] ->
                    [H|T]
            end;
        {error, Encoded} ->
            {error, Encoded}
    end;
%% Type queries
decode(<<$q,?M,?m,Hash:32/unsigned,$z>>, State) ->
    ?START(q, [?M,?m]),
    ?VALUE(<<Hash:32>>),
    case type_decoding:hash_lookup(Hash, State) of
        {not_found, Hash} ->
            {error, encode(fault, <<"ProtocolException">>, unknown_hash, Hash, State) };
        TypeDef ->
            {Hash,TypeDef, State}
    end;
decode(<<$y,?M,?m,Hash:32/unsigned,$z>>, State) ->
    {type_query_ack, Hash};
%% Anything else
decode(<<Unexpected/binary>>, State) ->
    {error, encode(fault, <<"ProtocolException">>, unexpected_byte_sequence, Unexpected, State) }.
%----------------------------------
decode(<<$b,Len:16/unsigned,Bin:Len/binary,$b,Rest/binary>>, Acc, State) ->
    decode(<<$b,Rest/binary>>,Acc ++ [Bin], State);
decode(<<$b,Len:16/unsigned,Bin:Len/binary,$B,Rest/binary>>, Acc, State) ->
    _Acc = Acc ++ [Bin],
    {_Rest,_Bin, State} = decode(<<$B,Rest/binary>>, State),
    {_Rest, list_to_binary(_Acc ++ [_Bin]), State};
decode(<<$s,Len:16,String:Len/binary,$s,Rest/binary>>,Acc, State) ->
    _String = list_to_binary(xmerl_ucs:from_utf8(String)),
    decode(<<$s,Rest/binary>>,Acc ++ [_String], State);
decode(<<$s,Len:16,String:Len/binary,$S,Rest/binary>>,Acc, State) ->
    _String = list_to_binary(xmerl_ucs:from_utf8(String)),
    _Acc = Acc ++ [_String],
    {_Rest,_Bin, _State} = decode(<<$S,Rest/binary>>, State),
    {_Rest, list_to_binary(_Acc ++ [_Bin]), _State};
decode(<<>>, List, State) -> {<<>>, List, State};
decode(<<$z>>, List, State) -> {<<>>, List, State};
decode(Args, List, State) ->
    case decode(Args,State) of
        {Rest, [H|T], _State} ->
            decode(Rest, List ++ [H|T], _State);
        {Rest, Result, _State} ->
            decode(Rest, List ++ [Result], _State);
        {ref, Rest, Ref, _State} ->
            _Ref = lists:nth(Ref + 1, List),
            decode(Rest, [List,[_Ref]] , _State);
        {error, Encoded} ->
            {error, Encoded}
    end.
decode(map, <<$z>>, Dict, State) -> {Dict, State};
decode(map, <<$z,Rest/binary>>, Dict, State) -> {Rest,Dict, State};
decode(map, Bin, Dict, State) ->
    {_Rest, Key, _State} = decode(Bin, State),
    case decode(_Rest, _State) of
        {Rest, Value, __State} ->
            decode(map, Rest, dict:store(Key, Value, Dict), __State);
        {ref, Rest, Ref, __State} ->
            %Value = lists:nth(Ref + 1, List),
            Value = Ref,
            decode(map, Rest, dict:store(Key, Value, Dict), __State)
    end;
decode(list, <<>>, List, State) -> {<<>>,List, State};
decode(list, <<$z>>, List, State) -> {<<>>,List, State};
decode(list, <<$z,Rest/binary>>, List, State) -> {Rest, List, State};
decode(list, Bin, List, State) ->
    case decode(Bin, State) of
        {error, Encoded} ->
            {error, Encoded};
        {Rest, {type_def,_,_,_}, _State} ->
            decode(list, Rest, List, _State);
        {not_found,Hash} ->
            {not_found, Hash};    
        {Rest, {not_found, Hash}, _State} ->
            {not_found, Hash};    
        {Rest, Value, _State} ->
            ?VALUE(Value),
            decode(list, Rest, List ++ [Value], _State)
    end;
decode(type_definition, ForeignType, Bin, State) ->
    {Rest,Count, _State} = decode(Bin, State),
    {NewRest,FieldNames, NewState} = decode(field, Rest, Count, [], _State),
    TypeDef = type_decoding:build_foreign_view(ForeignType,FieldNames,NewState),
    {NewRest, TypeDef, NewState}.
decode(field, <<$z,Rest/binary>>, Count, Acc, State) -> {Rest, Acc, State};
decode(field, Rest, 0, Acc, State) -> {Rest, Acc, State};
decode(field, Bin, Count, Acc, State) ->
    {Rest,Field, _State} = decode(Bin, State),
    case Field of
        {not_found,Hash} ->
            {not_found,Hash};
        {type_def,_,_,_} ->
            {_Rest, Object, __State} = decode(Rest, _State),
            decode(field, _Rest, Count - 1, Acc ++ [Object], __State);
        _ ->
            decode(field, Rest, Count - 1, Acc ++ [Field], _State)
    end.

%---------------------------------------------------------------------------
% Encoding
%---------------------------------------------------------------------------

encode(type_query, Hash) -> 
    ?START(q,[?M,?m]),
    ?VALUE(<<Hash:32>>),
    <<$q,?M,?m,Hash:32/unsigned,$z>>;
encode(type_query_ok, Hash) -> <<$y,?M,?m,Hash:32/unsigned,$z>>;
encode(type_information, TypeDef = #type_def{fieldnames = FieldNames,
                                             foreign_type = ForeignType}) ->
    Size = size(ForeignType),
    Count = count_fields(TypeDef),
    Int = encode(int, Count, []),
    _FieldNames = lists:map(fun erlang_to_camel_case/1,FieldNames),
    {AccOut, _} = lists:foldl(fun encode/2,{<<>>, []},_FieldNames),
    Hash = erlang:phash2(TypeDef),
    <<$O,Hash:32/unsigned,$t,Size:16/unsigned,ForeignType/binary,Int/binary,AccOut/binary,$z>>;

encode(Value, {Acc,State}) ->
    case encode(Value, State) of
        {ValueBin, _State} ->
            {<<Acc/binary,ValueBin/binary>>,_State};
        ValueBin ->
            {<<Acc/binary,ValueBin/binary>>,State}
    end;

% Null
encode(undefined, State) -> <<$N>>;

encode(Value, State) when is_integer(Value) -> encode(int, Value, State);
encode(Value, State) when is_float(Value) -> encode(double, Value, State);
encode(Value, State) when is_boolean(Value) -> encode(boolean, Value, State);
encode(Value, State) when is_atom(Value) -> encode(string, atom_to_list(Value), State);
encode(Value, State) when is_list(Value) -> encode(list, Value, State);
encode(Value, State) when is_pid(Value) -> throw("Erlang Pid encoding not supported");
%% Assume that a binary is a string
%% TODO what about encapsulating binary-data????
encode(Value, State) when is_binary(Value) -> encode(string, Value, State);
%% TODO The order of this is_tuple guard worries me a bit, needs further attention.
encode(Value, State) when is_tuple(Value) -> encode(object, Value, State).

% x20               # zero-length binary data
% x23 x01 x02 x03   # 3 octet data
% B x10 x00 ....    # 4k final chunk of data
% b x04 x00 ....    # 1k non-final chunk of data
encode(binary, <<>>, State) -> <<16#20>>;
encode(binary, Value, State) when size(Value) < 15 ->
    Size = 16#20 + size(Value),
    <<Size:8/unsigned,Value/binary>>;
encode(binary, Value, State) -> encode(binary, Value, <<>>, State);
encode(boolean, true, State) -> <<$T>>;
encode(boolean, false, State) -> <<$F>>;
encode(timestamp, {MegaSecs, Secs, MicroSecs}, State) ->
    Date = MegaSecs * ?MegaSeconds + Secs * ?Seconds + MicroSecs div ?MicroSeconds,
    <<$d,Date:64/unsigned>>;
encode(localtime, DateTime={{Year,Month,Day},{Hour,Min,Sec}}, State) ->
    [Universal] = calendar:local_time_to_universal_time_dst(DateTime),
    Seconds = calendar:datetime_to_gregorian_seconds(Universal),
    MilliSeconds = (Seconds - ?UnixEpoch) * 1000,
    <<$d,MilliSeconds:64/unsigned>>;
encode(double, 0.0, State) -> <<16#67>>;
encode(double, 1.0, State) -> <<16#68>>;
encode(double, Double, State) when Double >= -128.0, Double =< 127.0, Double == round(Double) ->
    Byte = round(Double),
    <<16#69, Byte/signed>>;
encode(double, Double, State) when Double >= -32768.0, Double =< 32767.0, Double == round(Double) ->
    Byte = round(Double),
    <<16#6a, Byte:16/signed>>;
encode(double, Double, State) ->
    case <<Double/float>> of
        <<B24,B16,B8,B0,0,0,0,0>> ->
            <<16#6b,B24,B16,B8,B0>>;
        Other ->
            <<$D,Other/binary>>
    end;
encode(int, Int, State) when Int >= -16, Int =< 47 ->
    _Int = Int + 16#90,
    <<_Int:8>>;
encode(int, Int, State) when Int >= -2048, Int =< 2047 ->
    <<B1:8,B0:8>> = <<Int:16>>,
    _B1 = B1 + 16#c8,
    <<_B1,B0>>;
encode(int, Int, State) when Int >= -262144, Int =< 262143 ->
    <<B2:8,B1:8,B0:8>> = <<Int:24>>,
    _B2 = B2 + 16#d4,
    <<_B2,B1,B0>>;
encode(int, Int, State) when Int > 16#100000000 -> <<$L,Int:64/unsigned>>;
encode(int, Int, State) -> <<$I,Int:32/unsigned>>;
encode(long, Long, State) when Long >= -8, Long =< 15 ->
    _Long = Long + 16#e0,
    <<_Long:8>>;
encode(long, Long, State) when Long >= -2048, Long =< 2047 ->
    <<B1:8,B0:8>> = <<Long:16>>,
    _B1 = B1 + 16#f8,
    <<_B1,B0>>;
encode(long, Long, State) when Long >= -262144, Long =< 262143 ->
    <<B2:8,B1:8,B0:8>> = <<Long:24>>,
    _B2 = B2 + 16#3c,
    <<_B2,B1,B0>>;
encode(long, Long, State) when Long >= -16#100000000, Long =< 16#100000000 -> <<16#77,Long:32>>;
encode(long, Long, State) -> <<$L,Long:64/unsigned>>;
encode(string, <<>>, State) -> <<0>>;
encode(string, [], State) -> <<0>>;
encode(string, String, State) when is_binary(String)-> encode(string, binary_to_list(String), State);
encode(string, String, State) when is_list(String)->
    UTF8 = case catch xmerl_ucs:is_incharset(String,'utf-8') of
               true ->
                   String;
               _ ->
                   xmerl_ucs:to_utf8(String)
           end,
    %% There is a question pending on the hessian list as to whether the length
    %% refers to the UTF-8 or the native length
    %Length = length(String),
    Length = length(UTF8),
    if
        Length < 32 ->
            Bin = list_to_binary(UTF8),
            <<Length:8,Bin/binary>>;
        true ->
            encode(string, list_to_binary(String), <<>>, State)
    end;
encode(dictionary, Dict, State) ->
    Encoder = fun(Key, Value, AccIn) ->
                KeyBin = encode(Key, State),
                ValueBin = encode(Value, State),
                <<AccIn/binary,KeyBin/binary,ValueBin/binary>> end,
    AccOut = dict:fold(Encoder, <<$M>>, Dict),
    <<AccOut/binary,$z>>;
%% Length
%::= 'l' b3 b2 b1 b0
%::= x6e int
encode(length, List, State) ->
    Length = length(List),
    case encode(int, Length, State) of
        <<$I,Int/binary>> ->
            <<$l,Int/binary>>;
        Other ->
            <<16#6e,Other/binary>>
    end;
%% Lists
encode(list, List, State) ->
    Length = encode(length, List, State),
    encode(list, List, <<$V,Length/binary>>, State);
encode(method, Method, State) when is_atom(Method) ->
    String = atom_to_list(Method),
    encode(method, String, State);
encode(method, Method, State) when is_binary(Method) ->
    _Method = erlang_to_camel_case(Method),
    Size = size(_Method),
    <<$m,Size:16/unsigned,_Method/binary>>;
%---------------------------------------------------
% TODO I don't think this ever gets called
encode(method, String, State) when is_list(String) ->
    _String = erlang_to_camel_case(String),
    Length = string:len(_String),
    Bin = list_to_binary(_String),
    <<$m,Length:16/unsigned,Bin/binary>>;
%---------------------------------------------------
encode(type, FullyQualifiedName, State) when is_list(FullyQualifiedName) ->
    Bin = list_to_binary(FullyQualifiedName),
    encode(type,Bin, State);
encode(type, FullyQualifiedName, State) when is_binary(FullyQualifiedName) ->
    Length = size(FullyQualifiedName),
    <<$t,Length:16,FullyQualifiedName/binary>>;
%% TODO implement header
%% reply   ::= r x01 x00 header* object z
%%         ::= r x01 x00 header* fault z
encode(reply, ok, State) -> <<$r,?M,?m,$N,$z>>;
encode(reply, {ok, Object}, State) -> encode(reply, Object, State);
encode(reply, {error, {Error, Reason} }, State) -> encode(fault, Error, Reason, State);
encode(reply, Object, State) ->
    ?START(r,[?M,?m]),
    Bin = case encode(Object, State) of
              {_Bin, NewState} ->
                    _Bin;
              _Bin ->
                  _Bin
          end,
    <<$r,?M,?m,Bin/binary,$z>>;
encode(object, DateTime = {MegaSecs, Secs, MicroSecs}, State) 
    when is_integer(MegaSecs), is_integer(Secs), is_integer(MicroSecs)->
    ?LOG("Employing date heuristic"),
    encode(timestamp,DateTime,State);    
encode(object, Object, State) when is_tuple(Object) ->
    [NativeType|Values] = tuple_to_list(Object),
    {TypeEncoding, EncodedRef, NewState} =
        case type_encoding:visit(NativeType,State) of
            {ref, Ref} ->
                encode(type_information, {ref, Ref}, State);
            {hash, Hash, Ref, State0} ->
                encode(type_information, {hash, Hash, Ref}, State0)
        end,        
    {AccOut, _NewState} = lists:foldl(fun encode/2,{<<>>, NewState},Values),
    {<<TypeEncoding/binary,$o,EncodedRef/binary,AccOut/binary>>, _NewState};
encode(type_information, {ref, Ref}, State) ->
    {<<>>, encode(int, Ref, State), State};
encode(type_information, {hash, Hash, Ref}, State) ->
    EncodedRef = encode(int, Ref, State),
    {<<$O,Hash:32/unsigned>>, EncodedRef, State}.
encode(binary, Value, <<>>, State) when size(Value) =< ?CHUNK_SIZE ->
    Size = size(Value),
    <<$B,Size:16,Value/binary>>;
encode(binary, Value, Acc, State) when size(Value) =< ?CHUNK_SIZE ->
    Size = size(Value),
    <<Acc/binary,$B,Size:16,Value/binary>>;
encode(binary, Value, <<>>, State) ->
    <<Chunk:?CHUNK_SIZE/binary,Rest/binary>> = Value,
    encode(binary, Rest, <<$b,?CHUNK_SIZE:16,Chunk/binary>>, State);
encode(binary, Value, Acc, State) ->
    <<Chunk:?CHUNK_SIZE/binary,Rest/binary>> = Value,
    encode(binary, Rest, <<Acc/binary,$b,?CHUNK_SIZE:16,Chunk/binary>>, State);
encode(string, Value, Acc, State) when size(Value) =< ?CHUNK_SIZE ->
    Size = size(Value),
    <<Acc/binary,$S,Size:16,Value/binary>>;
encode(string, Value, <<>>, State) ->
    <<Chunk:?CHUNK_SIZE/binary,Rest/binary>> = Value,
    encode(string, Rest, <<$s,?CHUNK_SIZE:16,Chunk/binary>>, State);
encode(string, Value, Acc, State) ->
    <<Chunk:?CHUNK_SIZE/binary,Rest/binary>> = Value,
    encode(string, Rest, <<Acc/binary,$s,?CHUNK_SIZE:16,Chunk/binary>>, State);
%---------------------------------------------------------------------------
% List Encoding
%---------------------------------------------------------------------------
encode(list, Type, List, State) when is_binary(Type) ->
    TypeLength = size(Type),
    ListLength = length(List),
    encode(list, List, <<$V,$t,TypeLength:16/unsigned,Type/binary,$l,ListLength:32/unsigned>>, State);
encode(list, List, Acc0, State) when is_binary(Acc0) ->
    {AccOut, State} = lists:foldl(fun encode_accumulate/2, {Acc0,State}, List),
    <<AccOut/binary,$z>>;
%---------------------------------------------------------------------------
% Call and Reply Encoding
%---------------------------------------------------------------------------
%% TODO implement header call    ::= c x01 x00 header* method object* z
encode(call, Method, Args, State) ->
    encode(call, Method, Args, fun encode_accumulate/2, State);
encode(fault, _Error, _Reason, State) ->
    encode(fault, <<"ServiceException">>, _Error, _Reason, State).
encode(fault, Code, _Error, _Reason, State) ->
    EncodedCode = encode(string,Code, State),
    <<131,100,L2:16/unsigned,Error/binary>> = term_to_binary(_Error),
    EncodedError = encode(string,Error, State),
    <<$r,?M,?m,$f,
      4,"code",EncodedCode/binary,
      7,"message",EncodedError/binary,
      6,"detail",31,"Stack trace not yet implemented",
      $z>>;
encode(call, Method, Args, Fun, State) when is_function(Fun) ->
    MethodBin = encode(method,Method, State),
    {Bin, NewState} = lists:foldl(Fun, {<<>>, State}, Args),
    <<$c,?M,?m,MethodBin/binary,Bin/binary,$z>>.

%---------------------------------------------------------------------------
% Invocation
%---------------------------------------------------------------------------

invoke(Module,Bin,DecodingState,EncodingState) ->
    case decode(Bin,DecodingState) of 
        {error, Reason} ->
            encode(fault, decoding_error, Reason, EncodingState);
        {not_found, Hash} ->
            encode(type_query,Hash);
        {peer_cannot_resolve,Hash} ->
            %% TODO what should happen here? Is this good enough?
            encode(reply,ok,[]);    
        {type_query_ack, Hash} ->
            %% TODO This has not been implemented yet
            ok;    
        %% Don't know if I like this weakly typed differentiation,
        %% it seems a bit brittle    
        {_,{Hash,TypeDef},_} ->
            encode(type_query_ok, Hash);
        %% TODO look into whether this 2nd branch for type_query_ok is needed,
        %% or whether to refactor the corresponding return value from the
        %% decode function
        {_,TypeDef,_} ->
            encode(type_information, TypeDef);        
        [Function,Args] ->
            Result = apply(Module,Function,Args),
            encode(reply,Result,EncodingState)
    end.

%% This is used for synchronous transports that can respond
%% to a type query    
call(Dispatcher,Method,Args,DecodingState,EncodingState) ->
    Bin = encode(call,Method,Args,EncodingState),
    Response0 = apply(Dispatcher,[Bin]),
    case decode(Response0,DecodingState) of
        {Hash,TypeDef,_} ->
            ok = send_type_negotiation(Dispatcher,TypeDef,DecodingState),
            Response = apply(Dispatcher,[Bin]),
            decode(Response,DecodingState);    
        Other ->
            Other             
    end.
    
send_type_negotiation(Dispatcher,TypeDef,DecodingState) ->
    TypeDefBin = hessian:encode(type_information, TypeDef),
    Response = apply(Dispatcher,[TypeDefBin]),
    case hessian:decode(Response,DecodingState) of
        ok ->
            ok;    
        Error ->
            throw({type_negotiation_error,Error})             
    end.    
        
%---------------------------------------------------------------------------
% Utility methods
%---------------------------------------------------------------------------
erlang_to_camel_case(String) when is_binary(String) ->
    AsList = binary_to_list(String),
    AsCamel = lists:foldl(fun camelize/2,[],AsList),
    list_to_binary(AsCamel);
erlang_to_camel_case(String) when is_atom(String) ->
    AsList = atom_to_list(String),
    AsCamel = lists:foldl(fun camelize/2,[],AsList),
    list_to_binary(AsCamel).    
        
camelize(Element,Acc) when Element == $_ -> [$_|Acc];
camelize(Element,[$_|Acc]) -> lists:append(Acc,[Element - 16#20]);
camelize(Element,Acc) -> lists:append(Acc,[Element]).
    

%% May want to take another look at this:
%% All of the primitive encoding functions do not return the state.
%% Maybe they should to avoid differentiations like this.
encode_accumulate(Value, {Acc, State}) ->
    case encode(Value, State) of 
        {Encoded,NewState} ->
             {<<Acc/binary,Encoded/binary>>,NewState};
        Encoded ->
            {<<Acc/binary,Encoded/binary>>,State}
    end.

is_type_def(#type_def{}) -> true;
is_type_def(_) -> false.

count_fields(#type_def{fieldnames = FieldNames}) -> length(FieldNames).