m_http

%%
%%   Copyright (c) 2016, Dmitry Kolesnikov
%%   Copyright (c) 2016, Mario Cardona
%%   All Rights Reserved.
%%
%%   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(m_http).
-compile({parse_transform, category}).
-include_lib("datum/include/datum.hrl").

%%
%%
-export([start/0]).
-export([unit/1, fail/1, '>>='/2, putT/1, getT/1]).
-export([new/1, so/1, method/1, header/2, payload/1, request/1, request/0]).
-export([once/1, once/2]).

%%
%%
-type m(A)    :: fun((_) -> [A|_]).
-type f(A, B) :: fun((A) -> m(B)).

-record('GET',    {uri, headers = []}).

%%
%% @doc starts application and its deps, use command in shell for RnD purpose 
-spec start() -> datum:either(_).

start() ->
   application:ensure_all_started(?MODULE).


%%%----------------------------------------------------------------------------   
%%%
%%% http monad
%%%
%%%----------------------------------------------------------------------------

%%
%%
-spec unit(A) -> m(A).

unit(X) ->
   m_state:unit(X).

%%
%%
-spec fail(_) -> _.

fail(X) ->
   m_state:fail(X).

%%
%%
-spec '>>='(m(A), f(A, B)) -> m(B).

'>>='(X, Fun) ->
   m_state:'>>='(X, Fun).

%%
%% @doc 
-spec putT(_) -> m(_).

putT({Mthd, Url}) when is_atom(Mthd) ->
   [m_state || new(Url), method(Mthd)];

putT(Expr) when is_list(Expr) ->
   case parse_either_request_or_header(Expr) of
      {request, Mthd, Url} ->
         putT({typecast:atom(Mthd), Url});
      {header, Head, Value} ->
         header(typecast:s(Head), hv(typecast:s(Value)));
      {payload, Value} ->
         payload(Value)
   end;

putT(X) ->
   payload(X).

%%
%% @doc
-spec getT(_) -> m(_).

getT(Code) when is_integer(Code) ->
   [m_state ||
      request(),
      require(code, Code)
   ];

getT(Head)
 when is_list(Head) ->
   [H, V] = binary:split(typecast:s(Head), <<$:>>),
   case hv(V) of
      <<$_>> ->
         require(header, lens:pair(H));
      Value  ->
         require(header, lens:c(lens:pair(H), lens:require(Value)))
   end;

getT('*') ->
   require(content, lens:id());

getT(ADT)
 when is_tuple(ADT) ->
   require(content, lens:p(ADT));

getT(Lens)
 when is_function(Lens) ->
   require(content, Lens).

%%
%% @doc evaluate monadic expression
-spec once(m(_)) -> _.

once(Expr) ->
   once(Expr, #{so => []}).

once(Expr, SOpt) ->
   try
      [Result | _] = Expr(SOpt),
      {ok, Result}
   catch throw:Reason ->
      {error, Reason}
   end.

%%%----------------------------------------------------------------------------   
%%%
%%% helper methods
%%%
%%%----------------------------------------------------------------------------

%%
%%
-spec parse_either_request_or_header(string()) -> 
   {request, string(), string()} | {header, string(), string()} | {payload, string()}.

parse_either_request_or_header([H | _] = Expr)
 when is_integer(H) ->
   parse_either_request_or_header(Expr, []);
parse_either_request_or_header(Expr) ->
   {payload, Expr}.

parse_either_request_or_header([$  | Tail], Acc) ->
   {request, lists:reverse(Acc), Tail};
parse_either_request_or_header([$: | Tail], Acc) ->
   {header, lists:reverse(Acc), Tail};
parse_either_request_or_header([Head | Tail], Acc) ->
   parse_either_request_or_header(Tail, [Head | Acc]).


%%
%% lenses to http context
l_req_url() ->
   lens:c(lens:at(req), lens:hd(), lens:ti(#'GET'.uri)).

l_req_method() ->
   lens:c(lens:at(req), lens:hd(), lens:t1()).

l_req_headers() ->
   lens:c(lens:at(req), lens:hd(), lens:ti(#'GET'.headers)).

l_req_header(Head) ->
   lens:c(lens:at(req), lens:hd(), lens:ti(#'GET'.headers), lens:pair(Head, ?None)).

l_req_payload() ->
   lens:c(lens:at(req), lens:tl()).




%%
%% create a context for http request
-spec new(_) -> m(_).

new(Url) ->
   fun(State) ->
      Request = #'GET'{
         uri     = url_string(Url),
         headers = [
            {<<"Connection">>, <<"keep-alive">>},
            {<<"Accept">>,     <<"*/*">>}
         ]
      },
      [Url | State#{req => [Request]}]
   end.

url_string({uri, _, _} = Url) -> uri:s(Url);
url_string(Url) -> Url. 

%% 
%% set socket options
-spec so(_) -> m(_).

so(SOpts) ->
   m_state:put(lens:at(so), SOpts).

%%
%% set method of http request
-spec method(_) -> m(_).

method(Mthd) ->
   m_state:put(l_req_method(), Mthd).


%%
%% add header to http request
-spec header(_, _) -> m(_).

header(Head, Value)
 when is_list(Value) ->
   m_state:put(l_req_header(typecast:s(Head)), typecast:s(Value));

header(Head, Value) ->
   m_state:put(l_req_header(typecast:s(Head)), Value).

hv(<<$\s, X/binary>>) -> hv(X);
hv(<<$\t, X/binary>>) -> hv(X);
hv(<<$\n, X/binary>>) -> hv(X);
hv(<<$\r, X/binary>>) -> hv(X);
hv(X) -> m_http_codec:typecast(X).


%%
%% encode and add payload to http request
-spec payload(_) -> m(_).

payload(Value) ->
   fun(State0) ->
      case
         m_http_codec:encode(
            lens:get(l_req_header(<<"Content-Type">>), State0),
            Value
         )
      of
         {ok, Payload} ->
            Length = erlang:iolist_size(Payload),
            State1 = lens:put(l_req_payload(), Payload, State0),
            State2 = lens:put(l_req_header(<<"Content-Length">>), Length, State1),
            [Payload | State2];
         {error, Reason} ->
            fail(Reason)
      end
   end.

%%
%% evaluate http request
-spec request() -> m(_).
-spec request(timeout()) -> m(_).

request() ->
   request(60000).

request(_Timeout) ->
   fun(#{so := SOpts} = State) ->
      case 
         hackney:request(
            lens:get(l_req_method(), State),
            lens:get(l_req_url(), State),
            lens:get(l_req_headers(), State),
            lens:get(l_req_payload(), State),
            [{pool, m_http_pool} | SOpts]
         )
      of
         {ok, Code, Head, Stream} ->
            stream(Stream, [{Code, typecast:s(Code), Head}], State);
         {error, Reason} ->
            fail(Reason)
      end
   end.

stream(Stream, Acc, State) ->
   case hackney:stream_body(Stream) of
      {ok, Data} ->
         stream(Stream, [Data | Acc], State);
      done ->
         case 
            m_http_codec:decode(
               [lens:get(l_req_header(<<"Accept">>), State) | lists:reverse(Acc)]
            )
         of
            {ok, Http} ->
               [Http | State#{ret => Http}];
            {error, Reason} ->
               fail(Reason)
         end;
      {error, Reason} ->
         fail(Reason)
   end.

%%
%%
-spec require(lens:lens()) -> m(_).
-spec require(atom(), lens:lens()) -> m(_).

require(Lens) ->
   fun(State) ->
      case lens:get(lens:c(lens:at(ret, #{}), Lens), State) of
         {ok, Expect} ->
            [Expect | State];
         {error, Reason} ->
            throw(Reason);
         LensFocusedAt ->
            [LensFocusedAt | State]
      end
   end.

require(code, Code) ->
   require( lens:c(lens:hd(), lens:t1(), lens:require(Code)) );

require(header, Lens) ->
   require( lens:c(lens:hd(), lens:t3(), Lens) );

require(content, Lens) ->
   require( lens:c(lens:tl(), lens:hd(), Lens) ).