@@ -3,6 +3,195 @@

   (:export ))

 (in-package :garagiste-app)

+(defclass recording-datastore ()

+  ((%record :accessor record

+            :initform (make-array 10

+                                  :adjustable t

+                                  :fill-pointer 0))))

+(defclass jsonapi-datastore ()

+  ((%database :reader database

+              :initform (make-hash-table))))

+(defgeneric add-object (store object))

+(defgeneric get-object (store type id))

+(defgeneric ingest-jsonapi (store object))

+(defgeneric stored-types (store))

+

+(defun object (store type id)

+  (get-object store type id))

+

+(defun (setf object) (new-value store type id)

+  (let ((tmp (alexandria:copy-hash-table new-value)))

+    (setf (gethash "id" tmp) id

+          (gethash "type" tmp) type)

+    (add-object store tmp)))

+

+(defclass batch ()

+  ((%id :accessor id)

+   (%shipments :accessor shipments-a)))

+(defmethod add-object ((store jsonapi-datastore) (object batch))

+  (setf (object :batches (id object))

+        (alexandria:alist-hash-table

+         `(("relationships" . ,(mapcar (lambda (it)

+                                         (alexandria:alist-hash-table

+                                          `(("type" . "shipments")

+                                            ("id" . ,it))))

+                                       (shipments-a object)))))))

+

+(defun normalize-type (type)

+  (declare (optimize debug))

+  (let ((normalize-char (lambda (ch)

+                          (case ch

+                            (#\_ #\-)

+                            (t (if (lower-case-p ch)

+                                   (char-upcase ch)

+                                   (char-downcase ch)))))))

+    (nth-value

+     0 (etypecase type

+         (simple-string (intern (map 'simple-string

+                                     normalize-char

+                                     type)

+                                :keyword))

+         (string (intern (map 'simple-string

+                              normalize-char

+                              type)

+                         :keyword))

+         (keyword type)))))

+

+(defmacro let-lazy ((&rest bindings) &body body)

+  (let* ((cache-syms (mapcar (lambda (it)

+                               (list (gensym (symbol-name (first it)))

+                                     nil))

+                             bindings))

+         (cache-bindings (mapcar (lambda (sym cache-sym)

+                                   `(,(first sym) (or ,(first cache-sym)

+                                                      (setf ,(first cache-sym)

+                                                            ,(second sym)))))

+                                 bindings

+                                 cache-syms)))

+    `(let ,cache-syms

+       (declare (ignorable ,@(mapcar 'first cache-syms)))

+       (symbol-macrolet ,cache-bindings

+         ,@body))))

+

+(defmacro hash-table-dbind (bindings h-t &body body)

+  (alexandria:once-only (h-t)

+    `(let-lazy ,(loop for (name key . rest) in bindings

+                      collect `(,name (gethash ,key ,h-t ,@rest)))

+       ,@body)))

+

+(defmacro destructure-resource (resource &body body)

+  `(hash-table-dbind ((id "id")

+                      (type "type")

+                      (attributes "attributes" 'empty)

+                      (relationships "relationships" 'empty)

+                      (links "links" 'empty)

+                      (meta "meta" 'empty))

+       ,resource

+     ,@body))

+

+

+(defgeneric id-resolver-gf (store resource))

+(defmethod id-resolver-gf ((store jsonapi-datastore) (resource hash-table))

+  (destructure-resource resource

+    (get-object store type id)))

+(defmethod id-resolver-gf ((store jsonapi-datastore) (resource string))

+  (patmatch:let-pat* (((vector type id) (fwoar.string-utils:split "/" resource :count 1)))

+    (get-object store

+                type

+                id)))

+

+(defun id-resolver (store)

+  (lambda (resource)

+    (id-resolver-gf store resource)))

+

+(defmethod add-object :before ((store recording-datastore) (object hash-table))

+  (vector-push-extend (destructure-resource object

+                        (list :add-object id type attributes))

+                      (record store)))

+

+(defmethod stored-types ((store jsonapi-datastore))

+  (alexandria:hash-table-keys (database store)))

+

+

+(defmethod ingest-jsonapi ((store jsonapi-datastore) (object hash-table))

+  (hash-table-dbind ((data "data" 'empty)

+                     (errors "errors" 'empty)

+                     (meta "meta" 'empty)

+                     (jsonapi "jsonapi" 'empty)

+                     (links "links" 'empty)

+                     (included "included" 'empty))

+      object

+    (when (and (eql data 'empty)

+               (eql errors 'empty)

+               (eql meta 'empty))

+      (warn "one of data, errors or meta must be specified in a toplevel object"))

+    (when (not (or (eql data 'empty)

+                   (eql errors 'empty)))

+      (warn "only one of data or errors may be specified"))

+    (unless (when (eql data 'empty)

+              (not (eql included 'empty)))

+      (warn "included may only be specified if data is specified"))

+    (if (typep included 'sequence)

+        (add-object store included)

+        (unless (eql included 'empty)

+          (warn "included should be a sequence")

+          (add-object store included)))

+    (add-object store data)))

+

+(defun resource-identifier-p (resource)

+  (destructure-resource resource

+    (and resource

+         (eql attributes 'empty)

+         (eql relationships 'empty)

+         (eql links 'empty))))

+

+(defmacro with-json-output ((stream &key indent) &body body)

+  "Set up a JSON streaming encoder context on STREAM, then evaluate BODY."

+  `(let* ((yason::*json-output*

+            (make-instance 'yason::json-output-stream

+                           :output-stream ,stream

+                           :indent ,indent))

+          (,stream yason::*json-output*))

+     ,@body))

+

+(defmethod add-object ((store jsonapi-datastore) (object hash-table))

+  (destructure-resource object

+    (let* ((store-ht (database store))

+           (type-store (alexandria:ensure-gethash (normalize-type type)

+                                                  store-ht

+                                                  (make-hash-table :test 'equal)))

+           (old-value (gethash id type-store)))

+      (unless (eql relationships 'empty)

+        (loop for v being the hash-values of relationships

+              for data = (gethash "data" v)

+              when data do

+                (add-object store data)))

+      (if (resource-identifier-p old-value)

+          (setf (gethash id type-store) object)

+          (if (resource-identifier-p object)

+              old-value

+              (setf (gethash id type-store) object))))))

+

+(defmethod add-object ((store jsonapi-datastore) (objects sequence))

+  (map 'list

+       (lambda (it)

+         (add-object store it))

+       objects))

+

+(defmethod get-object ((store jsonapi-datastore) type id)

+  (let* ((store-ht (database store))

+         (type-store (alexandria:ensure-gethash (normalize-type type)

+                                                store-ht

+                                                (make-hash-table :test 'equal))))

+    (gethash id type-store)))

+

+(defun summarize-objects-of-type (store type map-fn filter-fn)

+  (serapeum:collecting

+    (serapeum:do-hash-table (k v (gethash type (database store)))

+      (declare (ignore k))

+      (when (funcall filter-fn v)

+        (collect (funcall map-fn v))))))

+

 (defun get-signin-page ()

   (let ((c-j (make-instance 'drakma:cookie-jar)))

     (values (plump:parse

@@ -12,8 +201,99 @@

 (defun extract-auth-token (doc)

   (lquery:$1 (inline doc)

-             "form input[type=hidden][name=authenticity_token]"

-             (attr "value")))

+    "form input[type=hidden][name=authenticity_token]"

+    (attr "value")))

+

+(defvar *csrf-token* nil)

+(defun request-json (url cj &rest r &key (method :get) (parameters ()))

+  (declare (ignore method parameters))

+  (let ((drakma:*text-content-types* (acons "application" "json"

+                                            drakma:*text-content-types*))

+        (yason:*parse-json-booleans-as-symbols* t)

+        #+(or)(yason:*parse-json-null-as-keyword* t)

+        (yason:*parse-json-arrays-as-vectors* t))

+    #+(or)identity

+    (yason:parse

+     (apply #'drakma:http-request url

+            :cookie-jar cj

+            :accept "application/json"

+            :additional-headers (when *csrf-token*

+                                  `(("X-CSRF-Token" . ,*csrf-token*)))

+            r))))

+

+(defun login-garagiste (auth-token cj)

+  (drakma:http-request "https://app.garagiste.com/users/sign_in"

+                       :cookie-jar cj

+                       :method :post

+                       :parameters `(("utf8" . ,(drakma:url-encode "✓" :utf-8))

+                                     ("authenticity_token" . ,auth-token)

+                                     ("user[email]" . ,(swank:ed-rpc

+                                                        'get-passwd :garagiste-email

+                                                        "Garagiste Email? "))

+                                     ("user[password]" . ,(swank:ed-rpc

+                                                           'get-passwd :garagiste

+                                                           "Garagiste Password? "))

+                                     ("user[remember_me]" . "0")

+                                     ("commit" . "Log in"))))

+

+

+(defun get-user-data ()

+  (multiple-value-bind (doc cookie-jar) (get-signin-page)

+    (let* ((auth-token (extract-auth-token doc))

+           (user-home (login-garagiste auth-token cookie-jar)))

+      (setf *csrf-token*

+            (lquery:$1 (initialize user-home)

+              "meta[name=csrf-token]"

+              (attr "content")))

+      (values (yason:parse

+               (lquery:$1 (initialize user-home)

+                 "div[data-react-class=Portal]"

+                 (attr "data-react-props")))

+              cookie-jar))))

+

+(defun user-id (ud)

+  (fw.lu:dive '("data" "customerId")

+              ud))

+

+(defun customer (user-id cookie-jar)

+  (request-json (format nil "https://app.garagiste.com/customers/~a" user-id)

+                cookie-jar))

+

+(defun requests (user-id cookie-jar)

+  (request-json (format nil "https://app.garagiste.com/customers/~a/requests/" user-id)

+                cookie-jar))

+

+(defun orders (user-id cookie-jar)

+  (request-json (format nil "https://app.garagiste.com/customers/~a/orders/" user-id)

+                cookie-jar))

+

+(defun shipments (user-id cookie-jar)

+  (request-json (format nil "https://app.garagiste.com/customers/~a/shipments/" user-id)

+                cookie-jar))

+

+

+(data-lens:defalias simplify-order

+  (data-lens:<>1 (lambda (it)

+                   (mapcan (lambda (key el)

+                             (list key el))

+                           '(:unit-price :count :total-price :offering-name)

+                           it))

+                 (data-lens:juxt (data-lens:key "unit_price")

+                                 (data-lens:key "count")

+                                 (data-lens:key "total_price")

+                                 (data-lens:key "offering_name"))))

+

+(data-lens:defalias summarize-orders

+  (data-lens:<>1 (data-lens:denest)

+                 (data-lens:transform-head

+                  (lambda (it)

+                    (list :id it)))

+                 (data-lens:juxt (data-lens:juxt (data-lens:<>1 'normalize-type

+                                                                (data-lens:key "type"))

+                                                 (data-lens:key "id"))

+                                 (data-lens:<>1 'simplify-order

+                                                (data-lens:key "attributes")))))

+

+(defclass test-store (jsonapi-datastore recording-datastore)

+  ())

-(defun login-garagiste (user pass auth-token)

-  )