support for authentification using temporary session tokens

according to https://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html

async/runtime.ml

@@ -44,6 +44,7 @@ let run_request
     ~region
     ~access_key
     ~secret_key
+    ?session_token
     (module M : Aws.Call
       with type input = input
        and type output = output
@@ -55,13 +56,15 @@ let run_request
        Aws.Signing.sign_request
          ~access_key
          ~secret_key
+         ?session_token
          ~service:M.service
          ~region
          (M.to_http M.service region inp)
     | V2 ->
        Aws.Signing.sign_v2_request
          ~access_key
          ~secret_key
+         ?session_token
          ~service:M.service
          ~region
          (M.to_http M.service region inp)

async/runtime.mli

@@ -35,6 +35,7 @@ val run_request :
      region:string
   -> access_key:string
   -> secret_key:string
+  -> ?session_token:string
   -> ('input, 'output, 'error) Aws.call
   -> 'input
   -> [ `Ok of 'output | `Error of 'error Aws.Error.t ] Async.Deferred.t

lib/aws.ml

@@ -516,7 +516,7 @@ module Signing = struct
   (* NOTE(dbp 2015-01-13): This is a direct translation of reference implementation at:
    * http://docs.aws.amazon.com/general/latest/gr/sigv4-signed-request-examples.html
    *)
-  let sign_request ~access_key ~secret_key ~service ~region (meth, uri, headers) =
+  let sign_request ~access_key ~secret_key ?session_token ~service ~region (meth, uri, headers) =
     let host = Util.of_option_exn (Endpoints.endpoint_of service region) in
     let params = encode_query (Uri.query uri) in
     let sign key msg = Hash.sha256 ~key msg in
@@ -534,6 +534,10 @@ module Signing = struct
       ; "x-amz-content-sha256", payload_hash
       ; "x-amz-date", amzdate
       ]
+      @
+      match session_token with
+      | None -> []
+      | Some token -> ["x-amz-security-token", token]
     in
     let signed_headers = String.concat ";" (List.map fst canonical_headers) in
     let canonical_headers_str =
@@ -586,23 +590,25 @@ module Signing = struct
         ]
     in
     let headers =
-      ("x-amz-date", amzdate)
-      :: ("x-amz-content-sha256", payload_hash)
-      :: ("Authorization", authorization_header)
-      :: headers
+      canonical_headers
+      @ ["Authorization", authorization_header]
+      @ headers
     in
     meth, uri, headers
 
-  let sign_v2_request ~access_key ~secret_key ~service ~region (meth, uri, headers) =
+  let sign_v2_request ~access_key ~secret_key ?session_token ~service ~region (meth, uri, headers) =
     let host = Util.of_option_exn (Endpoints.endpoint_of service region) in
     let amzdate = Time.date_time_iso8601 (Time.now_utc ()) in
 
-    let query = Uri.add_query_params' uri
-                  [ "Timestamp", amzdate
+    let query =
+      let params = [ "Timestamp", amzdate
                   ; "AWSAccessKeyId", access_key
                   ; "SignatureMethod", "HmacSHA256"
                   ; "SignatureVersion", "2"
-                  ] in
+                  ]
+                  @ match session_token with None -> [] | Some t -> ["SecurityToken", t]
+      in Uri.add_query_params' uri params
+    in
 
     let params = encode_query (Uri.query query) in
     let canonical_uri = "/" in

lib/aws.mli

@@ -301,6 +301,7 @@ module Signing : sig
   val sign_request :
        access_key:string
     -> secret_key:string
+    -> ?session_token:string
     -> service:string
     -> region:string
     -> Request.t
@@ -322,6 +323,7 @@ module Signing : sig
   val sign_v2_request :
     access_key:string
     -> secret_key:string
+    -> ?session_token:string
     -> service:string
     -> region:string
     -> Request.t

libraries/s3/lib_test/test_async.ml

@@ -0,0 +1,14 @@
+open Aws_s3_test
+
+module T = TestSuite (struct
+  type 'a m = 'a Async.Deferred.t
+
+  let access_key = Unix.getenv "AWS_ACCESS_KEY"
+
+  let secret_key = Unix.getenv "AWS_SECRET_KEY"
+
+  let run_request ~region call input =
+    Aws_async.Runtime.run_request ~region ~access_key ~secret_key call input
+
+  let un_m v = Async.Thread_safe.block_on_async_exn (fun () -> v)
+end)

libraries/s3/lib_test/test_lwt.ml

@@ -0,0 +1,14 @@
+open Aws_s3_test
+
+module T = TestSuite (struct
+  type 'a m = 'a Lwt.t
+
+  let access_key = Unix.getenv "AWS_ACCESS_KEY"
+
+  let secret_key = Unix.getenv "AWS_SECRET_KEY"
+
+  let run_request ~region call input =
+    Aws_lwt.Runtime.run_request ~region ~access_key ~secret_key call input
+
+  let un_m = Lwt_main.run
+end)

lwt/runtime.ml

@@ -38,6 +38,7 @@ let run_request
     ~region
     ~access_key
     ~secret_key
+    ?session_token
     (module M : Aws.Call
       with type input = input
        and type output = output
@@ -49,13 +50,15 @@ let run_request
        Aws.Signing.sign_request
           ~access_key
           ~secret_key
+          ?session_token
           ~service:M.service
           ~region
           (M.to_http M.service region inp)
     | V2 ->
        Aws.Signing.sign_v2_request
           ~access_key
           ~secret_key
+          ?session_token
           ~service:M.service
           ~region
           (M.to_http M.service region inp)

lwt/runtime.mli

@@ -37,6 +37,7 @@ val run_request :
      region:string
   -> access_key:string
   -> secret_key:string
+  -> ?session_token:string
   -> ('input, 'output, 'error) Aws.call
   -> 'input
   -> [ `Ok of 'output | `Error of 'error Aws.Error.t ] Lwt.t