aws4-auth.lisp

   1 ;;;; aws4-auth.lisp
   2
   3 (in-package #:zs3)
   4
   5 ;;; http://docs.aws.amazon.com/general/latest/gr/rande.html#s3_region
   6 ;;; can be used to map endpoint to region, maybe?
   7
   8 (defun headers-for-signing (request)
   9   (append (all-amazon-headers request)
  10           (extra-http-headers request)
  11           (parameters-alist "host" (host request)
  12                             "content-type" (content-type request))))
  13
  14 (defun canonical-headers (headers)
  15   (flet ((trim (string)
  16            (string-trim " " string)))
  17     (let ((encoded
  18            (loop for (name . value) in headers
  19                  collect (cons (string-downcase name)
  20                                (trim value)))))
  21       (sort encoded #'string< :key 'car))))
  22
  23 (defun signed-headers (request)
  24   (mapcar 'first (canonical-headers (headers-for-signing request))))
  25
  26 (defun parameters-for-signing (request)
  27   (cond ((sub-resource request)
  28          (list (cons (sub-resource request) "")))
  29         (t
  30          (parameters request))))
  31
  32 (defun canonical-parameters (parameters)
  33   (let ((encoded
  34          (loop for (name . value) in parameters
  35                collect (cons
  36                         (url-encode name)
  37                         (url-encode value)))))
  38     (sort encoded #'string< :key 'car)))
  39
  40 (defun canonical-parameters-string (request)
  41   (format nil "~{~A=~A~^&~}"
  42                 (alist-plist (canonical-parameters
  43                               (parameters-for-signing request)))))
  44
  45 (defun hashed-payload (request)
  46   *empty-string-sha256*)
  47
  48 (defun path-to-sign (request)
  49   "Everything in the PATH of the request, up to the first ?"
  50   (let ((path (request-path request)))
  51     (subseq path 0 (position #\? path))))
  52
  53 (defun canonicalized-request-strings (request)
  54   "Return a list of lines canonicalizing the request according to
  55 http://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-header-based-auth.html."
  56   (let* ((headers (headers-for-signing request))
  57          (canonical-headers (canonical-headers headers)))
  58     (alexandria:flatten
  59      (list (http-method request)
  60            (path-to-sign request)
  61            (canonical-parameters-string request)
  62            (loop for (name . value) in canonical-headers
  63                  collect (format nil "~A:~A" name value))
  64            ""
  65            (format nil "~{~A~^;~}" (mapcar 'first canonical-headers))
  66            (hashed-payload request)))))
  67
  68 (defun string-to-sign-lines (request)
  69   "Return a list of strings to sign to construc"
  70   (list "AWS4-HMAC-SHA256"
  71         (iso8601-basic-timestamp-string)
  72         (with-output-to-string (s)
  73           (format s "~A/~A/s3/aws4_request"
  74                   (iso8601-basic-date-string)
  75                   (region request)))
  76         (strings-sha256/hex (canonicalized-request-strings request))))
  77
  78 (defun make-signing-key (credentials &key region service)
  79   (let* ((k1 (format nil "AWS4~A" (secret-key credentials)))
  80          (date-key (hmac-sha256 k1 (iso8601-basic-date-string)))
  81          (region-key (hmac-sha256 date-key region))
  82          (service-key (hmac-sha256 region-key service)))
  83     (hmac-sha256 service-key "aws4_request")))
  84
  85 (defclass aws4-auth-request (request)
  86   ((region
  87     :accessor region
  88     :initarg :region))
  89   (:default-initargs
  90    :region "us-east-1"))
  91
  92 (defmethod authorization-header-value ((request aws4-auth-request))
  93   (let ((key (make-signing-key *credentials*
  94                                :region (region request)
  95                                :service "s3")))
  96     (with-output-to-string (s)
  97       (write-string "AWS4-HMAC-SHA256" s)
  98       (format s " Credential=~A/~A/~A/s3/aws4_request"
  99               (access-key *credentials*)
 100               (iso8601-basic-date-string)
 101               (region request))
 102       (format s ",SignedHeaders=~{~A~^;~}" (signed-headers request))
 103       (format s ",Signature=~A"
 104               (strings-hmac-sha256/hex key (string-to-sign-lines request))))))
 105
 106 (defun test-aws4 (&key (region "us-east-1"))
 107   (let ((request (make-instance 'aws4-auth-request
 108                                 :amz-headers
 109                                 (parameters-alist :content-sha256 *empty-string-sha256*
 110                                                   :date (iso8601-basic-timestamp-string))
 111                                 :region region)))
 112     request))