1 ;;; guile-aws --- Scheme DSL for the AWS APIs
2 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
4 ;;; Guile-AWS is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published
6 ;;; by the Free Software Foundation, either version 3 of the License,
7 ;;; or (at your option) any later version.
9 ;;; Guile-AWS is distributed in the hope that it will be useful, but
10 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;; General Public License for more details.
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program. If not, see
16 ;;; <http://www.gnu.org/licenses/>.
18 (define-module (aws request
)
19 #:use-module
(aws base
)
20 #:use-module
(ice-9 match
)
21 #:use-module
(ice-9 format
)
22 #:use-module
(srfi srfi-1
)
23 #:use-module
(srfi srfi-19
)
24 #:use-module
(srfi srfi-26
)
25 #:use-module
(gcrypt hash
)
26 #:use-module
(gcrypt hmac
)
27 #:use-module
(rnrs bytevectors
)
28 #:use-module
(web client
)
29 #:use-module
((web http
) #:select
(header-writer))
30 #:use-module
(sxml simple
)
31 #:export
(make-operation->request serialize-aws-value
))
35 ;;; See: http://docs.aws.amazon.com/general/latest/gr/sigv4_signing.html
36 ;;; Make a POST request and pass request parameters in the body of the
37 ;;; request. Auth information is provided in an Authorization header.
41 (define algorithm
"AWS4-HMAC-SHA256")
43 (define (sign key msg
)
44 "Sign the string MSG with the secret key KEY (a bytevector) using the SHA256 algorithm."
45 (sign-data key
(string->utf8 msg
) #:algorithm
'sha256
))
48 (format #f
"~{~2,'0x~}" (bytevector->u8-list bv
)))
51 ;; See https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Query-Requests.html
52 (define* (serialize-aws-value thing
#:key
(path '()) n
(depth 0))
53 (define top?
(zero? depth
))
55 ((aws-structure? thing
)
56 (filter-map (lambda (member)
57 (match (aws-member-value member
)
60 (serialize-aws-value value
63 (list (or (aws-member-location-name member
)
64 (aws-member-name member
)))
65 (cons* (or (aws-member-location-name member
)
66 (aws-member-name member
))
68 (aws-structure-aws-name thing
)
72 (aws-structure-members thing
)))
75 ((aws-shape-primitive? thing
)
76 (serialize-aws-value (aws-shape-value thing
)
80 (serialize-aws-value (aws-shape-value thing
)
82 (cons (or (aws-shape-location-name thing
)
83 (aws-shape-aws-name thing
)) path
)
84 #:depth
(1+ depth
)))))
86 (serialize-aws-value (or (and thing
"true") "false")
90 (append-map (lambda (item n
)
91 (serialize-aws-value item
96 (iota (length thing
) 1)))
97 (else (format #f
"~a=~a"
98 (string-join (map (cut format
#f
"~a" <>)
99 (reverse (filter identity path
)))
103 (define* (make-operation->request api-metadata
)
104 "Return a procedure that accepts an operation and returns an HTTP request."
105 (define endpoint-prefix
106 (assoc-ref api-metadata
'endpointPrefix
))
107 (define service-name endpoint-prefix
)
109 (assoc-ref api-metadata
'apiVersion
))
111 (lambda* (#:key http operation-name input
)
113 (or (getenv "AWS_DEFAULT_REGION")
116 (or (getenv "AWS_ACCESS_KEY_ID")
117 (error "No access key available. Set the AWS_ACCESS_KEY_ID environment variable.")))
119 (or (getenv "AWS_SECRET_ACCESS_KEY")
120 (error "No secret access key available. Set the AWS_SECRET_ACCESS_KEY environment variable.")))
122 (assoc-ref http
"method"))
124 (string-join (list endpoint-prefix
129 (string-append "https://" host
"/"))
131 '(application/x-www-form-urlencoded
(charset .
"utf-8")))
133 ;; DynamoDB needs this, others don't.
134 (define amz-target
(and=> (assoc-ref api-metadata
'targetPrefix
)
135 (cut string-append
<> "."
138 ;; TODO: some APIs use JSON, others (like EC2) use plain query strings.
139 (define request-parameters
140 (string-join (cons* (format #f
"Action=~a" operation-name
)
141 (format #f
"Version=~a" api-version
)
142 (serialize-aws-value input
))
145 (define now
(current-date 0))
147 (date->string now
"~Y~m~dT~H~M~SZ"))
149 (date->string now
"~Y~m~d"))
152 ;; https://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html
154 ;; TODO: Create canonical URI--the part of the URI from domain to query
155 ;; string (use '/' if no path)
156 (define canonical-uri
"/")
159 (filter cdr
`((content-type .
,content-type
)
160 (host .
(,host .
#f
))
161 (x-amz-date .
,amz-date
)
162 (x-amz-target .
,amz-target
))))
163 (define authorization-header
164 (let* ((canonical-headers
165 ;; Header names must be trimmed, lower-case, sorted in
166 ;; code point order from low to high! Note: there must
167 ;; be a trailing newline character.
168 (string-join (map (match-lambda
170 (string-append (symbol->string key
) ":"
171 (with-output-to-string
173 ((header-writer key
) value
(current-output-port)))))))
177 ;; This lists the headers in the canonical-headers list,
178 ;; delimited with ";" and in alpha order. The request
179 ;; can include any headers; canonical-headers and
180 ;; signed-headers include those that you want to be
181 ;; included in the hash of the request. "Host" and
182 ;; "x-amz-date" are always required.
183 (string-join (map (compose symbol-
>string first
) headers
) ";"))
184 ;; The query string is blank because parameters are passed
185 ;; in the body of the request.
186 (canonical-querystring "")
188 (string-join (list method
190 canonical-querystring
194 (hexify (sha256 (string->utf8 request-parameters
))))
197 (string-join (list date-stamp
200 "aws4_request") "/"))
202 (string-join (list algorithm
205 (hexify (sha256 (string->utf8 canonical-request
))))
208 (let* ((kdate (sign (string->utf8
(string-append "AWS4" secret-key
)) date-stamp
))
209 (kregion (sign kdate region
))
210 (kservice (sign kregion service-name
))
211 (signing-key (sign kservice
"aws4_request")))
212 (hexify (sign signing-key string-to-sign
)))))
213 `(,(string->symbol algorithm
)
214 (Credential .
,(string-append access-key
"/" credential-scope
))
215 (SignedHeaders .
,signed-headers
)
216 (Signature .
,signature
))))
218 ;; For DynamoDB, the request can include any headers, but MUST
219 ;; include "host", "x-amz-date", "x-amz-target", "content-type",
220 ;; and "Authorization". Except for the authorization header, the
221 ;; headers must be included in the canonical-headers and
222 ;; signed-headers values, as noted earlier. Order here is not
225 (cons `(Authorization .
,authorization-header
)
226 (filter cdr headers
)))
231 ;#:method (string->symbol method)
232 #:body
(string->utf8 request-parameters
)
233 #:headers new-headers
))
234 (lambda (response body
)
235 (xml->sxml
(match body
238 ((? string? s
) s
)))))))