[RFD] adding DynamoDB

Makefile

@@ -33,6 +33,7 @@ LIBRARIES := \
 	aws-cloudformation \
 	aws-cloudtrail \
 	aws-cloudwatch \
+	aws-dynamodb \
 	aws-elasticache \
 	aws-elasticloadbalancing \
 	aws-rds \

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

aws-dynamodb.opam

@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "Tim McGilchrist <[email protected]>"
+authors: [ "Jan Rochel <[email protected]>" ]
+synopsis: "Amazon Web Services SDK bindings to Amazon DynamoDB"
+description: "Amazon Web Services SDK bindings to Amazon DynamoDB"
+version: "1.2"
+license: "BSD-3-clause"
+homepage: "https://github.com/inhabitedtype/ocaml-aws"
+dev-repo: "git+https://github.com/inhabitedtype/ocaml-aws.git"
+bug-reports: "https://github.com/inhabitedtype/ocaml-aws/issues"
+doc: "https://github.com/inhabitedtype/ocaml-aws"
+build: [
+  ["dune" "subst"] {pinned}
+  ["dune" "build" "-p" name "-j" jobs]
+]
+depends: [
+  "ocaml" {>= "4.08"}
+  "aws" {= version}
+  "dune" {>= "2.7"}
+  "ounit" {>= "2.2.4" & with-test}
+]

input/dynamodb/latest

@@ -0,0 +1 @@
+2012-08-10/

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

libraries/dynamodb/lib/batchGetItem.ml

@@ -0,0 +1,58 @@
+open Types
+open Aws
+type input = BatchGetItemInput.t
+type output = BatchGetItemOutput.t
+type error = Errors_internal.t
+let service = "dynamodb"
+let signature_version = Request.V4
+let to_http service region req =
+  let uri =
+    Uri.add_query_params
+      (Uri.of_string
+         (Aws.Util.of_option_exn (Endpoints.url_of service region)))
+      (List.append
+         [("Version", ["2012-08-10"]); ("Action", ["BatchGetItem"])]
+         (Util.drop_empty
+            (Uri.query_of_encoded
+               (Query.render (BatchGetItemInput.to_query req))))) in
+  (`POST, uri, [])
+let of_http body =
+  try
+    let xml = Ezxmlm.from_string body in
+    let resp = Xml.member "BatchGetItemResponse" (snd xml) in
+    try
+      Util.or_error (Util.option_bind resp BatchGetItemOutput.parse)
+        (let open Error in
+           BadResponse
+             {
+               body;
+               message = "Could not find well formed BatchGetItemOutput."
+             })
+    with
+    | Xml.RequiredFieldMissing msg ->
+        let open Error in
+          `Error
+            (BadResponse
+               {
+                 body;
+                 message =
+                   ("Error parsing BatchGetItemOutput - missing field in body or children: "
+                      ^ msg)
+               })
+  with
+  | Failure msg ->
+      `Error
+        (let open Error in
+           BadResponse { body; message = ("Error parsing xml: " ^ msg) })
+let parse_error code err =
+  let errors = [] @ Errors_internal.common in
+  match Errors_internal.of_string err with
+  | Some var ->
+      if
+        (List.mem var errors) &&
+          ((match Errors_internal.to_http_code var with
+            | Some var -> var = code
+            | None -> true))
+      then Some var
+      else None
+  | None -> None

libraries/dynamodb/lib/batchGetItem.mli

@@ -0,0 +1,7 @@
+open Types
+type input = BatchGetItemInput.t
+type output = BatchGetItemOutput.t
+type error = Errors_internal.t
+include
+  Aws.Call with type  input :=  input and type  output :=  output and type
+     error :=  error

libraries/dynamodb/lib/batchWriteItem.ml

@@ -0,0 +1,58 @@
+open Types
+open Aws
+type input = BatchWriteItemInput.t
+type output = BatchWriteItemOutput.t
+type error = Errors_internal.t
+let service = "dynamodb"
+let signature_version = Request.V4
+let to_http service region req =
+  let uri =
+    Uri.add_query_params
+      (Uri.of_string
+         (Aws.Util.of_option_exn (Endpoints.url_of service region)))
+      (List.append
+         [("Version", ["2012-08-10"]); ("Action", ["BatchWriteItem"])]
+         (Util.drop_empty
+            (Uri.query_of_encoded
+               (Query.render (BatchWriteItemInput.to_query req))))) in
+  (`POST, uri, [])
+let of_http body =
+  try
+    let xml = Ezxmlm.from_string body in
+    let resp = Xml.member "BatchWriteItemResponse" (snd xml) in
+    try
+      Util.or_error (Util.option_bind resp BatchWriteItemOutput.parse)
+        (let open Error in
+           BadResponse
+             {
+               body;
+               message = "Could not find well formed BatchWriteItemOutput."
+             })
+    with
+    | Xml.RequiredFieldMissing msg ->
+        let open Error in
+          `Error
+            (BadResponse
+               {
+                 body;
+                 message =
+                   ("Error parsing BatchWriteItemOutput - missing field in body or children: "
+                      ^ msg)
+               })
+  with
+  | Failure msg ->
+      `Error
+        (let open Error in
+           BadResponse { body; message = ("Error parsing xml: " ^ msg) })
+let parse_error code err =
+  let errors = [] @ Errors_internal.common in
+  match Errors_internal.of_string err with
+  | Some var ->
+      if
+        (List.mem var errors) &&
+          ((match Errors_internal.to_http_code var with
+            | Some var -> var = code
+            | None -> true))
+      then Some var
+      else None
+  | None -> None

libraries/dynamodb/lib/batchWriteItem.mli

@@ -0,0 +1,7 @@
+open Types
+type input = BatchWriteItemInput.t
+type output = BatchWriteItemOutput.t
+type error = Errors_internal.t
+include
+  Aws.Call with type  input :=  input and type  output :=  output and type
+     error :=  error

libraries/dynamodb/lib/createTable.ml

@@ -0,0 +1,57 @@
+open Types
+open Aws
+type input = CreateTableInput.t
+type output = CreateTableOutput.t
+type error = Errors_internal.t
+let service = "dynamodb"
+let signature_version = Request.V4
+let to_http service region req =
+  let uri =
+    Uri.add_query_params
+      (Uri.of_string
+         (Aws.Util.of_option_exn (Endpoints.url_of service region)))
+      (List.append [("Version", ["2012-08-10"]); ("Action", ["CreateTable"])]
+         (Util.drop_empty
+            (Uri.query_of_encoded
+               (Query.render (CreateTableInput.to_query req))))) in
+  (`POST, uri, [])
+let of_http body =
+  try
+    let xml = Ezxmlm.from_string body in
+    let resp = Xml.member "CreateTableResponse" (snd xml) in
+    try
+      Util.or_error (Util.option_bind resp CreateTableOutput.parse)
+        (let open Error in
+           BadResponse
+             {
+               body;
+               message = "Could not find well formed CreateTableOutput."
+             })
+    with
+    | Xml.RequiredFieldMissing msg ->
+        let open Error in
+          `Error
+            (BadResponse
+               {
+                 body;
+                 message =
+                   ("Error parsing CreateTableOutput - missing field in body or children: "
+                      ^ msg)
+               })
+  with
+  | Failure msg ->
+      `Error
+        (let open Error in
+           BadResponse { body; message = ("Error parsing xml: " ^ msg) })
+let parse_error code err =
+  let errors = [] @ Errors_internal.common in
+  match Errors_internal.of_string err with
+  | Some var ->
+      if
+        (List.mem var errors) &&
+          ((match Errors_internal.to_http_code var with
+            | Some var -> var = code
+            | None -> true))
+      then Some var
+      else None
+  | None -> None

libraries/dynamodb/lib/createTable.mli

@@ -0,0 +1,7 @@
+open Types
+type input = CreateTableInput.t
+type output = CreateTableOutput.t
+type error = Errors_internal.t
+include
+  Aws.Call with type  input :=  input and type  output :=  output and type
+     error :=  error