support for authentification using temporary session tokens

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
@@ -530,24 +530,28 @@ module Signing = struct
     let canonical_querystring = params in
     let payload_hash = Hash.sha256_hex "" in
     let canonical_headers =
-      "host:"
-      ^ host
-      ^ "\n"
-      ^ "x-amz-content-sha256:"
-      ^ payload_hash
-      ^ "\nx-amz-date:"
-      ^ amzdate
-      ^ "\n"
+      [ "host", host
+      ; "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 =
+      let add_header acc (name, value) = acc ^ name ^ ":" ^ value ^ "\n" in
+      List.fold_left add_header "" canonical_headers
     in
-    let signed_headers = "host;x-amz-content-sha256;x-amz-date" in
     let canonical_request =
       Request.string_of_meth meth
       ^ "\n"
       ^ canonical_uri
       ^ "\n"
       ^ canonical_querystring
       ^ "\n"
-      ^ canonical_headers
+      ^ canonical_headers_str
       ^ "\n"
       ^ signed_headers
       ^ "\n"
@@ -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

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