FCC 15. March 2024 Challenge

challenge_6.clj

(ns c6
  (:require
   [camel-snake-kebab.core :as csk]
   [clojure.data.json :as json]
   [clojure.string :as str]
   [clojure.test :refer [are is testing]]
   [babashka.fs :as fs]
   [babashka.http-client :as http]
   [malli.core :as m]
   [malli.dev.pretty :as pretty]
   [amazonica.aws.s3 :as s3]
   [amazonica.core :as aws]
   [aero.core :as aero]))

(def config (aero/read-config "fcc/config.edn"))

; ---------------------------------------------------------------------------------------
; AWS configuration

(System/setProperty "aws.region" "us-east-1")

(def aws-credentials (:aws config))

(def aws-config {:client-config {:path-style-access-enabled true}})

(def aws-s3-config (merge aws-credentials aws-config))

(aws/set-date-format! "yyyyMMdd")

; ---------------------------------------------------------------------------------------
; GCP configuration

(defn get-gcp-access-token []
  (let [response (http/post "https://oauth2.googleapis.com/token"
                            {:headers {:accept "application/json"
                                       :content-type "application/x-www-form-urlencoded"}
                             :form-params (:gcp config)})]
    (:access_token (json/read-str (:body response) :key-fn keyword))))

(def gcp-access-token (get-gcp-access-token))

; ---------------------------------------------------------------------------------------
; Test data

(def example-data
  (json/read-str
   (slurp "fcc/input/example-data.json")
   :key-fn keyword))

; ---------------------------------------------------------------------------------------
; GCP API access

(defn gcp-request
  "Makes a request to the google cloud api.
   The url is relative to the base url 'https://www.googleapis.com/drive/v3'."
  ([url] (gcp-request url nil))
  ([url params]
   (let [response (http/request (merge {:uri (str "https://www.googleapis.com/drive/v3" url)
                                        :headers {:authorization (str "Bearer " gcp-access-token)
                                                   :accept "application/json"
                                                   :content-type "application/json"}}
                                       params
                                       {:body (when (:body params) (json/write-str (:body params)))}))]
     (json/read-str (:body response) :key-fn keyword))))

(defn get-gd-files
  "Gets the files from google drive that match the query."
  [q]
  (:files (gcp-request "/files" {:method :get
                                 :query-params {:q q}})))

(defn get-gd-file
  "Gets the file from google drive at the given path.
   To do so it recursively searches for files at each path part to retrieve
   their id and lookup only their children."
  [path]
  (let [parts (fs/components path)]
    (loop [[part & parts] parts
           parent "root"]
      (let [files (try (get-gd-files (str "name = '" part "' and '" parent "' in parents and trashed = false"))
                       (catch Exception _ nil))]
        (if (empty? parts)
          (first files)
          (recur parts (-> files first :id)))))))

; ---------------------------------------------------------------------------------------
; File location inference

(defmulti file-location (fn [{:keys [type]}] type))

(defmethod file-location :outfit [{:keys [asset]}]
  (fs/path "vtuber" "outfits" (:fileName asset)))

(defmethod file-location :vrm [{:keys [asset vtuber]}]
  (fs/path "vtuber" "vrms" (format "%s %s.vrm"
                                 (csk/->PascalCase vtuber)
                                 (csk/->PascalCase (fs/strip-ext (:fileName asset))))))

(defmethod file-location :vroid [{:keys [asset vtuber]}]
  (fs/path "vtuber" "vroid" (format "%s-%s.vroid"
                                  (str/lower-case vtuber)
                                  (fs/strip-ext (:fileName asset)))))

; ---------------------------------------------------------------------------------------
; File storage protocol with implementations for local file system, GCP and AWS

(defprotocol FileStorage
  (exists? [_ path]))

(defn file-system-storage [root]
  (let [root (fs/absolutize root)]
    (reify FileStorage
      (exists? [_ path]
        (fs/exists? (fs/path root path))))))

(defn gcp-storage [root]
  (reify FileStorage
    (exists? [_ path]
      (not (nil? (get-gd-file (str (fs/path root path))))))))

(defn aws-storage [bucket]
  (reify FileStorage
    (exists? [_ path]
      (try
        (not (nil? (s3/get-object aws-s3-config bucket path)))
        (catch Exception _ false)))))


(defn- file-exists? [{:keys [vtuber asset type storage]}]
  (exists? storage (file-location {:vtuber vtuber
                                   :asset asset
                                   :type type})))

; ---------------------------------------------------------------------------------------
; Asset validation

(def non-empty-string [:string {:min 1}])

(defn distinct-keys [key]
  [:fn {:error/message (str (name key) " must be unique")}
   (fn [v] (apply distinct? (map key v)))])

(defn distinct-map-vals [key]
  [:fn {:error/message (str "values of " (name key) " must be unique")}
   (fn [v] (apply distinct? (mapcat (comp vals key) v)))])

(def Asset
  [:map
   [:name non-empty-string]
   [:fileName non-empty-string]
   [:description non-empty-string]
   [:alt non-empty-string]
   [:credits [:map-of :keyword #"^https://booth.pm/en/items/\d+$"]]])

(def Assets
  [:and
   [:vector Asset]
   (distinct-keys :fileName)
   (distinct-keys :name)
   (distinct-map-vals :credits)])

; ---------------------------------------------------------------------------------------
; Test cases

(testing "the assets are all valid"
  (is (m/validate Assets example-data) (pretty/explain Assets example-data)))

(testing "all assets are present"
  (let [gcp-storage (gcp-storage "FCC_Assets")
        vtuber "naomi"]
    (doall (pmap (fn [asset]
                   (are [type] (file-exists? {:asset asset
                                              :type type
                                              :storage gcp-storage
                                              :vtuber vtuber})
                     :outfit
                     :vrm
                     :vroid))
                 example-data))
    nil))

(testing "all outfits are available in s3 storage"
  (let [aws-storage (aws-storage "assets")
        vtuber "naomi"]
    (doseq [asset example-data]
      (is (file-exists? {:asset asset
                         :type :outfit
                         :storage aws-storage
                         :vtuber vtuber})))))

(testing "all vrm files are available locally"
  (let [file-storage (file-system-storage "fcc/assets")
        vtuber "naomi"]
    (doseq [asset example-data]
      (is (file-exists? {:asset asset
                         :type :vrm
                         :storage file-storage
                         :vtuber vtuber})))))

; ---------------------------------------------------------------------------------------