Let's talk to GitHub

Let's teach Common Lisp to talk to GitHub.

We'll need an API token. I like to put these sorts of things in config files. This makes it easier to configure scripts that are deployed to containers. You simply make the config files available through a mount point when starting the container. That way, you can avoid baking credentials into the script.

(defun config-directory ()
  (merge-pathnames
    (make-pathname :directory '(:relative ".config" "github"))
    (user-homedir-pathname)))

(defun config-file (&rest keyargs)
  (merge-pathnames (apply #'make-pathname keyargs) (config-directory)))

(defun load-token (pathname)
  (with-open-file (stream pathname :direction :input)
    (str:trim (read-line stream))))

(defun github-api-token ()
  (load-token (config-file :name "api-token")))

We'll make a lot of use miscellaneous, ad hoc CLOS objects. It is so common for these things to have names that it is worth its own mixin.

(defgeneric get-name (object))

(defclass named-object-mixin ()
  ((name :initarg :name
         :initform (require-initarg :name)
         :reader get-name
         :type string)))

And we'll define a default print-object method. Classes that use this mixin and don't provide their own print-object method will get this one by default.

(defmethod print-object ((obj named-object-mixin) stream)
  (print-unreadable-object (obj stream :identity t :type t)
    (format stream "~a" (slot-value obj 'name))))

We'll make an object to represent GitHub and put the API token in there.

(defclass github (named-object-mixin)
  ((api-token :initarg :api-token
              :initform (require-initarg :api-token)
              :reader get-api-token)))

(defparameter +github+ nil)

(defun github ()  
  (unless (and (boundp '+github+)
               (symbol-value '+github+))
    (setf (symbol-value '+github+)
          (make-instance 'github 
                         :name "GitHub"
                         :api-token (github-api-token))))
  (symbol-value '+github+))

To authenticate to GitHub, we need to pass the API token in the HTTP request headers.

(defun authorization-header (github)
  (cons "Authorization" (format nil "token ~a" (get-api-token github))))

So let's make a request:

* (dex:get "https://api.github.com/user"
           :headers (list (authorization-header (github))
                          '("Accept" . "application/vnd.github.v3+json")))
"{"login":"joseph-marshall69","id":60371090,"node_id":"MDQ6VXNlcjYwMzcxMDkw","avatar_url":"https://avatars.githubusercontent.com/u/60371090?v=4","gravatar_id":"","url":"https://api.github.com/users/jos...[sly-elided string of length 1535]"
200 (8 bits, #xC8, #o310, #b11001000)
#<HASH-TABLE :TEST EQUAL :COUNT 26 {1002A9B2A3}>
#<QURI.URI.HTTP:URI-HTTPS https://api.github.com/user>
#<CL+SSL::SSL-STREAM for #<FD-STREAM for "socket 172.26.126.123:33674, peer: 192.30.255.116:443" {1002A96333}>>

Success! But we got back the string representation of a JSON object. We'll instead request a stream as a return value and pass it to a JSON parser:

* (json:decode-json
    (dex:get "https://api.github.com/user"
             :headers (list (authorization-header (github))
                            '("Accept" . "application/vnd.github.v3+json"))
             :want-stream t))

((:LOGIN . "jrm-code-project") (:ID . 51824598)
 (:NODE--ID . "MDQ6VXNlcjUxODI0NTk4")
 (:AVATAR--URL . "https://avatars.githubusercontent.com/u/51824598?v=4")
 (:GRAVATAR--ID . "") (:URL . "https://api.github.com/users/jrm-code-project")
 (:HTML--URL . "https://github.com/jrm-code-project")
 (:FOLLOWERS--URL . "https://api.github.com/users/jrm-code-project/followers")
 (:FOLLOWING--URL
  . "https://api.github.com/users/jrm-code-project/following{/other_user}")
 (:GISTS--URL
  . "https://api.github.com/users/jrm-code-project/gists{/gist_id}")
 (:STARRED--URL
  . "https://api.github.com/users/jrm-code-project/starred{/owner}{/repo}")
 (:SUBSCRIPTIONS--URL
  . "https://api.github.com/users/jrm-code-project/subscriptions")
 (:ORGANIZATIONS--URL . "https://api.github.com/users/jrm-code-project/orgs")
 (:REPOS--URL . "https://api.github.com/users/jrm-code-project/repos")
 (:EVENTS--URL
  . "https://api.github.com/users/jrm-code-project/events{/privacy}")
 (:RECEIVED--EVENTS--URL
  . "https://api.github.com/users/jrm-code-project/received_events")
 (:TYPE . "User") (:SITE--ADMIN) (:NAME . "Joe Marshall") (:COMPANY)
 (:BLOG . "https://sites.google.com/site/evalapply/")
 (:LOCATION . "Seattle, WA") (:EMAIL) (:HIREABLE) (:BIO) (:TWITTER--USERNAME)
 (:PUBLIC--REPOS . 9) (:PUBLIC--GISTS . 0) (:FOLLOWERS . 21) (:FOLLOWING . 0)
 (:CREATED--AT . "2019-06-14T12:33:06Z")
 (:UPDATED--AT . "2022-03-15T15:18:03Z") (:PRIVATE--GISTS . 0)
 (:TOTAL--PRIVATE--REPOS . 0) (:OWNED--PRIVATE--REPOS . 0)
 (:DISK--USAGE . 44815) (:COLLABORATORS . 0) (:TWO--FACTOR--AUTHENTICATION)
 (:PLAN (:NAME . "free") (:SPACE . 976562499) (:COLLABORATORS . 0)
  (:PRIVATE--REPOS . 10000)))

JSON objects are mapped to alists. The key is a little funny because of how the JSON parser encodes JSON keys with underscores.

An alist is sort of a poor man's object. The problem with an alist is that there is no type associated with it. We know the slots in our poor man's object, but we don't know the class. Without the class information, we don't have a predicate or a way to dispatch to methods. We should create a real CLOS object from this JSON.

(defclass user (named-object-mixin)
  ((login :initarg :login)
   (id :initarg :id)
   (node-id :initarg :node--id)))

(defun json->user-instance (json)
  (apply #'make-instance 'user
         :allow-other-keys t
         (alist->plist json)))

Should we want to bring more fields into Lisp, we need simply add slots with the right initargs to the user class.

Now we can write

(defun get-self (github)
  (json->user-instance
    (json:decode-json
      (dex:get "https://api.github.com/user"
               :headers (list (authorization-header github)
                              '("Accept" . "application/vnd.github.v3+json"))
               :want-stream t))))

* (get-self (github))
#<USER Joe Marshall {1002BE7013}>

* (inspect *)

The object is a STANDARD-OBJECT of type USER.
0. NAME: "Joe Marshall"
1. LOGIN: "jrm-code-project"
2. ID: 51824598
3. NODE-ID: "MDQ6VXNlcjUxODI0NTk4"

GitHub is moving to a GraphQL API. That's easy to handle.

(defun graphql-query (github query &rest variables)
  (let ((content (json:encode-json-to-string
                  `((query . ,query)
                    (variables . ,(plist->alist variables))))))
    (let* ((json (json:decode-json
                  (dex:post "https://api.github.com/graphql"
                            :headers (list (authorization-header github)
                                           '("Accept" . "application/vnd.github.v3+json")
                                           '("Content-Type" . "application/json"))
                            :content content
                            :want-stream t)))
           (errors (cdr (assoc :errors json))))
      (when errors
        (let ((first-error (car errors)))
          (error (cdr (assoc :message first-error)))))
      (cdr (assoc :data json)))))

(defparameter +get-user-by-login-query+
  "query ($login: String!) {
     user (login: $login) {
       databaseId
       login
       name
       }
    }")
    
* (graphql-query (github) +get-user-by-login-query+ :login "jrm-code-project")
((:USER (:DATABASE-ID . 51824598) (:LOGIN . "jrm-code-project")
  (:NAME . "Joe Marshall")))

And you can use the above technique to turn this JSON into a CLOS instance.

At this point we're cooking. We can call GitHub from Common Lisp and get CLOS objects in return. Of course we need more calls other than get-user, but it's more of the same. With this layer as our basis, it is straightforward to script GitHub.