didibus · August 20, 2024 20:35 · didibus · Jul 25, 2021 · leonoel · Jul 30, 2021
diff --git a/complex_business_process_example.clj b/complex_business_process_example.clj
 (ns complex-business-process-example
  "A stupid example of a more complex business process to implement as a flowchart.")

 ;;;; 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

 (defn process-bar
  "Function modeling the flowchart for our bar business process.
   This uses plain Clojure approach, no special libs or tricks and plain old exceptions.

   Normally I'd factor some of this out into their own functions, but keeping it all into
   one for demo, and it makes it possibly easier to see the whole flow in one go.

   As you see, all functions this uses are either pure, or have all their dependencies injected
   into them, such as the DB functions taking the db as input, and some of the pure business logic
   functions taking the env as input, so they know which rules to apply based on environment, another
   ridiculous business requirement we couldn't get out of.

   It has conditional branching, multiple point of failures, retries, debugging printlns that stub as logs,
   validation failure as a happy path, failure as a error return, a small saga rollback procedure to keep the
   db consistent in case of failure of the two non-atomic writes, later steps leverage multiple returns
   from prior steps, it uses dependency injection, and all implementing fns are decoupled from it thus we
   are able to reuse them in other flows in completely different order without issue or risks of breaking
   this one."
  [input]
  (try
    (let [;; 1. Gathers config and dependencies
          env (:env config)
          db (if (prod? env) prod-db test-db)
          ;; 2. Validate input, return validation error with details if invalid
          valid-input? (valid-bar-input? input)
          _ (when-not valid-input? (throw (ex-info "Invalid input to bar."
                                                   {:type :invalid-input
                                                    :msg "All values of bar input must be numbers"})))
          ;; 3. Applies credit based on :credit input using business rules
          credit (apply-credit (:credit input) env)
          ;; 4. Conditionally choose the type of boost to apply based on the credit we got
          ;;    high credit we apply normal boost, low credit we apply generous boost
          boost (if (pos? credit)
                  (apply-bonus-over-credit credit (:bonus input) env)
                  (apply-generous-bonus-over-credit credit (:generous-bonus input) env))
          ;; 5. Get the first-name that maps to the boost amount, this is based on a business provided
          ;;    dictionary.
          first-name (boost->first-name boost env)
          ;; 6. Get the last-name that maps to the first-name, this is based on the mapping from the db.
          ;;    DB query can fail, retry it a few times with back-off if it does.
          ;;    Throw if all retry attempts fails.
          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)))
          ;; 7. Decide if we should apply boost based on a business provided dictionary that gives certain
          ;;    last-name the benefit of being boosted.
          should-boost (boost? last-name)]
      ;; 8. If we should boost, update the DB with the boost-record, reflect the boost in the DB total
      ;;     and return that we did boost.
      ;;    Else return that we did not boost.
      (if should-boost
        ;; 8.1 We need to update the DB by appending the new boost record to the boost-records and
        ;;     adding the new boost to the current total, but our DB doesn't let us do this in a
        ;;     transaction, so we implement a small SAGA where if we succeeded in updating the boost-records,
        ;;     but we fail to accordingly update the total, we will rollback the change to the boost-records
        ;;     and retry then entire set of operation, thus implementing our own best-effort transaction.
        (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.")
                  {:result :boosted}))))
        ;; 8.3 Return that we did not apply a boost.
        (do (println "Process bar did not boost.")
            {:result :not-boosted})))
    (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.")
              {: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))
              {:result :error}))))))

 ;;;; 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 complex-business-process-example
	"A stupid example of a more complex business process to implement as a flowchart.")

	;;;; 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

	(defn process-bar
	"Function modeling the flowchart for our bar business process.
	This uses plain Clojure approach, no special libs or tricks and plain old exceptions.

	Normally I'd factor some of this out into their own functions, but keeping it all into
	one for demo, and it makes it possibly easier to see the whole flow in one go.

	As you see, all functions this uses are either pure, or have all their dependencies injected
	into them, such as the DB functions taking the db as input, and some of the pure business logic
	functions taking the env as input, so they know which rules to apply based on environment, another
	ridiculous business requirement we couldn't get out of.

	It has conditional branching, multiple point of failures, retries, debugging printlns that stub as logs,
	validation failure as a happy path, failure as a error return, a small saga rollback procedure to keep the
	db consistent in case of failure of the two non-atomic writes, later steps leverage multiple returns
	from prior steps, it uses dependency injection, and all implementing fns are decoupled from it thus we
	are able to reuse them in other flows in completely different order without issue or risks of breaking
	this one."
	[input]
	(try
	(let [;; 1. Gathers config and dependencies
	env (:env config)
	db (if (prod? env) prod-db test-db)
	;; 2. Validate input, return validation error with details if invalid
	valid-input? (valid-bar-input? input)
	_ (when-not valid-input? (throw (ex-info "Invalid input to bar."
	{:type :invalid-input
	:msg "All values of bar input must be numbers"})))
	;; 3. Applies credit based on :credit input using business rules
	credit (apply-credit (:credit input) env)
	;; 4. Conditionally choose the type of boost to apply based on the credit we got
	;; high credit we apply normal boost, low credit we apply generous boost
	boost (if (pos? credit)
	(apply-bonus-over-credit credit (:bonus input) env)
	(apply-generous-bonus-over-credit credit (:generous-bonus input) env))
	;; 5. Get the first-name that maps to the boost amount, this is based on a business provided
	;; dictionary.
	first-name (boost->first-name boost env)
	;; 6. Get the last-name that maps to the first-name, this is based on the mapping from the db.
	;; DB query can fail, retry it a few times with back-off if it does.
	;; Throw if all retry attempts fails.
	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)))
	;; 7. Decide if we should apply boost based on a business provided dictionary that gives certain
	;; last-name the benefit of being boosted.
	should-boost (boost? last-name)]
	;; 8. If we should boost, update the DB with the boost-record, reflect the boost in the DB total
	;; and return that we did boost.
	;; Else return that we did not boost.
	(if should-boost
	;; 8.1 We need to update the DB by appending the new boost record to the boost-records and
	;; adding the new boost to the current total, but our DB doesn't let us do this in a
	;; transaction, so we implement a small SAGA where if we succeeded in updating the boost-records,
	;; but we fail to accordingly update the total, we will rollback the change to the boost-records
	;; and retry then entire set of operation, thus implementing our own best-effort transaction.
	(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.")
	{:result :boosted}))))
	;; 8.3 Return that we did not apply a boost.
	(do (println "Process bar did not boost.")
	{:result :not-boosted})))
	(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.")
	{: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))
	{:result :error}))))))

	;;;; 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))