WIP shop

1 files changed, 121 insertions, 0 deletions

diff --git a/shop.fnl b/shop.fnl
new file mode 100644
index 0000000..fea398e
--- /dev/null
+++ b/shop.fnl
@@ -0,0 +1,121 @@
+(local lib (require :lib))
+
+(fn create-order [db]
+  (let [id (_G.must (luna.crypto.random-string 16))]
+    (_G.must
+     (luna.db.exec
+       db "INSERT INTO orders (id, creation_time) VALUES (?, ?)"
+       [id (lib.now)]))
+    id))
+
+;; FIXME: prone to race conditions
+(fn place-order [db id name contact consent]
+  (local current-state
+    (_G.must
+      (luna.db.query db "SELECT state FROM orders WHERE id = ?" [id])))
+  (when (~= "cart" (. current-state 1 1))
+    (error "order must be a cart in order to place it"))
+
+  (lib.with-tx db
+    (fn [tx]
+      ;; remove ordered products from stock
+      (_G.must
+       (luna.db.exec-tx tx
+         "UPDATE products
+            SET stock = stock - (SELECT quantity
+                                 FROM order_lines
+                                 WHERE product_name = products.name
+                                   AND order_id = ?)
+          WHERE products.name IN (SELECT product_name
+                                  FROM order_lines
+                                  WHERE order_id = ?)"
+         [id id]))
+      (_G.must
+        (luna.db.exec-tx tx
+          "UPDATE orders SET placement_time = ?, state = 'placed', name = ?,
+                             contact = ?, consent = ?
+           WHERE id = ?"
+          [(lib.now) name contact consent id])))))
+
+(fn finish-order [db id]
+  (local current-state
+    (_G.must
+      (luna.db.query db "SELECT state FROM orders WHERE id = ?" [id])))
+  (when (~= "placed" (. current-state 1 1))
+    (error "order must be placed in order to finish it"))
+
+  (_G.must
+    (luna.db.exec db "UPDATE orders SET state = 'done' WHERE id = ?" [id])))
+
+;; FIXME: prone to race conditions
+(fn cancel-order [db id]
+  (local current-state
+    (_G.must
+      (luna.db.query db "SELECT state FROM orders WHERE id = ?" [id])))
+  (when (~= "placed" (. current-state 1 1))
+    (error "order must be placed in order to cancel it"))
+
+  (lib.with-tx db
+    (fn [tx]
+      ;; return stock
+      (_G.must
+       (luna.db.exec-tx tx
+         "UPDATE products
+            SET stock = stock + (SELECT quantity
+                                 FROM order_lines
+                                 WHERE product_name = products.name
+                                   AND order_id = ?)
+          WHERE products.name IN (SELECT product_name
+                                  FROM order_lines
+                                  WHERE order_id = ?)"
+         [id id]))
+      (_G.must
+       (luna.db.exec-tx tx
+         "UPDATE orders SET state = 'canceled' WHERE id = ?"
+         [id])))))
+
+(fn order-id [request]
+  (let [cookies-header (. request.headers :Cookie)
+        cookies (if cookies-header (lib.parse-values cookies-header) {})]
+    cookies.order))
+
+(fn create-order-line [db order-id name quantity]
+  (_G.must
+    (luna.db.exec
+      db
+      "INSERT INTO order_lines (order_id, product_name, quantity, creation_time)
+       VALUES (?, ?, ?, ?)"
+      [order-id name quantity (lib.now)])))
+
+(fn delete-order-line [db id]
+  (_G.must
+    (luna.db.exec db "DELETE FROM order_lines WHERE id = ?" [id])))
+
+(fn basket [db order-id]
+  (_G.must
+   (luna.db.query-assoc
+     db
+     "SELECT order_lines.id,
+             products.name,
+             products.title,
+             products.price_per AS \"price-per\",
+             products.packaging,
+             products.type,
+             products.short_description AS \"short-description\",
+             products.image1,
+             order_lines.quantity
+      FROM order_lines
+      INNER JOIN products ON products.name = order_lines.product_name
+      WHERE order_lines.order_id = ?
+      GROUP BY order_lines.id
+      ORDER BY order_lines.creation_time ASC"
+     [order-id])))
+
+{: create-order
+ : place-order
+ : finish-order
+ : cancel-order
+ : order-id
+ : create-order-line
+ : delete-order-line
+ : basket}