├── .travis.yml ├── .gitignore ├── Makefile ├── src └── crud │ ├── db.clj │ ├── hypercrud.clj │ ├── db │ └── datomic.clj │ ├── machine.clj │ └── entity.clj ├── test └── crud │ ├── test_entities.clj │ ├── test_utils.clj │ ├── hyperclient.clj │ ├── entity_test.clj │ ├── hypercrud_test.clj │ └── db_test.clj ├── project.clj └── README.md /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein2 3 | script: lein2 do clean, test 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /docs 2 | /target 3 | /lib 4 | /classes 5 | /checkouts 6 | pom.xml 7 | pom.xml.asc 8 | *.jar 9 | *.class 10 | /.lein-* 11 | /.nrepl-port 12 | /.nrepl-history 13 | .DS_Store 14 | /profiles.clj 15 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: pages docs 2 | 3 | ## 4 | ## Doc targets 5 | ## 6 | 7 | docs: 8 | lein marg 9 | 10 | pages: docs 11 | cd docs && git checkout gh-pages 12 | cd docs && git add . 13 | cd docs && git commit -am "new documentation push." 14 | cd docs && git push -u origin gh-pages 15 | -------------------------------------------------------------------------------- /src/crud/db.clj: -------------------------------------------------------------------------------- 1 | (ns crud.db 2 | "Provides storage facilities for creating and updating entities 3 | in a database") 4 | 5 | (defprotocol CrudDB 6 | "Protocol for representing the capabilities of a basic CRUD database" 7 | (commit! [db entity value] 8 | "Attempt to commit `value` to permanent storage") 9 | (retract! [db entity value] 10 | "Attempt to retract `value`") 11 | (present 12 | [db entity value] 13 | [db entity] 14 | "Generate a resource for `value`") 15 | (find-by [db params] 16 | "Search `db` for entity matching the specified `params`") 17 | (find-by-id [db id] 18 | "Search `db` for entity that can be uniquely identified by `id`") 19 | (has-attr? [db id])) 20 | 21 | (defmulti crud-db "Return a CrudDB using the specified `db-spec`" :type) 22 | 23 | -------------------------------------------------------------------------------- /test/crud/test_entities.clj: -------------------------------------------------------------------------------- 1 | (ns crud.test-entities 2 | (:require [crud.entity :refer :all] 3 | [crypto.password.bcrypt :as password] 4 | [schema.core :as s :refer [Str Bool Num Int Inst Keyword]])) 5 | 6 | (defn encrypt [attr] 7 | ;; The 4 here is so we're not slowing our tests down. IRL you should use at least 10 8 | {:name attr, :callable (fn [val] (password/encrypt val 4))}) 9 | 10 | (defentity User 11 | :schema {:id Int 12 | :email Str 13 | :name Str 14 | :secret Str} 15 | :storable [:id :email :name (encrypt :secret)] 16 | :uniqueness {:id :db.unique/identity}) 17 | 18 | (defentity Tweet 19 | :schema {:id Int 20 | :body Str 21 | :author Str} 22 | :uniqueness {:id :db.unique/identity} 23 | :links [(link :author [User :id])]) 24 | 25 | (defentity StorageTest 26 | :schema {:id Int 27 | :attr Int 28 | :ignored Int} 29 | :storable [:id :attr]) 30 | 31 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject crud "0.1.0-SNAPSHOT" 2 | :description "Create, Read, Update, Delete. Done!" 3 | :url "http://github.com/cddr/crud" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :scm {:url "git@github.com:cddr/crud.git"} 7 | :min-lein-version "2.0.0" 8 | 9 | :dependencies [[org.clojure/clojure "1.6.0"] 10 | [com.datomic/datomic-free "0.9.4899"] 11 | 12 | ;; http api 13 | [bidi "1.12.0"] 14 | [liberator "0.12.2"] 15 | [ring/ring-defaults "0.1.2"] 16 | 17 | ;; data modelling 18 | [prismatic/schema "0.2.6"] 19 | [environ "1.0.0"]] 20 | :plugins [[lein-ring "0.8.12"] 21 | [lein-environ "1.0.0"]] 22 | :ring {:handler crud.handler/app} 23 | :profiles 24 | {:dev {:env {:crud-db-uri "datomic:mem://crud-db-uri"} 25 | :dependencies [[javax.servlet/servlet-api "2.5"] 26 | [crypto-password "0.1.3"] 27 | [ring-mock "0.1.5"]]}}) 28 | -------------------------------------------------------------------------------- /test/crud/test_utils.clj: -------------------------------------------------------------------------------- 1 | (in-ns 'crud.core-test) 2 | 3 | ;; HTTP Response Helpers 4 | (defn- status= [status] (fn [response] 5 | (= status (:status response)))) 6 | 7 | (def ok? (status= 200)) 8 | (def created? (status= 201)) 9 | (def bad-request? (status= 400)) 10 | (def not-found? (status= 404)) 11 | (def invalid? (status= 422)) 12 | 13 | (def body? (fn [response body] 14 | (= body (get-in response [:body])))) 15 | (def error? (fn [response error] 16 | (= error (get-in response [:body :error])))) 17 | 18 | (defn submap? [a b] (clojure.set/subset? (set a) (set b))) 19 | (defn test-ids [n] (repeatedly n (partial d/tempid :db.part/user))) 20 | 21 | (defn dbg-handler [handler msg] 22 | (fn [req] 23 | (let [resp (handler req)] 24 | resp))) 25 | 26 | (defn make-client [app content-type] 27 | (let [parse-response (fn [response] 28 | (if (:body response) 29 | (assoc response :body (clojure.edn/read-string (slurp (:body response)))) 30 | :no-response))] 31 | (fn client 32 | ([method path] 33 | (client method path {} {})) 34 | ([method path params] 35 | (client method path params {})) 36 | ([method path params body] 37 | (-> (ring.mock.request/request method path params) 38 | (ring.mock.request/content-type "application/edn") 39 | (ring.mock.request/body (pr-str (or body {}))) 40 | app 41 | parse-response))))) 42 | 43 | -------------------------------------------------------------------------------- /test/crud/hyperclient.clj: -------------------------------------------------------------------------------- 1 | (ns crud.hyperclient 2 | (:require [ring.mock.request :as mock]) 3 | (:import [java.net URL URI])) 4 | 5 | (defprotocol HyperClient 6 | (current [this]) 7 | (back [this]) 8 | (history [this]) 9 | (invoke 10 | [this method uri body])) 11 | 12 | (defn location [client] 13 | (get-in (current client) [:headers "Location"])) 14 | 15 | (defn body [client] 16 | (:body (current client))) 17 | 18 | (defn status [client] 19 | (:status (current client))) 20 | 21 | (defn links [client] 22 | (:_links (body client))) 23 | 24 | (defn follow [client link {:keys [method body] 25 | :or {method :get 26 | body nil}}] 27 | (invoke client method (:href link) body)) 28 | 29 | (defn rel= [name] 30 | (fn [link] 31 | (= name (:rel link)))) 32 | 33 | (defn name= [name] 34 | (fn [link] 35 | (= name (:name link)))) 36 | 37 | (defn follow-redirect [client] 38 | (invoke client :get (location client) nil)) 39 | 40 | (defn follow-collection [client] 41 | (let [coll (get-in (body client) [:_links :collection])] 42 | (invoke client :get (:href coll) nil))) 43 | 44 | (defn- wrap-request [params] 45 | (fn [request] 46 | (-> request 47 | (mock/content-type "application/edn") 48 | (mock/header "Accept" "application/edn") 49 | (mock/body (pr-str params))))) 50 | 51 | (defn- wrap-response [] 52 | (fn [response] 53 | (assoc response 54 | :body (clojure.edn/read-string (:body response))))) 55 | 56 | (defn hyperclient [start-point hyperserver] 57 | (let [history (atom ()) 58 | request (fn [method uri params] 59 | (let [app (comp (wrap-response) 60 | hyperserver 61 | (wrap-request params))] 62 | (app (mock/request method uri)))) 63 | root "http://localhost"] 64 | 65 | ;; navigate to start-point 66 | (swap! history conj (request :get start-point nil)) 67 | 68 | (reify HyperClient 69 | (current [this] 70 | (first @history)) 71 | (back [this] 72 | (swap! history pop)) 73 | (history [this] 74 | @history) 75 | (invoke [this method uri params] 76 | (swap! history conj (request method (str root uri) params)))))) 77 | -------------------------------------------------------------------------------- /src/crud/hypercrud.clj: -------------------------------------------------------------------------------- 1 | (ns crud.hypercrud 2 | "A Crud `app` uses a CrudDB implementation to expose a hyper-media server against a set of entities. This means 3 | that relationships between entities can be explored programatically by inspecting links embedded in the server 4 | responses." 5 | (:require [clojure.string :refer [split join]] 6 | [bidi.bidi :refer [match-route path-for]] 7 | [bidi.ring :refer [make-handler]] 8 | [crud.machine :refer :all] 9 | [crud.entity :refer [routes publish-link]] 10 | [liberator.core :refer [resource by-method]])) 11 | 12 | (defn find-entity [app-spec req] 13 | (let [found? (fn [entity] 14 | (= (-> req :route-params :entity) 15 | (:name entity)))] 16 | (->> (:entities app-spec) 17 | (filter found?) 18 | first))) 19 | 20 | (defn index-handler [app-spec] 21 | (fn [req] 22 | (let [links {:item (for [entity (:entities app-spec)] 23 | (publish-link :collection 24 | {:name (:name entity) 25 | :entity (:name entity)}))} 26 | 27 | handler (resource {:allowed-methods [:get] 28 | :available-media-types ["application/edn"] 29 | :handle-ok {:_links links}})] 30 | (handler req)))) 31 | 32 | (defn collection-handler [app-spec] 33 | (fn [req] 34 | (if-let [entity (find-entity app-spec req)] 35 | (do 36 | (let [handler (resource (crud-collection entity (:db app-spec)))] 37 | (handler req)))))) 38 | 39 | (defn resource-handler [app-spec] 40 | (fn [req] 41 | (if-let [entity (find-entity app-spec req)] 42 | (let [id (-> req :route-params :id) 43 | handler (resource (case (:request-method req) 44 | :get (crud-get entity (:db app-spec) id) 45 | :delete (crud-delete entity (:db app-spec) id)))] 46 | (handler req))))) 47 | 48 | (defn hypercrud [app-spec] 49 | (let [handlers {:collection (collection-handler app-spec) 50 | :resource (resource-handler app-spec) 51 | :index (index-handler app-spec)} 52 | find-handler (fn [match] 53 | (match handlers))] 54 | (make-handler routes find-handler))) 55 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # crud 2 | 3 | [![Build Status](https://img.shields.io/travis/cddr/crud/master.svg)](https://travis-ci.org/cddr/crud) 4 | [![Documentation](http://img.shields.io/badge/documentation-latest-green.svg)](https://cddr.github.io/crud/uberdoc.html) 5 | [![Stories in Ready](https://badge.waffle.io/cddr/crud.png?label=ready&title=Ready)](https://waffle.io/cddr/crud) 6 | 7 | As a developer, I want to be able to describe a resource's high-level details 8 | like data integrity, associations, documentation etc. and have a system 9 | that builds a corresponding API and user interface so that I can focus on tooling 10 | for higher value activities like integration with other systems or data analysis. 11 | 12 | ## Basic Example 13 | 14 | The following program implements a "tweet" API with the following features 15 | 16 | * GET/POST/PATCH/DELETE "tweets" with :created_at, :authored_by and :msg attributes 17 | * For POST and PATCH, ensure that :msg is <144 characters 18 | * GET a list of tweets matching the specified parameters 19 | * GET "/api/doc" for swagger documentation for the Tweet and User resources 20 | * When persisting the User resource, :secret is filtered through the bcrypt algorithm 21 | 22 | ``` 23 | (ns crud.twitter 24 | (:require [crud :refer :all] 25 | [prismatic.schema :as s])) 26 | 27 | (defentity User 28 | :schema {:email s/Str 29 | :name s/Str 30 | :secret s/Str}) 31 | 32 | (defentity Tweet 33 | :schema {:created-at Date 34 | :msg s/Str} 35 | :links [(link :authored-by [User :id])]) 36 | 37 | (let [entities [User Tweet] 38 | db (crud-db {:type :datomic 39 | :uri "datomic:mem://tweet-db" 40 | :entities entities})] 41 | (run-jetty (hypercrud {:db db, :entities entities}) 42 | {:port 3000})) 43 | ``` 44 | 45 | OK. Lets make sure we're not flagrently violating security principles 46 | by storing the secret in plain text. The example below encrypts the 47 | :secret attribute before persisting it to storage 48 | 49 | ``` 50 | (ns crud.twitter 51 | (:require [crypto.password.bcrypt :as password] 52 | [prismatic.schema :as s])) 53 | 54 | (defn encrypt [attr] (fn [params] 55 | (password/encrypt (attr params)))) 56 | 57 | (defentity Tweet 58 | :schema {:created-at Date 59 | :authored-by User 60 | :msg s/Str} 61 | :links [(link :authored-by [User :id])] 62 | :storage [:email :name (encrypt :secret)]) 63 | ``` 64 | ## License 65 | 66 | Copyright © 2014 Andy Chambers 67 | -------------------------------------------------------------------------------- /test/crud/entity_test.clj: -------------------------------------------------------------------------------- 1 | (ns crud.entity-test 2 | (:require [clojure.test :refer :all] 3 | [crud.entity :refer :all] 4 | [schema.core :as s :refer [Str Num Inst Int Bool Keyword optional-key]])) 5 | 6 | (deftest test-read-id 7 | (let [mock-entity (fn [id-type] 8 | (map->Entity {:schema {:id id-type}}))] 9 | (testing "read-id" 10 | (is (= 42 (read-id (mock-entity Int) "42")))))) 11 | 12 | (deftest test-query-schema 13 | (let [mock-entity (map->Entity {:schema {:a Int, :b Str}}) 14 | can-find-by? (fn [key] 15 | (contains? (query-schema mock-entity) 16 | (s/optional-key key)))] 17 | (testing "find by" 18 | (is (can-find-by? :id)) 19 | (is (can-find-by? :a)) 20 | (is (can-find-by? :b))))) 21 | 22 | (deftest test-storage-agent 23 | (testing "keywords name and call themselves" 24 | (is (= {:name :foo, :callable :foo} 25 | (storage-agent :foo)))) 26 | 27 | (testing "custom :name and :callable" 28 | (let [test-agent (fn [attr] 29 | {:name attr, :callable attr})] 30 | (is (= {:name :foo, :callable :foo} 31 | (storage-agent (test-agent :foo))))))) 32 | 33 | (deftest test-storage-schema 34 | (let [mock-entity (fn [args] 35 | (map->Entity args)) 36 | will-persist? (fn [entity attr] 37 | (contains? (storage-schema entity) attr))] 38 | (testing "no storable specified" 39 | (let [e (mock-entity {:schema {:a Int, :b Int}})] 40 | (is (will-persist? e :a)) 41 | (is (will-persist? e :b)))) 42 | 43 | (testing "ignores attributes not in :storable" 44 | (let [e (mock-entity {:schema {:a Int, :b Int} 45 | :storable [:a]})] 46 | (is (not (will-persist? e :b))))) 47 | 48 | (testing "includes schema for transformed values" 49 | (let [mock-agent (fn [attr] 50 | {:name attr, :callable identity}) 51 | e (mock-entity {:schema {:a Int, :b Int} 52 | :storable [:a (mock-agent :b)]})] 53 | (is (will-persist? e :a)) 54 | (is (will-persist? e :b)))))) 55 | 56 | (deftest test-storable 57 | (testing "default case" 58 | (is (= {:a 1, :b 10} 59 | (storable-value (entity "yolo" {}) {:a 1, :b 10})))) 60 | 61 | (testing "remove non-storable entries" 62 | (is (= {:a 1} 63 | (storable-value (entity "yolo" {:storable [:a]}) 64 | {:a 1, :b 10})))) 65 | 66 | (testing "transform using storage agents" 67 | (let [double-agent (fn [attr] 68 | {:name attr, :callable (fn [val] 69 | (* 2 (attr val)))})] 70 | (is (= {:a 2} 71 | (storable-value (entity "yolo" {:storable [(double-agent :a)]}) 72 | {:a 1})))))) 73 | 74 | (deftest test-link 75 | (testing "construct link" 76 | (let [Author {:schema {:id Int}}] 77 | (is (= {:from :author 78 | :to Author 79 | :attr :id 80 | :cardinality :db.cardinality/one} 81 | (link :author [Author :id])))))) 82 | 83 | -------------------------------------------------------------------------------- /test/crud/hypercrud_test.clj: -------------------------------------------------------------------------------- 1 | (ns crud.hypercrud-test 2 | (:require 3 | [clojure.test :refer :all] 4 | [crud.hypercrud :refer :all] 5 | [crud.entity :refer :all] 6 | [crud.db :refer [crud-db commit!]] 7 | [crud.db.datomic] 8 | [crud.hyperclient :refer :all] 9 | [datomic.api :as d] 10 | [schema.core :as s :refer [Str Num Inst Int Bool Keyword]] 11 | [environ.core :refer [env]] 12 | [ring.mock.request :as mock])) 13 | 14 | (defentity Department 15 | :schema {:name Str}) 16 | 17 | (defentity Employee 18 | :schema {:name Str} 19 | :links [(link :department [Department :id])]) 20 | 21 | (defentity Cart 22 | :schema {:name Str 23 | :items [{:qty Int 24 | :price Num}]}) 25 | 26 | (defn test-fixture [entities] 27 | (let [db (do 28 | (d/delete-database (env :crud-db-uri)) 29 | (crud-db {:type :datomic, :uri (env :crud-db-uri), 30 | :entities entities}))] 31 | {:db db 32 | :server (hypercrud {:db db, :entities entities})})) 33 | 34 | (defn create [client params] 35 | (follow client (get-in (body client) [:_links :create]) 36 | {:method :post 37 | :body params}) 38 | (location client)) 39 | 40 | (deftest test-create-with-link 41 | (testing "link department to employee" 42 | (let [{:keys [db server]} (test-fixture [Employee Department]) 43 | dept (hyperclient "/Department" server) 44 | emp (hyperclient "/Employee" server)] 45 | (let [sales (create dept {:id 1, :name "sales"})] 46 | (create emp {:id 2, :name "andy" 47 | :_links {:department {:href sales}}}) 48 | (follow-redirect emp) 49 | (is (= {:href sales} 50 | (get-in (body emp) [:_links :department]))))))) 51 | 52 | (deftest test-create-with-component 53 | (testing "with cart fixture" 54 | (let [{:keys [db server]} (test-fixture [Cart]) 55 | client (hyperclient "/Cart" server)] 56 | 57 | (testing "create cart" 58 | (follow client (get-in (body client) [:_links :create]) 59 | {:method :post 60 | :body {:id 1, :name "x-mas list" 61 | :items [{:qty 10, :price 99.99} 62 | {:qty 1, :price 50.0}]}}) 63 | (is (= 201 (status client))))))) 64 | 65 | (deftest test-hypermedia 66 | (testing "collection resource" 67 | (let [{:keys [db server]} (test-fixture [Department]) 68 | client (hyperclient "/Department" server)] 69 | 70 | (testing "presented with operations" 71 | (is (= 200 (status client))) 72 | (is (= #{:self :create :item} 73 | (set (keys (links client)))))) 74 | 75 | (testing "create" 76 | (follow client (get-in (body client) [:_links :create]) 77 | {:method :post 78 | :body {:id 1, :name "drivers"}}) 79 | (is (= 201 (status client)))) 80 | 81 | (testing "redirected after create" 82 | (follow-redirect client) 83 | (is (= 200 (status client))) 84 | (is (= #{:self :collection} 85 | (set (keys (links client))))) 86 | (is (= {:id 1, :name "drivers"} 87 | (dissoc (body client) :_links)))) 88 | 89 | (testing "index" 90 | (follow-collection client) 91 | (is (= 1 (count (get-in (body client) [:_links :item]))))) 92 | 93 | (testing "destroy" 94 | (follow client (-> (get-in (body client) [:_links :item]) 95 | first) 96 | {:method :delete, :body nil}) 97 | ;; Respond to DELETE requests by returning the deleted resource's collection 98 | (is (= 200 (status client))) 99 | (is (= 0 (count (get-in (body client) [:_links :item])))))))) 100 | 101 | 102 | 103 | 104 | -------------------------------------------------------------------------------- /test/crud/db_test.clj: -------------------------------------------------------------------------------- 1 | (ns crud.db-test 2 | (:require [clojure.test :refer :all] 3 | [crud.entity :refer :all] 4 | [schema.core :as s :refer [Str Num Inst Int Bool Keyword]] 5 | [crud.db :refer [crud-db has-attr?]] 6 | [crud.db.datomic :refer [facts-for entity-attributes]] 7 | [datomic.api :as d] 8 | [environ.core :refer [env]] 9 | [clojure.data :refer [diff]])) 10 | 11 | (defentity Department 12 | :schema {:name Str}) 13 | 14 | (defentity User 15 | :schema {:role Str 16 | :email Str 17 | :name Str} 18 | :links [(link :department [Department :id])]) 19 | 20 | (defentity Cart 21 | :schema {:items [{:id Int 22 | :qty Int 23 | :price Num}]}) 24 | 25 | (defn test-db [entities] 26 | (d/delete-database (env :crud-db-uri)) 27 | (crud-db {:type :datomic, 28 | :uri (env :crud-db-uri), 29 | :entities entities 30 | :identity {:value-type Int}})) 31 | 32 | (deftest test-entity-attributes 33 | (testing "builtins" 34 | (let [db (test-db [])] 35 | (is (has-attr? db :entity)))) 36 | 37 | (testing "simple attributes" 38 | (let [db (test-db [Department])] 39 | (is (has-attr? db :id)) 40 | (is (has-attr? db :name)))) 41 | 42 | (testing "nested attributes" 43 | (let [db (test-db [Cart])] 44 | (is (has-attr? db :qty)) 45 | (is (has-attr? db :price)))) 46 | 47 | (testing "linked attributes" 48 | (let [db (test-db [User])] 49 | (is (has-attr? db :department))))) 50 | 51 | ;; (deftest test-transactions 52 | ;; (testing "commit!" 53 | ;; (let [db (test-db [Department]) 54 | ;; show (fn [id] (represent db Department (find-by-id db id)))] 55 | ;; (commit! db Department {:id 1 :name "foo"}) 56 | ;; (= {:id 1, :name "foo"} 57 | ;; (show 1))) 58 | ;; ;; (is (= "foo" 59 | ;; ;; (:name (find-by-id db 1)))))) 60 | 61 | ;; (testing "commit with link" 62 | ;; (let [db (test-db [Department User])] 63 | ;; (commit! db Department {:id 1, :name "drivers"}) 64 | ;; (commit! db User {:id 2, :name "linus", 65 | ;; :links {:department 1}}) 66 | 67 | ;; (let [linus (find-by-id db 2)] 68 | ;; (is (= "linus" 69 | ;; (:name linus))) 70 | ;; (is (= "drivers" 71 | ;; ((comp :name :department) linus)))))) 72 | 73 | ;; (testing "commit with nested attributes" 74 | ;; (let [db (test-db [Cart])] 75 | ;; (commit! db Cart {:id 1 76 | ;; :items [{:id 2, :qty 10, :price 9.99}]}) 77 | 78 | ;; ;; (is (= {:id 1 79 | ;; ;; :items [{:id 2, :qty 10, :price 9.99}]} 80 | ;; ;; (diff {:id 1 81 | ;; ;; :items #{{:id 2, :qty 10, :price 9.99}}} 82 | ;; ; (d/touch (find-by-id db 1))) 83 | 84 | ;; (let [{:keys [id items]} 85 | ;; (is (= 1 id)) 86 | 87 | ;; (let [{:keys [id qty price]} (first items)] 88 | ;; (is (= 10 qty)) 89 | ;; (is (= 9.99 price)))))) 90 | 91 | 92 | ;; store (partial commit! db Department) 93 | ;; retract #(retract! db Department (first (find-by-id db %))) 94 | ;; retrieve #(into {} (first (find-by-id db %)))] 95 | 96 | ;; (testing "can commit! entity" 97 | ;; (store {:id 1 :name "foo"}) 98 | ;; (store {:id 2 :name "bar"}) 99 | 100 | ;; (is (= {:id 1 :name "foo"} (retrieve 1))) 101 | ;; (is (= {:id 2 :name "bar"} (retrieve 2)))) 102 | 103 | ;; (testing "can retract! entity" 104 | ;; (retract 1) 105 | ;; (is (empty? (retrieve 1)))))) 106 | 107 | ;; (deftest test-representation 108 | ;; (let [db (test-db [Department User]) 109 | ;; dept! (partial commit! db Department) 110 | ;; user! (partial commit! db User) 111 | ;; dept? #(represent db Department (first (find-by-id db %))) 112 | ;; user? #(represent db User (first (find-by-id db %)))] 113 | 114 | ;; (testing "basic representation" 115 | ;; (dept! {:id 1 :name "foo"}) 116 | ;; (is (= {:id 1, :name "foo"} (dept? 1)))))) 117 | 118 | ;; (testing "link representation" 119 | ;; (user! {:id 2 :email "linus@example.com" 120 | ;; :_links {:department 1}}))) 121 | 122 | ;; (is (= [[:db/add 0 :id 1] 123 | ;; [:db/add 0 :department [:department 1]]] 124 | ;; ((facts-for db User {:id 1, :_links {:department 1}}) 0)))))) 125 | 126 | 127 | 128 | -------------------------------------------------------------------------------- /src/crud/db/datomic.clj: -------------------------------------------------------------------------------- 1 | (ns crud.db.datomic 2 | (:require [datomic.api :as d] 3 | [crud.entity :refer [Link storage-schema find-link-from collection-links 4 | resource-links locate]] 5 | [crud.db :refer :all] 6 | [clojure.walk] 7 | [schema.core :as s :refer [Str Num Inst Int Bool Keyword]] 8 | [clojure.walk :as walk]) 9 | (:import [java.net URL URI])) 10 | 11 | (def ^{:private true} type-map 12 | {Str :db.type/string 13 | Bool :db.type/boolean 14 | Long :db.type/long 15 | ;java.Math.BigInteger :db.type/bigint 16 | Num :db.type/double 17 | Int :db.type/long 18 | Float :db.type/float 19 | Inst :db.type/instant 20 | 21 | Link :db.type/ref 22 | 23 | URI :db.type/string}) 24 | 25 | (defn- branch? 26 | "Return true if `v` has sub-elements" 27 | [v] 28 | (some #{(class v)} [clojure.lang.PersistentArrayMap clojure.lang.PersistentHashMap])) 29 | 30 | (defn- cardinality [schema-val] 31 | (if (vector? schema-val) 32 | :db.cardinality/many 33 | :db.cardinality/one)) 34 | 35 | (defn- attr [unique? component? k v] 36 | (merge (if unique? 37 | {:db/unique unique?}) 38 | 39 | {:db/id (d/tempid :db.part/db) 40 | :db/ident k 41 | :db/valueType (if (vector? v) 42 | :db.type/ref 43 | (get type-map v :db.type/string)) 44 | :db/cardinality (cardinality v) 45 | :db/isComponent component? 46 | :db.install/_attribute :db.part/db})) 47 | 48 | (defn entity-attributes [entity] 49 | "Generate datomic attributes for the specified resource. 50 | 51 | If `uniqueness` is specified, each key represents a unique attribute. As long as 52 | it's 'truthy' the value may be used by CrudDB in an implementation specific way 53 | 54 | `links` should be a sequence of maps that match the `Link` schema. For each link, 55 | at attribute of type :db.type/ref will be generated. 56 | 57 | `storable` should be a sequence of attributes representing the storable 58 | part of the entity. Transformations may be represented using storage 59 | agents which are just maps with :name and :callable keys" 60 | (letfn [(factory [component?] 61 | (fn reducer [acc [k v]] 62 | (cond 63 | (vector? v) (into acc (conj (mapcat (partial mk-facts true) v) 64 | (attr (k (:uniqueness entity)) true k [Link]))) 65 | (branch? v) (into acc (mk-facts true v)) 66 | :else (conj acc (attr (k (:uniqueness entity)) component? k v))))) 67 | 68 | (mk-facts [component m] 69 | (reduce (factory component) [] (seq m)))] 70 | 71 | (concat (mk-facts false (storage-schema entity)) 72 | (->> (:links entity) 73 | (map :from) 74 | (map #(attr false false % Link)) 75 | vec)))) 76 | 77 | (defn facts-for [db entity value] 78 | (fn [root-id] 79 | (let [props (merge (select-keys (dissoc value :_links) 80 | (keys (storage-schema entity))) 81 | {:db/id root-id} 82 | {:entity (:name entity)}) 83 | links (get value :_links) 84 | make-link (fn [[rel-type lnk]] 85 | {rel-type (locate (:href lnk) rel-type)})] 86 | (merge props 87 | (->> links 88 | (map make-link) 89 | (apply merge)))))) 90 | 91 | (defrecord DatomicCrudDB [uri connection entities] 92 | CrudDB 93 | (present [db entity] 94 | (collection-links db entity (constantly true))) 95 | 96 | (present [db entity value] 97 | (let [relations (map :from (:links entity))] 98 | (merge (resource-links db entity value) 99 | (apply dissoc (into {} value) 100 | (conj relations :entity))))) 101 | 102 | (has-attr? [db attr] 103 | (-> (d/db (:connection db)) 104 | (d/entity attr) 105 | :db.install/_attribute)) 106 | 107 | (commit! [db entity value] 108 | (let [root-id (d/tempid :db.part/user) 109 | facts ((facts-for db entity value) root-id)] 110 | @(d/transact (:connection db) 111 | [facts]) 112 | db)) 113 | 114 | (retract! [db entity value] 115 | @(d/transact (:connection db) 116 | [[:db.fn/retractEntity (:db/id value)]]) 117 | db) 118 | 119 | (find-by [db params] 120 | (let [c (:connection db) 121 | db (d/db c) 122 | build-predicate (fn [[k v]] ['?e k v]) 123 | q {:find '[?e] 124 | :in '[$] 125 | :where (map build-predicate params)}] 126 | (->> (apply concat (d/q q db)) 127 | (map (partial d/entity db))))) 128 | 129 | (find-by-id [db id] 130 | (let [c (:connection db)] 131 | (first (find-by db {:id id}))))) 132 | 133 | (defmethod crud-db :datomic [db-spec] 134 | (let [{:keys [uri entities seed-data]} db-spec 135 | conn (do (d/create-database uri) 136 | (d/connect uri)) 137 | known? (fn [attr] (has-attr? (map->DatomicCrudDB {:connection conn}) (:db/ident attr))) 138 | attrs (->> entities 139 | (map (partial entity-attributes)) 140 | (mapcat identity) 141 | (filter (complement known?)) 142 | (group-by :db/ident) 143 | (vals) 144 | (map first)) 145 | builtins [(attr false false :entity Str)]] 146 | 147 | ;; populate db with attributes for the specified entities 148 | @(d/transact conn (concat builtins attrs)) 149 | 150 | (map->DatomicCrudDB {:connection conn 151 | :entities entities 152 | :uri uri}))) 153 | 154 | -------------------------------------------------------------------------------- /src/crud/machine.clj: -------------------------------------------------------------------------------- 1 | (ns crud.machine 2 | (:require 3 | [crud.db :refer [find-by-id find-by commit! retract! present]] 4 | [crud.entity :refer [read-id query-schema create-schema publish-link routes]] 5 | [schema.core :as s :refer [Str Num Inst Int Bool Keyword]] 6 | [schema.coerce :refer [coercer string-coercion-matcher]]) 7 | (:import [java.net URL URI])) 8 | 9 | (defn- validate-with [schema ctx] 10 | (let [parsed-input-path [::parsed-input] 11 | valid-input-path [::valid-parsed-input] 12 | error-input-path [::validation-error] 13 | validator #((coercer schema string-coercion-matcher) %) 14 | validated (validator (or (get-in ctx parsed-input-path) 15 | {}))] 16 | 17 | (if (schema.utils/error? validated) 18 | [false (assoc-in {} error-input-path validated)] 19 | [true (assoc-in {} valid-input-path validated)]))) 20 | 21 | (defn find-by-id! [entity db id ctx] 22 | (if-let [entity (find-by-id db (read-id entity id))] 23 | [true (assoc-in ctx [:entity] entity)] 24 | [false (assoc-in ctx [::parsed-input :id] id)])) 25 | 26 | (defn create! [entity db ctx] 27 | (let [value (get-in ctx [::valid-parsed-input])] 28 | (if (commit! db entity value) 29 | (assoc ctx :entity value)))) 30 | 31 | (defn destroy! [entity db ctx] 32 | (retract! db entity (:entity ctx))) 33 | 34 | (defn validate! [entity ctx] 35 | (if (= :get (get-in ctx [:request :request-method])) 36 | (validate-with (query-schema entity) ctx) 37 | (validate-with (create-schema entity) ctx))) 38 | 39 | (defn created-location [entity ctx] 40 | (let [value (:entity ctx)] 41 | (bidi.bidi/path-for routes :resource 42 | :entity (:name entity) 43 | :id (str (:id value))))) 44 | 45 | (defn known-content-type? [ctx] 46 | (if (= "application/edn" (get-in ctx [:request :content-type])) 47 | true 48 | [false {:error "Unsupported content type"}])) 49 | 50 | (defn malformed? 51 | "Tries to parse validate the request body against `(:schema entity) 52 | 53 | If successful, return false and put the result in the ::parsed-input `ctx` key, otherwise return true and 54 | put any errors in the ::parser-errors `ctx` key." 55 | [entity ctx] 56 | (let [input-path [:request :body] 57 | output-path [::parsed-input] 58 | ;; TODO: This might be something you want to configure at the application 59 | ;; level. Consider exposing via defentity 60 | {:keys [reader media-type]} {:reader clojure.edn/read-string 61 | :media-type "application/edn"}] 62 | (try 63 | (let [body-as-str (if-let [body (get-in ctx input-path)] 64 | (condp instance? body 65 | java.lang.String body 66 | (slurp (clojure.java.io/reader body))))] 67 | [false (assoc-in {} output-path (reader body-as-str))]) 68 | (catch RuntimeException e 69 | [true {:representation {:media-type media-type} 70 | :parser-error (.getLocalizedMessage e)}])))) 71 | 72 | (defn handle-ok! [entity db ctx] 73 | (present db entity (:entity ctx))) 74 | 75 | (defn handle-ok-collection! [entity db ctx] 76 | (present db entity)) 77 | 78 | (defn handle-not-found! [name id] 79 | {:error (str "Could not find " name " with id: " id)}) 80 | 81 | (defn handle-malformed! [ctx] 82 | {:error (:parser-error ctx)}) 83 | 84 | (defn handle-created! [] 85 | (pr-str "Created.")) 86 | 87 | (defn handle-deleted! [] 88 | (pr-str "Deleted.")) 89 | 90 | (defn handle-unprocessable-entity! [ctx] 91 | (schema.utils/error-val (::validation-error ctx))) 92 | 93 | ;; ## Hyper Resources 94 | ;; 95 | ;; Crud generates a set of liberator resources for each entity. Together, the resources implement a hyper-media 96 | ;; server exposing an explorable REST API. 97 | ;; 98 | 99 | (defn crud-collection 100 | "Return a liberator state-machine for GET /collection" 101 | [entity db] 102 | {:available-media-types ["application/edn"] 103 | :allowed-methods [:get :post] 104 | :known-content-type? known-content-type? 105 | :malformed? (partial malformed? entity) 106 | :processable? (partial validate! entity) 107 | :post! (partial create! entity db) 108 | :post-redirect true 109 | :location (partial created-location entity) 110 | :handle-ok (partial handle-ok-collection! entity db) 111 | :handle-created (pr-str "Created.") 112 | :handle-unprocessable-entity (comp schema.utils/error-val ::validation-error)}) 113 | 114 | (defn crud-get 115 | "Return a liberator state-machine for GET /resource/:id" 116 | [entity db id] 117 | {:allowed-methods [:get] 118 | :available-media-types ["application/edn"] 119 | :known-content-type? known-content-type? 120 | :exists? (partial find-by-id! entity db id) 121 | :handle-not-found (handle-not-found! name id) 122 | :handle-ok (partial handle-ok! entity db)}) 123 | 124 | (defn crud-put 125 | "Return a liberator state-machine for PUT /resource/:id" 126 | [entity db id] 127 | {:allowed-methods [:put] 128 | :available-media-types ["application/edn"] 129 | :known-content-type? known-content-type? 130 | :malformed? (partial malformed? entity) 131 | :processable? (partial validate! entity) 132 | :exists? (find-by-id! entity db id) 133 | :new? #(nil? (:entity %)) 134 | :can-put-to-missing? true 135 | :put! (partial create! entity) 136 | :handle-malformed (partial handle-malformed!) 137 | :handle-created (handle-created!) 138 | :handle-unprocessable-entity (partial handle-unprocessable-entity!)}) 139 | 140 | (defn crud-patch 141 | "Return a liberator state-machine for PATCH /resource/:id" 142 | [entity db id] 143 | {:allowed-methods [:patch] 144 | :available-media-types ["application/edn"] 145 | :known-content-type? known-content-type? 146 | :malformed? (partial malformed? entity) 147 | :processable? (partial validate! entity) 148 | :exists? (find-by-id! entity db id) 149 | :handle-not-found (handle-not-found! name id) 150 | :patch! (partial create! entity) 151 | :handle-malformed (partial handle-malformed!) 152 | :handle-unprocessable-entity (partial handle-unprocessable-entity!)}) 153 | 154 | 155 | (defn crud-delete 156 | "Return a liberator state-machine for DELETE /resource/:id" 157 | [entity db id] 158 | {:allowed-methods [:delete] 159 | :available-media-types ["application/edn"] 160 | :known-content-type? known-content-type? 161 | :exists? (partial find-by-id! entity db id) 162 | :delete! (partial destroy! entity db) 163 | :handle-not-found (handle-not-found! name id) 164 | :respond-with-entity? true 165 | :handle-ok (partial handle-ok-collection! entity db)}) 166 | 167 | -------------------------------------------------------------------------------- /src/crud/entity.clj: -------------------------------------------------------------------------------- 1 | (ns crud.entity 2 | "An entity is a just set of attributes around which we can define basic CRUD-like behaviour. 3 | 4 | Using `defentity` we can declare independently of the underlying database, how it relates to other entities, 5 | which attributes should actually be persisted to the database, any validations necessary to ensure data integrity 6 | (including which if any attributes define an entity's primary key)" 7 | (:require [schema.core :as s :refer [Str Num Inst Int Bool Keyword Any]] 8 | [schema.coerce :as c] 9 | [crud.db :refer [find-by]] 10 | [bidi.bidi :refer [path-for]] 11 | [clojure.string :refer [join lower-case split]] 12 | [clojure.edn :as edn]) 13 | (:import [java.net URL URI])) 14 | 15 | (def routes 16 | ["/" 17 | {[:entity "/" :id] :resource 18 | [:entity] :collection 19 | "" :index}]) 20 | 21 | (defn locate [path rel] 22 | (let [route-params (:route-params (bidi.bidi/match-route routes path))] 23 | [:id (edn/read-string (:id route-params))])) 24 | 25 | ;; ## Entities 26 | ;; 27 | ;; Entities are your business entities. User, Account, Order, LineItem etc. Use entities to define 28 | ;; your business entities and the relationships between them. All entities have 29 | 30 | (defprotocol EntityDefinition 31 | (read-id [entity id-str] 32 | "Try to coerce `id-str` to the schema type specified by :id key of `(:schema entity)` 33 | 34 | Returns nil if the coercion fails") 35 | 36 | (create-schema [entity] 37 | "Construct a schema that defines a valid attempt to create an instance of this entity") 38 | 39 | (query-schema [entity] 40 | "Construct a schema supporting queries represented by (key,value) pairs") 41 | 42 | (storage-schema [entity] 43 | "Constructs the storable part of `entity`'s schema") 44 | 45 | (storable-value [entity value] 46 | "Constructs a new value from the storable parts of `value` (according to `entity`) 47 | 48 | Specifically, if the :storable key of entity is nil, this returns `value`. Otherwise, we use the storage agents to 49 | construct a new value with some entries potentially added/removed/transformed") 50 | 51 | (find-link-from [entity attr-name] 52 | "Given an `entity`, find the link from `name`")) 53 | 54 | ;; ## Storage Agents 55 | ;; 56 | ;; Storage Agents may be used to transform values before persisting them to the database. This is useful if you 57 | ;; need to encrypt secrets or canonicalize addresses to name just two examples. The `:callable` key should be a 58 | ;; function of arity 1 which transforms a value so that it can be stored. The `:name` key represents the attribute 59 | ;; to which the transformed value will be assigned. 60 | 61 | (def StorageAgent 62 | "Schema representing a storage agent 63 | 64 | Storage agents may be used to transform values before persisting them to the database (e.g. encrypt secrets, 65 | canonicalize addresses etc)" 66 | (s/either Keyword 67 | {:name Keyword 68 | :callable ifn?})) 69 | 70 | (defn storage-agent 71 | "Constructs the storage agent specified by `form`" 72 | [form] 73 | (if (keyword? form) 74 | {:name form 75 | :callable form} 76 | form)) 77 | 78 | (defrecord Entity [schema links storable uniqueness] 79 | EntityDefinition 80 | (read-id [entity id-str] 81 | (let [id-reader edn/read-string] 82 | (id-reader id-str))) 83 | 84 | (create-schema [entity] 85 | (assoc (:schema entity) 86 | (s/optional-key :id) s/Any 87 | (s/optional-key :_links) s/Any)) 88 | 89 | (query-schema [entity] 90 | (let [optionalize (fn [[name type]] 91 | [(s/optional-key name) type])] 92 | (->> (seq (merge (:schema entity) 93 | {:id Int})) 94 | (map optionalize) 95 | (into {})))) 96 | 97 | (storage-schema [entity] 98 | (if (:storable entity) 99 | (select-keys (:schema entity) 100 | (->> (:storable entity) 101 | (map storage-agent) 102 | (map :name))) 103 | (merge (:schema entity) 104 | {:id s/Int}))) 105 | 106 | (storable-value [entity value] 107 | (let [extract (fn [agent] 108 | (let [k (:name agent)] 109 | [k ((:callable agent) value)]))] 110 | (if (:storable entity) 111 | (->> (:storable entity) 112 | (map storage-agent) 113 | (mapcat extract) 114 | (apply hash-map)) 115 | value))) 116 | 117 | (find-link-from [entity name] 118 | (let [{links :links} entity 119 | matched (fn [link] 120 | (if (= (:from link) name) 121 | link))] 122 | (some matched links)))) 123 | 124 | (defn entity [name options] 125 | (map->Entity (merge {:name name} options))) 126 | 127 | (defmacro defentity 128 | "Defines an entity 129 | 130 | `:schema` should be a map (possibly nested) that represents any schematic constraints required by this entity. It 131 | is currently assumed that the schema will be a Prismatic schema but in the future, I'd like to add support for 132 | other schema specification syntaxes (e.g. herbert) (PATCHES welcome :-)) 133 | 134 | `:links` should be a sequence of maps that represent the relationships in which this entity is involved. Each link 135 | must conform to the `Link` schema. When `find-by` returns a value, it will have keys for each Link. The `link` 136 | function provides syntax sugar for constructing Links. 137 | 138 | `:storable` should be a sequence of maps that representing the storable part of the entity. Transformations may be 139 | represented using storage agents which are just maps with :name and :callable keys 140 | 141 | `:uniqueness` if specified should be a map where each key represents a unique attribute. As long as it's 'truthy' 142 | CrudDB implementations are free to further refine the definition of uniqueness in an implementation specific way 143 | " 144 | [entity-name & body] 145 | (let [fmt-name (fn [x] 146 | (str x))] 147 | ;; (join "-" (map lower-case 148 | ;; (split (str x) #"(?=[A-Z])"))))] 149 | `(def ~entity-name 150 | (map->Entity (merge {:name ~(fmt-name entity-name) 151 | :uniqueness {:id :db.unique/identity}} 152 | (hash-map ~@body)))))) 153 | 154 | ;; ## Links 155 | ;; 156 | ;; Links put the 'hyper' in hyper-media. In generating the hyper-media representation of entities, we use 157 | ;; any links between entities to generate hyper-media links. This is a "meta-object protocol" of sorts for 158 | ;; the web and allows clients to explore the API programatically. 159 | 160 | (def Link 161 | "Schema representing an association between entities" 162 | {:from Keyword 163 | :to Any 164 | :attr Keyword 165 | :cardinality Keyword}) 166 | 167 | (defn link 168 | "Represent a link `from` to `attr` of `to` with optional `cardinality`" 169 | ([from [to attr] cardinality] 170 | {:from from 171 | :to to 172 | :attr attr 173 | :cardinality cardinality}) 174 | 175 | ([from [to attr]] 176 | (link from [to attr] :db.cardinality/one))) 177 | 178 | (defn find-link-to 179 | "Given `entity`, find the link to `other` (which should be an entity)" 180 | [entity other] 181 | (let [{links :links} entity 182 | matched (fn [link] 183 | (if (= (:to link) other) 184 | link))] 185 | (some matched links))) 186 | 187 | (defn publish-link [route-id options] 188 | (merge 189 | {:href (apply path-for routes route-id (flatten (seq options)))} 190 | (select-keys options [:name :href :title]))) 191 | 192 | (defn collection-links [db entity pred] 193 | (let [entity-name (:name entity) 194 | self (path-for routes :collection :entity entity-name) 195 | itemize (fn [item] 196 | {:href (path-for routes :resource 197 | :entity entity-name 198 | :id (:id item))})] 199 | {:_links 200 | {:self (publish-link :collection {:entity (:name entity)}) 201 | :create (publish-link :collection {:entity (:name entity)}) 202 | :item (->> (filter pred (find-by db {:entity entity-name})) 203 | (map itemize))}})) 204 | ;; :entities (->> (filter pred (find-by db {:entity entity-name})) 205 | ;; (map itemize))}})) 206 | 207 | (defn resource-links [db entity value] 208 | (let [self (publish-link :resource {:entity (:name entity), 209 | :id (:id value)}) 210 | coll (publish-link :collection {:entity (:name entity)}) 211 | links (for [lnk (:links entity)] 212 | (let [to (:to lnk) 213 | from (:from lnk) 214 | rel-value (from value)] 215 | {from (publish-link :resource {:entity (:name to) 216 | :id (:id rel-value)})}))] 217 | {:_links (merge {:self self 218 | :collection coll} 219 | (apply merge links))})) 220 | 221 | ;; (defprotocol Historian 222 | ;; "Historian provides an API for retrieving the history of changes made 223 | ;; to the entity identified by `id`" 224 | ;; (change-log [db entity id] 225 | ;; "Gather the history associated with the entity identified by `id`")) 226 | 227 | ;; (defprotocol AsynchronousValidator 228 | ;; "The validation function is called asynchronously for each transaction and gets to 229 | ;; add hints, warnings and errors in relation to entity as it existed immediately after 230 | ;; the transaction" 231 | ;; (validate [db-after id]) 232 | ;; (hints [db id] 233 | ;; "Return any hints associated with the entity at `id`") 234 | ;; (warnings [db id] 235 | ;; "Return any warnings associated with the entity at `id`") 236 | ;; (errors [db id] 237 | ;; "Return any errors associated with the entity at `id`")) 238 | 239 | 240 | 241 | ;; ;; (defn find-by-id [entity id] 242 | ;; ;; {:entity entity 243 | ;; ;; : 244 | 245 | 246 | ;; (defn evalue [entity value] 247 | ;; {:entity entity 248 | ;; :value value}) 249 | 250 | ;; (defn with-entity [entity value] 251 | ;; (with-meta value 252 | ;; {:entity entity})) 253 | 254 | --------------------------------------------------------------------------------