Storage

Мы уже познакомились с способами работы с БД и разобрались как моделировать идентичности. Теперь рассмотрим основную абстракцию хранилища подробнее.

Абстрактное хранилище для нашего приложения должно удовлетворять следующим требованиям:

  • поддержка транзакций
  • получение идентичности по идентификатору
  • реализация Identity Map
  • создание идентичности из ее состояния

Не во всех приложениях безвозвратное удаление имеет смысл. Чвсто удаление заменяют архивированием. Опустим этот функционал.

Выборки по различным условиям рассмотрим в следующем параграфе.

Основной код абстракции:

(ns publicator.use-cases.abstractions.storage
  (:require
   [clojure.spec.alpha :as s]
   [publicator.domain.abstractions.id-generator :as id-generator]
   [publicator.domain.abstractions.aggregate :as aggregate]
   [publicator.domain.identity :as identity]
   [publicator.utils.ext :as ext]))

(defprotocol Storage
  (-wrap-tx [this body]))

(defprotocol Transaction
  (-get-many [t ids])
  (-create [t state]))

(s/fdef get-many
  :args (s/cat :tx any?
               :ids (s/coll-of ::id-generator/id :distinct true))
  :ret (s/map-of ::id-generator/id ::identity/identity))

(s/fdef create
  :args (s/cat :tx any?
               :state ::aggregate/aggregate)
  :ret ::identity/identity)

(defn get-many [t ids] (-get-many t ids))
(defn create   [t state] (-create t state))

(declare ^:dynamic *storage*)

(defmacro with-tx
  "Note that body forms may be called multiple times,
   and thus should be free of side effects."
  [tx-name & body-forms-free-of-side-effects]
  `(-wrap-tx *storage*
            (fn [~tx-name]
              [email protected]body-forms-free-of-side-effects)))

Можно попытаться написать спецификацию для get-many, которая будет проверять поддержку Identity Map, но эта спецификация будет очень сложной, поэтому проверка ложится на программиста и тесты.

С помощью макроса with-tx мы можем удобно объявлять транзакцию:

(storage/with-tx t
  (storage/create t user-1-state)
  (storage/create t user-2-state))

Для оптимизации запросов, протокол транзакции поддерживает только метод get-many, а метод get-one выражается через него :

(s/fdef get-one
  :args (s/cat :tx any?
               :id ::id-generator/id)
  :ret (s/nilable ::identity/identity))

(defn get-one [t id]
  (let [res (get-many t [id])]
    (get res id)))

Часто мы будем выполнять только одно действие в транзакции, для этого объявим вспомогательные методы:

(s/fdef tx-get-one
  :args (s/cat :id ::id-generator/id)
  :ret (s/nilable ::aggregate/aggregate))

(defn tx-get-one [id]
  (with-tx t
    (when-let [x (get-one t id)]
      @x)))


(s/fdef tx-get-many
  :args (s/cat :ids (s/coll-of ::id-generator/id :distinct true))
  :ret (s/map-of ::id-generator/id ::aggregate/aggregate))

(defn tx-get-many [ids]
  (with-tx t
    (->> ids
         (get-many t)
         (ext/map-vals deref))))


(s/fdef tx-create
  :args (s/cat :state ::aggregate/aggregate)
  :ret ::aggregate/aggregate
  :fn #(= (-> % :args :state)
          (-> % :ret)))

(defn tx-create [state]
  (with-tx t
    @(create t state)))


(s/fdef tx-alter
  :args (s/cat :state ::aggregate/aggregate
               :f fn?
               :args (s/* any?))
  :ret (s/nilable ::aggregate/aggregate))

(defn tx-alter [state f & args]
  (with-tx t
    (when-let [x (get-one t (aggregate/id state))]
      (dosync
       (apply alter x f args)))))

Что бы лучше понять, как это использовать, разберитесь в тестах фейковой реализации этой абстракции:

(ns publicator.use-cases.test.fakes.storage-test
  (:require
   [publicator.use-cases.test.fakes.storage :as sut]
   [publicator.use-cases.abstractions.storage :as storage]
   [publicator.domain.abstractions.aggregate :as aggregate]
   [publicator.domain.identity :as identity]
   [publicator.utils.test.instrument :as instrument]
   [clojure.test :as t]))

(t/use-fixtures :once instrument/fixture)

(t/use-fixtures
  :each
  (fn [f]
    (with-bindings (sut/binding-map (sut/build-db))
      (f))))

(defrecord Test [counter]
  aggregate/Aggregate
  (id [_] 42)
  (spec [_] any?))

(t/deftest create
  (let [test (storage/tx-create (->Test 0))
        id (aggregate/id test)]
    (t/is (some? test))
    (t/is (some? (storage/tx-get-one id)))))

(t/deftest change
  (let [test (storage/tx-create (->Test 0))
        id   (aggregate/id test)
        _    (storage/tx-alter test update :counter inc)
        test (storage/tx-get-one id)]
    (t/is (= 1 (:counter test)))))

(t/deftest identity-map-persisted
  (let [test (storage/tx-create (->Test 0))
        id   (aggregate/id test)]
    (storage/with-tx t
      (let [x (storage/get-one t id)
            y (storage/get-one t id)]
        (t/is (identical? x y))))))

(t/deftest identity-map-in-memory
  (storage/with-tx t
    (let [x (storage/create t (->Test 0))
          y (storage/get-one t (aggregate/id @x))]
      (t/is (identical? x y)))))

(t/deftest identity-map-swap
  (storage/with-tx t
    (let [x (storage/create t (->Test 0))
          y (storage/get-one t (aggregate/id @x))
          _ (dosync (alter x update :counter inc))]
      (t/is (= 1 (:counter @x) (:counter @y))))))

(t/deftest concurrency
  (let [test (storage/tx-create (->Test 0))
        id   (aggregate/id test)
        n    10
        _    (->> (repeatedly #(future (storage/tx-alter test update :counter inc)))
                  (take n)
                  (doall)
                  (map deref)
                  (doall))
        test (storage/tx-get-one id)]
    (t/is (= n (:counter test)))))

(t/deftest inner-concurrency
  (let [test (storage/tx-create (->Test 0))
        id   (aggregate/id test)
        n    10
        _    (storage/with-tx t
               (->> (repeatedly #(future (as-> id <>
                                           (storage/get-one t <>)
                                           (dosync (alter <> update :counter inc)))))
                    (take n)
                    (doall)
                    (map deref)
                    (doall)))
        test (storage/tx-get-one id)]
    (t/is (= n (:counter test)))))

Наконец, сама фейковая реализация:

(ns publicator.use-cases.test.fakes.storage
  (:require
   [publicator.domain.identity :as identity]
   [publicator.domain.abstractions.aggregate :as aggregate]
   [publicator.use-cases.abstractions.storage :as storage]
   [publicator.utils.ext :as ext]))

(deftype Transaction [data identity-map]
  storage/Transaction
  (-get-many [_ ids]
    (let [ids-for-select (remove #(contains? @identity-map %) ids)
          selected       (->> ids-for-select
                              (select-keys data)
                              (ext/map-vals identity/build))]
      ;; Здесь принципиально использование reverse-merge,
      ;; т.к. другой поток может успеть извлечь данные из базы,
      ;; создать объект-идентичность, записать его в identity map
      ;; и сделать в нем изменения.
      ;; Если использовать merge, то этот поток затрет идентичность
      ;; другим объектом-идентичностью с начальным состоянием.
      ;; Фактически это нарушает саму идею identity-map -
      ;; сопоставление ссылки на объект с его идентификатором
      (-> identity-map
          (swap! ext/reverse-merge selected)
          (select-keys ids))))

  (-create [_ state]
    (let [id     (aggregate/id state)
          istate (identity/build state)]
      (swap! identity-map (fn [map]
                            {:pre [(not (contains? map id))]}
                            (assoc map id istate)))
      istate)))

(deftype Storage [db]
  storage/Storage
  (-wrap-tx [_ body]
    (loop []
      (let [data         @db
            identity-map (atom {})
            t            (Transaction. data identity-map)
            res          (body t)
            changed      (ext/map-vals deref @identity-map)
            new-data     (merge data changed)]
        (if (compare-and-set! db data new-data)
          res
          (recur))))))

(defn build-db []
  (atom {}))

(defn binding-map [db]
  {#'storage/*storage* (->Storage db)})

Эта фейковая реализация хранит все данные в атоме db. Этот атом содержит отображение идентификаторов на состояние сущностей:

{1 (->User 1 ...)
 2 (->Post 2 ...)
 3 (->Post 3 ...)}

identity-map - тоже атом, но содержит отображение идентификаторов на идентичности сущностей:

{1 (ref (->User 1 ...))
 2 (ref (->Post 2 ...))}

При этом identity-map будет содержать не все сущности, что есть в db, а только те, которые участвуют в транзакции.

-wrap-tx в бесконечном цикле пытается выполнить транзакцию. Если с начала транзакции никто не успел поменять данные, то транзакция проходит. Тут используется оптимистическая блокировка. А помогает в этом низкоуровневая атомарная операция атома compare-and-set!.