logging in, redeeming tokens

5 files changed, 114 insertions, 41 deletions

diff --git a/build-app.lisp b/build-app.lisp
index 1b16837..bd51d54 100644
--- a/build-app.lisp
+++ b/build-app.lisp
@@ -12,8 +12,17 @@
 
 ;;; HELP TEXTS
 (defparameter +invite-help-text+
-  "")
+  " 
+New contributor accounts are added to the your oneliners server by
+redeeming invite tokens.
 
+When the --redeem option is passed, the ARGS section is expected to be
+three items long, and is interpreted as TOKEN USERNAME PASSWORD. E.g.:
+
+    ol --redeem PHONEYTOKEN c00lhacker my1337pw
+
+Would attempt to make a new user named c00lhacker with password
+my1337pw.")
 
 ;;; CLON SYNOPSIS DEFINITION 
 
@@ -21,9 +30,9 @@
   (group (:header "Search")
          (text :contents "Usage: ol [OPTIONS] [TERMS ...]")
          (text :contents "Each term may be a command name or some tag like 'server' or 'tunnel'")
-         (lispobj :long-name "count" 
+         (lispobj :long-name "limit" 
                   :argument-type :optional
-                  :argument-name "Count"
+                  :argument-name "NUMBER"
                   :default-value 10
                   :description "The maximum number of results to return."
                   :typespec 'integer)
@@ -50,13 +59,12 @@
          (flag :long-name "update-interactive"
                :description "Interactively edit a oneliner and update the wiki."))
   (group (:header "Admin" :hidden t)
+         (flag :long-name "login"
+               :description "Attempt to login to your contributor account. ARGS are interpreted as USERNAME PASSWORD. Success will return ab API token, writing it automatically into your config file.")
          (flag :long-name "invite"
                :description "Request an invite token to send to a friend.")
-         (stropt :long-name "redeem"
-                 :argument-type :optional
-                 :default-value "DUMMY-TOKEN"
-                 :argument-name "TOKEN"
-                 :description "Redeem an invite token. See also --help-topic=invites"))
+         (flag :long-name "redeem"
+               :description "Redeem an invite token. See also --help-topic=invites"))
   (group (:header "Invites" :hidden t)
          (text :contents +invite-help-text+)))
 
@@ -82,25 +90,35 @@ than the users."
   (when (getopt :long-name "help")
     (help )
     (uiop:quit))
-
   (a:when-let (topic (getopt :long-name "help-topic"))
     (help :item (find-group-with-header (symbol-name topic)))
     (uiop:quit))
-
-  (let ((arguments (remainder)))
-
-    (unless arguments
+  (handler-case
+      (let ((arguments (remainder)))
+        (cond
+          ((getopt :long-name "redeem")
+           (destructuring-bind (token name pass) arguments
+             (cli::redeem-invite token name pass)))
+          ((getopt :long-name "login")
+           (destructuring-bind (user pass) arguments
+             (cli::login user pass)))
+          (arguments
+           ;; when the first argument is a number, try run a oneliner 
+           (a:when-let (hist-number (parse-integer (first arguments) :junk-allowed t))
+             (format t "TBD: Going to run command ~a with arguments ~a~%"
+                     hist-number (rest arguments))
+             (uiop:quit))   
+           ;; otherwise search for oneliners
+           (cli::search-for-oneliners arguments
+                                      (getopt :long-name "limit")
+                                      (getopt :long-name "not-flagged")))
+          (t
+           (help)))
+        (uiop:quit))
+    (error (e)
+      (format *error-output* "ERROR: ~a~%" e)
       (help)
-      (uiop:quit))
-
-    (alexandria:when-let (hist-number (parse-integer (first arguments) :junk-allowed t))
-      (format t "TBD: Going to run command ~a with arguments ~a~%"
-              hist-number (rest arguments))
-      (uiop:quit))
-
-    (cli:search-for-oneliners arguments :))
-
-  (uiop:quit))
+      (uiop:quit))))
 
 ;;; DUMP EXECUTABLE
 
diff --git a/clpmfile.lock b/clpmfile.lock
index c694db9..15bb931 100644
--- a/clpmfile.lock
+++ b/clpmfile.lock
@@ -42,6 +42,7 @@
 ("chipz" :version "2021-08-07" :source "quicklisp" :systems ("chipz"))
 ("chunga" :version "2020-04-27" :source "quicklisp" :systems ("chunga"))
 ("cl+ssl" :version "2021-12-30" :source "quicklisp" :systems ("cl+ssl"))
+("cl-annot" :version "2015-06-08" :source "quicklisp" :systems ("cl-annot"))
 ("cl-base64" :version "2020-10-16" :source "quicklisp" :systems ("cl-base64"))
 ("cl-change-case" :version "2021-04-11" :source "quicklisp" :systems
  ("cl-change-case"))
@@ -52,6 +53,8 @@
 ("cl-ppcre" :version "2019-05-21" :source "quicklisp" :systems
  ("cl-ppcre" "cl-ppcre-unicode"))
 ("cl-str" :version "2021-05-31" :source "quicklisp" :systems ("str"))
+("cl-syntax" :version "2015-04-07" :source "quicklisp" :systems
+ ("cl-syntax" "cl-syntax-annot"))
 ("cl-unicode" :version "2021-02-28" :source "quicklisp" :systems ("cl-unicode"))
 ("cl-utilities" :version "2010-10-07" :source "quicklisp" :systems
  ("cl-utilities"))
@@ -62,6 +65,7 @@
 ("fast-io" :version "2020-09-25" :source "quicklisp" :systems ("fast-io"))
 ("flexi-streams" :version "2021-08-07" :source "quicklisp" :systems
  ("flexi-streams"))
+("jonathan" :version "2020-09-25" :source "quicklisp" :systems ("jonathan"))
 ("local-time" :version "2021-01-24" :source "quicklisp" :systems ("local-time"))
 ("named-readtables" :version "2021-12-09" :source "quicklisp" :systems
  ("named-readtables"))
@@ -88,6 +92,8 @@
  ("trivial-gray-streams"))
 ("trivial-mimes" :version "2020-07-15" :source "quicklisp" :systems
  ("trivial-mimes"))
+("trivial-types" :version "2012-04-07" :source "quicklisp" :systems
+ ("trivial-types"))
 ("usocket" :version "2019-12-27" :source "quicklisp" :systems ("usocket"))
 ("xsubseq" :version "2017-08-30" :source "quicklisp" :systems ("xsubseq"))
 
@@ -105,6 +111,7 @@
  ((:system :name "fast-http") (:system :name "alexandria"))
  ((:system :name "dexador") (:system :name "alexandria"))
  ((:system :name "cl-cookie") (:system :name "alexandria"))
+ ((:system :name "cl-annot") (:system :name "alexandria"))
  ((:system :name "cl+ssl") (:system :name "alexandria"))
  ((:system :name "cffi-grovel") (:system :name "alexandria"))
  ((:system :name "cffi") (:system :name "alexandria"))
@@ -113,6 +120,7 @@
 
 ("babel" ((:system :name "quri") (:system :name "babel"))
  ((:system :name "proc-parse") (:system :name "babel"))
+ ((:system :name "jonathan") (:system :name "babel"))
  ((:system :name "fast-http") (:system :name "babel"))
  ((:system :name "dexador") (:system :name "babel"))
  ((:system :name "cffi") (:system :name "babel")))
@@ -137,6 +145,9 @@
 
 ("cl+ssl" ((:system :name "dexador") (:system :name "cl+ssl")))
 
+("cl-annot" ((:system :name "jonathan") (:system :name "cl-annot"))
+ ((:system :name "cl-syntax-annot") (:system :name "cl-annot")))
+
 ("cl-base64" ((:system :name "dexador") (:system :name "cl-base64")))
 
 ("cl-change-case" ((:system :name "str") (:system :name "cl-change-case")))
@@ -162,6 +173,7 @@
 
 ("cl-ppcre" ((:system :name "str") (:system :name "cl-ppcre"))
  ((:system :name "str") (:system :name "cl-ppcre-unicode"))
+ ((:system :name "jonathan") (:system :name "cl-ppcre"))
  ((:system :name "dexador") (:system :name "cl-ppcre"))
  ((:system :name "cl-unicode") (:system :name "cl-ppcre"))
  ((:system :name "cl-ppcre-unicode") (:system :name "cl-ppcre"))
@@ -171,6 +183,10 @@
 
 ("cl-str" ((:system :name "oneliners.cli") (:system :name "str")))
 
+("cl-syntax" ((:system :name "jonathan") (:system :name "cl-syntax"))
+ ((:system :name "jonathan") (:system :name "cl-syntax-annot"))
+ ((:system :name "cl-syntax-annot") (:system :name "cl-syntax")))
+
 ("cl-unicode" ((:system :name "cl-ppcre-unicode") (:system :name "cl-unicode")))
 
 ("cl-utilities" ((:system :name "quri") (:system :name "cl-utilities"))
@@ -184,17 +200,21 @@
 
 ("fast-http" ((:system :name "dexador") (:system :name "fast-http")))
 
-("fast-io" ((:system :name "dexador") (:system :name "fast-io")))
+("fast-io" ((:system :name "jonathan") (:system :name "fast-io"))
+ ((:system :name "dexador") (:system :name "fast-io")))
 
 ("flexi-streams"
  ((:system :name "smart-buffer") (:system :name "flexi-streams"))
  ((:system :name "cl+ssl") (:system :name "flexi-streams")))
 
+("jonathan" ((:system :name "oneliners.cli") (:system :name "jonathan")))
+
 ("local-time" ((:system :name "cl-cookie") (:system :name "local-time")))
 
 ("named-readtables"
  ((:system :name "net.didierverna.clon.setup")
-  (:system :name "named-readtables")))
+  (:system :name "named-readtables"))
+ ((:system :name "cl-syntax") (:system :name "named-readtables")))
 
 ("oneliners.api-client.asd"
  ((:system :name "oneliners.cli") (:system :name "oneliners.api-client"))
@@ -204,7 +224,8 @@
 
 ("osicat" ((:system :name "oneliners.cli") (:system :name "osicat")))
 
-("proc-parse" ((:system :name "fast-http") (:system :name "proc-parse"))
+("proc-parse" ((:system :name "jonathan") (:system :name "proc-parse"))
+ ((:system :name "fast-http") (:system :name "proc-parse"))
  ((:system :name "cl-cookie") (:system :name "proc-parse")))
 
 ("quri" ((:system :name "dexador") (:system :name "quri"))
@@ -238,6 +259,9 @@
 
 ("trivial-mimes" ((:system :name "dexador") (:system :name "trivial-mimes")))
 
+("trivial-types" ((:system :name "jonathan") (:system :name "trivial-types"))
+ ((:system :name "cl-syntax") (:system :name "trivial-types")))
+
 ("usocket" ((:system :name "dexador") (:system :name "usocket"))
  ((:system :name "cl+ssl") (:system :name "usocket")))
 
diff --git a/oneliners.api-client.lisp b/oneliners.api-client.lisp
index 98c156d..8d43eae 100644
--- a/oneliners.api-client.lisp
+++ b/oneliners.api-client.lisp
@@ -47,7 +47,8 @@ header.
 COOKIES should be an instance of CL-COOKIE:COOKIE-JAR. Defaults to
 *COOKIES*.
 "
-    (let ((content-type-var (gensym))) 
+    (let ((content-type-var (gensym)) 
+          (http-error-var (gensym))) 
       `(let ((*host* (or ,host *host*))
              (*body* (or ,body *body*))
              (*headers* (or ,headers *headers*))
@@ -55,7 +56,11 @@ COOKIES should be an instance of CL-COOKIE:COOKIE-JAR. Defaults to
              (,content-type-var ,content-type))
          (when ,content-type-var
            (push (cons "Content-Type" ,content-type-var) *headers*))
-         ,@forms)))
+           (handler-case (progn ,@forms)
+              (dex:http-request-failed (,http-error-var)
+                   (format *error-output* "~a -- ~a" 
+                           (dex:response-status ,http-error-var)
+                           (dex:response-body ,http-error-var)))))))
 
 
 (DEFUN GET--SEARCH (&KEY TAGS LIMIT NOTFLAGGED)
diff --git a/oneliners.cli.asd b/oneliners.cli.asd
index 45d5d5b..9b390fd 100644
--- a/oneliners.cli.asd
+++ b/oneliners.cli.asd
@@ -4,6 +4,7 @@
   :license "AGPLv3"
   :depends-on ("trivial-clipboard"
                "str"
+               "jonathan"
                "dexador"
                "osicat"
                "net.didierverna.clon"
diff --git a/src/lib.lisp b/src/lib.lisp
index 2480dab..720ff85 100644
--- a/src/lib.lisp
+++ b/src/lib.lisp
@@ -2,7 +2,8 @@
 
 (defpackage oneliners.cli
   (:use :cl)
-  (:local-nicknames (#:api #:oneliners.api-client)))
+  (:local-nicknames (#:api #:oneliners.api-client)
+                    (#:a #:alexandria)))
 
 (in-package :oneliners.cli)
 
@@ -25,7 +26,13 @@
   (let ((conf-file (config-file)))
     (ensure-directories-exist conf-file)
     (with-open-file (out conf-file :direction :output)
-      (print (make-config :host "https://oneliners.wiki") out))))
+      (print (make-config :host "http://localhost:8888") out))))
+
+(defun write-config-to-disk ()
+  (let ((conf-file (config-file)))
+    (ensure-directories-exist conf-file)
+    (with-open-file (out conf-file :direction :output :if-exists :supersede)
+      (print *config* out))))
 
 (defun fetch-config-from-disk ()
   (let ((conf
@@ -41,6 +48,9 @@
 
 (defun host () (getf *config* :host))
 (defun api-token () (getf *config* :api-token))
+(defun (setf api-token) (newval)
+  (setf (getf *config* :api-token) newval))
+
 
 (defun config-file ()
   (merge-pathnames ".config/oneliners.config" (user-homedir-pathname)))
@@ -53,20 +63,35 @@
   (when (uiop:file-exists-p (last-search-file))
     (nth n (uiop:read-file-form (last-search-file)))))
 
-;;; SEARCHNG THE WIKI
+;;; API REQUEST FUNCTIONS
+
+(defun login (user pass)
+  (ensure-config)
+  (a:when-let (response (jonathan:parse
+                         (api:request-with
+                             (:host (host)) 
+                           (api:post--token-contributor user :password pass))))
+    (setf (api-token) (getf response :token))
+    (write-config-to-disk)
+    (format t "Access token written to ~a~%" (config-file))))
+
+(defun redeem-invite (token name pass) 
+  (ensure-config )
+  (api:request-with
+      (:host (host))
+    (api:post--redeem-invite token
+                             :username name
+                             :password1 pass
+                             :password2 pass)))
 
 (defun search-for-oneliners (terms limit not-flagged-p)
   (assert (loop for term in terms never (find #\, term) ))
-  (handler-case
-      (api:request-with
-          (:host (host))
-          (api:get--search :tags (str:join ",")
-                           :limit limit
-                           :notflagged (if not-flagged-p "true" "false")))
-    (dex:http-request-failed (e)
-      (format *error-output* "~a -- ~a"
-              (dex:response-status e)
-              (dex:response-body e)))))
+  (ensure-config)
+  (print (api:request-with
+             (:host (host))
+           (api:get--search :tags (str:join "," terms)
+                            :limit limit
+                            :notflagged (if not-flagged-p "true" "false")))))
 
 ;;; RUNNING COMMANDS