src/backends/accordius.lisp

   1 (in-package #:lw2.backend)
   2
   3 ;;; REST API
   4
   5 (defun do-wl-rest-query (endpoint filters &key auth-token)
   6   (lw2-graphql-query (lambda () (values endpoint filters)) :auth-token auth-token))
   7
   8 (defclass accordius-query (closer-mop:funcallable-standard-object) ()
   9   (:metaclass closer-mop:funcallable-standard-class))
  10
  11 (defmethod run-query ((query accordius-query))
  12   (lw2-graphql-query query :return-type :string))
  13
  14 (define-backend-operation lw2-query-string backend-accordius (query-type return-type args &rest rest)
  15   (declare (ignore rest))
  16   (let ((obj (make-instance 'accordius-query)))
  17     (closer-mop:set-funcallable-instance-function
  18      obj
  19      (lambda ()
  20        (values
  21         (format nil "~(~A~)s/~@[~A/~]" query-type (if (eq return-type :single) (cdr (assoc :document-id args))))
  22         (loop for arg in args
  23            unless (member (car arg) '(:document-id :limit :view))
  24            collect (cons (json:lisp-to-camel-case (string (car arg))) (cdr arg))))))
  25     obj))
  26
  27 (define-backend-operation postprocess-query-result backend-accordius (result)
  28   (if-let (data (assoc :data result))
  29           (cdadr data)
  30           result))
  31
  32 (define-backend-operation call-with-backend-response backend-accordius (fn query &key return-type auth-token)
  33    (multiple-value-bind (endpoint filters)
  34        (funcall query)
  35      (call-with-http-response
  36       fn
  37       (quri:render-uri (quri:merge-uris (quri:make-uri :path endpoint :query filters) (quri:uri (rest-api-uri *current-backend*))))
  38       :additional-headers (if auth-token `(("authorization" . ,auth-token)) nil)
  39       :want-stream (not return-type))))
  40
  41 (define-backend-operation get-post-body backend-accordius (post-id &key &allow-other-keys)
  42   (acons :tags (lw2-graphql-query (lambda () (values "tags/" `(("document_id" . ,post-id))))) (call-next-method)))
  43
  44 (define-backend-operation lw2-search-query backend-accordius (query &key &allow-other-keys)
  45   (values
  46    (do-wl-rest-query "post_search/" `(("query" . ,query)))
  47    (do-wl-rest-query "comment_search/" `(("query" . ,query)))))
  48
  49 (defun do-wl-rest-mutate (mutation-type endpoint post-params auth-token)
  50   (call-with-http-response
  51    #'identity
  52    (quri:render-uri (quri:merge-uris (quri:make-uri :path endpoint :query "") (quri:uri (rest-api-uri *current-backend*))))
  53    :method mutation-type
  54    :content post-params
  55    :headers (alist "authorization" auth-token)))
  56
  57 (defun do-wl-create-tag (document-id text auth-token)
  58   (do-wl-rest-mutate :post "tags/" `((:DOCUMENT-ID . ,document-id) (:TEXT . ,text)) auth-token))
  59
  60
  61 ;;;; BACKEND SPECIFIC GRAPHQL
  62
  63 (define-backend-operation get-user-page-items backend-accordius (user-id request-type &key &allow-other-keys)
  64   (declare (ignore user-id request-type))
  65   (let ((*graphql-correct* t))
  66     (declare (special *graphql-correct*))
  67     (call-next-method)))
  68
  69 (define-backend-operation get-conversation-messages backend-accordius (conversation-id auth-token)
  70   (declare (ignore conversation-id auth-token))
  71   (let ((*messages-index-fields* (cons :html-body (remove :content *messages-index-fields*))))
  72     (call-next-method)))
  73
  74 (define-backend-operation user-fields backend-accordius ()
  75   (remove :groups (call-next-method)))
  76
  77 ;;;; LOGIN
  78
  79 (in-package #:lw2.login)
  80
  81 (define-backend-operation do-lw2-mutation backend-accordius (auth-token target-type mutation-type terms fields)
  82   (let ((endpoint
  83          (case target-type
  84            (:post "posts")
  85            (:comment "comments")
  86            )))
  87     (cond
  88       ((eq mutation-type :delete) (do-wl-rest-mutate mutation-type
  89                                     (concatenate 'string endpoint "/"
  90                                                  (cdr (assoc :DOCUMENT-ID terms)))
  91                                     nil
  92                                     auth-token))
  93       (t (call-next-method)))))
  94
  95
  96 (define-backend-operation do-login backend-accordius (user-designator password &key &allow-other-keys)
  97   (let* ((response
  98            (do-lw2-post-query nil `(("query" . "mutation Login($username: String, $password: String) { Login(username: $username, password: $password) {userId, sessionKey, expiration}}")
  99                                     ("variables" .
 100                                      (("username" . ,user-designator)
 101                                       ("password" . ,password))))))
 102          (user-id (format nil "~A" (cdr (assoc :user-id response))))
 103          (auth-token (cdr (assoc :session-key response)))
 104          (expiration (truncate (* 1000 (cdr (assoc :expiration response))))))
 105     (values user-id auth-token nil expiration)))
 106
 107 (define-backend-operation do-lw2-create-user backend-accordius (username email password)
 108   ;; TODO: Add actual code
 109   (let (user-id auth-token error-message expiration)
 110     (values user-id auth-token error-message expiration)))
 111
 112 (define-backend-operation do-lw2-forgot-password backend-accordius (email)
 113   ;; TODO: Add actual code
 114   (let (successfulp error-message)
 115     (values successfulp error-message)))
 116
 117 (define-backend-operation do-lw2-reset-password backend-accordius (auth-token password)
 118   ;; TODO: Add actual code
 119   (let (user-id auth-token error-message expiration)
 120     (values user-id auth-token error-message expiration)))