aws-sdk-lisp/api.lisp at master · pokepay/aws-sdk-lisp · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
(defpackage #:aws-sdk/api
  (:use #:cl)
  (:import-from #:aws-sdk/session
                #:*session*
                #:session-credentials
                #:session-region)
  (:import-from #:aws-sdk/credentials
                #:credentials-keys
                #:credentials-headers
                #:default-aws-credentials)
  (:import-from #:aws-sdk/request
                #:request
                #:request-session
                #:request-service
                #:request-headers
                #:request-payload
                #:request-method
                #:request-path
                #:request-params
                #:request-host
                #:request-endpoint
                #:request-signing-name)
  (:import-from #:aws-sign4)
  (:import-from #:dexador)
  (:import-from #:quri)
  (:export #:*session*
           #:aws-request))
(in-package #:aws-sdk/api)

(defun aws-request (req &key want-stream)
  (check-type req request)
  (let* ((session (request-session req))
         (credentials (or (session-credentials session)
                          (default-aws-credentials)))
         (region (session-region session)))
    (unless credentials
      (error "No credentials are found"))
    (unless region
      (error "AWS region is not configured"))
    (let ((aws-sign4:*aws-credentials* (lambda () (credentials-keys credentials)))
          (headers (append (credentials-headers credentials)
                           (request-headers req)))
          (payload (request-payload req)))
      (multiple-value-bind (authorization x-amz-date)
          (let ((uri (quri:uri (request-path req))))
            (aws-sign4:aws-sign4 :region region
                                 :service (or (request-signing-name req) (request-service req))
                                 :method (request-method req)
                                 :host (request-host req region)
                                 :path (quri:uri-path uri)
                                 :params (quri:uri-query-params uri)
                                 :headers headers
                                 :payload (or payload "")))
        (multiple-value-list
         (handler-bind ((dex:http-request-failed #'dex:ignore-and-continue))
           (dex:request (request-endpoint req region)
                        :method (request-method req)
                        :headers `(("Authorization" . ,authorization)
                                   ("X-Amz-Date" . ,x-amz-date)
                                   ("X-Amz-Content-Sha256" . ,(aws-sdk/utils::sha-256 (or payload "")))
                                   ,@headers)
                        :content payload
                        :keep-alive nil
                        :want-stream want-stream)))))))