@@ -26,6 +26,7 @@

           )

   :serial t

   :components ((:file "package")

+               (:file "event-pump")

                (:file "js-executor")

                (:file "slack-client")

                (:file "test-ui")))

@@ -9,6 +9,9 @@

 	   #:help #:make-message #:modules #:latest-id #:work-queue #:result-queue

 	   #:ws-client #:waiting-pings #:ts #:channel))

+(defpackage slacker.api

+  (:use))

+

 (defpackage :hhgbot-augmented-assistant

   (:use :cl :alexandria :serapeum :slacker))

 ;; (defpackage #:hhgbot

@@ -1,13 +1,5 @@

 (in-package :slacker)

-(defclass event-pump ()

-  ((%ws-client :accessor ws-client :initarg :ws-client)

-   (%waiting-pings :accessor waiting-pings :initform 0)

-   (%modules :accessor modules :initform (make-hash-table))

-   (%latest-id :accessor latest-id :initform 0)

-   (%work-queue :accessor work-queue :initform (make-instance 'chanl:unbounded-channel))

-   (%result-queue :accessor result-queue :initform (make-instance 'chanl:unbounded-channel))))

-

 (defmethod attach-module ((event-pump event-pump) module &rest args &key)

   (setf (gethash (make-keyword module)

 		 (modules event-pump))

@@ -189,6 +181,10 @@

 	   ,@body)

        (setf (gethash ,name *command-table*) (function ,command-sym)))))

+(defun safe-apply (func event-pump ts channel args)

+  (with-simple-restart (continue "Skip command")

+    (apply func event-pump ts channel args)))

+

 (defun handle-command (event-pump ts channel command args)

   (declare (ignorable args))

   (let* ((command (subseq (plump:decode-entities command) 1))

@@ -197,8 +193,51 @@

     (terpri)

     (print command)

     (if handler

-	(apply handler event-pump ts channel args)

-	(queue-message event-pump channel (concat "I don't underand the command `" command "`.")))))

+	(safe-apply handler event-pump ts channel args)

+	(queue-message event-pump channel (concat "I don't understand the command `" command "`.")))))

+

+(defun slack-api-call (method &rest args)

+  (bb:with-promise (resolve reject)

+    (bt:make-thread

+     (lambda ()

+       (handler-case

+	   (let ((api-result (yason:parse

+			      (babel:octets-to-string 

+			       (drakma:http-request (concat "https://slack.com/api/" method "?token=" *api-token*)

+						    :method :post

+						    :content (quri:url-encode-params

+							      (loop for (key value) on args by #'cddr

+								 collect (cons (string-downcase key) value)))

+						    :proxy (list "127.0.0.1" 8080))))))

+	     ;todo error handling . . .

+	     (resolve api-result)) 

+	 (t (c) (reject c)))))))

+

+(defgeneric api-call (name args)

+  (:method ((name symbol) (args list))

+    (slack-api-call ,)))

+

+(defmacro define-api-wrapper (name required-args &rest args)

+  (flet ((name-case (string)

+	   (let ((parts (split-sequence #\- (string-downcase string))))

+	     (apply #'concatenate 'string

+		    (car parts)

+		    (mapcar #'string-capitalize (cdr parts))))))

+    (let* ((api-method-name (name-case name)))

+      `(progn (defun ,name (,@required-args &rest r &key ,@args)

+		(apply #'slack-api-call ,api-method-name

+		       ,@(loop for req-arg in required-args

+			    append (list (make-keyword req-arg) req-arg))

+		       r))

+	      (eval-when (:compile-toplevel :load-toplevel :execute)

+		(let ((*package* 'slacker.api))

+		  (import ',name)

+		  (export ',name)))))))

+

+

+(defmacro define-api-wrappers (&body body)

+  `(progn ,@(loop for (name required-args . rest) in body

+		 collect `(define-api-wrapper ,name ,required-args ,@rest))))

 (defun edit-message (ts channel text)

   (babel:octets-to-string

@@ -237,3 +276,12 @@

 	("text" . ,data)))

      s)))

+

+(in-package :slacker.api)

+

+(slacker::define-api-wrappers

+  (chat.delete (ts channel) as_user)

+  (chat.me-message (channel text))

+  (chat.post-message (channel text) parse link_name attachments unfurl_links unfurl_media username as_user icon_uri icon_emoji)

+  (chat.update (ts channel text) attachments parse link_names as_user))

+

@@ -5,14 +5,22 @@

 (defvar *client*)

 ;; Macros

+(defun start-in-repl (&optional (start-bot t))

+  (ubiquitous:restore :hhgbot-augmented-assistant)

+  (setf slacker::*api-token* (ubiquitous:value :api-token :atomampd))

+  (if start-bot

+      (start-with-apitoken)

+      slacker::*api-token*))

+

 (defun start-with-apitoken ()

   (ubiquitous:restore :hhgbot-augmented-assistant)

-  (let ((slacker::*api-token* (ubiquitous:restore :api-token :atomampd)))

+  (let ((slacker::*api-token* (ubiquitous:value :api-token :atomampd)))

     (unless slacker::*api-token*

       (format *terminal-io* "~&API Token? ")

       (finish-output *terminal-io*)

       (setf slacker::*api-token* (read-line)))

-    (slacker:coordinate-threads)))

+    (values (slacker:coordinate-threads)

+	    slacker::*api-token*)))

 (defmacro if-let* ((&rest bindings) &body (then-form &optional else-form))

   "Like if-let, but sets bindings sequentially.  Doesn't short-circuit."

@@ -29,22 +37,27 @@

 (define-command "myip" (event-pump ts channel)

   (in-wq (event-pump)

     (blackbird:alet ((ip (carrier:request "http://api.ipify.org/" :return-body t)))

-      (format *zxcv* "~&IP: ~a~%" ip)

+      (format *zxcv* "~&IP: ~a~%TS: ~a~%CHANNEL: ~a~%CLIENT: ~A~%" (babel:octets-to-string ip) ts channel event-pump)

       (edit-message ts channel

 		    (concat "My ip is: "

 			    (babel:octets-to-string ip))))))

 (define-command "jira" (event-pump ts channel project &optional issue-number &rest rest)

-  (apply #'edit-message ts channel

-	 (fw.lu:ensure-list

-	  (cond (rest

-		 "I don't understand . . .")

-		(issue-number

-		 (format nil "https://atomampd.atlassian.net/browse/~A-~A"

-			 project issue-number))

-		(t

-		 (format nil "https://atomampd.atlassian.net/browse/ATOMOS-~a"

-			 project))))))

+  (let ((drakma:*drakma-default-external-format* :utf-8))

+    (apply #'edit-message ts channel

+	   (fw.lu:ensure-list

+	    (cond (rest

+		   "I don't understand . . .")

+		  (issue-number

+		   (format nil "https://atomampd.atlassian.net/browse/~A-~A"

+			   project issue-number))

+		  (t

+		   (format nil "https://atomampd.atlassian.net/browse/ATOMOS-~a"

+			   project)))))))

+

+(define-command "pr" (event-pump ts channel num)

+  (let ((num (parse-integer num)))

+    (edit-message ts channel (format nil "https://bitbucket.org/atomampd/atomos/pull-requests/~d?w=1" num))))

 (define-command "js>" (event-pump ts channel &rest args)

   (declare (ignorable ts))

@@ -66,7 +79,95 @@

 	(format s seq)))))

 (define-command "paste" (event-pump ts channel)

-  (ubiquitous:restore :atomampd-slack)

+  (with-simple-restart (abort "Stop command")

+    (ubiquitous:restore :atomampd-slack)

+    (format t "foo")

+    (let ((drakma:*drakma-default-external-format* :utf-8))

+      (edit-message ts channel

+		    (format nil "```~%~a~%```"

+			    (pop (ubiquitous:value :clip)))))))

+

+(define-command "id" (event-pump ts channel &optional (for "channel"))

   (edit-message ts channel

-		(format nil "```~%~a~%```"

-			(pop (ubiquitous:value :clip)))))

+		(string-case for

+		  ("channel" channel)

+		  (t (concat "don't know the id for " for)))))

+    

+(defmacro with ((var val) &body body)

+  `(let ((,var ,val))

+     ,@body))

+

+(ql:quickload '(:vecto :ironclad))

+

+(defun hash-of-vector (vec)

+  (ironclad:byte-array-to-hex-string (ironclad:digest-sequence :sha256 vec)))

+

+(defpackage #:vecto-example

+  (:use :cl :alexandria :serapeum :slacker :vecto)

+  (:shadowing-import-from :alexandria :rotate))

+

+(in-package :vecto-example)

+(defmacro with ((var val) &body body)

+  `(let ((,var ,val))

+     ,@body))

+

+

+(defun octets-to-36string (octets)

+  (string-join (map 'list (lambda (it)

+			    (format nil "~2,1,0,'0@a"

+				    (with (*print-base* 36)

+				      (write-to-string it ))))

+		    octets)))

+

+(defmacro with-digested-output ((stream (data-sym digest-sym)) data-form &body body)

+  (with-gensyms (digest-stream data-stream)

+    `(let* ((,digest-stream (ironclad:make-digesting-stream :sha256))

+	    (,data-stream (ironclad:make-octet-output-stream))

+	    (,stream (make-broadcast-stream ,data-stream ,digest-stream)))

+       ,data-form

+       (let ((,data-sym (ironclad:get-output-stream-octets ,data-stream))

+	     (,digest-sym (ironclad:produce-digest ,digest-stream)))

+	 ,@body))))

+

+(define-command "ring-word" (event-pump ts channel &optional (content #(#x3BB)))

+  (bt:make-thread

+   (lambda ()

+     (declare (optimize (debug 3)))

+     (let ((*default-pathname-defaults* "/home/edwlan/github_repos/hhgbot/"))

+       (with-canvas (:width 90 :height 90)

+	 (let ((font (get-font "times.ttf"))

+	       (step (/ pi 7)))

+	   (set-font font 40)

+	   (translate 45 45)

+	   (format hhgbot-augmented-assistant::*zxcv* "~&content: ~s~%" content)

+	   (draw-centered-string 0 -10 (map 'vector #'char-code content))

+	   (set-rgb-stroke 1 0 0)

+	   (centered-circle-path 0 0 35)

+	   (stroke)

+	   (set-rgba-stroke 0 0 1.0 0.5)

+	   (set-line-width 4)

+	   (dotimes (i 14)

+	     (with-graphics-state

+	       (vecto:rotate (* i step))

+	       (move-to 30 0)

+	       (line-to 40 0)

+	       (stroke))))

+	 (let* ((image-directory (ensure-directories-exist "/home/edwlan/public_html/slack_images/"))

+		(image-basename (concat channel "-" ts ".png"))

+		(image-filename (merge-pathnames image-basename image-directory))

+		(payload

+		 (concat "token=" *api-token*

+			 "&channel=" channel

+			 "&text=..." 

+			 "&as_user=true"

+			 "&attachments="

+			 (quri:url-encode

+			  (concat

+			   "[{\"fallback\": \"foo\", \"ts\":" ts ",\"image_url\": \"https://srv2.elangley.org/~edwlan/slack_images/"

+			   image-basename "\"}]")))))

+	   (vecto:save-png image-filename)

+	   (babel:octets-to-string

+	    (drakma:http-request "https://slack.com/api/chat.postMessage"

+				 :method :post

+				 :content payload))))))

+     :name "Image Maker"))