wandersoncferreira/complex_business_process_example.clj

## complex_business_process_example.clj
(ns didibus-example.core
  "A stupid example of a more complex business process to implement as a flowchart."
  (:require [tilakone.core :as tk :refer [_]]))


;;;; Config

(def config
  "When set to :test will trigger the not-boosted branch which won't write to db.
   When set to :prod will trigger the boosted branch which will try to write to the db."
  {:env :prod})

(def chance-of-failure
  "The chances that any db read or write 'times out'.
   1 means there is a 1 in 1 chance a read or write times out, always does.
   2 means there is a 1 in 2 chance a read or write times out.
   3 means there is 1 in 3 chance a read or write times out.
   X means there is 1 in X chance a read or write times out."
  3)

;;;; Fake Databases

(def prod-db
  "Our fake prod db, we pretend it has first-name -> last-name
   mappings and some total of some business thing which is supposed
   to reflect the total of all 'boost' events logged in boost-records.
   This means boost-records and total must always reconcile.
   eg: {john mayer
        jane queen
        :boost-records [{:first-name john, :last-name mayer, :boost 12}]
        :total 12}"
  (atom {"john" "mayer"
         "jane" "queen"
         :boost-records []
         :total 0}))

(def test-db
  "Same as prod db, but is for non prod environments.
   Based on the rules and our example input, it should not be written too, but will
   be read from"
  (atom {"john" "doe"
         "jane" "doee"
         :boost-records []
         :total 0}))

;;;; Utils

(defn prod?
  "[pure] Returns true if end is :prod, false otherwise."
  [env]
  (boolean (#{:prod} env)))

;;;; Validation

(defn valid-bar-input?
  "[pure] Returns true if input is valid for bar processing, false otherwise."
  [input]
  (every? number? (vals input)))

;;;; Pure business logic

(defn apply-credit
  "[pure] Applies given credit using ridiculous business stakeholder requirements."
  [credit env]
  (if (prod? env)
    (inc credit)
    (dec credit)))


(defn apply-bonus-over-credit
  "[pure] Applies given bonus over credit using ridiculous business stakeholder requirements."
  [credit bonus env]
  (if (prod? env)
    (+ 10 credit bonus)
    (- credit bonus 10)))

(defn apply-generous-bonus-over-credit
  "[pure] Applies given generous bonus generously over credit using ridiculous business stakeholder requirements."
  [credit bonus env]
  (if (prod? env)
    (+ 100 credit bonus)
    (- credit bonus 100)))

(defn boost->first-name
  "[pure] Given a boost amount, returns the first-name that should dictate boosting based on
   ridiculous business stakeholder requirements."
  [boost env]
  (if (prod? env)
    (if (pos? boost)
      "john"
      "jane")
    (if (neg? boost)
      "john"
      "jane")))

(defn boost?
  "[pure] Returns true if we should boost based on ridiculous business stakeholder requirements."
  [last-name]
  (if (#{"mayer"} last-name)
    true
    false))

;;;; Pretends to be impure blocking DB reads/writes

(defn impure-query-get-last-name
  "Get last-name from db for given first-name.
   Can throw based on chance-of-failure setting."
  [db first-name]
  (when (zero? (rand-int chance-of-failure))
    (throw (ex-info "Timed out getting last-name from db" {:first-name first-name})))
  (Thread/sleep 1000)
  (get @db first-name))

(defn impure-query-get-total
  "Get total from db.
   Can throw based on chance-of-failure setting."
  [db]
  (when (zero? (rand-int chance-of-failure))
    (throw (ex-info "Timed out getting total from db" {})))
  (Thread/sleep 1000)
  (get @db :total))

(defn impure-query-get-boost-records
  "Get boost records from db.
   Can throw based on chance-of-failure setting."
  [db]
  (when (zero? (rand-int chance-of-failure))
    (throw (ex-info "Timed out getting boost-records from db" {})))
  (Thread/sleep 1000)
  (get @db :boost-records))

(defn impure-write-total
  "Write total to db, overwrites existing total with given total.
   Can throw based on chance-of-failure setting."
  [db total]
  (when (zero? (rand-int chance-of-failure))
    (throw (ex-info "Timed out writing total to db" {:total total})))
  (Thread/sleep 1000)
  (swap! db assoc :total total))

(defn impure-write-boost-records
  "Write boost records to db, overwrites existing boost records with given boost records.
   Can throw based on chance-of-failure setting."
  [db boost-records]
  (when (zero? (rand-int chance-of-failure))
    (throw (ex-info "Timed out writing boost-records to db" {:boost-records boost-records})))
  (Thread/sleep 1000)
  (swap! db assoc :boost-records boost-records))

;;;; Business Processes
;;; Implemented using state machine via Tilakone library

(def process-bar-states
  "These are all the states of the complex business logic."
  [{::tk/name :start
    ::tk/transitions [{::tk/on :start
                       ::tk/to :credit-applied
                       ::tk/guards [:validate-input]}
                      {::tk/on _
                       ::tk/to :invalid-input}]}

   {::tk/name :invalid-input
    ::tk/enter {::tk/actions [:invalid-input]}}

   {::tk/name :credit-applied
    ::tk/transitions [{::tk/on :apply-credit
                       ::tk/to :boost-applied}]
    ::tk/enter {::tk/actions [:apply-credit]}}

   {::tk/name :boost-applied
    ::tk/transitions [{::tk/on :apply-boost
                       ::tk/to :with-first-name}]
    ::tk/enter {::tk/actions [:apply-boost]}}

   {::tk/name :with-first-name
    ::tk/transitions [{::tk/on :get-first-name
                       ::tk/to :with-last-name}]
    ::tk/enter {::tk/actions [:get-first-name]}}

   {::tk/name :with-last-name
    ::tk/transitions [{::tk/on :get-last-name
                       ::tk/to :boosted
                       ::tk/guards [:should-boost?]}
                      {::tk/on _
                       ::tk/to :not-boosted}]
    ::tk/enter {::tk/actions [:get-last-name]}}

   {::tk/name :boosted
    ::tk/enter {::tk/actions [:boost]}}

   {::tk/name :not-boosted
    ::tk/enter {::tk/actions [:not-boost]}}])

(def process-bar-fsm
  {::tk/states process-bar-states
   ::tk/guard? (fn [{::tk/keys [guard process] :as fsm}]
                 (let [{:keys [input]} process]
                   (case guard
                     :validate-input (valid-bar-input? input)
                     :should-boost? (boost? (:last-name process)))))

   ::tk/action! (fn [{::tk/keys [action process] :as fsm}]
                  (let [{:keys [input]} process
                        ;; 1. Gathers config and dependencies
                        env (:env config)
                        db (if (prod? env) prod-db test-db)]
                    (case action
                      :invalid-input (throw (ex-info "Invalid input bar."
                                                     {:type :invalid-input
                                                      :msg "All values of bar input must be numbers"}))
                      :apply-credit (let [credit (apply-credit (:credit input) env)]
                                      (assoc-in fsm [::tk/process :credit] credit))
                      :apply-boost (let [credit (:credit process)
                                         boost (if (pos? credit)
                                                 (apply-bonus-over-credit credit (:bonus input) env)
                                                 (apply-generous-bonus-over-credit credit (:generous-bonus input) env))]
                                     (assoc-in fsm [::tk/process :boost] boost))
                      :get-first-name (let [first-name (boost->first-name (:boost process) env)]
                                        (assoc-in fsm [::tk/process :first-name] first-name))
                      :get-last-name (let [first-name (:first-name process)
                                           last-name (loop [retries [10 100 1000]]
                                                       ;; This here is a good example of when try/catch doesn't play as well
                                                       ;; with Clojure, since you can't call recur from inside a catch, which
                                                       ;; is why I have to convert it to returning a command that indicates
                                                       ;; I need to recur outside of the catch afterwards.
                                                       (let [res (try (impure-query-get-last-name db first-name)
                                                                      (catch Exception e
                                                                        (if retries
                                                                          (do (Thread/sleep (first retries))
                                                                              (println "Retrying to query last name after failure.")
                                                                              :retry)
                                                                          (do (println "All attempts to query last name failed.")
                                                                              (throw e)))))]
                                                         (if (#{:retry} res)
                                                           (recur (next retries))
                                                           res)))]
                                       (assoc-in fsm [::tk/process :last-name] last-name))
                      :boost (let [{:keys [first-name last-name boost]} process]
                               (loop [retries [10 100 1000 1250 1500 2000]]
                                 (let [res (try
                                             (let [boost-records (impure-query-get-boost-records db)
                                                   total (impure-query-get-total db)
                                                   new-boost-record {:first-name first-name
                                                                     :last-name last-name
                                                                     :boost boost}
                                                   new-boost-records (conj boost-records new-boost-record)
                                                   new-total (+ total boost)]
                                               (impure-write-boost-records db new-boost-records)
                                               (try (impure-write-total db new-total)
                                                    (catch Exception e
                                                      ;; Rollback our transaction, trying a few times to do so, as a best effort to clean up and
                                                      ;; leave the DB in a consistent state.
                                                      (loop [retries [10 100 200]]
                                                        (let [res (try (impure-write-boost-records db boost-records)
                                                                       (catch Exception e
                                                                         (if retries
                                                                           (do (Thread/sleep (first retries))
                                                                               (println "Retrying to rollback boost records after updating total, after failing to do so.")
                                                                               :retry)
                                                                           ;; Log that we failed to rollback, and log the boost-record which we failed to remove, so we might
                                                                           ;; manually be able to fix the DB state if we needed too.
                                                                           (do (println "Failed to rollback boost records after updating total, out-of-sync boost record is: " new-boost-record)
                                                                               (throw e)))))]
                                                          (if (#{:retry} res)
                                                            (recur (next retries))
                                                            (throw e)))))))
                                             (catch Exception e
                                               (if retries
                                                 (do (Thread/sleep (first retries))
                                                     (println "Retrying to update boost-records and total after failure.")
                                                     :retry)
                                                 (do (println "All attempts to update boost-records and total failed.")
                                                     (throw e)))))]
                                   (if (#{:retry} res)
                                     (recur (next retries))
                                     ;; 8.2 Return that we applied a boost.
                                     (do res
                                         (println "Process bar boosted.")
                                         (assoc-in fsm [::tk/process :result] {:result :boosted}))))))
                      :not-boost (do (println "Process bar did not boost.")
                                     ;; 8.3 Return that we did not apply a boost.
                                     (assoc-in fsm [::tk/process :result] {:result :not-boosted})))))
   ::tk/state :start

   :input nil
   })

(def actions
  [:start
   :apply-credit
   :apply-boost
   :get-first-name
   :get-last-name])

(defn process-bar
  [input]
  (let [initial-fsm (assoc process-bar-fsm :input input)
        final-fsm
        (reduce
         (fn [fsm action]
           (try
             (let [new-fsm (tk/apply-signal fsm action)]
               (println "\n state: " (::tk/state new-fsm))
               new-fsm)
             (catch Exception e
               (let [edata (ex-data e)]
                 (case (:type edata)
                   ;; 9. Return a validation error with details of what in the input was invalid.
                   :invalid-input
                   (do (println "Invalid input passed to bar.")
                       (reduced {:result :invalid-input :msg (:msg edata)}))

                   ;; 10. Return that we failed to perform the bar process with an unexpected issue and its details.
                   (do (println (str "Process bar failed unexpectedly with error: " e))
                       (reduced {:result :error})))))))
         initial-fsm
         actions)]
    (if (#{:invalid-input :error} (:result final-fsm))
      final-fsm
      (:result final-fsm))))


;;;; REPL

;; Run our process to see it go in :prod
(println
 (process-bar {:credit 0
               :bonus 1
               :generous-bonus 2}))

;; Print the db to see if it had the effect we intended to it.
(println
 (if (prod? (:env config))
   @prod-db
   @test-db))

;; Run it with a wrong input
(println
 (process-bar {:credit "0"
               :bonus 1
               :generous-bonus 2}))

;; Run it again and see what happens to the DB
(println
 (process-bar {:credit 2
               :bonus 12
               :generous-bonus 23}))
;; Print the db to see if it had the effect we intended to it.
(println
 (if (prod? (:env config))
   @prod-db
   @test-db))

;; Change to :test env
(def config {:env :test})

;; Run our process to see it go in :test
(println
 (process-bar {:credit 0
               :bonus 1
               :generous-bonus 2}))

;; Print the db to see if it had the effect we intended to it.
(println
 (if (prod? (:env config))
   @prod-db
   @test-db))
	(ns didibus-example.core
	"A stupid example of a more complex business process to implement as a flowchart."
	(:require [tilakone.core :as tk :refer [_]]))


	;;;; Config

	(def config
	"When set to :test will trigger the not-boosted branch which won't write to db.
	When set to :prod will trigger the boosted branch which will try to write to the db."
	{:env :prod})

	(def chance-of-failure
	"The chances that any db read or write 'times out'.
	1 means there is a 1 in 1 chance a read or write times out, always does.
	2 means there is a 1 in 2 chance a read or write times out.
	3 means there is 1 in 3 chance a read or write times out.
	X means there is 1 in X chance a read or write times out."
	3)

	;;;; Fake Databases

	(def prod-db
	"Our fake prod db, we pretend it has first-name -> last-name
	mappings and some total of some business thing which is supposed
	to reflect the total of all 'boost' events logged in boost-records.
	This means boost-records and total must always reconcile.
	eg: {john mayer
	jane queen
	:boost-records [{:first-name john, :last-name mayer, :boost 12}]
	:total 12}"
	(atom {"john" "mayer"
	"jane" "queen"
	:boost-records []
	:total 0}))

	(def test-db
	"Same as prod db, but is for non prod environments.
	Based on the rules and our example input, it should not be written too, but will
	be read from"
	(atom {"john" "doe"
	"jane" "doee"
	:boost-records []
	:total 0}))

	;;;; Utils

	(defn prod?
	"[pure] Returns true if end is :prod, false otherwise."
	[env]
	(boolean (#{:prod} env)))

	;;;; Validation

	(defn valid-bar-input?
	"[pure] Returns true if input is valid for bar processing, false otherwise."
	[input]
	(every? number? (vals input)))

	;;;; Pure business logic

	(defn apply-credit
	"[pure] Applies given credit using ridiculous business stakeholder requirements."
	[credit env]
	(if (prod? env)
	(inc credit)
	(dec credit)))


	(defn apply-bonus-over-credit
	"[pure] Applies given bonus over credit using ridiculous business stakeholder requirements."
	[credit bonus env]
	(if (prod? env)
	(+ 10 credit bonus)
	(- credit bonus 10)))

	(defn apply-generous-bonus-over-credit
	"[pure] Applies given generous bonus generously over credit using ridiculous business stakeholder requirements."
	[credit bonus env]
	(if (prod? env)
	(+ 100 credit bonus)
	(- credit bonus 100)))

	(defn boost->first-name
	"[pure] Given a boost amount, returns the first-name that should dictate boosting based on
	ridiculous business stakeholder requirements."
	[boost env]
	(if (prod? env)
	(if (pos? boost)
	"john"
	"jane")
	(if (neg? boost)
	"john"
	"jane")))

	(defn boost?
	"[pure] Returns true if we should boost based on ridiculous business stakeholder requirements."
	[last-name]
	(if (#{"mayer"} last-name)
	true
	false))

	;;;; Pretends to be impure blocking DB reads/writes

	(defn impure-query-get-last-name
	"Get last-name from db for given first-name.
	Can throw based on chance-of-failure setting."
	[db first-name]
	(when (zero? (rand-int chance-of-failure))
	(throw (ex-info "Timed out getting last-name from db" {:first-name first-name})))
	(Thread/sleep 1000)
	(get @db first-name))

	(defn impure-query-get-total
	"Get total from db.
	Can throw based on chance-of-failure setting."
	[db]
	(when (zero? (rand-int chance-of-failure))
	(throw (ex-info "Timed out getting total from db" {})))
	(Thread/sleep 1000)
	(get @db :total))

	(defn impure-query-get-boost-records
	"Get boost records from db.
	Can throw based on chance-of-failure setting."
	[db]
	(when (zero? (rand-int chance-of-failure))
	(throw (ex-info "Timed out getting boost-records from db" {})))
	(Thread/sleep 1000)
	(get @db :boost-records))

	(defn impure-write-total
	"Write total to db, overwrites existing total with given total.
	Can throw based on chance-of-failure setting."
	[db total]
	(when (zero? (rand-int chance-of-failure))
	(throw (ex-info "Timed out writing total to db" {:total total})))
	(Thread/sleep 1000)
	(swap! db assoc :total total))

	(defn impure-write-boost-records
	"Write boost records to db, overwrites existing boost records with given boost records.
	Can throw based on chance-of-failure setting."
	[db boost-records]
	(when (zero? (rand-int chance-of-failure))
	(throw (ex-info "Timed out writing boost-records to db" {:boost-records boost-records})))
	(Thread/sleep 1000)
	(swap! db assoc :boost-records boost-records))

	;;;; Business Processes
	;;; Implemented using state machine via Tilakone library

	(def process-bar-states
	"These are all the states of the complex business logic."
	[{::tk/name :start
	::tk/transitions [{::tk/on :start
	::tk/to :credit-applied
	::tk/guards [:validate-input]}
	{::tk/on _
	::tk/to :invalid-input}]}

	{::tk/name :invalid-input
	::tk/enter {::tk/actions [:invalid-input]}}

	{::tk/name :credit-applied
	::tk/transitions [{::tk/on :apply-credit
	::tk/to :boost-applied}]
	::tk/enter {::tk/actions [:apply-credit]}}

	{::tk/name :boost-applied
	::tk/transitions [{::tk/on :apply-boost
	::tk/to :with-first-name}]
	::tk/enter {::tk/actions [:apply-boost]}}

	{::tk/name :with-first-name
	::tk/transitions [{::tk/on :get-first-name
	::tk/to :with-last-name}]
	::tk/enter {::tk/actions [:get-first-name]}}

	{::tk/name :with-last-name
	::tk/transitions [{::tk/on :get-last-name
	::tk/to :boosted
	::tk/guards [:should-boost?]}
	{::tk/on _
	::tk/to :not-boosted}]
	::tk/enter {::tk/actions [:get-last-name]}}

	{::tk/name :boosted
	::tk/enter {::tk/actions [:boost]}}

	{::tk/name :not-boosted
	::tk/enter {::tk/actions [:not-boost]}}])

	(def process-bar-fsm
	{::tk/states process-bar-states
	::tk/guard? (fn [{::tk/keys [guard process] :as fsm}]
	(let [{:keys [input]} process]
	(case guard
	:validate-input (valid-bar-input? input)
	:should-boost? (boost? (:last-name process)))))

	::tk/action! (fn [{::tk/keys [action process] :as fsm}]
	(let [{:keys [input]} process
	;; 1. Gathers config and dependencies
	env (:env config)
	db (if (prod? env) prod-db test-db)]
	(case action
	:invalid-input (throw (ex-info "Invalid input bar."
	{:type :invalid-input
	:msg "All values of bar input must be numbers"}))
	:apply-credit (let [credit (apply-credit (:credit input) env)]
	(assoc-in fsm [::tk/process :credit] credit))
	:apply-boost (let [credit (:credit process)
	boost (if (pos? credit)
	(apply-bonus-over-credit credit (:bonus input) env)
	(apply-generous-bonus-over-credit credit (:generous-bonus input) env))]
	(assoc-in fsm [::tk/process :boost] boost))
	:get-first-name (let [first-name (boost->first-name (:boost process) env)]
	(assoc-in fsm [::tk/process :first-name] first-name))
	:get-last-name (let [first-name (:first-name process)
	last-name (loop [retries [10 100 1000]]
	;; This here is a good example of when try/catch doesn't play as well
	;; with Clojure, since you can't call recur from inside a catch, which
	;; is why I have to convert it to returning a command that indicates
	;; I need to recur outside of the catch afterwards.
	(let [res (try (impure-query-get-last-name db first-name)
	(catch Exception e
	(if retries
	(do (Thread/sleep (first retries))
	(println "Retrying to query last name after failure.")
	:retry)
	(do (println "All attempts to query last name failed.")
	(throw e)))))]
	(if (#{:retry} res)
	(recur (next retries))
	res)))]
	(assoc-in fsm [::tk/process :last-name] last-name))
	:boost (let [{:keys [first-name last-name boost]} process]
	(loop [retries [10 100 1000 1250 1500 2000]]
	(let [res (try
	(let [boost-records (impure-query-get-boost-records db)
	total (impure-query-get-total db)
	new-boost-record {:first-name first-name
	:last-name last-name
	:boost boost}
	new-boost-records (conj boost-records new-boost-record)
	new-total (+ total boost)]
	(impure-write-boost-records db new-boost-records)
	(try (impure-write-total db new-total)
	(catch Exception e
	;; Rollback our transaction, trying a few times to do so, as a best effort to clean up and
	;; leave the DB in a consistent state.
	(loop [retries [10 100 200]]
	(let [res (try (impure-write-boost-records db boost-records)
	(catch Exception e
	(if retries
	(do (Thread/sleep (first retries))
	(println "Retrying to rollback boost records after updating total, after failing to do so.")
	:retry)
	;; Log that we failed to rollback, and log the boost-record which we failed to remove, so we might
	;; manually be able to fix the DB state if we needed too.
	(do (println "Failed to rollback boost records after updating total, out-of-sync boost record is: " new-boost-record)
	(throw e)))))]
	(if (#{:retry} res)
	(recur (next retries))
	(throw e)))))))
	(catch Exception e
	(if retries
	(do (Thread/sleep (first retries))
	(println "Retrying to update boost-records and total after failure.")
	:retry)
	(do (println "All attempts to update boost-records and total failed.")
	(throw e)))))]
	(if (#{:retry} res)
	(recur (next retries))
	;; 8.2 Return that we applied a boost.
	(do res
	(println "Process bar boosted.")
	(assoc-in fsm [::tk/process :result] {:result :boosted}))))))
	:not-boost (do (println "Process bar did not boost.")
	;; 8.3 Return that we did not apply a boost.
	(assoc-in fsm [::tk/process :result] {:result :not-boosted})))))
	::tk/state :start

	:input nil
	})

	(def actions
	[:start
	:apply-credit
	:apply-boost
	:get-first-name
	:get-last-name])

	(defn process-bar
	[input]
	(let [initial-fsm (assoc process-bar-fsm :input input)
	final-fsm
	(reduce
	(fn [fsm action]
	(try
	(let [new-fsm (tk/apply-signal fsm action)]
	(println "\n state: " (::tk/state new-fsm))
	new-fsm)
	(catch Exception e
	(let [edata (ex-data e)]
	(case (:type edata)
	;; 9. Return a validation error with details of what in the input was invalid.
	:invalid-input
	(do (println "Invalid input passed to bar.")
	(reduced {:result :invalid-input :msg (:msg edata)}))

	;; 10. Return that we failed to perform the bar process with an unexpected issue and its details.
	(do (println (str "Process bar failed unexpectedly with error: " e))
	(reduced {:result :error})))))))
	initial-fsm
	actions)]
	(if (#{:invalid-input :error} (:result final-fsm))
	final-fsm
	(:result final-fsm))))



	;;;; REPL

	;; Run our process to see it go in :prod
	(println
	(process-bar {:credit 0
	:bonus 1
	:generous-bonus 2}))

	;; Print the db to see if it had the effect we intended to it.
	(println
	(if (prod? (:env config))
	@prod-db
	@test-db))

	;; Run it with a wrong input
	(println
	(process-bar {:credit "0"
	:bonus 1
	:generous-bonus 2}))

	;; Run it again and see what happens to the DB
	(println
	(process-bar {:credit 2
	:bonus 12
	:generous-bonus 23}))
	;; Print the db to see if it had the effect we intended to it.
	(println
	(if (prod? (:env config))
	@prod-db
	@test-db))

	;; Change to :test env
	(def config {:env :test})

	;; Run our process to see it go in :test
	(println
	(process-bar {:credit 0
	:bonus 1
	:generous-bonus 2}))

	;; Print the db to see if it had the effect we intended to it.
	(println
	(if (prod? (:env config))
	@prod-db
	@test-db))