├── .circleci └── config.yml ├── .docker-clojure └── deps.edn ├── .gitignore ├── README.md ├── core ├── deps.edn ├── src │ └── publicator │ │ ├── domain │ │ ├── abstractions │ │ │ ├── aggregate.clj │ │ │ ├── id_generator.clj │ │ │ ├── instant.clj │ │ │ └── password_hasher.clj │ │ ├── aggregates │ │ │ ├── post.clj │ │ │ └── user.clj │ │ ├── identity.clj │ │ └── test │ │ │ ├── factories.clj │ │ │ ├── fakes.clj │ │ │ └── fakes │ │ │ ├── id_generator.clj │ │ │ └── password_hasher.clj │ │ ├── use_cases │ │ ├── abstractions │ │ │ ├── post_queries.clj │ │ │ ├── session.clj │ │ │ ├── storage.clj │ │ │ └── user_queries.clj │ │ ├── interactors │ │ │ ├── post │ │ │ │ ├── create.clj │ │ │ │ ├── list.clj │ │ │ │ ├── show.clj │ │ │ │ └── update.clj │ │ │ └── user │ │ │ │ ├── log_in.clj │ │ │ │ ├── log_out.clj │ │ │ │ └── register.clj │ │ ├── services │ │ │ └── user_session.clj │ │ └── test │ │ │ ├── factories.clj │ │ │ ├── fakes.clj │ │ │ └── fakes │ │ │ ├── post_queries.clj │ │ │ ├── session.clj │ │ │ ├── storage.clj │ │ │ └── user_queries.clj │ │ └── utils │ │ ├── ext.clj │ │ ├── spec.clj │ │ └── test │ │ └── instrument.clj └── test │ └── publicator │ ├── domain │ ├── aggregates │ │ ├── post_test.clj │ │ └── user_test.clj │ └── identity_test.clj │ └── use_cases │ ├── interactors │ ├── post │ │ ├── create_test.clj │ │ ├── list_test.clj │ │ ├── show_test.clj │ │ └── update_test.clj │ └── user │ │ ├── log_in_test.clj │ │ ├── log_out_test.clj │ │ └── register_test.clj │ └── test │ └── fakes │ └── storage_test.clj ├── crypto ├── deps.edn ├── src │ └── publicator │ │ └── crypto │ │ └── password_hasher.clj └── test │ └── publicator │ └── crypto │ └── password_hasher_test.clj ├── docker-compose.yml ├── main ├── .gitignore ├── Procfile ├── deps.edn └── src │ └── publicator │ └── main │ ├── binding_map.clj │ └── core.clj ├── persistence ├── deps.edn ├── dev │ └── user.clj ├── resources │ └── db │ │ └── migration │ │ ├── V1__id_sequence.sql │ │ ├── V2__create_post.sql │ │ └── V3__create_user.sql ├── src │ └── publicator │ │ └── persistence │ │ ├── components │ │ ├── data_source.clj │ │ └── migration.clj │ │ ├── id_generator.clj │ │ ├── init.clj │ │ ├── post_queries.clj │ │ ├── post_queries.sql │ │ ├── storage.clj │ │ ├── storage │ │ ├── post_mapper.clj │ │ ├── post_mapper.sql │ │ ├── user_mapper.clj │ │ └── user_mapper.sql │ │ ├── types.clj │ │ ├── user_queries.clj │ │ ├── user_queries.sql │ │ └── utils │ │ └── env.clj └── test │ └── publicator │ └── persistence │ ├── id_generator_test.clj │ ├── post_queries_test.clj │ ├── storage │ ├── post_mapper_test.clj │ └── user_mapper_test.clj │ ├── storage_test.clj │ ├── storage_test.sql │ ├── test │ ├── db.clj │ └── db.sql │ └── user_queries_test.clj └── web ├── .dir-locals.el ├── deps.edn ├── dev ├── system.clj └── user.clj ├── src └── publicator │ └── web │ ├── components │ ├── handler.clj │ └── jetty.clj │ ├── controllers │ ├── pages │ │ └── root.clj │ ├── post │ │ ├── create.clj │ │ ├── list.clj │ │ ├── show.clj │ │ └── update.clj │ └── user │ │ ├── log_in.clj │ │ ├── log_out.clj │ │ └── register.clj │ ├── form_renderer.clj │ ├── forms │ ├── post │ │ └── params.clj │ └── user │ │ ├── log_in.clj │ │ └── register.clj │ ├── handler.clj │ ├── init.clj │ ├── middlewares │ ├── bindings.clj │ ├── layout.clj │ ├── responder.clj │ ├── session.clj │ └── transit_params.clj │ ├── presenters │ ├── explain_data.clj │ ├── layout.clj │ └── post │ │ ├── list.clj │ │ └── show.clj │ ├── responders │ ├── base.clj │ ├── post │ │ ├── create.clj │ │ ├── list.clj │ │ ├── show.clj │ │ └── update.clj │ └── user │ │ ├── log_in.clj │ │ ├── log_out.clj │ │ └── register.clj │ ├── responses.clj │ ├── routing.clj │ ├── template.clj │ ├── templates │ ├── layout.mustache │ ├── pages │ │ └── root.mustache │ └── post │ │ ├── list.mustache │ │ └── show.mustache │ └── transit.clj └── test └── publicator └── web ├── controllers ├── pages │ └── root_test.clj ├── post │ ├── create_test.clj │ ├── list_test.clj │ ├── show_test.clj │ └── update_test.clj └── user │ ├── log_in_test.clj │ ├── log_out_test.clj │ └── register_test.clj ├── middlewares └── transit_params_test.clj ├── presenters ├── explain_data_test.clj └── layout_test.clj └── responders ├── post ├── create_test.clj ├── list_test.clj ├── show_test.clj └── update_test.clj ├── shared_testing.clj └── user ├── log_in_test.clj ├── log_out_test.clj └── register_test.clj /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | jobs: 3 | build: 4 | docker: 5 | - image: clojure:tools-deps-alpine 6 | environment: 7 | CLJ_CONFIG: /root/project/.docker-clojure 8 | TEST_DATABASE_URL: postgres://postgres:password@localhost:5432/postgres 9 | - image: postgres:10.4-alpine 10 | environment: 11 | POSTGRES_PASSWORD: password 12 | steps: 13 | - checkout 14 | - restore_cache: 15 | key: 16 | deps 17 | {{ checksum "core/deps.edn" }} 18 | {{ checksum "web/deps.edn" }} 19 | {{ checksum "persistence/deps.edn" }} 20 | - run: 21 | name: Core 22 | command: | 23 | cd core 24 | clojure -Adev:run-tests 25 | - run: 26 | name: Web 27 | command: | 28 | cd web 29 | clojure -Adev:run-tests 30 | - run: 31 | name: Persistence 32 | command: | 33 | cd persistence 34 | clojure -Adev:run-tests 35 | - save_cache: 36 | key: 37 | deps 38 | {{ checksum "core/deps.edn" }} 39 | {{ checksum "web/deps.edn" }} 40 | {{ checksum "persistence/deps.edn" }} 41 | paths: 42 | - /root/.m2 43 | - /root/.gitlibs 44 | -------------------------------------------------------------------------------- /.docker-clojure/deps.edn: -------------------------------------------------------------------------------- 1 | {:aliases {:cider {:extra-deps {darkleaf/cider-tools-desp 2 | {:git/url "https://github.com/darkleaf/cider-tools-deps.git" 3 | :sha "1025b510db24b36ab741bc5599e36806eec904ec"}} 4 | :main-opts ["-m" "darkleaf.cider-tools-deps" 5 | "port" "4444" "host" "0.0.0.0"]} 6 | :repl {:extra-deps {darkleaf/repl-tools-deps 7 | {:git/url "https://github.com/darkleaf/repl-tools-deps.git" 8 | :sha "04e128ca67785e4eb7ccaecfdaffa3054442358c"}} 9 | :main-opts ["-m" "darkleaf.repl-tools-deps"]} 10 | 11 | :run-tests {:extra-deps {com.cognitect/test-runner 12 | {:git/url "https://github.com/cognitect-labs/test-runner.git" 13 | :sha "028a6d41ac9ac5d5c405dfc38e4da6b4cc1255d5"}} 14 | :main-opts ["-m" "cognitect.test-runner"]} 15 | 16 | :coverage {:extra-deps {cloverage {:mvn/version "1.0.13"}} 17 | :main-opts ["-m" "cloverage.coverage" "-p" "src" "-s" "test"]}}} 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.m2 2 | /.gitlibs 3 | 4 | .cpcache 5 | target -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [](https://circleci.com/gh/darkleaf/publicator/tree/master) 2 | 3 | # Demo 4 | 5 | https://darkleaf-publicator2.herokuapp.com/ 6 | 7 | # Версии 8 | 9 | + [1.0](https://github.com/darkleaf/publicator/tree/1.0) 10 | + [2.0 / current](https://github.com/darkleaf/publicator/tree/master) 11 | + [3.0 / under development](https://github.com/darkleaf/publicator/tree/3.0) 12 | 13 | В версии 3.0 для моделирования агрегатов используется [datascript](https://github.com/tonsky/datascript/) 14 | 15 | # Разработка в docker 16 | + `docker-compose run --rm --service-ports app sh` 17 | + перейти в подпроект, например `cd core` 18 | + `clojure -Adev:repl` или `clojure -Adev:cider` 19 | 20 | # Запуск в docker 21 | + `docker-compose run --rm --service-ports app sh` 22 | + `cd main` 23 | + `clojure -Astart` 24 | + http://localhost:4446/ 25 | 26 | # Heroku deploy 27 | 28 | + `docker-compose run --rm --service-ports app sh` 29 | + `cd main` 30 | + `clojure -Auberjar`, выполняется долго из-за docker 31 | + выйти в из docker 32 | + `cd main` 33 | + `heroku deploy:jar main.jar` 34 | -------------------------------------------------------------------------------- /core/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/test.check {:mvn/version "0.9.0"} 2 | orchestra {:mvn/version "2017.11.12-1"} 3 | darkleaf/either {:git/url "https://github.com/darkleaf/either.git" 4 | :sha "18877bc52019a4efa5ec8f32ddb4774d9ccff525"}} 5 | 6 | :aliases {:dev {:extra-paths ["test"]}}} 7 | -------------------------------------------------------------------------------- /core/src/publicator/domain/abstractions/aggregate.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.abstractions.aggregate 2 | (:require 3 | [clojure.spec.alpha :as s])) 4 | 5 | (defprotocol Aggregate 6 | (id [this]) 7 | (spec [this])) 8 | 9 | (s/def ::aggregate #(satisfies? Aggregate %)) 10 | -------------------------------------------------------------------------------- /core/src/publicator/domain/abstractions/id_generator.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.abstractions.id-generator 2 | (:require 3 | [clojure.spec.alpha :as s])) 4 | 5 | (defprotocol IdGenerator 6 | (-generate [this])) 7 | 8 | (declare ^:dynamic *id-generator*) 9 | 10 | (s/def ::id pos-int?) 11 | 12 | (s/fdef generate 13 | :ret ::id) 14 | 15 | (defn generate [] 16 | (-generate *id-generator*)) 17 | -------------------------------------------------------------------------------- /core/src/publicator/domain/abstractions/instant.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.abstractions.instant 2 | (:require 3 | [clojure.spec.alpha :as s]) 4 | (:import 5 | [java.time Instant])) 6 | 7 | (defn ^:dynamic *now* [] 8 | (Instant/now)) 9 | 10 | (s/fdef now 11 | :ret inst?) 12 | 13 | (defn now [] 14 | (*now*)) 15 | -------------------------------------------------------------------------------- /core/src/publicator/domain/abstractions/password_hasher.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.abstractions.password-hasher 2 | (:refer-clojure :exclude [derive]) 3 | (:require [clojure.spec.alpha :as s])) 4 | 5 | ;; check нужет, т.к. derive для одного и того же пароля может давать разные результаты, 6 | ;; т.к. результат может содержать случайную соль 7 | 8 | (defprotocol PasswordHasher 9 | (-derive [this password]) 10 | (-check [this attempt encrypted])) 11 | 12 | (declare ^:dynamic *password-hasher*) 13 | 14 | (s/def ::password string?) 15 | (s/def ::encrypted string?) 16 | 17 | (s/fdef derive 18 | :args (s/cat :password ::password) 19 | :ret ::encrypted 20 | :fn #(not= (-> % :args :password) 21 | (-> % :ret))) 22 | 23 | (defn derive [password] 24 | (-derive *password-hasher* password)) 25 | 26 | 27 | (s/fdef check 28 | :args (s/cat :attempt ::password 29 | :encrypted ::encrypted) 30 | :ret boolean?) 31 | 32 | (defn check [attempt encrypted] 33 | (-check *password-hasher* attempt encrypted)) 34 | -------------------------------------------------------------------------------- /core/src/publicator/domain/aggregates/post.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.aggregates.post 2 | (:require 3 | [clojure.spec.alpha :as s] 4 | [publicator.domain.abstractions.aggregate :as aggregate] 5 | [publicator.domain.abstractions.id-generator :as id-generator] 6 | [publicator.domain.abstractions.instant :as instant])) 7 | 8 | (s/def ::id ::id-generator/id) 9 | (s/def ::title (s/and string? #(re-matches #".{1,255}" %))) 10 | (s/def ::content string?) 11 | (s/def ::created-at inst?) 12 | 13 | (s/def ::post (s/keys :req-un [::id ::title ::content ::created-at])) 14 | 15 | (defrecord Post [id title content created-at] 16 | aggregate/Aggregate 17 | (id [_] id) 18 | (spec [_] ::post)) 19 | 20 | (defn post? [x] (instance? Post x)) 21 | 22 | (s/fdef build 23 | :args (s/cat :params (s/keys :req-un [::title ::content])) 24 | :ret ::post) 25 | 26 | (defn build [{:keys [title content]}] 27 | (map->Post {:id (id-generator/generate) 28 | :title title 29 | :content content 30 | :created-at (instant/now)})) 31 | -------------------------------------------------------------------------------- /core/src/publicator/domain/aggregates/user.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.aggregates.user 2 | (:require 3 | [publicator.domain.abstractions.password-hasher :as password-hasher] 4 | [publicator.domain.abstractions.id-generator :as id-generator] 5 | [publicator.domain.abstractions.instant :as instant] 6 | [publicator.domain.abstractions.aggregate :as aggregate] 7 | [clojure.spec.alpha :as s])) 8 | 9 | (s/def ::id ::id-generator/id) 10 | (s/def ::login (s/and string? #(re-matches #"\w{3,255}" %))) 11 | (s/def ::full-name (s/and string? #(re-matches #".{2,255}" %))) 12 | (s/def ::password (s/and string? #(re-matches #".{8,255}" %))) 13 | (s/def ::password-digest ::password-hasher/encrypted) 14 | (s/def ::posts-ids (s/coll-of ::id-generator/id :kind set?)) 15 | (s/def ::created-at inst?) 16 | 17 | (s/def ::user (s/keys :req-un [::id ::login ::full-name ::password-digest ::posts-ids 18 | ::created-at])) 19 | 20 | (defrecord User [id login full-name password-digest posts-ids created-at] 21 | aggregate/Aggregate 22 | (id [_] id) 23 | (spec [_] ::user)) 24 | 25 | (defn user? [x] (instance? User x)) 26 | 27 | (s/fdef build 28 | :args (s/cat :params (s/keys :req-un [::login ::full-name ::password] 29 | :opt-un [::posts-ids])) 30 | :ret ::user) 31 | 32 | (defn build [{:keys [login full-name password posts-ids] 33 | :or {posts-ids #{}}}] 34 | (map->User {:id (id-generator/generate) 35 | :login login 36 | :full-name full-name 37 | :password-digest (password-hasher/derive password) 38 | :posts-ids posts-ids 39 | :created-at (instant/now)})) 40 | 41 | (defn authenticated? [user password] 42 | (password-hasher/check password (:password-digest user))) 43 | -------------------------------------------------------------------------------- /core/src/publicator/domain/identity.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.identity 2 | (:require 3 | [publicator.domain.abstractions.aggregate :as aggregate] 4 | [clojure.spec.alpha :as s]) 5 | (:import 6 | [clojure.lang Ref])) 7 | 8 | (defn- build-validator [initial] 9 | (fn [new] 10 | (if (not= (class initial) 11 | (class new)) 12 | (throw (ex-info "Aggregate class was changed." 13 | {:type ::class-was-changed 14 | :initial initial 15 | :new new}))) 16 | (if (not= (aggregate/id initial) 17 | (aggregate/id new)) 18 | (throw (ex-info "Aggregate id was changed." 19 | {:type ::id-was-changed 20 | :initial initial 21 | :new new}))) 22 | (if-let [ed (s/explain-data (aggregate/spec new) new)] 23 | (throw (ex-info (str "Aggregate was invalid." 24 | (with-out-str (s/explain-out ed))) 25 | {:type ::aggregate-was-invalid 26 | :explain-data ed}))) 27 | true)) 28 | 29 | (s/def ::identity #(instance? Ref %)) 30 | 31 | (defn build [initial] 32 | (ref initial 33 | :validator (build-validator initial))) 34 | -------------------------------------------------------------------------------- /core/src/publicator/domain/test/factories.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.test.factories 2 | (:require 3 | [clojure.spec.alpha :as s] 4 | [clojure.spec.gen.alpha :as sgen] 5 | [publicator.domain.aggregates.user :as user] 6 | [publicator.domain.aggregates.post :as post])) 7 | 8 | (defn gen [spec] 9 | (-> spec s/gen sgen/generate)) 10 | 11 | (defn build-user 12 | ([] (build-user {})) 13 | ([params] 14 | (-> (s/keys :req-un [::user/login 15 | ::user/full-name 16 | ::user/password]) 17 | gen 18 | (merge params) 19 | user/build))) 20 | 21 | (defn build-post 22 | ([] (build-post {})) 23 | ([params] 24 | (-> (s/keys :req-un [::post/title 25 | ::post/content]) 26 | gen 27 | (merge params) 28 | post/build))) 29 | -------------------------------------------------------------------------------- /core/src/publicator/domain/test/fakes.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.test.fakes 2 | (:require 3 | [publicator.domain.test.fakes.password-hasher :as password-hasher] 4 | [publicator.domain.test.fakes.id-generator :as id-generator])) 5 | 6 | (defn fixture [f] 7 | (let [binding-map (merge (password-hasher/binding-map) 8 | (id-generator/binding-map))] 9 | (with-bindings binding-map 10 | (f)))) 11 | -------------------------------------------------------------------------------- /core/src/publicator/domain/test/fakes/id_generator.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.test.fakes.id-generator 2 | (:require 3 | [publicator.domain.abstractions.id-generator :as id-generator])) 4 | 5 | (deftype IdGenerator [counter] 6 | id-generator/IdGenerator 7 | 8 | (-generate [_] 9 | (swap! counter inc))) 10 | 11 | (defn build [] 12 | (IdGenerator. (atom 0))) 13 | 14 | (defn binding-map [] 15 | {#'id-generator/*id-generator* (build)}) 16 | -------------------------------------------------------------------------------- /core/src/publicator/domain/test/fakes/password_hasher.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.test.fakes.password-hasher 2 | (:require 3 | [publicator.domain.abstractions.password-hasher :as password-hasher] 4 | [clojure.string :as str])) 5 | 6 | (deftype PasswordHasher [] 7 | password-hasher/PasswordHasher 8 | 9 | (-derive [_ password] 10 | (str/reverse password)) 11 | 12 | (-check [_ attempt encrypted] 13 | (= (str/reverse attempt) 14 | encrypted))) 15 | 16 | (defn binding-map [] 17 | {#'password-hasher/*password-hasher* (->PasswordHasher)}) 18 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/abstractions/post_queries.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.abstractions.post-queries 2 | (:require 3 | [publicator.domain.aggregates.user :as user] 4 | [publicator.domain.aggregates.post :as post] 5 | [clojure.spec.alpha :as s])) 6 | 7 | (defprotocol GetList 8 | (-get-list [this])) 9 | 10 | (declare ^:dynamic *get-list*) 11 | 12 | (s/def ::post (s/merge ::post/post 13 | (s/keys :req [::user/id ::user/full-name]))) 14 | (s/def ::posts (s/coll-of ::post)) 15 | 16 | (s/fdef get-list 17 | :args nil? 18 | :ret ::posts) 19 | 20 | (defn get-list [] 21 | (-get-list *get-list*)) 22 | 23 | 24 | (defprotocol GetById 25 | (-get-by-id [this id])) 26 | 27 | (declare ^:dynamic *get-by-id*) 28 | 29 | (s/fdef get-by-id 30 | :args (s/cat :id ::post/id) 31 | :ret (s/nilable ::post)) 32 | 33 | (defn get-by-id [id] 34 | (-get-by-id *get-by-id* id)) 35 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/abstractions/session.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.abstractions.session 2 | (:refer-clojure :exclude [get set!])) 3 | 4 | (defprotocol Session 5 | (-get [this k]) 6 | (-set! [this k v])) 7 | 8 | (declare ^:dynamic *session*) 9 | 10 | (defn get [k] 11 | (-get *session* k)) 12 | 13 | (defn set! [k v] 14 | (-set! *session* k v)) 15 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/abstractions/storage.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.abstractions.storage 2 | (:require 3 | [clojure.spec.alpha :as s] 4 | [publicator.domain.abstractions.id-generator :as id-generator] 5 | [publicator.domain.abstractions.aggregate :as aggregate] 6 | [publicator.domain.identity :as identity] 7 | [publicator.utils.ext :as ext])) 8 | 9 | (defprotocol Storage 10 | (-wrap-tx [this body])) 11 | 12 | (defprotocol Transaction 13 | (-get-many [t ids]) 14 | (-create [t state])) 15 | 16 | (s/fdef get-many 17 | :args (s/cat :tx any? 18 | :ids (s/coll-of ::id-generator/id :distinct true)) 19 | :ret (s/map-of ::id-generator/id ::identity/identity)) 20 | 21 | (s/fdef create 22 | :args (s/cat :tx any? 23 | :state ::aggregate/aggregate) 24 | :ret ::identity/identity) 25 | 26 | (defn get-many [t ids] (-get-many t ids)) 27 | (defn create [t state] (-create t state)) 28 | 29 | (declare ^:dynamic *storage*) 30 | 31 | (defmacro with-tx 32 | "Note that body forms may be called multiple times, 33 | and thus should be free of side effects." 34 | [tx-name & body-forms-free-of-side-effects] 35 | `(-wrap-tx *storage* 36 | (fn [~tx-name] 37 | ~@body-forms-free-of-side-effects))) 38 | 39 | (s/fdef get-one 40 | :args (s/cat :tx any? 41 | :id ::id-generator/id) 42 | :ret (s/nilable ::identity/identity)) 43 | 44 | (defn get-one [t id] 45 | (let [res (get-many t [id])] 46 | (get res id))) 47 | 48 | (def preload get-many) 49 | 50 | (s/fdef tx-get-one 51 | :args (s/cat :id ::id-generator/id) 52 | :ret (s/nilable ::aggregate/aggregate)) 53 | 54 | (defn tx-get-one [id] 55 | (with-tx t 56 | (when-let [x (get-one t id)] 57 | @x))) 58 | 59 | 60 | (s/fdef tx-get-many 61 | :args (s/cat :ids (s/coll-of ::id-generator/id :distinct true)) 62 | :ret (s/map-of ::id-generator/id ::aggregate/aggregate)) 63 | 64 | (defn tx-get-many [ids] 65 | (with-tx t 66 | (->> ids 67 | (get-many t) 68 | (ext/map-vals deref)))) 69 | 70 | (s/fdef tx-create 71 | :args (s/cat :state ::aggregate/aggregate) 72 | :ret ::aggregate/aggregate 73 | :fn #(= (-> % :args :state) 74 | (-> % :ret))) 75 | 76 | (defn tx-create [state] 77 | (with-tx t 78 | @(create t state))) 79 | 80 | 81 | (s/fdef tx-alter 82 | :args (s/cat :state ::aggregate/aggregate 83 | :f fn? 84 | :args (s/* any?)) 85 | :ret (s/nilable ::aggregate/aggregate)) 86 | 87 | (defn tx-alter [state f & args] 88 | (with-tx t 89 | (when-let [x (get-one t (aggregate/id state))] 90 | (dosync 91 | (apply alter x f args))))) 92 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/abstractions/user_queries.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.abstractions.user-queries 2 | (:require 3 | [clojure.spec.alpha :as s] 4 | [publicator.domain.aggregates.user :as user])) 5 | 6 | (defprotocol GetByLogin 7 | (-get-by-login [this login])) 8 | 9 | (declare ^:dynamic *get-by-login*) 10 | 11 | (s/fdef get-by-login 12 | :args (s/cat :login ::user/login) 13 | :ret (s/nilable ::user/user)) 14 | 15 | (defn get-by-login [login] 16 | (-get-by-login *get-by-login* login)) 17 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/interactors/post/create.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.post.create 2 | (:require 3 | [publicator.use-cases.services.user-session :as user-session] 4 | [publicator.use-cases.abstractions.storage :as storage] 5 | [publicator.domain.aggregates.post :as post] 6 | [publicator.domain.identity :as identity] 7 | [clojure.spec.alpha :as s] 8 | [publicator.utils.spec :as utils.spec] 9 | [darkleaf.either :as e])) 10 | 11 | (s/def ::params (utils.spec/only-keys :req-un [::post/title ::post/content])) 12 | 13 | (defn- check-authorization= [] 14 | (if (user-session/logged-out?) 15 | (e/left [::logged-out]) 16 | (e/right [::authorized]))) 17 | 18 | (defn- check-params= [params] 19 | (if-let [ed (s/explain-data ::params params)] 20 | (e/left [::invalid-params ed]))) 21 | 22 | (defn- create-post [t params] 23 | (storage/create t (post/build params))) 24 | 25 | (defn- set-authorship [t ipost] 26 | (let [iuser (user-session/iuser t)] 27 | (dosync (alter iuser update :posts-ids conj (:id @ipost))))) 28 | 29 | (defn initial-params [] 30 | (e/extract 31 | (e/let= [ok (check-authorization=)] 32 | [::initial-params {}]))) 33 | 34 | (defn process [params] 35 | (storage/with-tx t 36 | (e/extract 37 | (e/let= [ok (check-authorization=) 38 | ok (check-params= params) 39 | ipost (create-post t params)] 40 | (set-authorship t ipost) 41 | [::processed @ipost])))) 42 | 43 | (defn authorize [] 44 | (e/extract 45 | (check-authorization=))) 46 | 47 | (s/def ::logged-out (s/tuple #{::logged-out})) 48 | (s/def ::invalid-params (s/tuple #{::invalid-params} map?)) 49 | (s/def ::initial-params (s/tuple #{::initial-params} map?)) 50 | (s/def ::processed (s/tuple #{::processed} ::post/post)) 51 | (s/def ::authorized (s/tuple #{::authorized})) 52 | 53 | (s/fdef authorize 54 | :args nil? 55 | :ret (s/or :ok ::authorized 56 | :err ::logged-out)) 57 | 58 | (s/fdef initial-params 59 | :args nil? 60 | :ret (s/or :ok ::initial-params 61 | :err ::logged-out)) 62 | 63 | (s/fdef process 64 | :args (s/cat :params map?) 65 | :ret (s/or :ok ::processed 66 | :err ::logged-out 67 | :err ::invalid-params)) 68 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/interactors/post/list.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.post.list 2 | (:require 3 | [publicator.use-cases.services.user-session :as user-session] 4 | [publicator.use-cases.abstractions.post-queries :as post-q] 5 | [clojure.spec.alpha :as s])) 6 | 7 | (defn process [] 8 | (let [user (user-session/user) 9 | posts (post-q/get-list)] 10 | [::processed posts])) 11 | 12 | (s/def ::processed (s/tuple #{::processed} ::post-q/posts)) 13 | 14 | (s/fdef process 15 | :args nil? 16 | :ret (s/or :ok ::processed)) 17 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/interactors/post/show.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.post.show 2 | (:require 3 | [publicator.use-cases.services.user-session :as user-session] 4 | [publicator.use-cases.abstractions.post-queries :as post-q] 5 | [publicator.domain.aggregates.post :as post] 6 | [darkleaf.either :as e] 7 | [clojure.spec.alpha :as s])) 8 | 9 | (defn- get-by-id= [id] 10 | (if-let [post (post-q/get-by-id id)] 11 | (e/right post) 12 | (e/left [::not-found]))) 13 | 14 | (defn process [id] 15 | (e/extract 16 | (e/let= [user (user-session/user) 17 | post (get-by-id= id)] 18 | [::processed post]))) 19 | 20 | (s/def ::not-found (s/tuple #{::not-found})) 21 | (s/def ::processed (s/tuple #{::processed} ::post-q/post)) 22 | 23 | (s/fdef process 24 | :args (s/cat :id ::post/id) 25 | :ret (s/or :ok ::processed 26 | :err ::not-found)) 27 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/interactors/post/update.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.post.update 2 | (:require 3 | [publicator.domain.aggregates.post :as post] 4 | [publicator.domain.identity :as identity] 5 | [publicator.use-cases.services.user-session :as user-session] 6 | [publicator.use-cases.abstractions.storage :as storage] 7 | [publicator.utils.spec :as utils.spec] 8 | [darkleaf.either :as e] 9 | [clojure.spec.alpha :as s])) 10 | 11 | (s/def ::params (utils.spec/only-keys :req-un [::post/title ::post/content])) 12 | 13 | (defn- check-authorization= [t id] 14 | (let [iuser (user-session/iuser t)] 15 | (cond 16 | (nil? iuser) (e/left [::logged-out]) 17 | (not (contains? (:posts-ids @iuser) id)) (e/left [::not-authorized]) 18 | :else (e/right [::authorized])))) 19 | 20 | (defn- find-post= [t id] 21 | (if-some [ipost (storage/get-one t id)] 22 | (e/right ipost) 23 | (e/left [::not-found]))) 24 | 25 | (defn- check-params= [params] 26 | (if-some [ed (s/explain-data ::params params)] 27 | (e/left [::invalid-params ed]))) 28 | 29 | (defn- update-post [ipost params] 30 | (dosync (alter ipost merge params))) 31 | 32 | (defn- post->params [post] 33 | (select-keys post [:title :content])) 34 | 35 | (defn initial-params [id] 36 | (storage/with-tx t 37 | (e/extract 38 | (e/let= [ok (check-authorization= t id) 39 | ipost (find-post= t id) 40 | params (post->params @ipost)] 41 | [::initial-params @ipost params])))) 42 | 43 | (defn process [id params] 44 | (storage/with-tx t 45 | (e/extract 46 | (e/let= [ok (check-authorization= t id) 47 | ok (check-params= params) 48 | ipost (find-post= t id)] 49 | (update-post ipost params) 50 | [::processed @ipost])))) 51 | 52 | (defn authorize [ids] 53 | (storage/with-tx t 54 | (->> ids 55 | (map #(check-authorization= t %)) 56 | (map e/extract)))) 57 | 58 | (s/def ::logged-out (s/tuple #{::logged-out})) 59 | (s/def ::invalid-params (s/tuple #{::invalid-params} map?)) 60 | (s/def ::not-found (s/tuple #{::not-found})) 61 | (s/def ::not-authorized (s/tuple #{::not-authorized})) 62 | (s/def ::initial-params (s/tuple #{::initial-params} ::post/post map?)) 63 | (s/def ::processed (s/tuple #{::processed} ::post/post)) 64 | (s/def ::authorized (s/tuple #{::authorized})) 65 | 66 | (s/fdef initial-params 67 | :args (s/cat :id ::post/id) 68 | :ret (s/or :ok ::initial-params 69 | :err ::logged-out 70 | :err ::not-authorized 71 | :err ::not-found)) 72 | 73 | (s/fdef process 74 | :args (s/cat :id ::post/id 75 | :params any?) 76 | :ret (s/or :ok ::processed 77 | :err ::logged-out 78 | :err ::not-authorized 79 | :err ::not-found 80 | :err ::invalid-params)) 81 | 82 | (s/fdef authorize 83 | :args (s/cat :ids (s/coll-of ::post/id)) 84 | :ret (s/coll-of (s/or :ok ::authorized 85 | :err ::logged-out 86 | :err ::not-found 87 | :err ::not-authorized))) 88 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/interactors/user/log_in.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.user.log-in 2 | (:require 3 | [publicator.use-cases.abstractions.user-queries :as user-q] 4 | [publicator.use-cases.services.user-session :as user-session] 5 | [publicator.domain.aggregates.user :as user] 6 | [darkleaf.either :as e] 7 | [clojure.spec.alpha :as s] 8 | [publicator.utils.spec :as utils.spec])) 9 | 10 | (s/def ::params (utils.spec/only-keys :req-un [::user/login ::user/password])) 11 | 12 | (defn- check-authorization= [] 13 | (if (user-session/logged-in?) 14 | (e/left [::already-logged-in]) 15 | (e/right [::authorized]))) 16 | 17 | (defn- find-user= [params] 18 | (if-let [user (user-q/get-by-login (:login params))] 19 | (e/right user) 20 | (e/left [::authentication-failed]))) 21 | 22 | (defn- check-authentication= [user params] 23 | (if (user/authenticated? user (:password params)) 24 | (e/right) 25 | (e/left [::authentication-failed]))) 26 | 27 | (defn- check-params= [params] 28 | (if-let [exp (s/explain-data ::params params)] 29 | (e/left [::invalid-params exp]) 30 | (e/right))) 31 | 32 | (defn initial-params [] 33 | (e/extract 34 | (e/let= [ok (check-authorization=)] 35 | [::initial-params {}]))) 36 | 37 | (defn process [params] 38 | (e/extract 39 | (e/let= [ok (check-authorization=) 40 | ok (check-params= params) 41 | user (find-user= params) 42 | ok (check-authentication= user params)] 43 | (user-session/log-in! user) 44 | [::processed]))) 45 | 46 | (defn authorize [] 47 | (e/extract 48 | (check-authorization=))) 49 | 50 | (s/def ::already-logged-in (s/tuple #{::already-logged-in})) 51 | (s/def ::authentication-failed (s/tuple #{::authentication-failed})) 52 | (s/def ::invalid-params (s/tuple #{::invalid-params} map?)) 53 | (s/def ::initial-params (s/tuple #{::initial-params} map?)) 54 | (s/def ::processed (s/tuple #{::processed})) 55 | (s/def ::authorized (s/tuple #{::authorized})) 56 | 57 | (s/fdef initial-params 58 | :args nil? 59 | :ret (s/or :ok ::initial-params 60 | :err ::already-logged-in)) 61 | 62 | (s/fdef process 63 | :args (s/cat :params any?) 64 | :ret (s/or :ok ::processed 65 | :err ::already-logged-in 66 | :err ::authentication-failed 67 | :err ::invalid-params)) 68 | 69 | (s/fdef authorize 70 | :args nil? 71 | :ret (s/or :ok ::authorized 72 | :err ::already-logged-in)) 73 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/interactors/user/log_out.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.user.log-out 2 | (:require 3 | [publicator.use-cases.services.user-session :as user-session] 4 | [publicator.domain.aggregates.user :as user] 5 | [darkleaf.either :as e] 6 | [clojure.spec.alpha :as s])) 7 | 8 | (defn- check-authorization= [] 9 | (if (user-session/logged-out?) 10 | (e/left [::already-logged-out]) 11 | (e/right [::authorized]))) 12 | 13 | (defn process [] 14 | (e/extract 15 | (e/let= [ok (check-authorization=)] 16 | (user-session/log-out!) 17 | [::processed]))) 18 | 19 | (defn authorize [] 20 | (e/extract 21 | (check-authorization=))) 22 | 23 | (s/def ::already-logged-out (s/tuple #{::already-logged-out})) 24 | (s/def ::processed (s/tuple #{::processed})) 25 | (s/def ::authorized (s/tuple #{::authorized})) 26 | 27 | (s/fdef process 28 | :args nil? 29 | :ret (s/or :ok ::processed 30 | :err ::already-logged-out)) 31 | 32 | (s/fdef authorize 33 | :args nil? 34 | :ret (s/or :ok ::authorized 35 | :err ::already-logged-out)) 36 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/interactors/user/register.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.user.register 2 | (:require 3 | [publicator.use-cases.abstractions.storage :as storage] 4 | [publicator.use-cases.abstractions.user-queries :as user-q] 5 | [publicator.use-cases.services.user-session :as user-session] 6 | [publicator.domain.aggregates.user :as user] 7 | [darkleaf.either :as e] 8 | [clojure.spec.alpha :as s] 9 | [publicator.utils.spec :as utils.spec])) 10 | 11 | (s/def ::params (utils.spec/only-keys :req-un [::user/login 12 | ::user/full-name 13 | ::user/password])) 14 | 15 | (defn- check-authorization= [] 16 | (if (user-session/logged-in?) 17 | (e/left [::already-logged-in]) 18 | (e/right [::authorized]))) 19 | 20 | (defn- check-params= [params] 21 | (if-let [exp (s/explain-data ::params params)] 22 | (e/left [::invalid-params exp]))) 23 | 24 | (defn- check-not-registered= [params] 25 | (if (user-q/get-by-login (:login params)) 26 | (e/left [::already-registered]))) 27 | 28 | (defn- create-user [params] 29 | (storage/tx-create (user/build params))) 30 | 31 | (defn initial-params [] 32 | (e/extract 33 | (e/let= [ok (check-authorization=)] 34 | [::initial-params {}]))) 35 | 36 | (defn process [params] 37 | (e/extract 38 | (e/let= [ok (check-authorization=) 39 | ok (check-params= params) 40 | ok (check-not-registered= params) 41 | user (create-user params)] 42 | (user-session/log-in! user) 43 | [::processed user]))) 44 | 45 | (defn authorize [] 46 | (e/extract 47 | (check-authorization=))) 48 | 49 | (s/def ::already-logged-in (s/tuple #{::already-logged-in})) 50 | (s/def ::invalid-params (s/tuple #{::invalid-params} map?)) 51 | (s/def ::already-registered (s/tuple #{::already-registered})) 52 | (s/def ::initial-params (s/tuple #{::initial-params} map?)) 53 | (s/def ::processed (s/tuple #{::processed} ::user/user)) 54 | (s/def ::authorized (s/tuple #{::authorized})) 55 | 56 | (s/fdef initial-params 57 | :args nil? 58 | :ret (s/or :ok ::initial-params 59 | :err ::already-logged-in)) 60 | 61 | (s/fdef process 62 | :args (s/cat :params any?) 63 | :ret (s/or :ok ::processed 64 | :err ::already-logged-in 65 | :err ::invalid-params 66 | :err ::already-registered)) 67 | 68 | (s/fdef authorize 69 | :args nil? 70 | :ret (s/or :ok ::authorized 71 | :err ::already-logged-in)) 72 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/services/user_session.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.services.user-session 2 | (:require 3 | [publicator.use-cases.abstractions.session :as session] 4 | [publicator.use-cases.abstractions.storage :as storage])) 5 | 6 | (defn user-id [] 7 | (session/get ::id)) 8 | 9 | (defn logged-in? [] 10 | (boolean (user-id))) 11 | 12 | (defn logged-out? [] 13 | (not (logged-in?))) 14 | 15 | (defn log-in! [user] 16 | (session/set! ::id (:id user))) 17 | 18 | (defn log-out! [] 19 | (session/set! ::id nil)) 20 | 21 | (defn user [] 22 | (when-let [id (user-id)] 23 | (storage/tx-get-one id))) 24 | 25 | (defn iuser [t] 26 | (when-let [id (user-id)] 27 | (storage/get-one t id))) 28 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/test/factories.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.test.factories 2 | (:require 3 | [publicator.domain.test.factories :as factories] 4 | [publicator.use-cases.abstractions.storage :as storage])) 5 | 6 | (def gen factories/gen) 7 | 8 | (defn create-user 9 | ([] (create-user {})) 10 | ([params] 11 | (storage/tx-create 12 | (factories/build-user params)))) 13 | 14 | (defn create-post 15 | ([] (create-post {})) 16 | ([params] 17 | (storage/tx-create 18 | (factories/build-post params)))) 19 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/test/fakes.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.test.fakes 2 | (:require 3 | [publicator.domain.test.fakes :as domain.fakes] 4 | [publicator.use-cases.test.fakes.session :as session] 5 | [publicator.use-cases.test.fakes.storage :as storage] 6 | [publicator.use-cases.test.fakes.user-queries :as user-q] 7 | [publicator.use-cases.test.fakes.post-queries :as post-q])) 8 | 9 | (defn fixture [f] 10 | (let [db (storage/build-db) 11 | binding-map (merge (session/binding-map) 12 | (storage/binding-map db) 13 | (user-q/binding-map db) 14 | (post-q/binding-map db))] 15 | (with-bindings binding-map 16 | (domain.fakes/fixture f)))) 17 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/test/fakes/post_queries.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.test.fakes.post-queries 2 | (:require 3 | [publicator.use-cases.abstractions.post-queries :as post-q] 4 | [publicator.domain.aggregates.post :as post] 5 | [publicator.domain.aggregates.user :as user])) 6 | 7 | (defn- author-for-post [db post] 8 | (->> @db 9 | (vals) 10 | (filter user/user?) 11 | (filter #(contains? (:posts-ids %) (:id post))) 12 | (first))) 13 | 14 | (defn- assoc-user-fields [post user] 15 | (assoc post 16 | ::user/id (:id user) 17 | ::user/full-name (:full-name user))) 18 | 19 | (deftype GetList [db] 20 | post-q/GetList 21 | (-get-list [_] 22 | (->> @db 23 | (vals) 24 | (filter post/post?) 25 | (map #(when-some [author (author-for-post db %)] 26 | (assoc-user-fields % author))) 27 | (remove nil?)))) 28 | 29 | (deftype GetById [db] 30 | post-q/GetById 31 | (-get-by-id [_ id] 32 | (when-some [post (get @db id)] 33 | (when-some [author (author-for-post db post)] 34 | (assoc-user-fields post author))))) 35 | 36 | (defn binding-map [db] 37 | {#'post-q/*get-list* (->GetList db) 38 | #'post-q/*get-by-id* (->GetById db)}) 39 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/test/fakes/session.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.test.fakes.session 2 | (:require 3 | [publicator.use-cases.abstractions.session :as session])) 4 | 5 | (deftype FakeSession [storage] 6 | session/Session 7 | (-get [_ k] (get @storage k)) 8 | (-set! [_ k v] (swap! storage assoc k v))) 9 | 10 | (defn binding-map [] 11 | {#'session/*session* (FakeSession. (atom {}))}) 12 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/test/fakes/storage.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.test.fakes.storage 2 | (:require 3 | [publicator.domain.identity :as identity] 4 | [publicator.domain.abstractions.aggregate :as aggregate] 5 | [publicator.use-cases.abstractions.storage :as storage] 6 | [publicator.utils.ext :as ext])) 7 | 8 | (deftype Transaction [data identity-map] 9 | storage/Transaction 10 | (-get-many [_ ids] 11 | (let [ids-for-select (remove #(contains? @identity-map %) ids) 12 | selected (->> ids-for-select 13 | (select-keys data) 14 | (ext/map-vals identity/build))] 15 | ;; Здесь принципиально использование reverse-merge, 16 | ;; т.к. другой поток может успеть извлечь данные из базы, 17 | ;; создать объект-идентичность, записать его в identity map 18 | ;; и сделать в нем изменения. 19 | ;; Если использовать merge, то этот поток затрет идентичность 20 | ;; другим объектом-идентичностью с начальным состоянием. 21 | ;; Фактически это нарушает саму идею identity-map - 22 | ;; сопоставление ссылки на объект с его идентификатором 23 | (-> identity-map 24 | (swap! ext/reverse-merge selected) 25 | (select-keys ids)))) 26 | 27 | (-create [_ state] 28 | (let [id (aggregate/id state) 29 | istate (identity/build state)] 30 | (swap! identity-map (fn [map] 31 | {:pre [(not (contains? map id))]} 32 | (assoc map id istate))) 33 | istate))) 34 | 35 | (deftype Storage [db] 36 | storage/Storage 37 | (-wrap-tx [_ body] 38 | (loop [] 39 | (let [data @db 40 | identity-map (atom {}) 41 | t (Transaction. data identity-map) 42 | res (body t) 43 | changed (ext/map-vals deref @identity-map) 44 | new-data (merge data changed)] 45 | (if (compare-and-set! db data new-data) 46 | res 47 | (recur)))))) 48 | 49 | (defn build-db [] 50 | (atom {})) 51 | 52 | (defn binding-map [db] 53 | {#'storage/*storage* (->Storage db)}) 54 | -------------------------------------------------------------------------------- /core/src/publicator/use_cases/test/fakes/user_queries.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.test.fakes.user-queries 2 | (:require 3 | [publicator.domain.aggregates.user :as user] 4 | [publicator.use-cases.abstractions.user-queries :as user-q])) 5 | 6 | (deftype GetByLogin [db] 7 | user-q/GetByLogin 8 | (-get-by-login [_ login] 9 | (->> db 10 | (deref) 11 | (vals) 12 | (filter user/user?) 13 | (filter #(= login (:login %))) 14 | (first)))) 15 | 16 | (defn binding-map [db] 17 | {#'user-q/*get-by-login* (->GetByLogin db)}) 18 | -------------------------------------------------------------------------------- /core/src/publicator/utils/ext.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.utils.ext) 2 | 3 | (defn in? [coll elm] 4 | (boolean (some #(= elm %) coll))) 5 | 6 | (defn map-vals [f m] 7 | (reduce-kv 8 | (fn [acc k v] (assoc acc k (f v))) 9 | {} m)) 10 | 11 | (defn map-keys [f m] 12 | (reduce-kv 13 | (fn [acc k v] (assoc acc (f k) v)) 14 | {} m)) 15 | 16 | (defn reverse-merge [m1 m2] 17 | (merge m2 m1)) 18 | -------------------------------------------------------------------------------- /core/src/publicator/utils/spec.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.utils.spec 2 | (:require 3 | [clojure.spec.alpha :as s])) 4 | 5 | ;; https://groups.google.com/forum/#!topic/clojure/fti0eJdPQJ8 6 | (defmacro only-keys [& {:keys [req req-un opt opt-un] :as args}] 7 | (let [keys-spec `(s/keys ~@(apply concat (vec args)))] 8 | `(s/with-gen 9 | (s/merge ~keys-spec 10 | (s/map-of ~(set (concat req 11 | (map (comp keyword name) req-un) 12 | opt 13 | (map (comp keyword name) opt-un))) 14 | any?)) 15 | #(s/gen ~keys-spec)))) 16 | -------------------------------------------------------------------------------- /core/src/publicator/utils/test/instrument.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.utils.test.instrument 2 | (:require 3 | [orchestra.spec.test :as st])) 4 | 5 | (defn fixture [f] 6 | ;; Для параллельных тестов можно попробовать locking. 7 | ;; Но есть подозрение, что это не заработает. 8 | ;; (locking st/instrument 9 | ;; (st/instrument)) 10 | (st/instrument) 11 | (f)) 12 | -------------------------------------------------------------------------------- /core/test/publicator/domain/aggregates/post_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.aggregates.post-test 2 | (:require 3 | [publicator.domain.aggregates.post :as sut] 4 | [publicator.domain.test.fakes :as fakes] 5 | [publicator.utils.test.instrument :as instrument] 6 | [publicator.domain.test.factories :as factories] 7 | [publicator.domain.abstractions.aggregate :as aggregate] 8 | [clojure.spec.alpha :as s] 9 | [clojure.test :as t])) 10 | 11 | (t/use-fixtures :each fakes/fixture) 12 | (t/use-fixtures :once instrument/fixture) 13 | 14 | (t/deftest build 15 | (let [params {:title "John Doe" 16 | :content "Lorem ipsum"} 17 | post (sut/build params)] 18 | (t/is (sut/post? post)))) 19 | 20 | (t/deftest aggregate 21 | (t/testing "id" 22 | (let [post (factories/build-post)] 23 | (t/is (= (:id post) 24 | (aggregate/id post))))) 25 | (t/testing "spec" 26 | (let [post (factories/build-post) 27 | spec (aggregate/spec post)] 28 | (t/is (s/valid? spec post))))) 29 | -------------------------------------------------------------------------------- /core/test/publicator/domain/aggregates/user_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.aggregates.user-test 2 | (:require 3 | [publicator.domain.aggregates.user :as sut] 4 | [publicator.domain.test.fakes :as fakes] 5 | [publicator.utils.test.instrument :as instrument] 6 | [publicator.domain.test.factories :as factories] 7 | [publicator.domain.abstractions.aggregate :as aggregate] 8 | [clojure.spec.alpha :as s] 9 | [clojure.test :as t])) 10 | 11 | (t/use-fixtures :each fakes/fixture) 12 | (t/use-fixtures :once instrument/fixture) 13 | 14 | (t/deftest build 15 | (let [params {:login "john_doe" 16 | :full-name "John Doe" 17 | :password "password"} 18 | user (sut/build params)] 19 | (t/is (sut/user? user)))) 20 | 21 | (t/deftest authenticated? 22 | (let [password (factories/gen ::sut/password) 23 | user (factories/build-user {:password password})] 24 | (t/is (sut/authenticated? user password)))) 25 | 26 | (t/deftest aggregate 27 | (t/testing "id" 28 | (let [user (factories/build-user)] 29 | (t/is (= (:id user) 30 | (aggregate/id user))))) 31 | (t/testing "spec" 32 | (let [user (factories/build-user) 33 | spec (aggregate/spec user)] 34 | (t/is (s/valid? spec user))))) 35 | -------------------------------------------------------------------------------- /core/test/publicator/domain/identity_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.domain.identity-test 2 | (:require 3 | [publicator.domain.identity :as sut] 4 | [publicator.domain.abstractions.aggregate :as aggregate] 5 | [publicator.utils.test.instrument :as instrument] 6 | [clojure.spec.alpha :as s] 7 | [clojure.test :as t])) 8 | 9 | (t/use-fixtures :once instrument/fixture) 10 | 11 | (defrecord Aggregate [id property] 12 | aggregate/Aggregate 13 | (id [_] id) 14 | (spec [_] (fn [_] (some? property)))) 15 | 16 | (defrecord OtherAggregate [id property] 17 | aggregate/Aggregate 18 | (id [_] id) 19 | (spec [_] (fn [_] (some? property)))) 20 | 21 | (t/deftest identity-test 22 | (let [iagg (sut/build (->Aggregate 1 true))] 23 | (t/testing "validator" 24 | (t/is (thrown-with-msg? clojure.lang.ExceptionInfo 25 | #"Aggregate id was changed." 26 | (dosync (alter iagg assoc :id 2)))) 27 | (t/is (thrown-with-msg? clojure.lang.ExceptionInfo 28 | #"Aggregate class was changed." 29 | (dosync (alter iagg map->OtherAggregate)))) 30 | (t/is (thrown-with-msg? clojure.lang.ExceptionInfo 31 | #"Aggregate was invalid." 32 | (dosync (alter iagg assoc :property nil))))))) 33 | -------------------------------------------------------------------------------- /core/test/publicator/use_cases/interactors/post/create_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.post.create-test 2 | (:require 3 | [publicator.use-cases.interactors.post.create :as sut] 4 | [publicator.use-cases.abstractions.storage :as storage] 5 | [publicator.use-cases.services.user-session :as user-session] 6 | [publicator.use-cases.test.fakes :as fakes] 7 | [publicator.utils.test.instrument :as instrument] 8 | [publicator.use-cases.test.factories :as factories] 9 | [clojure.test :as t])) 10 | 11 | (t/use-fixtures :each fakes/fixture) 12 | (t/use-fixtures :once instrument/fixture) 13 | 14 | (t/deftest process 15 | (let [user (factories/create-user) 16 | _ (user-session/log-in! user) 17 | params (factories/gen ::sut/params) 18 | [tag post] (sut/process params) 19 | user (storage/tx-get-one (:id user))] 20 | (t/testing "success" 21 | (t/is (= ::sut/processed tag))) 22 | (t/testing "update user" 23 | (t/is (contains? (:posts-ids user) (:id post)))))) 24 | 25 | (t/deftest logged-out 26 | (let [params (factories/gen ::sut/params) 27 | [tag] (sut/process params)] 28 | (t/testing "has error" 29 | (t/is (= ::sut/logged-out tag))))) 30 | 31 | (t/deftest invalid-params 32 | (let [user (factories/create-user) 33 | _ (user-session/log-in! user) 34 | params {} 35 | [tag _] (sut/process params)] 36 | (t/testing "error" 37 | (t/is (= ::sut/invalid-params tag))))) 38 | 39 | (t/deftest initial-params 40 | (let [user (factories/create-user) 41 | _ (user-session/log-in! user) 42 | [tag _] (sut/initial-params)] 43 | (t/is (= ::sut/initial-params tag)))) 44 | 45 | (t/deftest initial-params 46 | (let [[tag] (sut/initial-params)] 47 | (t/is (= ::sut/logged-out tag)))) 48 | -------------------------------------------------------------------------------- /core/test/publicator/use_cases/interactors/post/list_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.post.list-test 2 | (:require 3 | [publicator.use-cases.interactors.post.list :as sut] 4 | [publicator.use-cases.test.fakes :as fakes] 5 | [publicator.utils.test.instrument :as instrument] 6 | [publicator.use-cases.test.factories :as factories] 7 | [clojure.test :as t])) 8 | 9 | (t/use-fixtures :each fakes/fixture) 10 | (t/use-fixtures :once instrument/fixture) 11 | 12 | (t/deftest process 13 | (let [post (factories/create-post) 14 | post-id (:id post) 15 | user (factories/create-user {:posts-ids #{post-id}}) 16 | [tag posts] (sut/process)] 17 | (t/is (= ::sut/processed tag)) 18 | (t/is (not-empty posts)))) 19 | -------------------------------------------------------------------------------- /core/test/publicator/use_cases/interactors/post/show_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.post.show-test 2 | (:require 3 | [publicator.use-cases.interactors.post.show :as sut] 4 | [publicator.use-cases.test.fakes :as fakes] 5 | [publicator.utils.test.instrument :as instrument] 6 | [publicator.use-cases.test.factories :as factories] 7 | [clojure.test :as t])) 8 | 9 | (t/use-fixtures :each fakes/fixture) 10 | (t/use-fixtures :once instrument/fixture) 11 | 12 | (t/deftest process 13 | (let [post (factories/create-post) 14 | post-id (:id post) 15 | user (factories/create-user {:posts-ids #{post-id}}) 16 | [tag post] (sut/process (:id post))] 17 | (t/is (= ::sut/processed tag)) 18 | (t/is (some? post)))) 19 | -------------------------------------------------------------------------------- /core/test/publicator/use_cases/interactors/post/update_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.post.update-test 2 | (:require 3 | [publicator.use-cases.interactors.post.update :as sut] 4 | [publicator.use-cases.abstractions.storage :as storage] 5 | [publicator.use-cases.services.user-session :as user-session] 6 | [publicator.use-cases.test.fakes :as fakes] 7 | [publicator.utils.test.instrument :as instrument] 8 | [publicator.use-cases.test.factories :as factories] 9 | [clojure.spec.alpha :as s] 10 | [clojure.test :as t])) 11 | 12 | (t/use-fixtures :each fakes/fixture) 13 | (t/use-fixtures :once instrument/fixture) 14 | 15 | (t/deftest process 16 | (let [post (factories/create-post) 17 | post-id (:id post) 18 | user (factories/create-user {:posts-ids #{post-id}}) 19 | _ (user-session/log-in! user) 20 | params (factories/gen ::sut/params) 21 | [tag post] (sut/process post-id params)] 22 | (t/testing "success" 23 | (t/is (= ::sut/processed tag))) 24 | (t/testing "updated" 25 | (t/is (= params (select-keys post (keys params))))))) 26 | 27 | (t/deftest logged-out 28 | (let [post (factories/create-post) 29 | params (factories/gen ::sut/params) 30 | [tag] (sut/process (:id post) params)] 31 | (t/testing "has error" 32 | (t/is (= ::sut/logged-out tag))))) 33 | 34 | (t/deftest another-author 35 | (let [user (factories/create-user) 36 | _ (user-session/log-in! user) 37 | post (factories/create-post) 38 | params (factories/gen ::sut/params) 39 | [tag] (sut/process (:id post) params)] 40 | (t/testing "error" 41 | (t/is (= ::sut/not-authorized tag))))) 42 | 43 | (t/deftest invalid-params 44 | (let [post (factories/create-post) 45 | post-id (:id post) 46 | user (factories/create-user {:posts-ids #{post-id}}) 47 | _ (user-session/log-in! user) 48 | params {} 49 | [tag] (sut/process post-id params)] 50 | (t/testing "error" 51 | (t/is (= ::sut/invalid-params tag))))) 52 | 53 | (t/deftest not-found 54 | (let [wrong-id 42 55 | user (factories/create-user {:posts-ids #{wrong-id}}) 56 | _ (user-session/log-in! user) 57 | params (factories/gen ::sut/params) 58 | [tag] (sut/process wrong-id params)] 59 | (t/testing "error" 60 | (t/is (= ::sut/not-found tag))))) 61 | 62 | (t/deftest initial-params 63 | (let [post (factories/create-post) 64 | post-id (:id post) 65 | user (factories/create-user {:posts-ids #{post-id}}) 66 | _ (user-session/log-in! user) 67 | [tag] (sut/initial-params (:id post))] 68 | (t/testing "success" 69 | (t/is (= ::sut/initial-params tag))))) 70 | -------------------------------------------------------------------------------- /core/test/publicator/use_cases/interactors/user/log_in_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.user.log-in-test 2 | (:require 3 | [publicator.use-cases.interactors.user.log-in :as sut] 4 | [publicator.domain.aggregates.user :as user] 5 | [publicator.use-cases.services.user-session :as user-session] 6 | [publicator.use-cases.test.fakes :as fakes] 7 | [publicator.utils.test.instrument :as instrument] 8 | [publicator.use-cases.test.factories :as factories] 9 | [clojure.test :as t])) 10 | 11 | (t/use-fixtures :each fakes/fixture) 12 | (t/use-fixtures :once instrument/fixture) 13 | 14 | (t/deftest main 15 | (let [password (factories/gen ::user/password) 16 | user (factories/create-user {:password password}) 17 | params {:login (:login user), :password password} 18 | [tag] (sut/process params)] 19 | (t/testing "success" 20 | (t/is (= ::sut/processed tag))) 21 | (t/testing "logged in" 22 | (t/is (user-session/logged-in?))))) 23 | 24 | (t/deftest wrong-login 25 | (let [params {:login "john_doe" 26 | :password "secret password"} 27 | [tag] (sut/process params)] 28 | (t/testing "has error" 29 | (t/is (= ::sut/authentication-failed tag))))) 30 | 31 | (t/deftest wrong-password 32 | (let [user (factories/create-user) 33 | params {:login (:login user) 34 | :password "wrong password"} 35 | [tag] (sut/process params)] 36 | (t/testing "has error" 37 | (t/is (= ::sut/authentication-failed tag))))) 38 | 39 | (t/deftest already-logged-in 40 | (let [user (factories/create-user) 41 | _ (user-session/log-in! user) 42 | params {:login "foo" 43 | :password "bar"} 44 | [tag] (sut/process params)] 45 | (t/testing "has error" 46 | (t/is (= ::sut/already-logged-in tag))))) 47 | 48 | (t/deftest invalid-params 49 | (let [params {} 50 | [tag] (sut/process params)] 51 | (t/testing "error" 52 | (t/is (= ::sut/invalid-params tag))))) 53 | -------------------------------------------------------------------------------- /core/test/publicator/use_cases/interactors/user/log_out_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.user.log-out-test 2 | (:require 3 | [publicator.use-cases.interactors.user.log-out :as sut] 4 | [publicator.domain.aggregates.user :as user] 5 | [publicator.use-cases.services.user-session :as user-session] 6 | [publicator.use-cases.test.fakes :as fakes] 7 | [publicator.utils.test.instrument :as instrument] 8 | [publicator.use-cases.test.factories :as factories] 9 | [clojure.test :as t])) 10 | 11 | (t/use-fixtures :each fakes/fixture) 12 | (t/use-fixtures :once instrument/fixture) 13 | 14 | (t/deftest main 15 | (let [user (factories/create-user) 16 | _ (user-session/log-in! user) 17 | [tag] (sut/process)] 18 | (t/testing "success" 19 | (t/is (= ::sut/processed tag))) 20 | (t/testing "logged out" 21 | (t/is (user-session/logged-out?))))) 22 | 23 | (t/deftest already-logged-out 24 | (let [[tag] (sut/process)] 25 | (t/testing "has error" 26 | (t/is (= ::sut/already-logged-out tag))))) 27 | -------------------------------------------------------------------------------- /core/test/publicator/use_cases/interactors/user/register_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.interactors.user.register-test 2 | (:require 3 | [publicator.use-cases.interactors.user.register :as sut] 4 | [publicator.use-cases.services.user-session :as user-session] 5 | [publicator.use-cases.abstractions.storage :as storage] 6 | [publicator.use-cases.abstractions.user-queries :as user-q] 7 | [publicator.use-cases.test.fakes :as fakes] 8 | [publicator.utils.test.instrument :as instrument] 9 | [publicator.use-cases.test.factories :as factories] 10 | [clojure.test :as t])) 11 | 12 | (t/use-fixtures :each fakes/fixture) 13 | (t/use-fixtures :once instrument/fixture) 14 | 15 | (t/deftest process 16 | (let [params (factories/gen ::sut/params) 17 | [tag user] (sut/process params)] 18 | (t/testing "success" 19 | (t/is (= ::sut/processed tag))) 20 | (t/testing "logged in" 21 | (t/is (user-session/logged-in?))) 22 | (t/testing "persisted" 23 | (t/is (some? (storage/tx-get-one (:id user))))))) 24 | 25 | (t/deftest already-registered 26 | (let [params (factories/gen ::sut/params) 27 | _ (factories/create-user {:login (:login params)}) 28 | [tag] (sut/process params)] 29 | (t/testing "has error" 30 | (t/is (= ::sut/already-registered tag))) 31 | (t/testing "not sign in" 32 | (t/is (user-session/logged-out?))))) 33 | 34 | (t/deftest already-logged-in 35 | (let [user (factories/create-user) 36 | _ (user-session/log-in! user) 37 | params (factories/gen ::sut/params) 38 | [tag] (sut/process params)] 39 | (t/testing "has error" 40 | (t/is (= ::sut/already-logged-in tag))))) 41 | 42 | (t/deftest invalid-params 43 | (let [params {} 44 | [tag _] (sut/process params)] 45 | (t/testing "error" 46 | (t/is (= ::sut/invalid-params tag))))) 47 | -------------------------------------------------------------------------------- /core/test/publicator/use_cases/test/fakes/storage_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.use-cases.test.fakes.storage-test 2 | (:require 3 | [publicator.use-cases.test.fakes.storage :as sut] 4 | [publicator.use-cases.abstractions.storage :as storage] 5 | [publicator.domain.abstractions.aggregate :as aggregate] 6 | [publicator.domain.identity :as identity] 7 | [publicator.utils.test.instrument :as instrument] 8 | [clojure.test :as t])) 9 | 10 | (t/use-fixtures :once instrument/fixture) 11 | 12 | (t/use-fixtures 13 | :each 14 | (fn [f] 15 | (with-bindings (sut/binding-map (sut/build-db)) 16 | (f)))) 17 | 18 | (defrecord Test [counter] 19 | aggregate/Aggregate 20 | (id [_] 42) 21 | (spec [_] any?)) 22 | 23 | (t/deftest create 24 | (let [test (storage/tx-create (->Test 0)) 25 | id (aggregate/id test)] 26 | (t/is (some? test)) 27 | (t/is (some? (storage/tx-get-one id))))) 28 | 29 | (t/deftest change 30 | (let [test (storage/tx-create (->Test 0)) 31 | id (aggregate/id test) 32 | _ (storage/tx-alter test update :counter inc) 33 | test (storage/tx-get-one id)] 34 | (t/is (= 1 (:counter test))))) 35 | 36 | (t/deftest identity-map-persisted 37 | (let [test (storage/tx-create (->Test 0)) 38 | id (aggregate/id test)] 39 | (storage/with-tx t 40 | (let [x (storage/get-one t id) 41 | y (storage/get-one t id)] 42 | (t/is (identical? x y)))))) 43 | 44 | (t/deftest identity-map-in-memory 45 | (storage/with-tx t 46 | (let [x (storage/create t (->Test 0)) 47 | y (storage/get-one t (aggregate/id @x))] 48 | (t/is (identical? x y))))) 49 | 50 | (t/deftest identity-map-swap 51 | (storage/with-tx t 52 | (let [x (storage/create t (->Test 0)) 53 | y (storage/get-one t (aggregate/id @x)) 54 | _ (dosync (alter x update :counter inc))] 55 | (t/is (= 1 (:counter @x) (:counter @y)))))) 56 | 57 | (t/deftest concurrency 58 | (let [test (storage/tx-create (->Test 0)) 59 | id (aggregate/id test) 60 | n 10 61 | _ (->> (repeatedly #(future (storage/tx-alter test update :counter inc))) 62 | (take n) 63 | (doall) 64 | (map deref) 65 | (doall)) 66 | test (storage/tx-get-one id)] 67 | (t/is (= n (:counter test))))) 68 | 69 | (t/deftest inner-concurrency 70 | (let [test (storage/tx-create (->Test 0)) 71 | id (aggregate/id test) 72 | n 10 73 | _ (storage/with-tx t 74 | (->> (repeatedly #(future (as-> id <> 75 | (storage/get-one t <>) 76 | (dosync (alter <> update :counter inc))))) 77 | (take n) 78 | (doall) 79 | (map deref) 80 | (doall))) 81 | test (storage/tx-get-one id)] 82 | (t/is (= n (:counter test))))) 83 | -------------------------------------------------------------------------------- /crypto/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {publicator.core {:local/root "../core"} 2 | buddy/buddy-hashers {:mvn/version "1.3.0"}} 3 | 4 | :aliases {:dev {:extra-paths ["test"]}}} 5 | -------------------------------------------------------------------------------- /crypto/src/publicator/crypto/password_hasher.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.crypto.password-hasher 2 | (:require 3 | [buddy.hashers] 4 | [publicator.domain.abstractions.password-hasher :as password-hasher])) 5 | 6 | (deftype PasswordHasher [] 7 | password-hasher/PasswordHasher 8 | (-derive [_ password] 9 | (buddy.hashers/derive password)) 10 | (-check [_ attempt encrypted] 11 | (buddy.hashers/check attempt encrypted))) 12 | 13 | (defn binding-map [] 14 | {#'password-hasher/*password-hasher* (PasswordHasher.)}) 15 | -------------------------------------------------------------------------------- /crypto/test/publicator/crypto/password_hasher_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.crypto.password-hasher-test 2 | (:require 3 | [clojure.test :as t] 4 | [publicator.utils.test.instrument :as instrument] 5 | [publicator.crypto.password-hasher :as sut] 6 | [publicator.domain.abstractions.password-hasher :as password-hasher])) 7 | 8 | (defn- setup [t] 9 | (with-bindings (sut/binding-map) 10 | (t))) 11 | 12 | (t/use-fixtures :once 13 | instrument/fixture) 14 | 15 | (t/use-fixtures :each 16 | setup) 17 | 18 | (t/deftest ok 19 | (let [pass "strong password" 20 | digest (password-hasher/derive pass)] 21 | (t/is (password-hasher/check pass digest)))) 22 | -------------------------------------------------------------------------------- /docker-compose.yml: -------------------------------------------------------------------------------- 1 | version: '3' 2 | 3 | volumes: 4 | m2: 5 | gitlibs: 6 | 7 | services: 8 | app: 9 | image: clojure:tools-deps-alpine 10 | working_dir: "${PWD}" 11 | command: "true" 12 | ports: 13 | - "4444:4444" # nrepl 14 | - "4445:4445" # http (web) 15 | - "4446:4446" # http (main) 16 | environment: 17 | - "CLJ_CONFIG=${PWD}/.docker-clojure" 18 | - DATABASE_URL=postgres://postgres:password@db:5432/postgres 19 | - TEST_DATABASE_URL=postgres://postgres:password@test-db:5432/postgres 20 | - PORT=4446 21 | volumes: 22 | - ".:${PWD}:cached" # cached - MacOS option 23 | - m2:/root/.m2 24 | - gitlibs:/root/.gitlibs 25 | links: 26 | - db 27 | - test-db 28 | db: &db 29 | image: postgres:10.4-alpine 30 | environment: 31 | - POSTGRES_PASSWORD=password 32 | test-db: 33 | <<: *db 34 | -------------------------------------------------------------------------------- /main/.gitignore: -------------------------------------------------------------------------------- 1 | /main.jar -------------------------------------------------------------------------------- /main/Procfile: -------------------------------------------------------------------------------- 1 | web: java -cp main.jar clojure.main -m publicator.main.core -------------------------------------------------------------------------------- /main/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {publicator.web {:local/root "../web"} 2 | publicator.persistence {:local/root "../persistence"} 3 | publicator.crypto {:local/root "../crypto"} 4 | spootnik/signal {:mvn/version "0.2.2"}} 5 | 6 | :aliases {:start {:main-opts ["-m" "publicator.main.core"]} 7 | :uberjar {:main-opts ["-m" "hf.depstar.uberjar" "main.jar"] 8 | :extra-deps 9 | {com.healthfinch/depstar {:git/url "https://github.com/healthfinch/depstar.git" 10 | :sha "4aa7b35189693feebc7d7e4a180b8af0326c9164"}}}}} 11 | -------------------------------------------------------------------------------- /main/src/publicator/main/binding_map.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.main.binding-map 2 | (:require 3 | [com.stuartsierra.component :as component] 4 | [publicator.persistence.storage :as storage] 5 | [publicator.persistence.storage.user-mapper :as user-mapper] 6 | [publicator.persistence.storage.post-mapper :as post-mapper] 7 | [publicator.persistence.user-queries :as user-q] 8 | [publicator.persistence.post-queries :as post-q] 9 | [publicator.persistence.id-generator :as id-generator] 10 | [publicator.crypto.password-hasher :as password-hasher])) 11 | 12 | (defrecord BindingMap [data-source val] 13 | component/Lifecycle 14 | (start [this] 15 | (let [data-source (:val data-source) 16 | mappers (merge 17 | (post-mapper/mapper) 18 | (user-mapper/mapper)) 19 | binding-map (merge 20 | (storage/binding-map data-source mappers) 21 | (user-q/binding-map data-source) 22 | (post-q/binding-map data-source) 23 | (password-hasher/binding-map) 24 | (id-generator/binding-map data-source))] 25 | (assoc this :val binding-map))) 26 | (stop [this] 27 | (assoc this :val nil))) 28 | 29 | (defn build [] 30 | (BindingMap. nil nil)) 31 | -------------------------------------------------------------------------------- /main/src/publicator/main/core.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.main.core 2 | (:require 3 | [com.stuartsierra.component :as component] 4 | [signal.handler :as signal] 5 | [publicator.web.components.jetty :as jetty] 6 | [publicator.web.components.handler :as handler] 7 | [publicator.persistence.components.data-source :as data-source] 8 | [publicator.persistence.components.migration :as migration] 9 | [publicator.persistence.utils.env :as env] 10 | [publicator.main.binding-map :as binding-map] 11 | 12 | [publicator.persistence.init] 13 | [publicator.web.init])) 14 | 15 | (defn http-opts [] 16 | {:host "0.0.0.0" 17 | :port (bigint (System/getenv "PORT"))}) 18 | 19 | (defn -main [& _] 20 | (let [system (component/system-map 21 | :data-source (data-source/build (env/data-source-opts "DATABASE_URL")) 22 | :migration (component/using (migration/build) [:data-source]) 23 | :binding-map (component/using (binding-map/build) [:data-source]) 24 | :handler (component/using (handler/build) [:binding-map]) 25 | :jetty (component/using (jetty/build (http-opts)) [:binding-map :handler])) 26 | system (component/start system)] 27 | (signal/with-handler :term 28 | (prn "caught SIGTERM, quitting.") 29 | (component/stop system) 30 | (System/exit 0)))) 31 | -------------------------------------------------------------------------------- /persistence/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {publicator.core {:local/root "../core"} 2 | com.stuartsierra/component {:mvn/version "0.3.2"} 3 | org.flywaydb/flyway-core {:mvn/version "5.0.7"} 4 | funcool/clojure.jdbc {:mvn/version "0.9.0"} 5 | com.layerware/hugsql-core {:mvn/version "0.4.8"} 6 | com.layerware/hugsql-adapter-clojure-jdbc {:mvn/version "0.4.8"} 7 | org.postgresql/postgresql {:mvn/version "42.2.2"} 8 | com.mchange/c3p0 {:mvn/version "0.9.5.2"}} 9 | 10 | :paths ["src" "resources"] 11 | :aliases {:dev {:extra-paths ["dev" "test"]}}} 12 | -------------------------------------------------------------------------------- /persistence/dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require 3 | [publicator.persistence.init])) 4 | 5 | (defn start []) 6 | 7 | (defn stop []) 8 | -------------------------------------------------------------------------------- /persistence/resources/db/migration/V1__id_sequence.sql: -------------------------------------------------------------------------------- 1 | CREATE SEQUENCE "id-generator"; 2 | -------------------------------------------------------------------------------- /persistence/resources/db/migration/V2__create_post.sql: -------------------------------------------------------------------------------- 1 | CREATE TABLE "post" ( 2 | "id" bigint PRIMARY KEY, 3 | "title" varchar(255), 4 | "content" text, 5 | "created-at" timestamp 6 | ); 7 | -------------------------------------------------------------------------------- /persistence/resources/db/migration/V3__create_user.sql: -------------------------------------------------------------------------------- 1 | CREATE TABLE "user" ( 2 | "id" bigint PRIMARY KEY, 3 | "login" varchar(255) UNIQUE, 4 | "full-name" varchar(255), 5 | "password-digest" text, 6 | "posts-ids" bigint[], 7 | "created-at" timestamp 8 | ); 9 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/components/data_source.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.components.data-source 2 | (:require 3 | [com.stuartsierra.component :as component]) 4 | (:import 5 | [com.mchange.v2.c3p0 ComboPooledDataSource])) 6 | 7 | (defrecord DataSource [config val] 8 | component/Lifecycle 9 | (start [this] 10 | (assoc this :val 11 | (doto (ComboPooledDataSource.) 12 | (.setJdbcUrl (:jdbc-url config)) 13 | (.setUser (:user config)) 14 | (.setPassword (:password config))))) 15 | (stop [this] 16 | (.close val) 17 | (assoc this :val nil))) 18 | 19 | (defn build [config] 20 | (DataSource. config nil)) 21 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/components/migration.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.components.migration 2 | (:require 3 | [com.stuartsierra.component :as component]) 4 | (:import 5 | [org.flywaydb.core Flyway])) 6 | 7 | (defrecord Migration [data-source] 8 | component/Lifecycle 9 | (start [this] 10 | (doto (Flyway.) 11 | (.setDataSource (:val data-source)) 12 | (.migrate)) 13 | this) 14 | (stop [this] 15 | this)) 16 | 17 | (defn build [] 18 | (Migration. nil)) 19 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/id_generator.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.id-generator 2 | (:require 3 | [jdbc.core :as jdbc] 4 | [publicator.domain.abstractions.id-generator :as id-generator])) 5 | 6 | (deftype IdGenerator [data-source] 7 | id-generator/IdGenerator 8 | (-generate [_] 9 | (with-open [conn (jdbc/connection data-source)] 10 | (let [stmt (jdbc/prepared-statement conn "SELECT nextval('id-generator') AS id") 11 | resp (jdbc/fetch-one conn stmt)] 12 | (:id resp))))) 13 | 14 | (defn binding-map [datasource] 15 | {#'id-generator/*id-generator* (->IdGenerator datasource)}) 16 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/init.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.init 2 | (:require 3 | [publicator.persistence.types] 4 | [hugsql.core :as hugsql] 5 | [hugsql.adapter.clojure-jdbc :as cj-adapter])) 6 | 7 | (hugsql/set-adapter! (cj-adapter/hugsql-adapter-clojure-jdbc)) 8 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/post_queries.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.post-queries 2 | (:require 3 | [hugsql.core :as hugsql] 4 | [jdbc.core :as jdbc] 5 | [publicator.use-cases.abstractions.post-queries :as post-q] 6 | [publicator.domain.aggregates.post :as post])) 7 | 8 | (hugsql/def-db-fns "publicator/persistence/post_queries.sql") 9 | 10 | (defn- sql->post [row] 11 | (post/map->Post row)) 12 | 13 | (deftype GetList [data-source] 14 | post-q/GetList 15 | (-get-list [this] 16 | (with-open [conn (jdbc/connection data-source)] 17 | (map sql->post (post-get-list conn))))) 18 | 19 | (deftype GetById [data-source] 20 | post-q/GetById 21 | (-get-by-id [this id] 22 | (with-open [conn (jdbc/connection data-source)] 23 | (when-let [row (post-get-by-id conn {:id id})] 24 | (sql->post row))))) 25 | 26 | (defn binding-map [data-source] 27 | {#'post-q/*get-list* (GetList. data-source) 28 | #'post-q/*get-by-id* (GetById. data-source)}) 29 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/post_queries.sql: -------------------------------------------------------------------------------- 1 | -- :name- post-get-list :? :n 2 | SELECT "post".*, 3 | "user"."id" AS "publicator.domain.aggregates.user/id", 4 | "user"."full-name" AS "publicator.domain.aggregates.user/full-name" 5 | FROM "post" 6 | JOIN "user" ON "user"."posts-ids" @> ARRAY["post"."id"] 7 | 8 | -- :name- post-get-by-id :? :1 9 | SELECT "post".*, 10 | "user"."id" AS "publicator.domain.aggregates.user/id", 11 | "user"."full-name" AS "publicator.domain.aggregates.user/full-name" 12 | FROM "post" 13 | JOIN "user" ON "user"."posts-ids" @> ARRAY["post"."id"] 14 | WHERE "post"."id" = :id 15 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/storage.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.storage 2 | (:require 3 | [jdbc.core :as jdbc] 4 | [publicator.use-cases.abstractions.storage :as storage] 5 | [publicator.domain.abstractions.aggregate :as aggregate] 6 | [publicator.domain.abstractions.id-generator :as id-generator] 7 | [publicator.domain.identity :as identity] 8 | [publicator.utils.ext :as ext] 9 | [clojure.spec.alpha :as s]) 10 | (:import 11 | [java.util.concurrent TimeoutException] 12 | [java.time Instant])) 13 | 14 | (s/def ::version some?) 15 | (s/def ::versioned-id (s/keys :req-un [::id-generator/id ::version])) 16 | (s/def ::versioned-aggregate (s/keys :req-un [::aggregate/aggregate ::version])) 17 | 18 | ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 19 | 20 | (defprotocol Mapper 21 | (-lock [this conn ids]) 22 | (-select [this conn ids]) 23 | (-insert [this conn aggregates]) 24 | (-delete [this conn ids])) 25 | 26 | (s/def ::mapper #(satisfies? Mapper %)) 27 | 28 | (s/fdef lock 29 | :args (s/cat :this ::mapper, :conn any?, :ids (s/coll-of ::id-generator/id)) 30 | :ret (s/coll-of ::versioned-id)) 31 | 32 | (s/fdef select 33 | :args (s/cat :this ::mapper, :conn any?, :ids (s/coll-of ::id-generator/id)) 34 | :ret (s/coll-of ::versioned-aggregate)) 35 | 36 | (s/fdef insert 37 | :args (s/cat :this ::mapper, :conn any?, :aggregates (s/coll-of ::aggregate/aggregate)) 38 | :ret any?) 39 | 40 | (s/fdef delete 41 | :args (s/cat :this ::mapper, :conn any?, :ids (s/coll-of ::id-generator/id)) 42 | :ret any?) 43 | 44 | (defn- default-for-empty [f default] 45 | (fn [this conn coll] 46 | (if (empty? coll) 47 | default 48 | (f this conn coll)))) 49 | 50 | (def lock (default-for-empty -lock [])) 51 | (def select (default-for-empty -select [])) 52 | (def insert (default-for-empty -insert nil)) 53 | (def delete (default-for-empty -delete nil)) 54 | 55 | ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 56 | 57 | (defrecord Transaction [data-source mappers identity-map] 58 | storage/Transaction 59 | (-get-many [this ids] 60 | (with-open [conn (jdbc/connection data-source)] 61 | (let [ids-for-select (remove #(contains? @identity-map %) ids) 62 | selected (->> mappers 63 | (vals) 64 | (mapcat #(select % conn ids-for-select)) 65 | (map (fn [{:keys [aggregate version]}] 66 | (let [iaggregate (identity/build aggregate)] 67 | (alter-meta! iaggregate assoc 68 | ::version version 69 | ::initial aggregate) 70 | iaggregate))) 71 | (group-by #(-> % deref aggregate/id)) 72 | (ext/map-vals first))] 73 | ;; Здесь принципиально использование reverse-merge, 74 | ;; т.к. другой поток может успеть извлечь данные из базы, 75 | ;; создать объект-идентичность, записать его в identity map 76 | ;; и сделать в нем изменения. 77 | ;; Если использовать merge, то этот поток затрет идентичность 78 | ;; другим объектом-идентичностью с начальным состоянием. 79 | ;; Фактически это нарушает саму идею identity-map - 80 | ;; сопоставление ссылки на объект с его идентификатором 81 | (-> identity-map 82 | (swap! ext/reverse-merge selected) 83 | (select-keys ids))))) 84 | 85 | (-create [this state] 86 | (let [id (aggregate/id state) 87 | istate (identity/build state)] 88 | (swap! identity-map (fn [map] 89 | {:pre [(not (contains? map id))]} 90 | (assoc map id istate))) 91 | istate))) 92 | 93 | (defn- build-tx [data-source mappers] 94 | (Transaction. data-source mappers (atom {}))) 95 | 96 | (defn- need-insert? [identity] 97 | (not= @identity 98 | (-> identity meta ::initial))) 99 | 100 | (defn- need-delete? [identity] 101 | (let [initial (-> identity meta ::initial)] 102 | (and (some? initial) 103 | (not= @identity initial)))) 104 | 105 | (defn- lock-all [conn mappers identities] 106 | (let [ids (->> identities 107 | (vals) 108 | (filter need-delete?) 109 | (map deref) 110 | (map aggregate/id)) 111 | db-versions (->> mappers 112 | (vals) 113 | (mapcat #(lock % conn ids)) 114 | (group-by :id) 115 | (ext/map-vals #(-> % first :version))) 116 | memory-versions (->> (select-keys identities ids) 117 | (ext/map-vals #(-> % meta ::version)))] 118 | (= db-versions memory-versions))) 119 | 120 | (defn- delete-all [conn mappers identities] 121 | (let [groups (->> identities 122 | (vals) 123 | (filter need-delete?) 124 | (map deref) 125 | (group-by class) 126 | (ext/map-keys #(get mappers %)) 127 | (ext/map-vals #(map aggregate/id %)))] 128 | (doseq [[manager ids] groups] 129 | (delete manager conn ids)))) 130 | 131 | (defn- insert-all [conn mappers identities] 132 | (let [groups (->> identities 133 | (vals) 134 | (filter need-insert?) 135 | (map deref) 136 | (group-by class) 137 | (ext/map-keys #(get mappers %)))] 138 | (doseq [[manager aggregates] groups] 139 | (insert manager conn aggregates)))) 140 | 141 | (defn- commit [tx mappers] 142 | (let [data-source (:data-source tx) 143 | identities @(:identity-map tx)] 144 | (with-open [conn (jdbc/connection data-source)] 145 | (jdbc/atomic conn 146 | (when (lock-all conn mappers identities) 147 | (delete-all conn mappers identities) 148 | (insert-all conn mappers identities) 149 | true))))) 150 | 151 | (defn- timestamp [] 152 | (inst-ms (Instant/now))) 153 | 154 | (deftype Storage [data-source mappers opts] 155 | storage/Storage 156 | (-wrap-tx [this body] 157 | (let [soft-timeout (get opts :soft-timeout-ms 500) 158 | stop-after (+ (timestamp) soft-timeout)] 159 | (loop [attempt 0] 160 | (let [tx (build-tx data-source mappers) 161 | res (body tx) 162 | success? (commit tx mappers)] 163 | (cond 164 | success? res 165 | (< (timestamp) stop-after) (recur (inc attempt)) 166 | :else (throw (TimeoutException. 167 | (str "Can't run transaction after " 168 | attempt " attempts"))))))))) 169 | 170 | 171 | 172 | (s/fdef binding-map 173 | :args (s/cat :data-source any? 174 | :mappers (s/map-of class? ::mapper) 175 | :opts (s/? map?)) 176 | :ret map?) 177 | 178 | (defn binding-map 179 | ([data-source mappers] 180 | (binding-map data-source mappers {})) 181 | ([data-source mappers opts] 182 | {#'storage/*storage* (Storage. data-source mappers opts)})) 183 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/storage/post_mapper.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.storage.post-mapper 2 | (:require 3 | [hugsql.core :as hugsql] 4 | [publicator.domain.aggregates.post :as post] 5 | [publicator.persistence.storage :as persistence.storage]) 6 | (:import 7 | [publicator.domain.aggregates.post Post])) 8 | 9 | (hugsql/def-db-fns "publicator/persistence/storage/post_mapper.sql") 10 | 11 | (defn- row->versioned-aggregate [row] 12 | {:aggregate (-> row (dissoc :version) post/map->Post) 13 | :version (-> row (get :version))}) 14 | 15 | (deftype PostMapper [] 16 | persistence.storage/Mapper 17 | (-lock [_ conn ids] 18 | (post-locks conn {:ids ids})) 19 | (-select [_ conn ids] 20 | (map row->versioned-aggregate (post-select conn {:ids ids}))) 21 | (-insert [_ conn aggregates] 22 | (post-insert conn {:vals (map vals aggregates)})) 23 | (-delete [_ conn ids] 24 | (post-delete conn {:ids ids}))) 25 | 26 | (defn mapper [] 27 | {Post (PostMapper.)}) 28 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/storage/post_mapper.sql: -------------------------------------------------------------------------------- 1 | -- :name- post-insert :! 2 | INSERT INTO "post" VALUES :tuple*:vals; 3 | 4 | -- :name- post-select :? :* 5 | SELECT *, xmin AS version FROM "post" WHERE id IN (:v*:ids) 6 | 7 | -- :name- post-delete :! 8 | DELETE FROM "post" WHERE id IN (:v*:ids) 9 | 10 | -- :name- post-locks :? :* 11 | SELECT id, xmin AS version FROM "post" WHERE id IN (:v*:ids) FOR UPDATE 12 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/storage/user_mapper.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.storage.user-mapper 2 | (:require 3 | [hugsql.core :as hugsql] 4 | [publicator.domain.aggregates.user :as user] 5 | [publicator.persistence.storage :as persistence.storage]) 6 | (:import 7 | [publicator.domain.aggregates.user User])) 8 | 9 | (hugsql/def-db-fns "publicator/persistence/storage/user_mapper.sql") 10 | 11 | (defn- row->versioned-aggregate [row] 12 | {:aggregate (-> row (dissoc :version) user/map->User) 13 | :version (-> row (get :version))}) 14 | 15 | (deftype UserMapper [] 16 | persistence.storage/Mapper 17 | (-lock [_ conn ids] 18 | (user-locks conn {:ids ids})) 19 | (-select [_ conn ids] 20 | (map row->versioned-aggregate (user-select conn {:ids ids}))) 21 | (-insert [_ conn aggregates] 22 | (user-insert conn {:vals (map vals aggregates)})) 23 | (-delete [_ conn ids] 24 | (user-delete conn {:ids ids}))) 25 | 26 | (defn mapper [] 27 | {User (UserMapper.)}) 28 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/storage/user_mapper.sql: -------------------------------------------------------------------------------- 1 | -- :name- user-insert :! 2 | INSERT INTO "user" VALUES :tuple*:vals; 3 | 4 | -- :name- user-select :? :* 5 | SELECT *, xmin AS version FROM "user" WHERE id IN (:v*:ids) 6 | 7 | -- :name- user-delete :! 8 | DELETE FROM "user" WHERE id IN (:v*:ids) 9 | 10 | -- :name- user-locks :? :* 11 | SELECT id, xmin AS version FROM "user" WHERE id IN (:v*:ids) FOR UPDATE 12 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/types.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.types 2 | (:require 3 | [jdbc.proto]) 4 | (:import 5 | [org.postgresql.jdbc PgArray] 6 | [org.postgresql.util PGobject] 7 | [java.sql Timestamp] 8 | [java.time Instant] 9 | [java.util Collection])) 10 | 11 | (extend-protocol jdbc.proto/ISQLResultSetReadColumn 12 | PGobject 13 | (from-sql-type [this _conn _metadata _i] 14 | (let [type (.getType this) 15 | value (.getValue this)] 16 | (case type 17 | "xid" (bigint value) 18 | :else this))) 19 | 20 | PgArray 21 | (from-sql-type [this _conn metadata i] 22 | (let [column-name (.getColumnName metadata i) 23 | arr (.getArray this)] 24 | (cond 25 | (re-matches #".+-ids" column-name) (set arr) 26 | :else (vec arr)))) 27 | 28 | Timestamp 29 | (from-sql-type [this _conn _metadata _i] 30 | (.toInstant this))) 31 | 32 | (extend-protocol jdbc.proto/ISQLType 33 | Instant 34 | (set-stmt-parameter! [self conn stmt index] 35 | (let [sql-val (Timestamp/from self)] 36 | (.setObject stmt index sql-val))) 37 | 38 | Collection 39 | (set-stmt-parameter! [self conn stmt index] 40 | (let [scalar-type (-> stmt 41 | .getParameterMetaData 42 | (.getParameterTypeName index) 43 | (subs 1)) 44 | sql-val (.createArrayOf conn scalar-type (to-array self))] 45 | (.setObject stmt index sql-val)))) 46 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/user_queries.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.user-queries 2 | (:require 3 | [hugsql.core :as hugsql] 4 | [jdbc.core :as jdbc] 5 | [publicator.use-cases.abstractions.user-queries :as user-q] 6 | [publicator.domain.aggregates.user :as user])) 7 | 8 | (hugsql/def-db-fns "publicator/persistence/user_queries.sql") 9 | 10 | (deftype GetByLogin [data-source] 11 | user-q/GetByLogin 12 | (-get-by-login [this login] 13 | (with-open [conn (jdbc/connection data-source)] 14 | (when-let [row (user-get-by-login conn {:login login})] 15 | (user/map->User row))))) 16 | 17 | (defn binding-map [data-source] 18 | [#'user-q/*get-by-login* (GetByLogin. data-source)]) 19 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/user_queries.sql: -------------------------------------------------------------------------------- 1 | -- :name- user-get-by-login :? :1 2 | SELECT * FROM "user" WHERE login = :login LIMIT 1 3 | -------------------------------------------------------------------------------- /persistence/src/publicator/persistence/utils/env.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.utils.env) 2 | 3 | (defn data-source-opts [env-name] 4 | (let [database-url (System/getenv env-name) 5 | pattern #"postgres://(\S+):(\S+)@(\S+):(\S+)/(\S+)" 6 | [_ user password host port path] (re-matches pattern database-url)] 7 | {:jdbc-url (str "jdbc:postgresql://" host ":" port "/" path) 8 | :user user 9 | :password password})) 10 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/id_generator_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.id-generator-test 2 | (:require 3 | [clojure.test :as t] 4 | [publicator.domain.abstractions.id-generator :as id-generator] 5 | [publicator.utils.test.instrument :as instrument] 6 | [publicator.persistence.test.db :as db] 7 | [publicator.persistence.id-generator :as sut])) 8 | 9 | (defn- setup [t] 10 | (with-bindings (sut/binding-map db/*data-source*) 11 | (t))) 12 | 13 | (t/use-fixtures :once 14 | instrument/fixture 15 | db/once-fixture) 16 | 17 | (t/use-fixtures :each 18 | db/each-fixture 19 | setup) 20 | 21 | (t/deftest generate 22 | (t/is (pos-int? (id-generator/generate)))) 23 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/post_queries_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.post-queries-test 2 | (:require 3 | [clojure.test :as t] 4 | [publicator.utils.test.instrument :as instrument] 5 | [publicator.use-cases.test.factories :as factories] 6 | [publicator.domain.test.fakes.password-hasher :as fakes.password-hasher] 7 | [publicator.domain.test.fakes.id-generator :as fakes.id-generator] 8 | [publicator.persistence.storage :as persistence.storage] 9 | [publicator.persistence.storage.user-mapper :as user-mapper] 10 | [publicator.persistence.storage.post-mapper :as post-mapper] 11 | [publicator.persistence.test.db :as db] 12 | [publicator.use-cases.abstractions.post-queries :as post-q] 13 | [publicator.persistence.post-queries :as sut] 14 | [publicator.domain.aggregates.user :as user])) 15 | 16 | (defn setup [t] 17 | (with-bindings (merge 18 | (fakes.password-hasher/binding-map) 19 | (fakes.id-generator/binding-map) 20 | (persistence.storage/binding-map db/*data-source* 21 | (merge 22 | (user-mapper/mapper) 23 | (post-mapper/mapper))) 24 | (sut/binding-map db/*data-source*)) 25 | (t))) 26 | 27 | (t/use-fixtures :once 28 | instrument/fixture 29 | db/once-fixture) 30 | 31 | (t/use-fixtures :each 32 | db/each-fixture 33 | setup) 34 | 35 | (defn post-with-user [post user] 36 | (assoc post 37 | ::user/id (:id user) 38 | ::user/full-name (:full-name user))) 39 | 40 | (t/deftest get-list-found 41 | (let [post (factories/create-post) 42 | user (factories/create-user {:posts-ids #{(:id post)}}) 43 | res (post-q/get-list) 44 | item (first res)] 45 | (t/is (= 1 (count res))) 46 | (t/is (= (post-with-user post user) 47 | item)))) 48 | 49 | (t/deftest get-list-empty 50 | (let [res (post-q/get-list)] 51 | (t/is (empty? res)))) 52 | 53 | (t/deftest get-by-id 54 | (let [post (factories/create-post) 55 | id (:id post) 56 | user (factories/create-user {:posts-ids #{id}}) 57 | item (post-q/get-by-id id)] 58 | (t/is (= (post-with-user post user) 59 | item)))) 60 | 61 | (t/deftest get-by-id-not-found 62 | (let [item (post-q/get-by-id 42)] 63 | (t/is (nil? item)))) 64 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/storage/post_mapper_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.storage.post-mapper-test 2 | (:require 3 | [clojure.test :as t] 4 | [publicator.utils.test.instrument :as instrument] 5 | [publicator.use-cases.test.factories :as factories] 6 | [publicator.domain.test.fakes.password-hasher :as fakes.password-hasher] 7 | [publicator.domain.test.fakes.id-generator :as fakes.id-generator] 8 | [publicator.persistence.storage :as persistence.storage] 9 | [publicator.persistence.test.db :as db] 10 | [publicator.use-cases.abstractions.storage :as storage] 11 | [publicator.persistence.storage.post-mapper :as sut])) 12 | 13 | (defn- setup [t] 14 | (with-bindings (merge 15 | (fakes.password-hasher/binding-map) 16 | (fakes.id-generator/binding-map) 17 | (persistence.storage/binding-map db/*data-source* (sut/mapper))) 18 | (t))) 19 | 20 | (t/use-fixtures :once 21 | instrument/fixture 22 | db/once-fixture) 23 | 24 | (t/use-fixtures :each 25 | db/each-fixture 26 | setup) 27 | 28 | (t/deftest create 29 | (let [entity (factories/create-post)] 30 | (t/is (some? entity)) 31 | (t/is (= entity 32 | (storage/tx-get-one (:id entity)))))) 33 | 34 | (t/deftest change 35 | (let [entity (factories/create-post) 36 | title "new title" 37 | _ (storage/tx-alter entity assoc :title title) 38 | entity (storage/tx-get-one (:id entity))] 39 | (t/is (= title (:title entity))))) 40 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/storage/user_mapper_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.storage.user-mapper-test 2 | (:require 3 | [clojure.test :as t] 4 | [publicator.utils.test.instrument :as instrument] 5 | [publicator.use-cases.test.factories :as factories] 6 | [publicator.domain.test.fakes.password-hasher :as fakes.password-hasher] 7 | [publicator.domain.test.fakes.id-generator :as fakes.id-generator] 8 | [publicator.persistence.storage :as persistence.storage] 9 | [publicator.persistence.test.db :as db] 10 | [publicator.use-cases.abstractions.storage :as storage] 11 | [publicator.persistence.storage.user-mapper :as sut])) 12 | 13 | (defn- setup [t] 14 | (with-bindings (merge 15 | (fakes.password-hasher/binding-map) 16 | (fakes.id-generator/binding-map) 17 | (persistence.storage/binding-map db/*data-source* (sut/mapper))) 18 | (t))) 19 | 20 | (t/use-fixtures :once 21 | instrument/fixture 22 | db/once-fixture) 23 | 24 | (t/use-fixtures :each 25 | db/each-fixture 26 | setup) 27 | 28 | (t/deftest create 29 | (let [entity (factories/create-user {:posts-ids #{1 2 3}})] 30 | (t/is (some? entity)) 31 | (t/is (= entity 32 | (storage/tx-get-one (:id entity)))))) 33 | 34 | (t/deftest change 35 | (let [entity (factories/create-user) 36 | login "new_login" 37 | _ (storage/tx-alter entity assoc :login login) 38 | entity (storage/tx-get-one (:id entity))] 39 | (t/is (= login (:login entity))))) 40 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/storage_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.storage-test 2 | (:require 3 | [publicator.utils.test.instrument :as instrument] 4 | [clojure.test :as t] 5 | [hugsql.core :as hugsql] 6 | [jdbc.core :as jdbc] 7 | [publicator.domain.abstractions.aggregate :as aggregate] 8 | [publicator.use-cases.abstractions.storage :as storage] 9 | [publicator.persistence.test.db :as db] 10 | [publicator.persistence.storage :as sut])) 11 | 12 | (defrecord TestEntity [id counter] 13 | aggregate/Aggregate 14 | (id [_] id) 15 | (spec [_] any?)) 16 | 17 | (defn build-test-entity [] 18 | (TestEntity. 42 0)) 19 | 20 | ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 21 | 22 | (hugsql/def-db-fns "publicator/persistence/storage_test.sql") 23 | 24 | (defn- aggregate->sql [aggregate] 25 | (vals aggregate)) 26 | 27 | (defn- row->versioned-aggregate [row] 28 | {:aggregate (-> row (dissoc :version) map->TestEntity) 29 | :version (-> row (get :version))}) 30 | 31 | (def mapper (reify sut/Mapper 32 | (-lock [_ conn ids] 33 | (test-entity-locks conn {:ids ids})) 34 | (-select [_ conn ids] 35 | (map row->versioned-aggregate (test-entity-select conn {:ids ids}))) 36 | (-insert [_ conn states] 37 | (test-entity-insert conn {:vals (map aggregate->sql states)})) 38 | (-delete [_ conn ids] 39 | (test-entity-delete conn {:ids ids})))) 40 | 41 | ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 42 | 43 | (defn- setup [t] 44 | (with-bindings (sut/binding-map db/*data-source* {TestEntity mapper}) 45 | (t))) 46 | 47 | (defn- test-table [t] 48 | (with-open [conn (jdbc/connection db/*data-source*)] 49 | (drop-test-entity-table conn) 50 | (create-test-entity-table conn)) 51 | (t)) 52 | 53 | (t/use-fixtures :once 54 | instrument/fixture 55 | db/once-fixture) 56 | 57 | (t/use-fixtures :each 58 | db/each-fixture 59 | test-table 60 | setup) 61 | 62 | (t/deftest create 63 | (let [entity (storage/tx-create (build-test-entity))] 64 | (t/is (some? (storage/tx-get-one (aggregate/id entity)))))) 65 | 66 | (t/deftest change 67 | (let [entity (storage/tx-create (build-test-entity)) 68 | _ (storage/tx-alter entity update :counter inc) 69 | entity (storage/tx-get-one (:id entity))] 70 | (t/is (= 1 (:counter entity))))) 71 | 72 | (t/deftest identity-map-persisted 73 | (let [id (:id (storage/tx-create (build-test-entity)))] 74 | (storage/with-tx t 75 | (let [x (storage/get-one t id) 76 | y (storage/get-one t id)] 77 | (t/is (identical? x y)))))) 78 | 79 | (t/deftest identity-map-in-memory 80 | (storage/with-tx t 81 | (let [x (storage/create t (build-test-entity)) 82 | y (storage/get-one t (aggregate/id @x))] 83 | (t/is (identical? x y))))) 84 | 85 | (t/deftest identity-map-swap 86 | (storage/with-tx t 87 | (let [x (storage/create t (build-test-entity)) 88 | y (storage/get-one t (aggregate/id @x))] 89 | (dosync (alter x update :counter inc)) 90 | (t/is (= 1 (:counter @x) (:counter @y)))))) 91 | 92 | (t/deftest concurrency 93 | (let [test (storage/tx-create (build-test-entity)) 94 | id (aggregate/id test) 95 | n 10 96 | _ (->> (repeatedly #(future (storage/tx-alter test update :counter inc))) 97 | (take n) 98 | (doall) 99 | (map deref) 100 | (doall)) 101 | test (storage/tx-get-one id)] 102 | (t/is (= n (:counter test))))) 103 | 104 | (t/deftest inner-concurrency 105 | (let [test (storage/tx-create (build-test-entity)) 106 | id (aggregate/id test) 107 | n 10 108 | _ (storage/with-tx t 109 | (->> (repeatedly #(future (as-> id <> 110 | (storage/get-one t <>) 111 | (dosync (alter <> update :counter inc))))) 112 | (take n) 113 | (doall) 114 | (map deref) 115 | (doall))) 116 | test (storage/tx-get-one id)] 117 | (t/is (= n (:counter test))))) 118 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/storage_test.sql: -------------------------------------------------------------------------------- 1 | -- :name- create-test-entity-table :! :raw 2 | CREATE TABLE "test-entity" ( 3 | "id" bigint PRIMARY KEY, 4 | "counter" integer 5 | ); 6 | 7 | -- :name- drop-test-entity-table :! :raw 8 | DROP TABLE IF EXISTS "test-entity" 9 | 10 | -- :name- test-entity-insert :! 11 | INSERT INTO "test-entity" VALUES :tuple*:vals; 12 | 13 | -- :name- test-entity-select :? :* 14 | SELECT *, xmin AS version FROM "test-entity" WHERE id IN (:v*:ids) 15 | 16 | -- :name- test-entity-delete :! 17 | DELETE FROM "test-entity" WHERE id IN (:v*:ids) 18 | 19 | -- :name- test-entity-locks :? :* 20 | SELECT id, xmin AS version FROM "test-entity" WHERE id IN (:v*:ids) FOR UPDATE 21 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/test/db.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.test.db 2 | (:require 3 | [publicator.persistence.components.data-source :as data-source] 4 | [publicator.persistence.components.migration :as migration] 5 | [publicator.persistence.utils.env :as env] 6 | [com.stuartsierra.component :as component] 7 | [jdbc.core :as jdbc] 8 | [hugsql.core :as hugsql] 9 | [hugsql.adapter.clojure-jdbc :as cj-adapter])) 10 | 11 | (hugsql/def-db-fns "publicator/persistence/test/db.sql" 12 | {:adapter (cj-adapter/hugsql-adapter-clojure-jdbc) 13 | :quoting :ansi}) 14 | 15 | (defn- build-system [] 16 | (component/system-map 17 | :data-source (data-source/build (env/data-source-opts "TEST_DATABASE_URL")) 18 | :migration (component/using (migration/build) 19 | [:data-source]))) 20 | 21 | (defn- with-system [f] 22 | (let [system (atom (build-system))] 23 | (try 24 | (swap! system component/start) 25 | (f @system) 26 | (finally 27 | (swap! system component/stop))))) 28 | 29 | (declare ^:dynamic *data-source*) 30 | 31 | (defn once-fixture [t] 32 | (with-system 33 | (fn [system] 34 | (let [data-source (-> system :data-source :val)] 35 | (binding [*data-source* data-source] 36 | (t)))))) 37 | 38 | (defn each-fixture [t] 39 | (try 40 | (t) 41 | (finally 42 | (with-open [conn (jdbc/connection *data-source*)] 43 | (truncate-all conn))))) 44 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/test/db.sql: -------------------------------------------------------------------------------- 1 | -- :name- truncate-all :! 2 | DO $$ 3 | DECLARE 4 | statements CURSOR FOR 5 | SELECT tablename FROM pg_tables 6 | WHERE schemaname = 'public' 7 | AND tablename != 'flyway_schema_history'; 8 | BEGIN 9 | FOR stmt IN statements LOOP 10 | EXECUTE 'TRUNCATE TABLE ' || quote_ident(stmt.tablename); 11 | END LOOP; 12 | END $$ 13 | -------------------------------------------------------------------------------- /persistence/test/publicator/persistence/user_queries_test.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.persistence.user-queries-test 2 | (:require 3 | [clojure.test :as t] 4 | [publicator.utils.test.instrument :as instument] 5 | [publicator.use-cases.test.factories :as factories] 6 | [publicator.domain.test.fakes.password-hasher :as fakes.password-hasher] 7 | [publicator.domain.test.fakes.id-generator :as fakes.id-generator] 8 | [publicator.persistence.storage :as persistence.storage] 9 | [publicator.persistence.storage.user-mapper :as user-mapper] 10 | [publicator.persistence.test.db :as db] 11 | [publicator.use-cases.abstractions.user-queries :as user-q] 12 | [publicator.persistence.user-queries :as sut])) 13 | 14 | (defn setup [t] 15 | (with-bindings (merge 16 | (fakes.password-hasher/binding-map) 17 | (fakes.id-generator/binding-map) 18 | (persistence.storage/binding-map db/*data-source* 19 | (user-mapper/mapper)) 20 | (sut/binding-map db/*data-source*)) 21 | (t))) 22 | 23 | (t/use-fixtures :once 24 | instument/fixture 25 | db/once-fixture) 26 | 27 | (t/use-fixtures :each 28 | db/each-fixture 29 | setup) 30 | 31 | (t/deftest get-found 32 | (let [user (factories/create-user) 33 | item (user-q/get-by-login (:login user))] 34 | (t/is (= user item)))) 35 | 36 | (t/deftest get-not-found 37 | (let [item (user-q/get-by-login "some_login")] 38 | (t/is (nil? item)))) 39 | -------------------------------------------------------------------------------- /web/.dir-locals.el: -------------------------------------------------------------------------------- 1 | ((nil 2 | (eval . 3 | (setq cider-refresh-before-fn "user/stop" 4 | cider-refresh-after-fn "user/start")))) 5 | -------------------------------------------------------------------------------- /web/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {publicator.core {:local/root "../core"} 2 | metosin/ring-http-response {:mvn/version "0.9.0"} 3 | functionalbytes/sibiro {:mvn/version "0.1.4"} 4 | cljstache {:mvn/version "2.0.1"} 5 | ring/ring-core {:mvn/version "1.6.2"} 6 | ring/ring-jetty-adapter {:mvn/version "1.6.2"} 7 | ring/ring-anti-forgery {:mvn/version "1.3.0"} 8 | com.stuartsierra/component {:mvn/version "0.3.2"} 9 | com.cognitect/transit-clj {:mvn/version "0.8.309"} 10 | phrase {:mvn/version "0.3-alpha3"}} 11 | 12 | :aliases {:dev {:extra-paths ["dev" "test"] 13 | :extra-deps {ring/ring-mock {:mvn/version "0.3.2"} 14 | clj-http {:mvn/version "3.8.0"}}}}} 15 | -------------------------------------------------------------------------------- /web/dev/system.clj: -------------------------------------------------------------------------------- 1 | (ns system 2 | (:require 3 | [com.stuartsierra.component :as component] 4 | [publicator.web.components.jetty :as jetty] 5 | [publicator.web.components.handler :as handler] 6 | [publicator.use-cases.test.factories :as factories] 7 | [publicator.use-cases.test.fakes.storage :as storage] 8 | [publicator.use-cases.test.fakes.user-queries :as user-q] 9 | [publicator.use-cases.test.fakes.post-queries :as post-q] 10 | [publicator.domain.test.fakes.id-generator :as id-generator] 11 | [publicator.domain.test.fakes.password-hasher :as password-hasher])) 12 | 13 | (defrecord BindingMap [val] 14 | component/Lifecycle 15 | (start [this] 16 | (let [db (storage/build-db)] 17 | (assoc this :val 18 | (merge (storage/binding-map db) 19 | (user-q/binding-map db) 20 | (post-q/binding-map db) 21 | (id-generator/binding-map) 22 | (password-hasher/binding-map))))) 23 | (stop [this] this)) 24 | 25 | (defrecord Seed [binding-map] 26 | component/Lifecycle 27 | (start [this] 28 | (with-bindings (:val binding-map) 29 | (let [post1 (factories/create-post) 30 | user1 (factories/create-user {:login "user1" 31 | :password "12345678" 32 | :full-name "User1" 33 | :posts-ids #{(:id post1)}}) 34 | post2 (factories/create-post) 35 | user2 (factories/create-user {:login "user2" 36 | :password "12345678" 37 | :full-name "User2" 38 | :posts-ids #{(:id post2)}})])) 39 | this) 40 | (stop [this] 41 | this)) 42 | 43 | (defn build [] 44 | (component/system-map 45 | :binding-map (->BindingMap nil) 46 | :seed (component/using (->Seed nil) 47 | [:binding-map]) 48 | :handler (component/using (handler/build) 49 | [:binding-map]) 50 | :jetty (component/using (jetty/build {:port 4445}) 51 | [:binding-map :handler]))) 52 | -------------------------------------------------------------------------------- /web/dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require 3 | [publicator.web.init] 4 | [com.stuartsierra.component :as component] 5 | [system])) 6 | 7 | (def system (system/build)) 8 | 9 | (defn start [] 10 | (alter-var-root #'system component/start)) 11 | 12 | (defn stop [] 13 | (alter-var-root #'system component/stop)) 14 | -------------------------------------------------------------------------------- /web/src/publicator/web/components/handler.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.components.handler 2 | (:require 3 | [com.stuartsierra.component :as component] 4 | [publicator.web.handler :as handler])) 5 | 6 | (defrecord Handler [binding-map val] 7 | component/Lifecycle 8 | (start [this] 9 | (assoc this :val (handler/build (:val binding-map)))) 10 | (stop [this] this)) 11 | 12 | (defn build [] 13 | (->Handler nil nil)) 14 | -------------------------------------------------------------------------------- /web/src/publicator/web/components/jetty.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.components.jetty 2 | (:require 3 | [com.stuartsierra.component :as component] 4 | [ring.adapter.jetty :as jetty])) 5 | 6 | (defrecord Jetty [config handler val] 7 | component/Lifecycle 8 | (start [this] 9 | (if val 10 | this 11 | (assoc this :val 12 | (jetty/run-jetty 13 | (:val handler) 14 | (assoc config :join? false))))) 15 | (stop [this] 16 | (if val 17 | (do 18 | (.stop val) 19 | (assoc this :val nil)) 20 | this))) 21 | 22 | (defn build [config] 23 | (Jetty. config nil nil)) 24 | -------------------------------------------------------------------------------- /web/src/publicator/web/controllers/pages/root.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.controllers.pages.root 2 | (:require 3 | [publicator.web.responses :as responses])) 4 | 5 | (defn show [_] 6 | (responses/render-page "pages/root" {})) 7 | 8 | (def routes 9 | #{[:get "/" #'show :pages/root]}) 10 | -------------------------------------------------------------------------------- /web/src/publicator/web/controllers/post/create.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.controllers.post.create 2 | (:require 3 | [publicator.use-cases.interactors.post.create :as interactor])) 4 | 5 | (defn initial-params [req] 6 | [interactor/initial-params]) 7 | 8 | (defn process [{:keys [transit-params]}] 9 | [interactor/process transit-params]) 10 | 11 | (def routes 12 | #{[:get "/new-post" #'initial-params :post.create/initial-params] 13 | [:post "/new-post" #'process :post.create/process]}) 14 | -------------------------------------------------------------------------------- /web/src/publicator/web/controllers/post/list.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.controllers.post.list 2 | (:require 3 | [publicator.use-cases.interactors.post.list :as interactor])) 4 | 5 | (defn process [req] 6 | [interactor/process]) 7 | 8 | (def routes 9 | #{[:get "/posts" #'process :post.list/process]}) 10 | -------------------------------------------------------------------------------- /web/src/publicator/web/controllers/post/show.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.controllers.post.show 2 | (:require 3 | [publicator.use-cases.interactors.post.show :as interactor])) 4 | 5 | (defn process [{:keys [route-params]}] 6 | (let [id (-> route-params :id Integer.)] 7 | [interactor/process id])) 8 | 9 | (def routes 10 | #{[:get "/posts/:id{\\d+}" #'process :post.show/process]}) 11 | -------------------------------------------------------------------------------- /web/src/publicator/web/controllers/post/update.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.controllers.post.update 2 | (:require 3 | [publicator.use-cases.interactors.post.update :as interactor])) 4 | 5 | (defn- req->id [req] 6 | (-> req 7 | :route-params 8 | :id 9 | Integer.)) 10 | 11 | (defn initial-params [req] 12 | (let [id (req->id req)] 13 | [interactor/initial-params id])) 14 | 15 | (defn process [{:keys [transit-params] :as req}] 16 | (let [id (req->id req)] 17 | [interactor/process id transit-params])) 18 | 19 | (def routes 20 | #{[:get "/posts/:id{\\d+}/edit" #'initial-params :post.update/initial-params] 21 | [:post "/posts/:id{\\d+}/edit" #'process :post.update/process]}) 22 | -------------------------------------------------------------------------------- /web/src/publicator/web/controllers/user/log_in.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.controllers.user.log-in 2 | (:require 3 | [publicator.use-cases.interactors.user.log-in :as interactor])) 4 | 5 | (defn initial-params [req] 6 | [interactor/initial-params]) 7 | 8 | (defn process [{:keys [transit-params]}] 9 | [interactor/process transit-params]) 10 | 11 | (def routes 12 | #{[:get "/log-in" #'initial-params :user.log-in/initial-params] 13 | [:post "/log-in" #'process :user.log-in/process]}) 14 | -------------------------------------------------------------------------------- /web/src/publicator/web/controllers/user/log_out.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.controllers.user.log-out 2 | (:require 3 | [publicator.use-cases.interactors.user.log-out :as interactor])) 4 | 5 | (defn process [_] 6 | [interactor/process]) 7 | 8 | (def routes 9 | #{[:post "/log-out" #'process :user.log-out/process]}) 10 | -------------------------------------------------------------------------------- /web/src/publicator/web/controllers/user/register.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.controllers.user.register 2 | (:require 3 | [publicator.use-cases.interactors.user.register :as interactor])) 4 | 5 | (defn initial-params [_] 6 | [interactor/initial-params]) 7 | 8 | (defn process [{:keys [transit-params]}] 9 | [interactor/process transit-params]) 10 | 11 | (def routes 12 | #{[:get "/register" #'initial-params :user.register/initial-params] 13 | [:post "/register" #'process :user.register/process]}) 14 | -------------------------------------------------------------------------------- /web/src/publicator/web/form_renderer.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.form-renderer 2 | (:require 3 | [cljstache.core :as mustache] 4 | [publicator.web.transit :as transit])) 5 | 6 | (defn render [form] 7 | (mustache/render "
", {:data (transit/write form)})) 8 | -------------------------------------------------------------------------------- /web/src/publicator/web/forms/post/params.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.forms.post.params 2 | (:require 3 | [publicator.web.routing :as routing])) 4 | 5 | (defn description [{:keys [url method]}] 6 | {:widget :submit, :name "Готово" 7 | :url url, :method method, :nested 8 | {:widget :group, :nested 9 | [:title {:widget :input, :label "Заголовок"} 10 | :content {:widget :textarea, :label "Содержание"}]}}) 11 | 12 | (defn build-create [initial-params] 13 | (let [cfg {:url (routing/path-for :post.create/process) 14 | :method :post}] 15 | {:initial-data initial-params 16 | :errors {} 17 | :description (description cfg)})) 18 | 19 | (defn build-update [id initial-params] 20 | (let [cfg {:url (routing/path-for :post.update/process {:id (str id)}) 21 | :method :post}] 22 | {:initial-data initial-params 23 | :errors {} 24 | :description (description cfg)})) 25 | -------------------------------------------------------------------------------- /web/src/publicator/web/forms/user/log_in.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.forms.user.log-in 2 | (:require 3 | [publicator.web.routing :as routing])) 4 | 5 | (defn description [] 6 | {:widget :submit, :name "Войти", 7 | :url (routing/path-for :user.log-in/process), :method :post, :nested 8 | {:widget :group, :nested 9 | [:login {:widget :input, :label "Логин"} 10 | :password {:widget :input, :label "Пароль", :type "password"}]}}) 11 | 12 | (defn build [initial-params] 13 | {:initial-data initial-params 14 | :errors {} 15 | :description (description)}) 16 | 17 | (defn authentication-failed-error [] 18 | {:form-ujs/error "Неверный логин или пароль"}) 19 | -------------------------------------------------------------------------------- /web/src/publicator/web/forms/user/register.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.forms.user.register 2 | (:require 3 | [publicator.web.routing :as routing])) 4 | 5 | (defn description [] 6 | {:widget :submit, :name "Зарегистрироваться" 7 | :url (routing/path-for :user.register/process), :method :post, :nested 8 | {:widget :group, :nested 9 | [:login {:widget :input, :label "Логин"} 10 | :full-name {:widget :input, :label "Полное имя"} 11 | :password {:widget :input, :label "Пароль", :type "password"}]}}) 12 | 13 | (defn build [initial-params] 14 | {:initial-data initial-params 15 | :errors {} 16 | :description (description)}) 17 | 18 | (defn already-registered-error [] 19 | {:form-ujs/error "Уже зарегистрирован"}) 20 | -------------------------------------------------------------------------------- /web/src/publicator/web/handler.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.handler 2 | (:require 3 | [ring.middleware.session :as ring.session] 4 | [ring.middleware.params :as ring.params] 5 | [ring.middleware.keyword-params :as ring.keyword-params] 6 | [ring.middleware.anti-forgery :as ring.anti-forgery] 7 | [publicator.web.routing :as routing] 8 | [publicator.web.middlewares.layout :as layout] 9 | [publicator.web.middlewares.session :as session] 10 | [publicator.web.middlewares.transit-params :as tranist-params] 11 | [publicator.web.middlewares.responder :as responder] 12 | [publicator.web.middlewares.bindings :as bindings])) 13 | 14 | (defn build [binding-map] 15 | (-> routing/handler 16 | 17 | responder/wrap-reponder 18 | layout/wrap-layout 19 | session/wrap-session 20 | tranist-params/wrap-transit-params 21 | (bindings/wrap-bindings binding-map) 22 | 23 | ring.anti-forgery/wrap-anti-forgery 24 | ring.session/wrap-session 25 | ring.keyword-params/wrap-keyword-params 26 | ring.params/wrap-params)) 27 | -------------------------------------------------------------------------------- /web/src/publicator/web/init.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.init 2 | (:require 3 | [publicator.web.responders.user.log-in] 4 | [publicator.web.responders.user.log-out] 5 | [publicator.web.responders.user.register] 6 | [publicator.web.responders.post.list] 7 | [publicator.web.responders.post.show] 8 | [publicator.web.responders.post.create] 9 | [publicator.web.responders.post.update])) 10 | -------------------------------------------------------------------------------- /web/src/publicator/web/middlewares/bindings.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.middlewares.bindings) 2 | 3 | (defn wrap-bindings [handler binding-map] 4 | (fn [req] 5 | (with-bindings binding-map 6 | (handler req)))) 7 | -------------------------------------------------------------------------------- /web/src/publicator/web/middlewares/layout.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.middlewares.layout 2 | (:require 3 | [publicator.web.template :as template] 4 | [publicator.web.presenters.layout :as presenters.layout])) 5 | 6 | (defn wrap-layout [handler] 7 | (fn [req] 8 | (let [resp (handler req) 9 | type (get-in resp [:headers "Content-Type"]) 10 | body (:body resp)] 11 | (if (not= "text/html" type) 12 | resp 13 | (let [data (presenters.layout/present req) 14 | data (assoc data :content body) 15 | body (template/render "layout" data)] 16 | (assoc resp :body body)))))) 17 | -------------------------------------------------------------------------------- /web/src/publicator/web/middlewares/responder.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.middlewares.responder 2 | (:require 3 | [publicator.web.responders.base :as responders.base])) 4 | 5 | (defn wrap-reponder [handler] 6 | (fn [req] 7 | (let [resp (handler req)] 8 | (if (vector? resp) 9 | (let [[interactor & args] resp 10 | result (apply interactor args)] 11 | (responders.base/result->resp result)) 12 | resp)))) 13 | -------------------------------------------------------------------------------- /web/src/publicator/web/middlewares/session.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.middlewares.session 2 | (:require 3 | [publicator.use-cases.abstractions.session :as session])) 4 | 5 | (deftype Session [storage] 6 | session/Session 7 | (-get [_ k] (get @storage k)) 8 | (-set! [_ k v] (swap! storage assoc k v))) 9 | 10 | (defn wrap-session [handler] 11 | (fn [req] 12 | (let [storage (atom (get-in req [:session ::storage])) 13 | resp (binding [session/*session* (Session. storage)] 14 | (handler req))] 15 | (-> resp 16 | (assoc :session/key (:session/key req)) 17 | (assoc :session (:session req)) 18 | (assoc-in [:session ::storage] @storage))))) 19 | -------------------------------------------------------------------------------- /web/src/publicator/web/middlewares/transit_params.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.middlewares.transit-params 2 | (:require 3 | [publicator.web.transit :as transit] 4 | [ring.util.request :as ring.request])) 5 | 6 | (defn wrap-transit-params [handler] 7 | (fn [req] 8 | (handler 9 | (cond-> req 10 | (= "application/transit+json" (ring.request/content-type req)) 11 | (assoc :transit-params (-> req ring.request/body-string transit/read)))))) 12 | -------------------------------------------------------------------------------- /web/src/publicator/web/presenters/explain_data.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.presenters.explain-data 2 | (:require 3 | [clojure.spec.alpha :as s] 4 | [phrase.alpha :as phrase])) 5 | 6 | ;; todo: использовать локализацию, например: https://github.com/tonsky/tongue 7 | 8 | (phrase/defphraser :default 9 | [ctx {:keys [in]}] 10 | [in "Неизвестная ошибка"]) 11 | 12 | (phrase/defphraser #(contains? % k) 13 | [ctx {:keys [in]} k] 14 | [(conj in k) "Обязательное"]) 15 | 16 | (phrase/defphraser string? 17 | [ctx {:keys [in]}] 18 | [in "Должно быть строкой"]) 19 | 20 | (phrase/defphraser #(re-matches re %) 21 | [ctx {:keys [in]} re] 22 | (or 23 | (when-some [[_ r-min r-max] (re-matches #"\\w\{(\d+),(\d+)\}" (str re))] 24 | [in (str "Кол-во латинских букв и цифр от " r-min " до " r-max)]) 25 | (when-some [[_ r-min r-max] (re-matches #"\.\{(\d+),(\d+)\}" (str re))] 26 | [in (str "Кол-во символов от " r-min " до " r-max)]) 27 | [in "Неизвестная ошибка"])) 28 | 29 | (defn ->errors [explain-data] 30 | (let [problems (::s/problems explain-data) 31 | pairs (map #(phrase/phrase :ctx %) problems)] 32 | (reduce 33 | (fn [acc [in message]] 34 | (assoc-in acc (conj in :form-ujs/error) message)) 35 | {} 36 | pairs))) 37 | -------------------------------------------------------------------------------- /web/src/publicator/web/presenters/layout.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.presenters.layout 2 | (:require 3 | [publicator.use-cases.services.user-session :as user-session] 4 | [publicator.web.routing :as routing] 5 | [ring.middleware.anti-forgery :as anti-forgery])) 6 | 7 | (defn present [req] 8 | (cond-> {:csrf anti-forgery/*anti-forgery-token*} 9 | (user-session/logged-in?) 10 | (assoc :log-out {:text "Log out" 11 | :url (routing/path-for :user.log-out/process)}) 12 | 13 | (user-session/logged-out?) 14 | (assoc :register {:text "Register" 15 | :url (routing/path-for :user.register/initial-params)}) 16 | 17 | (user-session/logged-out?) 18 | (assoc :log-in {:text "Log in" 19 | :url (routing/path-for :user.log-in/initial-params)}))) 20 | -------------------------------------------------------------------------------- /web/src/publicator/web/presenters/post/list.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.presenters.post.list 2 | (:require 3 | [publicator.use-cases.interactors.post.list :as interactor] 4 | [publicator.use-cases.interactors.post.create :as interactors.post.create] 5 | [publicator.use-cases.interactors.post.update :as interactors.post.update] 6 | [publicator.domain.aggregates.user :as user] 7 | [publicator.web.routing :as routing])) 8 | 9 | (defn- post->model [post authorization] 10 | {:id (:id post) 11 | :url (routing/path-for :post.show/process {:id (-> post :id str)}) 12 | :update-url (routing/path-for :post.update/initial-params {:id (-> post :id str)}) 13 | :title (:title post) 14 | :can-update? (= [::interactors.post.update/authorized] authorization) 15 | :user-full-name (::user/full-name post)}) 16 | 17 | (defn processed [posts] 18 | (let [authorizations (interactors.post.update/authorize (map :id posts)) 19 | view-models (map post->model posts authorizations) 20 | can-create? (= [::interactors.post.create/authorized] 21 | (interactors.post.create/authorize))] 22 | (cond-> {} 23 | :always (assoc :posts view-models) 24 | can-create? (assoc :new {:text "New" 25 | :url (routing/path-for :post.create/initial-params)})))) 26 | -------------------------------------------------------------------------------- /web/src/publicator/web/presenters/post/show.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.presenters.post.show 2 | (:require 3 | [publicator.domain.aggregates.user :as user])) 4 | 5 | (defn processed [post] 6 | {:title (:title post) 7 | :content (:content post) 8 | :user-full-name (::user/full-name post)}) 9 | -------------------------------------------------------------------------------- /web/src/publicator/web/responders/base.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responders.base 2 | (:require 3 | [publicator.web.responses :as responses] 4 | [publicator.web.presenters.explain-data :as explain-data] 5 | [publicator.web.routing :as routing])) 6 | 7 | (defmulti result->resp first) 8 | 9 | (defmethod result->resp ::forbidden [_] 10 | {:status 403 11 | :headers {} 12 | :body "forbidden"}) 13 | 14 | (defmethod result->resp ::not-found [_] 15 | {:status 404 16 | :headers {} 17 | :body "not-found"}) 18 | 19 | (defmethod result->resp ::invalid-params [[_ explain-data]] 20 | (-> explain-data 21 | explain-data/->errors 22 | responses/render-errors)) 23 | 24 | (defmethod result->resp ::redirect-to-root [_] 25 | (responses/redirect-for-form (routing/path-for :pages/root))) 26 | -------------------------------------------------------------------------------- /web/src/publicator/web/responders/post/create.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responders.post.create 2 | (:require 3 | [publicator.use-cases.interactors.post.create :as interactor] 4 | [publicator.web.responders.base :as responders.base] 5 | [publicator.web.responses :as responses] 6 | [publicator.web.forms.post.params :as form])) 7 | 8 | (defmethod responders.base/result->resp ::interactor/initial-params [[_ params]] 9 | (let [form (form/build-create params)] 10 | (responses/render-form form))) 11 | 12 | (derive ::interactor/processed ::responders.base/redirect-to-root) 13 | (derive ::interactor/invalid-params ::responders.base/invalid-params) 14 | (derive ::interactor/logged-out ::responders.base/forbidden) 15 | -------------------------------------------------------------------------------- /web/src/publicator/web/responders/post/list.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responders.post.list 2 | (:require 3 | [publicator.use-cases.interactors.post.list :as interactor] 4 | [publicator.web.responders.base :as responders.base] 5 | [publicator.web.responses :as responses] 6 | [publicator.web.presenters.post.list :as presenter])) 7 | 8 | (defmethod responders.base/result->resp ::interactor/processed [[_ posts]] 9 | (let [model (presenter/processed posts)] 10 | (responses/render-page "post/list" model))) 11 | -------------------------------------------------------------------------------- /web/src/publicator/web/responders/post/show.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responders.post.show 2 | (:require 3 | [publicator.use-cases.interactors.post.show :as interactor] 4 | [publicator.web.responders.base :as responders.base] 5 | [publicator.web.responses :as responses] 6 | [publicator.web.presenters.post.show :as presenter])) 7 | 8 | (defmethod responders.base/result->resp ::interactor/processed [[_ posts]] 9 | (let [model (presenter/processed posts)] 10 | (responses/render-page "post/show" model))) 11 | 12 | (derive ::interactor/not-found ::responders.base/not-found) 13 | -------------------------------------------------------------------------------- /web/src/publicator/web/responders/post/update.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responders.post.update 2 | (:require 3 | [publicator.use-cases.interactors.post.update :as interactor] 4 | [publicator.web.responders.base :as responders.base] 5 | [publicator.web.responses :as responses] 6 | [publicator.web.forms.post.params :as form])) 7 | 8 | (defmethod responders.base/result->resp ::interactor/initial-params [[_ post params]] 9 | (let [form (form/build-update (:id post) params)] 10 | (responses/render-form form))) 11 | 12 | (derive ::interactor/processed ::responders.base/redirect-to-root) 13 | (derive ::interactor/invalid-params ::responders.base/invalid-params) 14 | (derive ::interactor/logged-out ::responders.base/forbidden) 15 | (derive ::interactor/not-authorized ::responders.base/forbidden) 16 | (derive ::interactor/not-found ::responders.base/not-found) 17 | -------------------------------------------------------------------------------- /web/src/publicator/web/responders/user/log_in.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responders.user.log-in 2 | (:require 3 | [publicator.use-cases.interactors.user.log-in :as interactor] 4 | [publicator.web.responders.base :as responders.base] 5 | [publicator.web.responses :as responses] 6 | [publicator.web.forms.user.log-in :as form] 7 | [publicator.web.routing :as routing])) 8 | 9 | (defmethod responders.base/result->resp ::interactor/initial-params [[_ params]] 10 | (let [form (form/build params)] 11 | (responses/render-form form))) 12 | 13 | (defmethod responders.base/result->resp ::interactor/authentication-failed [_] 14 | (-> (form/authentication-failed-error) 15 | responses/render-errors)) 16 | 17 | (derive ::interactor/processed ::responders.base/redirect-to-root) 18 | (derive ::interactor/invalid-params ::responders.base/invalid-params) 19 | (derive ::interactor/already-logged-in ::responders.base/forbidden) 20 | -------------------------------------------------------------------------------- /web/src/publicator/web/responders/user/log_out.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responders.user.log-out 2 | (:require 3 | [publicator.use-cases.interactors.user.log-out :as interactor] 4 | [publicator.web.responders.base :as responders.base] 5 | [publicator.web.responses :as responses] 6 | [publicator.web.routing :as routing])) 7 | 8 | (defmethod responders.base/result->resp ::interactor/processed [_] 9 | (responses/redirect-for-page (routing/path-for :pages/root))) 10 | 11 | (derive ::interactor/already-logged-out ::responders.base/forbidden) 12 | -------------------------------------------------------------------------------- /web/src/publicator/web/responders/user/register.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responders.user.register 2 | (:require 3 | [publicator.use-cases.interactors.user.register :as interactor] 4 | [publicator.web.responders.base :as responders.base] 5 | [publicator.web.responses :as responses] 6 | [publicator.web.presenters.explain-data :as explain-data] 7 | [publicator.web.forms.user.register :as form] 8 | [publicator.web.routing :as routing])) 9 | 10 | (defmethod responders.base/result->resp ::interactor/initial-params [[_ params]] 11 | (let [form (form/build params)] 12 | (responses/render-form form))) 13 | 14 | (defmethod responders.base/result->resp ::interactor/already-registered [_] 15 | (-> (form/already-registered-error) 16 | responses/render-errors)) 17 | 18 | (derive ::interactor/processed ::responders.base/redirect-to-root) 19 | (derive ::interactor/invalid-params ::responders.base/invalid-params) 20 | (derive ::interactor/already-logged-in ::responders.base/forbidden) 21 | -------------------------------------------------------------------------------- /web/src/publicator/web/responses.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.responses 2 | (:require 3 | [publicator.web.template :as template] 4 | [publicator.web.form-renderer :as form-renderer] 5 | [publicator.web.transit :as transit] 6 | [ring.util.http-response :as http-response])) 7 | 8 | (defn render-page 9 | ([template] (render-page template {})) 10 | ([template model] 11 | (-> (template/render template model) 12 | (http-response/ok) 13 | (http-response/content-type "text/html")))) 14 | 15 | (defn render-form [form] 16 | (-> form 17 | form-renderer/render 18 | http-response/ok 19 | (http-response/content-type "text/html"))) 20 | 21 | (defn render-errors [errors] 22 | (-> errors 23 | transit/write 24 | http-response/unprocessable-entity 25 | (http-response/content-type "application/transit+json"))) 26 | 27 | (defn redirect-for-page [url] 28 | (http-response/found url)) 29 | 30 | (defn redirect-for-form [url] 31 | (http-response/created url)) 32 | -------------------------------------------------------------------------------- /web/src/publicator/web/routing.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.routing 2 | (:require 3 | [sibiro.core] 4 | [sibiro.extras] 5 | [clojure.set :as set] 6 | [publicator.web.controllers.pages.root :as pages.root] 7 | [publicator.web.controllers.user.log-in :as user.log-in] 8 | [publicator.web.controllers.user.log-out :as user.log-out] 9 | [publicator.web.controllers.user.register :as user.register] 10 | [publicator.web.controllers.post.list :as post.list] 11 | [publicator.web.controllers.post.show :as post.show] 12 | [publicator.web.controllers.post.create :as post.create] 13 | [publicator.web.controllers.post.update :as post.update])) 14 | 15 | (def routes 16 | (sibiro.core/compile-routes 17 | (set/union 18 | pages.root/routes 19 | user.log-in/routes 20 | user.log-out/routes 21 | user.register/routes 22 | post.list/routes 23 | post.show/routes 24 | post.create/routes 25 | post.update/routes))) 26 | 27 | (def handler (sibiro.extras/make-handler routes)) 28 | 29 | (defn uri-for [& args] 30 | (let [ret (apply sibiro.core/uri-for routes args)] 31 | (assert (some? ret) (str "route not found for " args)) 32 | ret)) 33 | 34 | (defn path-for [& args] 35 | (let [ret (apply sibiro.core/path-for routes args)] 36 | (assert (some? ret) (str "route not found for " args)) 37 | ret)) 38 | -------------------------------------------------------------------------------- /web/src/publicator/web/template.clj: -------------------------------------------------------------------------------- 1 | (ns publicator.web.template 2 | (:require 3 | [cljstache.core :as mustache])) 4 | 5 | (defn render [template-name data] 6 | (let [path (str "publicator/web/templates/" template-name ".mustache")] 7 | (mustache/render-resource path data))) 8 | -------------------------------------------------------------------------------- /web/src/publicator/web/templates/layout.mustache: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 14 | 15 | 16 | 47 |# | 11 |Title | 12 |Author | 13 |Actions | 14 |
---|---|---|---|
{{id}} | 20 |21 | {{title}} 22 | | 23 |{{user-full-name}} | 24 |25 | {{#can-update?}} 26 | edit 27 | {{/can-update?}} 28 | | 29 |