Browser presign POST upload using AWS-SDK

deps.edn

;; reference
;; https://github.com/kamil-perczynski/s3-direct-browser-upload

{:deps {org.clojure/clojure          {:mvn/version "1.10.1"}
        hiccup/hiccup                {:mvn/version "2.0.0-alpha2"}
        io.pedestal/pedestal.jetty   {:mvn/version "0.5.8"}
        io.pedestal/pedestal.service {:mvn/version "0.5.8"}
        commons-codec/commons-codec  {:mvn/version "1.15"}
        com.cognitect.aws/api        {:mvn/version "0.8.474"}
        com.cognitect.aws/endpoints  {:mvn/version "1.1.11.842"}
        ;; s3 required just for "list objects". The upload itself don't need it!
        com.cognitect.aws/s3         {:mvn/version "809.2.734.0"}}}

server.clj

(ns demo-upload-s3.server
  (:require [io.pedestal.http :as http]
            [hiccup2.core :as h]
            [cognitect.aws.client.api :as aws]
            [ring.util.mime-type :as mime]
            [cognitect.aws.credentials :as aws.cred]
            [cognitect.aws.region :as aws.reg]
            [cheshire.core :as json])
  (:import (java.nio.charset StandardCharsets)
           (java.util UUID Base64)
           (java.time Instant Duration)
           (java.time.temporal ChronoUnit)
           (org.apache.commons.codec.digest HmacUtils HmacAlgorithms)))

(set! *warn-on-reflection* true)

(defn as-aws-date
  [^Instant instant]
  (-> instant
      .toString
      (.replaceAll "[:\\-]|\\.\\d{3}" "")))

(defn ^String as-aws-sort-date
  [instant]
  (subs (as-aws-date instant) 0 8))

(defn compute-signature
  [{::keys [credentials
            encoded-policy
            region
            date]}]
  ;; TODO: Can we use JVM?
  ;    import javax.crypto.*;
  ;    import java.security.AlgorithmParameters;
  ;
  ;    // get cipher object for password-based encryption
  ;    Cipher c = Cipher.getInstance("PBEWithHmacSHA256AndAES_256");
  (let [short-date (as-aws-sort-date date)
        date-key (-> (HmacUtils. HmacAlgorithms/HMAC_SHA_256
                                 (str "AWS4" (:aws/secret-access-key credentials)))
                     (.hmac short-date))
        date-region-key (-> (HmacUtils. HmacAlgorithms/HMAC_SHA_256
                                        date-key)
                            (.hmac (str region)))
        date-region-service-key (-> (HmacUtils. HmacAlgorithms/HMAC_SHA_256
                                                date-region-key)
                                    (.hmac "s3"))
        signing-key (-> (HmacUtils. HmacAlgorithms/HMAC_SHA_256
                                    date-region-service-key)
                        (.hmac "aws4_request"))]
    (-> (HmacUtils. HmacAlgorithms/HMAC_SHA_256
                    signing-key)
        (.hmacHex (str encoded-policy)))))

;; compute-signature is a pure function!!! you can unit-test offline it!
(comment
  (compute-signature
    {::credentials    {:aws/secret-access-key "a"}
     ::encoded-policy "b"
     ::region         "c"
     ::date           (.toInstant #inst"2000")})
  => "495906feb1fa7de0e8b941f7a4bb66d85b7909d2e70a6c8520abb80fb2e0ef35")

(defn upload-policy
  [{::keys [^Instant date credentials
            region key bucket]
    :as    env}]
  (let [x-amz-credential (format "%s/%s/%s/%s/%s"
                                 (:aws/access-key-id credentials)
                                 (as-aws-sort-date date)
                                 region
                                 "s3"
                                 "aws4_request")
        x-amz-algorithm "AWS4-HMAC-SHA256"
        expiration (.plus date (Duration/of 1 ChronoUnit/HOURS))
        policy (-> (json/generate-string {:expiration (str expiration)
                                          ;; Keep in sync with ::fields
                                          :conditions [{:key key}
                                                       {:bucket bucket}
                                                       {:X-Amz-Algorithm x-amz-algorithm}
                                                       {:X-Amz-Credential x-amz-credential}
                                                       {:X-Amz-Date (as-aws-date date)}
                                                       {:X-Amz-Meta-Tx "hello world"}]})
                   .getBytes
                   (->> (.encodeToString (Base64/getEncoder))))
        x-amz-signature (compute-signature (assoc env
                                             ::encoded-policy policy))]
    {::url    (format "https://s3.%s.amazonaws.com/%s"
                      region bucket)
     ;; Keep in sync with :conditions
     ::fields {"Policy"           policy
               "bucket"           bucket
               "X-Amz-Date"       (as-aws-date date)
               "X-Amz-Signature"  x-amz-signature
               "X-Amz-Algorithm"  x-amz-algorithm
               "X-Amz-Credential" x-amz-credential
               "key"              key
               "X-Amz-Meta-Tx"    "hello world"}}))

;; upload-policy is a pure function!!! you can unit-test offline it!
(comment
  (upload-policy
    {::credentials {:aws/secret-access-key "a"
                    :aws/access-key-id     "b"}
     ::key         "c"
     ::bucket      "d"
     ::region      "e"
     ::date        (.toInstant #inst"2000")})
  => {:demo-upload-s3.server/url    "https://s3.e.amazonaws.com/d",
      :demo-upload-s3.server/fields {"Policy"           "eyJleHBpcmF0aW9uIjoiMjAwMC0wMS0wMVQwMTowMDowMFoiLCJjb25kaXRpb25zIjpbeyJrZXkiOiJjIn0seyJidWNrZXQiOiJkIn0seyJYLUFtei1BbGdvcml0aG0iOiJBV1M0LUhNQUMtU0hBMjU2In0seyJYLUFtei1DcmVkZW50aWFsIjoiYi8yMDAwMDEwMS9lL3MzL2F3czRfcmVxdWVzdCJ9LHsiWC1BbXotRGF0ZSI6IjIwMDAwMTAxVDAwMDAwMFoifSx7IlgtQW16LU1ldGEtVHgiOiJoZWxsbyB3b3JsZCJ9XX0=",
                                     "bucket"           "d",
                                     "X-Amz-Date"       "20000101T000000Z",
                                     "X-Amz-Signature"  "3eded8b71c7079c551b24065dacbad3b10b2fdb2a0e46e98a55c65ecc8df5102",
                                     "X-Amz-Algorithm"  "AWS4-HMAC-SHA256",
                                     "X-Amz-Credential" "b/20000101/e/s3/aws4_request",
                                     "key"              "c",
                                     "X-Amz-Meta-Tx"    "hello world"}})


;; HTML/Page stuff

(defn body
  [{::keys [bucket key-prefix s3]
    :as    req}]
  (let [id (UUID/randomUUID)
        env (assoc req
              ::key (str key-prefix "/" id))
        {::keys [url fields]} (upload-policy env)]
    [:body
     [:form
      {:action  url
       :method  "POST"
       :style   {:display        "flex"
                 :flex-direction "column"}
       :enctype "multipart/form-data"}
      (for [[k v] fields]
        [:input {:name     k
                 :value    v
                 :readonly true}])
      [:input {:type "file" :name "file"}]
      [:button {:type "submit"} "Save"]]
     ;; S3 just for list object.
     ;; You do not need to require s3 to use it!
     (let [contents (-> (aws/invoke s3 {:op      :ListObjects
                                        :request {:Bucket bucket
                                                  :Prefix key-prefix}})
                        :Contents)]
       (if (empty? contents)
         [:div "Empty bucket"]
         [:ul
          (for [content (reverse (sort-by :LastModified contents))]
            [:li
             {:style {:border "1px solid black"}}
             [:table
              [:tbody
               (for [[k v] content]
                 [:tr
                  [:th {:style {:color "purple"}}
                   [:pre (pr-str k)]]
                  [:td [:pre (pr-str v)]]])]]])]))]))


(def bucket
  ;; PUT YOUR BUCKET HERE
  (delay "browser-upload"))
(def key-prefix
  ;; PUT A PREFIX HERE
  (delay "upload-data"))


;; credentials example:
;; {:aws/access-key-id     "XXXXXXXX",
;;  :aws/secret-access-key "xxxx+yyyy/zzzzz",
;;  :aws/session-token     nil}
(def credentials
  (delay (aws.cred/fetch (aws.cred/default-credentials-provider aws.cred/fetch-async))))
;; region example:
;; "us-east-1"
(def region
  (delay (aws.reg/fetch (aws.reg/default-region-provider aws.reg/fetch-async))))

(def s3
  (delay (aws/client {:api :s3})))


(defn index
  [req]
  {:body    (->> [:html
                  [:head
                   [:title "demo-upload-s3"]
                   [:meta {:charset (str StandardCharsets/UTF_8)}]]
                  (body (assoc req
                          ::credentials @credentials
                          ::region @region
                          ::s3 @s3
                          ::date (Instant/now)
                          ::key-prefix @key-prefix
                          ::bucket @bucket))]
                 (h/html
                   {:mode :html}
                   (h/raw "<!DOCTYPE html>\n"))
                 str)
   :headers {"Content-Type" (mime/default-mime-types "html")}
   :status  200})

(defonce state (atom nil))

(defn restart!
  [st]
  (some-> st http/stop)
  (-> {::http/port   8080
       ::http/routes `#{["/" :get index]}
       ::http/join?  false
       ::http/type   :jetty}
      http/default-interceptors
      http/dev-interceptors
      http/create-server
      http/start))

(defn -main
  [& _]
  (swap! state restart!))