/src/core/server.lisp
Lisp | 166 lines | 128 code | 16 blank | 22 comment | 5 complexity | 52d5921374624869f625385c374cc2c6 MD5 | raw file
1(in-package :chillax.core) 2 3;;; 4;;; Status codes 5;;; 6(defparameter +status-codes+ 7 '((200 . :ok) 8 (201 . :created) 9 (202 . :accepted) 10 (304 . :not-modified) 11 (400 . :bad-request) 12 (404 . :not-found) 13 (405 . :resource-not-allowed) 14 (409 . :conflict) 15 (412 . :precondition-failed) 16 (415 . :bad-content-type) 17 (500 . :internal-server-error)) 18 "A simple alist of keyword names for HTTP status codes, keyed by status code.") 19 20(defparameter +utf-8+ (make-external-format :utf-8 :eol-style :lf)) 21 22;;; 23;;; Conditions 24;;; 25(define-condition couchdb-error () ()) 26 27(define-condition unexpected-response (couchdb-error) 28 ((status-code :initarg :status-code :reader error-status-code) 29 (response :initarg :response :reader error-response)) 30 (:report (lambda (condition stream) 31 (format stream "Unexpected response with status code: ~A~@ 32 HTTP Response: ~A~@ 33 Please report this to Chillax's maintainer(s)" 34 (error-status-code condition) 35 (error-response condition))))) 36 37;;; 38;;; Server API 39;;; 40 41;; Server Protocol 42(defgeneric server-host (server)) 43(defgeneric server-port (server)) 44(defgeneric server-username (server)) 45(defgeneric server-password (server)) 46(defgeneric server-secure-p (server)) 47(defgeneric data->json (server data &key) 48 (:documentation "Converts DATA to JSON suitable for sending to CouchDB.")) 49(defgeneric json->data (server json &key) 50 (:documentation "Converts JSON to the desired data structure.")) 51(defgeneric make-db-object (server name) 52 (:documentation 53"Creates an object which represents a database connection in SERVER. The object must conform to the 54database protocol.")) 55 56(defun couch-request (server uri &rest all-keys 57 &key (content nil contentp) (convert-data-p t) 58 &allow-other-keys) 59 "Sends an HTTP request to the CouchDB server represented by SERVER. Most of the keyword arguments 60for drakma:http-request are available as kwargs for this message." 61 (let* ((content (cond ((and contentp convert-data-p) 62 (data->json server content)) 63 ((and contentp (not convert-data-p)) 64 content) 65 (t ""))) 66 (content-length (or (getf all-keys :content-length) 67 (flex:octet-length content :external-format +utf-8+)))) 68 (remf all-keys :content-length) 69 (remf all-keys :convert-data-p) 70 (multiple-value-bind (response status-code) 71 (apply #'http-request (strcat (server-uri server) uri) 72 :content-type "application/json" 73 :external-format-out +utf-8+ 74 :external-format-in +utf-8+ 75 :basic-authorization (when (server-username server) 76 (list (server-username server) 77 (server-password server))) 78 :content content 79 :content-length content-length 80 all-keys) 81 (values (json->data server response) 82 (or (cdr (assoc status-code +status-codes+ :test #'=)) 83 ;; The code should never get here once we know all the 84 ;; status codes CouchDB might return. 85 (error "Unknown status code: ~A. HTTP Response: ~A" 86 status-code response)))))) 87 88;; Server functions 89(defun server-uri (server) 90 "Returns a string representation of the URL SERVER represents." 91 (format nil "~A://~A:~A/" 92 (if (server-secure-p server) 93 "https" 94 "http") 95 (server-host server) 96 (server-port server))) 97 98(defun all-dbs (server) 99 "Requests a list of all existing databases from SERVER." 100 (couch-request server "_all_dbs")) 101 102(defun config-info (server) 103 "Requests the current configuration from SERVER." 104 (couch-request server "_config")) 105 106(defun replicate (server source target &key create-target-p continuousp 107 &aux (to-json `("source" ,source "target" ,target))) 108 "Replicates the database in SOURCE to TARGET. SOURCE and TARGET can both be either database names 109in the local server, or full URLs to local or remote databases. If CREATE-TARGET-P is true, the 110target database will automatically be created if it does not exist. If CONTINUOUSP is true, CouchDB 111will continue propagating any changes in SOURCE to TARGET." 112 ;; There are some caveats to the keyword arguments - 113 ;; create-target-p: doesn't actually seem to work at all in CouchDB 0.10 114 ;; continuousp: The CouchDB documentation warns that this continuous replication 115 ;; will only last as long as the CouchDB daemon is running. If the 116 ;; daemon is restarted, replication must be restarted as well. 117 ;; Note that there are plans to add 'persistent' replication. 118 (when create-target-p (setf to-json (append `("create_target" "true") to-json))) 119 (when continuousp (setf to-json (append `("continuous" "true") to-json))) 120 (couch-request server "_replicate" :method :post :content (format nil "{~{~s:~s~^,~}}" to-json))) 121 122(defun stats (server) 123 "Requests general statistics from SERVER." 124 (couch-request server "_stats")) 125 126(defun active-tasks (server) 127 "Lists all the currently active tasks on SERVER." 128 (couch-request server "_active_tasks")) 129 130(defun get-uuids (server &key (number 10)) 131 "Returns a list of NUMBER unique IDs requested from SERVER. The UUIDs generated by the server are 132reasonably unique, but are not checked against existing UUIDs, so conflicts may still happen." 133 (couch-request server (format nil "_uuids?count=~A" number))) 134 135;;; 136;;; Sample protocol implementation 137;;; 138(defclass standard-server () 139 ((host 140 :reader server-host 141 :initarg :host) 142 (port 143 :reader server-port 144 :initarg :port) 145 (username 146 :reader server-username 147 :initarg :username) 148 (password 149 :reader server-password 150 :initarg :password) 151 (securep 152 :reader server-secure-p 153 :initarg :securep)) 154 (:documentation 155 "Default implementation of the server protocol.") 156 (:default-initargs 157 :host "127.0.0.1" 158 :port 5984 159 :username nil 160 :password nil 161 :securep nil)) 162 163(defmethod data->json ((server standard-server) data &key) 164 data) 165(defmethod json->data ((server standard-server) json &key) 166 json)