Make authorized Azure Blob Storage REST requests.

azure_storage.erl

%% @author toraritte
%% @doc Make authorized Azure Storage REST requests.

-module(aaa).

-export(
   [ azure_storage_request/0
   , azure_storage_request/1
   , azure_storage_request/4
   , azure_storage_request/6
   , date_rfc7231_7_1_1_1/0
   ]).

-type request_headers() :: httpc:headers().

-type string_to_sign_header_field() :: httpc:field().

start() ->
    ssl:start()
,   inets:start()
.

% A sample request: {{-
% https://docs.microsoft.com/en-us/azure/storage/common/storage-rest-api-auth#send-the-request
%
% Request:
%
% > GET /?comp=list HTTP/1.1
%
% Request Headers:
%
% > x-ms-date: Thu, 16 Nov 2017 23:34:04 GMT
% > x-ms-version: 2014-02-14
% > Authorization: SharedKey contosorest:1dVlYJWWJAOSHTCPGiwdX1rOS8B4fenYP/VrU0LfzQk=
% > Host: contosorest.blob.core.windows.net
% > Connection: Keep-Alive
%
% Where the  syntax of  the `Authorization`  header is
% the following:
% ```
% Authorization="[SharedKey|SharedKeyLite] <AccountName>:<Signature>"
% ```
% }}-
% azure_storage_request() ->
%     azure_storage_request(head)
% .

azure_storage_request(StorageAccount, Container, Blob, Method) ->
    azure_storage_request
      ( StorageAccount
      , Container
      , Blob
      , Method
      , []
      , []
      , []
      )
.

azure_storage_request(Method, Headers, HTTPOptions, Options) ->
    azure_storage_request
      ( StorageAccount
      , Container
      , Blob
      , ""
      , Method
      , Headers
      , HTTPOptions
      , Options
      )
.

-type account_name() :: string().
% See `x-ms-version` at https://docs.microsoft.com/en-us/rest/api/storageservices/get-blob#request-headers
% Be aware of this related issue: https://github.com/Azure/azure-rest-api-specs/issues/8947
-type rest_version() :: string().
-spec azure_storage_request( account_name(), string(),
azure_storage_request
( StorageAccount
, Container
, Blob
, SharedKey
, Method
, Headers
, HTTPOptions
, Options
, RESTVersion
)
->
    % TODO this should be in `init/1` in a `gen_*` behaviour
    start()

,   Url =
        lists:flatten(
          [ "https://"
          , StorageAccount
          , ".blob.core.windows.net/"
          , Container
          , "/"
          , Blob
          ])

,   NewHeaders =
        futil:pipe(
          [ Headers
          % REQUIRED HEADERS
          % The headers `x-ms-date` (or `Date`), `x-ms-version`,
          % and `Authorization` are always required (as far as I
          % can tell). See the list of REST API page:
          % https://docs.microsoft.com/en-us/rest/api/storageservices/blob-service-rest-api
          , (futil:curry(fun add_x_ms_version_header/2))(RESTVersion)
          , fun add_date_headers/1
          , fun add_authorized_header/?

,   Request =
        { Url
        , add_date_headers(Headers)
        }

,   httpc:request(Method, Request, HTTPOptions, Options)
.

-spec add_x_ms_version_header( request_headers(), rest_version() ) -> request_headers().
add_x_ms_version_header(Headers, RESTVersion) ->
    % CHECK REST VERSION SYNTAX
    % https://docs.microsoft.com/en-us/rest/api/storageservices/versioning-for-the-azure-storage-services#requests-authorized-using-azure-ad-shared-key-or-shared-key-lite
    % > The  x-ms-version  request   header  value  must  be
    % > specified in the format YYYY-MM-DD.
    % See more at "-type rest_version()".
    D = [ $\\, $d ] %> \d
,   RawRegex = [ $^, D, "{4}-", D, "{2}-", D, "{2}" ] % ^\d{4}-\d{2}-\d{2}
,   {ok, CompiledRegex} = re:compile(RawRegex).
,   {match,[{0,10}]} = re:run(RESTVersion, CompiledRegex)

,   [ { "x-ms-version", RESTVersion }
    | Headers
    ]
.

% TODO re-implement in Erlang to make this OS independent
% NOTE "In RFC 5322 3.3, GMT is referred to as `obs-zone`.
date_rfc7231_7_1_1_1() ->
    "\n0000+" ++ D = lists:reverse(os:cmd("date --utc --rfc-email"))
,   lists:reverse(D) ++ "GMT"
.

% Note on date headers {{-
% https://docs.microsoft.com/en-us/rest/api/storageservices/authorize-with-shared-key?source=docs#specifying-the-date-header
% > All authorized requests must include the Coordinated
% > Universal Time (UTC) timestamp  for the request. You
% > can specify  the timestamp either in  the `x-ms-date
% > header`,  or  in   the  standard  HTTP/HTTPS  `Date`
% > header.  If  both  headers   are  specified  on  the
% > request,  the value  of `x-ms-date`  is used  as the
% > request's time of creation.
% }}-
add_date_headers(Headers) ->
    CurrentDateTime = date_rfc7231_7_1_1_1()
,   [ { "Date",      CurrentDateTime }
    , { "x-ms-date", CurrentDateTime }
    | Headers
    ]
.

% StringToSign = VERB + "\n" +
%                Content-Encoding + "\n" +
%                Content-Language + "\n" +
%                Content-Length + "\n" +
%                Content-MD5 + "\n" +
%                Content-Type + "\n" +
%                Date + "\n" +
%                If-Modified-Since + "\n" +
%                If-Match + "\n" +
%                If-None-Match + "\n" +
%                If-Unmodified-Since + "\n" +
%                Range + "\n" +
%                CanonicalizedHeaders +
% /*HTTP Verb*/                               GET\n
% /*Content-Encoding*/                        \n
% /*Content-Language*/                        \n
% /*Content-Length (empty string when zero)*/ \n
% /*Content-MD5*/                             \n
% /*Content-Type*/                            \n
% /*Date*/                                    \n
% /*If-Modified-Since */                      \n
% /*If-Match*/                                \n
% /*If-None-Match*/                           \n
% /*If-Unmodified-Since*/                     \n
% /*Range*/                                   \n
% /*CanonicalizedHeaders*/                    x-ms-date:Fri, 26 Jun 2015 23:39:12 GMT\nx-ms-version:2015-02-21\n
% /*CanonicalizedResource*/                   /myaccount /mycontainer\ncomp:metadata\nrestype:container\ntimeout:20
make_azure_authorization_signature(SharedKey, StorageAccount, Method, Headers) ->

    Verb =
        string:to_upper(atom_to_list(Method))

,   StringToSignExceptCanonicalized =
           Verb ++ "\n"
        ++ compute_headers_in_string_to_sign(Headers)
,
.

-spec compute_headers_in_string_to_sign( request_headers() ).
compute_headers_in_string_to_sign(RequestHeaders) ->

    HeadersInStringToSign =
        [ "Content-Encoding"
        , "Content-Language"
        , "Content-Length"
        , "Content-MD5"
        , "Content-Type"
        , "Date"
        , "If-Modified-Since"
        , "If-Match"
        , "If-None-Match"
        , "If-Unmodified-Since"
        , "Range"
        ]

,   lists:foldl
      ( (futil:curry(fun process_header/3))(RequestHeaders)
      , HeadersInStringToSign
      )
.

-type acc() :: string()
-spec process_header
      ( request_headers()
      , string_to_sign_header_field()
      , acc()
      )
      -> acc()
.
process_header(RequestHeaders, StringToSignHeaderName, Acc) ->

    RequestHeaderValue =
        proplists:get_value(StringToSignHeaderName, RequestHeaders)

,   do_process_header
      ( RequestHeaders
      , StringToSignHeaderName
      , RequestHeaderValue
      , Acc
      )
.

-type request_header_value() :: httpc:value().
-spec do_process_header
      ( request_headers()
      , string_to_sign_header_field()
      , request_header_value()
      , acc()
      )
      -> request_header_value()
.
% do_process_header - "Content-Length" {{-

% https://docs.microsoft.com/en-us/rest/api/storageservices/authorize-with-shared-key?source=docs
% > In  the current  version,  the Content-Length  field
% > must be an empty string if the content length of the
% > request is zero. In  version 2014-02-14 and earlier,
% > the content  length was  included even if  zero. See
% > below for more information on the old behavior.
do_process_header(RequestHeaders, "Content-Length", undefined, Acc) ->
    do_process_header(RequestHeaders, "Date", "", Acc)
;
do_process_header(_RequestHeaders, "Content-Length", "0", Acc) ->
    do_process_header(RequestHeaders, "Date", "", Acc)
;
% "Content-Length"'s any other value will be caught in
% the general clause.

% }}-
% do_process_header - "Date" and "x-ms-date" {{-
% https://docs.microsoft.com/en-us/rest/api/storageservices/authorize-with-shared-key?source=docs#specifying-the-date-header
% > If you  set x-ms-date (which we  did), construct the
% > signature with an empty value for the Date header.
do_process_header(RequestHeaders, "Date", DateDate, Acc) ->
    % RequestDate =
    %     case
    %         { proplists:get_value("x-ms-date", RequestHeaders)
    %         , DateDate
    %         }
    %     of
    %         { undefined, undefined } ->
    %             erlang:error(no_date_header_present)
    %     ;   { undefined, Date } ->
    %             Date
    %     ;   { XMSDate, _Date } ->
    %             XMSDate
    %     end
,   return_string_to_sign_line(Acc, "")
;

% }}-
% do_process_header - general catch-all clause {{-
do_process_header
( _RequestHeaders
, _StringToSignHeaderName
, RequestHeaderValue
, Acc
)
->
    return_string_to_sign_line(Acc, RequestHeaderValue)
.
% }}-

-spec return_string_to_sign_line( acc(), request_header_value() ).
return_string_to_sign_line(Acc, RequestHeaderValue) ->
    Acc ++ RequestHeaderValue ++ "\n"
.

canonicalized_headers(Headers) ->
    % https://docs.microsoft.com/en-us/rest/api/storageservices/authorize-with-shared-key
    MassagedHeaders =
        % 1. Retrieve all headers for the resource that
        %    begin with x-ms-,  including the x-ms-date
        %    header.
        lists:filtermap
          ( fun({ Key, Value }) ->
              % 2. Convert each HTTP header name to lowercase.
              case string:to_lower(Key) of
                  "x-ms-" ++ _ = XMSHeader ->
                      { true
                      % 5. Trim  any whitespace  around the  colon in
                      %    the header.
                      % 6. Append  a   new-line  character   to  each
                      %    canonicalized  header   in  the  resulting
                      %    list.
                      , [ XMSHeader, $:, Value, $\n ]
                      % , { XMSHeader, Value}
                      }
              ;   _Other ->
                      false
              end
          , Headers
          )
% 3. Sort  the   headers  lexicographically  by
%    header  name,  in  ascending  order.  Each
%    header may appear only once in the string.
,   lists:usort
      ( fun( { Header_1, _ }, { Header_2, _ } ) ->
            Header_1 =< Header_2
        end
      , FilteredLoweredHeaders
      )
.

% 45> Quotes = [$[, $", $', $]].
% "[\"']"
% 46> f(R), {ok, R} = re:compile([$(, Quotes, ".*", Quotes, $)]).
% {ok,{re_pattern,1,0,0,
%                 <<69,82,67,80,147,0,0,0,0,0,0,0,1,0,0,0,255,255,255,255,
%                   255,255,...>>}}
% 47> re:split("l\"of\"a", R).
% [<<"l">>,<<"\"of\"">>,<<"a">>]
% 48> re:split("l'of'a", R).
% [<<"l">>,<<"'of'">>,<<"a">>]
% 49> re:split("l'of'aand another 'quote'", R).
% [<<"l">>,<<"'of'aand another 'quote'">>,<<>>]
% 50> re:split("'lofa'", R).
% [<<>>,<<"'lofa'">>,<<>>]
% 51> re:split("'lofa'", Quotes).
% [<<>>,<<"lofa">>,<<>>]
% 52> lists:flatten(Quotes).
% "[\"']"
% 53> lists:flatten([$', $"]).
% "'\""

% vim: set fdm=marker:
% vim: set foldmarker={{-,}}-:
% vim: set nowrap:

futil.erl

-module(futil).

-export(
    [
    % Functional helpers
      pipe/1
    , composeFlipped/1
    , cflip/1
    , curry/1
    , flip/3

    % General helpers
    , stitch/1
    , stringify/1
    , sanitize_string/1
    ]).

% FUNCTIONAL HELPERS ================================================== {{-
% Recursive left-to-right composition instead of a traditional one instead of (b -> c) -> (a -> b) -> (a -> c), it is (a -> b) -> (b -> c) -> ... -> (x -> y) -> (y -> z)
% See PureScript's Control.Semigroupoid.composeFlipped (>>>) or Haskell's Control.Arrow.>>>
composeFlipped([G|[]]) -> % {{-
    G;
composeFlipped([F,G|Rest]) ->
    Composition =
        fun(X) ->
            G(F(X))
        end,
    composeFlipped([Composition|Rest]).
% }}-

pipe([Arg|Functions]) ->
    (composeFlipped(Functions))(Arg).

flip(F, A, B) ->
    F(B,A).

% [ ((curry(fun flip/3))(fun string:join/2))("")
% (a -> b -> c) -> b -> a -> c
cflip(Arg) ->
    (curry(fun flip/3))(Arg).

curry(AnonymousFun) -> % {{-
    {arity, Arity} =
        erlang:fun_info(AnonymousFun, arity),

    do_curry(AnonymousFun, Arity, [[], [], []]).

%% `curry/1` internals {{-
do_curry(Fun, 0, [_Fronts, _Middle, _Ends] = X) ->
    [F, M, E] =
        lists:map(fun(L) -> string:join(L, "") end, X),
    Fstring =
        F ++ "Run(" ++ string:trim(M, trailing, ",") ++ ")" ++ E,

    {ok, Tokens, _} =
        erl_scan:string(Fstring ++ "."),
    {ok, Parsed} =
        erl_parse:parse_exprs(Tokens),

    FunBinding =
        erl_eval:add_binding(
          'Run',
          Fun,
          erl_eval:new_bindings()
        ),
    {value ,CurriedFun, _} =
        erl_eval:exprs(Parsed, FunBinding),

    CurriedFun;

do_curry(Fun, Arity, [Fronts, Middle, Ends]) ->
    VarName = [64 + Arity],
    NewFronts = ["fun(" ++ VarName ++ ") -> " | Fronts] ,
    NewMiddle = [VarName ++ ","|Middle],
    NewEnds = [" end"|Ends],
    do_curry(Fun, Arity-1, [NewFronts, NewMiddle, NewEnds]).
%    }}-
%   }}-

% }}-
% GENERERAL HELPERS =================================================== {{-

% Same as `lists:flatten(lists:join(" ", UtteranceList))`.
stitch([Utterance]) ->
    Utterance;
stitch([Utterance|Rest]) ->
    Utterance ++ " " ++ stitch(Rest).

stringify(Term) ->
    R = io_lib:format("~p",[Term]),
    lists:flatten(R).

sanitize_string(String) ->
    lists:filter
        ( fun
            (Char) when Char >= 65, Char =< 90
                      ; Char >= 97, Char =< 122
                      ; Char >= 48, Char =< 57
                -> true;
            (_) -> false
          end
        , String
        ).

% }}-

% vim: set fdm=marker:
% vim: set foldmarker={{-,}}-:
% vim: set nowrap: