From 4ac8c491b0dc368ef875ed62a3fea945005fe0e6 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Wed, 16 Feb 2022 15:03:47 -0600 Subject: getting an auth token doubles as logging in for any current session --- clpmfile.lock | 2 +- oneliners.api-client.lisp | 252 +++++++++++++++++++++++++++++++--------------- src/main.lisp | 123 +++++++--------------- 3 files changed, 208 insertions(+), 169 deletions(-) diff --git a/clpmfile.lock b/clpmfile.lock index 19a17bb..6cc6c06 100644 --- a/clpmfile.lock +++ b/clpmfile.lock @@ -78,7 +78,7 @@ ("jonathan" :version "2020-09-25" :source "quicklisp" :systems ("jonathan")) ("lambda-riffs" :version (:commit "f7b3c081f2361f7370c80e7ff4a432241f34ce55") :source :implicit-vcs :systems ("lambda-riffs")) -("lazybones" :version (:commit "7b2f218547cd083a45f3aeed97ffc4ed67855d88") +("lazybones" :version (:commit "9ee1735d9bcea68b4514da46dadd7a4ef2e3ef02") :source :implicit-vcs :systems ("lazybones" "lazybones-hunchentoot")) ("lazybones-client" :version (:commit "15572ea0f7613a94993c49b3ee2a58e90e560a9a") :source :implicit-vcs diff --git a/oneliners.api-client.lisp b/oneliners.api-client.lisp index d3142fb..1e1422e 100644 --- a/oneliners.api-client.lisp +++ b/oneliners.api-client.lisp @@ -5,26 +5,32 @@ (defpackage #:ONELINERS.API-CLIENT (:use :cl :lazybones-client.shared) (:export #:*host* #:*body* #:*headers* #:*cookies* #:request-with - #:POST--AUTH - #:POST--ONELINER - #:PUT--ONELINER-ONELINER - #:GET--SEARCH)) + #:GET--FOOBAR-NUMBER +#:GET--SEARCH +#:PATCH--FLAG-ONELINER +#:PATCH--EDIT-ONELINER +#:PATCH--UNLOCK-ONELINER +#:PATCH--LOCK-ONELINER +#:POST--ADD-ONELINER +#:POST--MAKE-INVITE +#:POST--TOKEN-CONTRIBUTOR +#:POST--REDEEM-INVITE)) (in-package :ONELINERS.API-CLIENT) (defvar *host* nil "The host to which the client will send its requests.") -(defvar *body* nil - "Body passed to client post, put, and patch requests") + (defvar *body* nil + "Body passed to client post, put, and patch requests") -(defvar *cookies* nil - "An instance of CL-COOKIE:COOKIE-JAR.") + (defvar *cookies* nil + "An instance of CL-COOKIE:COOKIE-JAR.") -(defvar *headers* nil - "A liist of (header-name . header-value) pairs.") + (defvar *headers* nil + "A liist of (header-name . header-value) pairs.") -(defmacro request-with ((&key host body headers content-type cookies) &body forms) + (defmacro request-with ((&key host body headers content-type cookies) &body forms) "Make a request in a specific context. HOST is a string, the hostname where the request will be sent. Defaults @@ -52,98 +58,186 @@ COOKIES should be an instance of CL-COOKIE:COOKIE-JAR. Defaults to ,@forms))) -(DEFUN POST--AUTH () - "Requests an authorization token" +(DEFUN GET--FOOBAR-NUMBER (NUMBER &KEY NAME AGE) + "Doesn't do anything really" (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* - (FORMAT NIL "/auth") (WHEN (OR) (LIST "?"))))) + (FORMAT NIL "/foobar/~a" NUMBER) + (WHEN (OR NAME AGE) + (LIST "?" + (IF NAME + (CONCATENATE 'STRING (SYMBOL-NAME 'NAME) "=" + (FORMAT NIL "~a" NAME)) + "") + (IF AGE + (CONCATENATE 'STRING "&" (SYMBOL-NAME 'AGE) "=" + (FORMAT NIL "~a" AGE)) + "")))))) + (DEXADOR:GET LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*))) + + +(DEFUN GET--SEARCH (&KEY TAGS LIMIT NOTFLAGGED) + "A search endpoint returning a JSON encoded array of Oneliner Entries. TAGS cannot be empty." + (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING + (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* + (FORMAT NIL "/search") + (WHEN (OR TAGS LIMIT NOTFLAGGED) + (LIST "?" + (IF TAGS + (CONCATENATE 'STRING (SYMBOL-NAME 'TAGS) "=" + (FORMAT NIL "~a" TAGS)) + "") + (IF LIMIT + (CONCATENATE 'STRING "&" (SYMBOL-NAME 'LIMIT) "=" + (FORMAT NIL "~a" LIMIT)) + "") + (IF NOTFLAGGED + (CONCATENATE 'STRING "&" (SYMBOL-NAME 'NOTFLAGGED) + "=" (FORMAT NIL "~a" NOTFLAGGED)) + "")))))) + (DEXADOR:GET LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*))) + + +(DEFUN PATCH--FLAG-ONELINER (ONELINER) + "Flag the oneliner for review. Open to anyone." + (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING + (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* + (FORMAT NIL "/flag/~a" ONELINER) NIL))) + (IF LAZYBONES-CLIENT.SHARED:*BODY* + (DEXADOR:PATCH LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT + LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*) + (DEXADOR:PATCH LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*)))) + + +(DEFUN PATCH--EDIT-ONELINER (ONELINER) + "Edit the fields of a oneliner." + (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING + (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* + (FORMAT NIL "/edit/~a" ONELINER) NIL))) + (IF LAZYBONES-CLIENT.SHARED:*BODY* + (DEXADOR:PATCH LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT + LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*) + (DEXADOR:PATCH LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*)))) + + +(DEFUN PATCH--UNLOCK-ONELINER (ONELINER) + "Unlocks a oneliner." + (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING + (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* + (FORMAT NIL "/unlock/~a" ONELINER) NIL))) + (IF LAZYBONES-CLIENT.SHARED:*BODY* + (DEXADOR:PATCH LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT + LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*) + (DEXADOR:PATCH LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*)))) + + +(DEFUN PATCH--LOCK-ONELINER (ONELINER) + "Locks a oneliner. Locked oneliners cannot be edited or flagged." + (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING + (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* + (FORMAT NIL "/lock/~a" ONELINER) NIL))) + (IF LAZYBONES-CLIENT.SHARED:*BODY* + (DEXADOR:PATCH LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT + LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*) + (DEXADOR:PATCH LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*)))) + + +(DEFUN POST--ADD-ONELINER () + "Make a new [oneliner](#oneliner-post-body)." + (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING + (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* + (FORMAT NIL "/add-oneliner") NIL))) (IF LAZYBONES-CLIENT.SHARED:*BODY* (DEXADOR:POST LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT - LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR - LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS - LAZYBONES-CLIENT.SHARED:*HEADERS*) + LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*) (DEXADOR:POST LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR - LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS - LAZYBONES-CLIENT.SHARED:*HEADERS*)))) + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*)))) -(DEFUN POST--ONELINER () - "Adds a new oneliner entry to the wiki database." +(DEFUN POST--MAKE-INVITE () + "On success, return an object containing a new [invite token](#invite-token)." (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* - (FORMAT NIL "/oneliner") (WHEN (OR) (LIST "?"))))) + (FORMAT NIL "/make-invite") NIL))) (IF LAZYBONES-CLIENT.SHARED:*BODY* (DEXADOR:POST LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT - LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR - LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS - LAZYBONES-CLIENT.SHARED:*HEADERS*) + LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*) (DEXADOR:POST LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR - LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS - LAZYBONES-CLIENT.SHARED:*HEADERS*)))) + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*)))) -(DEFUN PUT--ONELINER-ONELINER (ONELINER) - "Updates a oneliner entry in the wiki database." +(DEFUN POST--TOKEN-CONTRIBUTOR (CONTRIBUTOR &KEY PASSWORD) + "Authenticate a contributor and reply with an [api token](#access-token)" (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* - (FORMAT NIL "/oneliner/~a" ONELINER) (WHEN (OR) (LIST "?"))))) + (FORMAT NIL "/token/~a" CONTRIBUTOR) + (WHEN (OR PASSWORD) + (LIST "?" + (IF PASSWORD + (CONCATENATE 'STRING (SYMBOL-NAME 'PASSWORD) "=" + (FORMAT NIL "~a" PASSWORD)) + "")))))) (IF LAZYBONES-CLIENT.SHARED:*BODY* - (DEXADOR:PUT LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT - LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR - LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS - LAZYBONES-CLIENT.SHARED:*HEADERS*) - (DEXADOR:PUT LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR - LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS - LAZYBONES-CLIENT.SHARED:*HEADERS*)))) - + (DEXADOR:POST LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT + LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*) + (DEXADOR:POST LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*)))) -(DEFUN GET--SEARCH - (&KEY COMMANDS KEYWORDS LIMIT PAGE NEXTPAGE NOTFLAGGED ONLYAUDITED) - "A search endpoint returning a JSON encoded array of Oneliner Entries. -**Note**: either command or keywords are required. -" +(DEFUN POST--REDEEM-INVITE (INVITE &KEY USERNAME PASSWORD1 PASSWORD2) + "Redeem an [invite code](#invite-code) and create a new [contributor](#new-contributor-post-body)" (LET ((LAZYBONES-CLIENT.SHARED::REQ-STRING (APPLY #'CONCATENATE 'STRING LAZYBONES-CLIENT.SHARED:*HOST* - (FORMAT NIL "/search") - (WHEN - (OR COMMANDS KEYWORDS LIMIT PAGE NEXTPAGE NOTFLAGGED - ONLYAUDITED) + (FORMAT NIL "/redeem/~a" INVITE) + (WHEN (OR USERNAME PASSWORD1 PASSWORD2) (LIST "?" - (IF COMMANDS - (CONCATENATE 'STRING (SYMBOL-NAME 'COMMANDS) "=" - (FORMAT NIL "~a" COMMANDS)) - "") - (IF KEYWORDS - (CONCATENATE 'STRING "&" (SYMBOL-NAME 'KEYWORDS) - "=" (FORMAT NIL "~a" KEYWORDS)) - "") - (IF LIMIT - (CONCATENATE 'STRING "&" (SYMBOL-NAME 'LIMIT) "=" - (FORMAT NIL "~a" LIMIT)) + (IF USERNAME + (CONCATENATE 'STRING (SYMBOL-NAME 'USERNAME) "=" + (FORMAT NIL "~a" USERNAME)) "") - (IF PAGE - (CONCATENATE 'STRING "&" (SYMBOL-NAME 'PAGE) "=" - (FORMAT NIL "~a" PAGE)) + (IF PASSWORD1 + (CONCATENATE 'STRING "&" (SYMBOL-NAME 'PASSWORD1) + "=" (FORMAT NIL "~a" PASSWORD1)) "") - (IF NEXTPAGE - (CONCATENATE 'STRING "&" (SYMBOL-NAME 'NEXTPAGE) - "=" (FORMAT NIL "~a" NEXTPAGE)) - "") - (IF NOTFLAGGED - (CONCATENATE 'STRING "&" (SYMBOL-NAME 'NOTFLAGGED) - "=" (FORMAT NIL "~a" NOTFLAGGED)) - "") - (IF ONLYAUDITED - (CONCATENATE 'STRING "&" (SYMBOL-NAME 'ONLYAUDITED) - "=" (FORMAT NIL "~a" ONLYAUDITED)) + (IF PASSWORD2 + (CONCATENATE 'STRING "&" (SYMBOL-NAME 'PASSWORD2) + "=" (FORMAT NIL "~a" PASSWORD2)) "")))))) (IF LAZYBONES-CLIENT.SHARED:*BODY* - (DEXADOR:GET LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT - LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR - LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS - LAZYBONES-CLIENT.SHARED:*HEADERS*) - (DEXADOR:GET LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR - LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS - LAZYBONES-CLIENT.SHARED:*HEADERS*)))) + (DEXADOR:POST LAZYBONES-CLIENT.SHARED::REQ-STRING :CONTENT + LAZYBONES-CLIENT.SHARED:*BODY* :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*) + (DEXADOR:POST LAZYBONES-CLIENT.SHARED::REQ-STRING :COOKIE-JAR + LAZYBONES-CLIENT.SHARED:*COOKIES* :HEADERS + LAZYBONES-CLIENT.SHARED:*HEADERS*)))) diff --git a/src/main.lisp b/src/main.lisp index 13d0d57..11be7fd 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -84,17 +84,7 @@ :index-reader access-by-contributor)) (:metaclass db:persistent-class)) -(defgeneric revoke-access (what) - (:documentation "Effectively deletes an api-access instance.") - (:method ((access api-access)) - (db:with-transaction () - (db:delete-object access))) - (:method ((token string)) - (a:when-let ((access (access-by-token token))) - (revoke-access access))) - (:method ((contributor contributor)) - (a:when-let ((access (access-by-contributor contributor))) - (revoke-access access)))) + (defclass oneliner (db:store-object) ((oneliner @@ -165,6 +155,7 @@ ;;; SERVICE CONTROL (defvar *server* nil) +(defvar *server-domain* "localhost") (defvar *cleaning-thread* nil) (defvar *runningp* nil) (defvar *instance-salt* "change me" @@ -206,8 +197,10 @@ (port 8888) (address "127.0.0.1") (salt "change me") + (domain "localhost") store-dir) - (setf *instance-salt* salt ) + (setf *instance-salt* salt + *server-domain* domain) (ensure-datastore store-dir) (ensure-server port address) (lzb:install-app *server* (lzb:app)) @@ -298,6 +291,18 @@ (db:with-transaction () (make-instance 'api-access :contributor contributor))) +(defgeneric revoke-access (what) + (:documentation "Effectively deletes an api-access instance.") + (:method ((access api-access)) + (db:with-transaction () + (db:delete-object access))) + (:method ((token string)) + (a:when-let ((access (access-by-token token))) + (revoke-access access))) + (:method ((contributor contributor)) + (a:when-let ((access (access-by-contributor contributor))) + (revoke-access access)))) + (defun make-new-oneliner (contributor plist) (with-plist (oneliner tags brief description) plist @@ -427,16 +432,19 @@ "Authenticate a contributor and reply with an [api token](#access-token)" (cond ((equal (pw-hash password (contributor-salt contributor)) (hashed-pw contributor)) - (to-json - (a:if-let (access (access-by-contributor contributor)) - (list :token (api-token access)) ; return extant tokens - (list :token (api-token (make-api-access contributor)))))) ; or make a new one + (let ((token (a:if-let (access (access-by-contributor contributor)) + (api-token access) + (api-token (make-api-access contributor))))) + (lzb:set-response-cookie + +auth-cookie-name+ token + :path "/" :domain *server-domain*) + (to-json (list :token token)))) (t (http-err 401)))) (defun authorized-to-invite () - "To make a new invite, a contributor must be either authorized, -having not exceeded their invite limit, or must be an admin." + "To make a new invite, a contributor must be authorized and must not +have exceeded the invite limit." (a:when-let (contributor (and (api-token-authorization) (request-contributor))) (or (adminp contributor) (can-invite-p contributor)))) @@ -453,17 +461,19 @@ having not exceeded their invite limit, or must be an admin." "true") (defun admin-only () - "The request requires an API access token. -Only contributors with admin privileges are allowed to perform this action." + "The request requires an API access token. Only contributors with +admin privileges are allowed to perform this action." (a:when-let (contributor (request-contributor)) (adminp contributor))) -(defendpoint* :patch "/lock/:oneliner a-oneliner-id:" () (:auth 'admin-only) +(defendpoint* :patch "/lock/:oneliner a-oneliner-id:" () + (:auth 'admin-only) "Locks a oneliner. Locked oneliners cannot be edited or flagged." (lock-oneliner oneliner (request-contributor)) "true") -(defendpoint* :patch "/unlock/:oneliner a-oneliner-id:" () (:auth 'admin-only) +(defendpoint* :patch "/unlock/:oneliner a-oneliner-id:" () + (:auth 'admin-only) "Unlocks a oneliner." (unlock-oneliner oneliner (request-contributor)) "true") @@ -485,79 +495,17 @@ Only contributors with admin privileges are allowed to perform this action." (limit an-int) (notflagged a-boolean)) () - "A search endpoint returning a JSON encoded array of Oneliner Entries. - -**Note**: either command or keywords are required. -" + "A search endpoint returning a JSON encoded array of Oneliner Entries. TAGS cannot be empty." (if tags (to-json (list :oneliners (query-oneliners :tags tags :notflagged notflagged :limit limit))) - (t ; else responde with 400 - (http-err 400)))) - - - + (http-err 400))) ;;; HELPERS -(defun slot-name-of (class name) - "Returns the symbol naming a slot in the class class. Returns NIL if -there is no such slot. Useful for converting keywords into slot -names. NAME must be a symbol or a string." - (assert (or (stringp name) (symbolp name))) - (let ((name (if (symbolp name) (symbol-name name) name))) - (loop for slot-def in (closer-mop:class-slots (find-class class)) - for slot-name = (closer-mop:slot-definition-name slot-def) - when (string-equal name (symbol-name slot-name)) - return slot-name))) - -(defun initarg-keyword (thing) - (a:make-keyword - (string-upcase - (if (symbolp thing) (symbol-name thing) thing)))) - -(defun json-plist->initarg-keywords (plist) - (loop for (k v . more) on plist by #'cddr - collect (initarg-keyword k) - collect v)) - -(defun object-with-id (id-string) - "Integer id of the desired entity.." - (db:store-object-with-id (parse-integer id-string))) - -(defparameter +updatable-oneliner-slot-keywords+ - '(:|oneliner| :|commands| :|brief| :|description|)) - -(defun valid-oneliner-update-data-p (jsonplist) - "Checks the fields of jsonplist, return t if they are sufficient to update a oneliner entry." - (loop for (k v . more) on jsonplist by #'cddr - always (member k +updatable-oneliner-slot-keywords+))) - -(defun update-oneliner (contributor oneliner json-body) - "Accepts a decoded json body, a plist, and " - (assert (valid-oneliner-update-data-p json-body)) - (db:with-transaction () - (loop for (k v . more) on json-body - do (setf (slot-value oneliner (slot-name-of 'oneliner k)) v)) - (setf (edit-history oneliner) (get-universal-time)))) - -(defun valid-oneliner-init-data-p (plist) - "dchecks the fields in plist,returns t if they are sufficient to create a new oneliner." - ;; right now, just aliasing valid-oneliner-update-data-p - (valid-oneliner-update-data-p plist)) - -(defun add-oneliner-to-db (contributor json-plist) - "adds a new oneliner to the database, returning it upon success " - (assert (valid-oneliner-init-data-p json-plist)) - (db:with-transaction () - (apply 'make-instance 'oneliner - :created-at (get-universal-time) - :created-by contributor - (json-plist->initarg-keywords json-plist)))) - (defun pw-hash (plaintext salt) "Hash plaintext using SALT and the value of *INSTANCE-SALT*" (flexi-streams:octets-to-string @@ -581,9 +529,6 @@ names. NAME must be a symbol or a string." thereis (search word description :test #'char-equal)))) - - - (defun to-json (thing) (let ((jonathan:*false-value* :false) (jonathan:*null-value* :null)) -- cgit v1.2.3