diff --git a/keystone.lisp b/keystone.lisp index 2b16c3f..61fba75 100644 --- a/keystone.lisp +++ b/keystone.lisp @@ -17,12 +17,41 @@ (defclass connection () - ((username :initarg :username :reader connection-username) - (tenant-id :initarg :tenant-id :initform nil :reader connection-tenant-id) - (tenant-name :initarg :tenant-name :initform nil :reader connection-tenant-name) - (password :initarg :password :reader connection-password) + ((username :initarg :username + :reader connection-username + :initform (error ":USERNAME is required when creating a connection.")) + (tenant-id :initarg :tenant-id + :reader connection-tenant-id) + (tenant-name :initarg :tenant-name + :reader connection-tenant-name) + (password :initarg :password + :initform (error ":PASSWORD is required when creating a connection.") + :reader connection-password) (token :initarg :password) - (url :initarg :url :reader connection-url))) + (url :initarg :url + :reader connection-url + :initform (error ":URL is required when creating a connection.")))) + +(defmethod encode-json ((connection connection) + &optional (stream json:*json-output*)) + "Write the JSON representation (Object) of the keystone CONNECTION +to STREAM (or to *JSON-OUTPUT*)." + (with-slots (username password) connection + (with-explicit-encoder + (encode-json + `(:object + :auth + (:object + :password-credentials + (:object + :username ,username + :password ,password) + ,@(cond + ((slot-boundp connection 'tenant-id) + (list :tenant-id (connection-tenant-id connection))) + ((slot-boundp connection 'tenant-name) + (list :tenant-name (connection-tenant-name connection)))))) + stream)))) (defclass connection-v2 (connection) ((version :initform 2 :reader connection-version))) @@ -66,35 +95,25 @@ (:documentation "Authenticate and retrieve a token.")) (defmethod authenticate ((connection connection-v2)) - (with-slots (url token username password tenant-id tenant-name) connection - (unless (or tenant-id tenant-name) - (error "No tenant-id nor tenant-name specified, cannot authenticate.")) - (let ((tenant-prop (if tenant-id - (list "tenantId" tenant-id) - (list "tenantName" tenant-name)))) - (multiple-value-bind (body status-code headers uri stream must-close reason-phrase) - (http-request (format nil "~a/v2.0/tokens" url) - :method :POST - :want-stream t - :stream *cached-stream* - :content-type "application/json" - :content - (with-explicit-encoder - (encode-json-to-string - `(:object "auth" (:object "passwordCredentials" - (:object "username" ,username - "password" ,password) - ,@tenant-prop))))) - (declare (ignore must-close reason-phrase body)) - (cond - ((and (eql status-code 200) - (json-response-p headers)) - (setf token - (cdr (assoc :token (cdr (assoc :access (decode-json stream))))))) - ((json-response-p headers) - (json-error (decode-json stream))) - (t - (unknown-error uri status-code))))))) + (with-slots (url token) connection + (multiple-value-bind (body status-code headers uri stream must-close reason-phrase) + (http-request (format nil "~a/v2.0/tokens" url) + :method :POST + :want-stream t + :stream *cached-stream* + :content-type "application/json" + :content + (encode-json-to-string connection)) + (declare (ignore must-close reason-phrase body)) + (cond + ((and (eql status-code 200) + (json-response-p headers)) + (setf token + (cdr (assoc :token (cdr (assoc :access (decode-json stream))))))) + ((json-response-p headers) + (json-error (decode-json stream))) + (t + (unknown-error uri status-code)))))) (defgeneric connection-token-id (connection) (:documentation "Retrieve token id for CONNECTION.")) diff --git a/tests/keystone.lisp b/tests/keystone.lisp index ad7051d..326f7ce 100644 --- a/tests/keystone.lisp +++ b/tests/keystone.lisp @@ -17,7 +17,7 @@ (in-package :cl-keystone-client-test) -(def-suite keystone :description "My Example Suite") +(def-suite keystone :description "Test the Openstack Keystone client.") (in-suite keystone) @@ -54,8 +54,24 @@ (coerce '(#\Return #\Linefeed) 'string))))) (test make-connection - "Make a connection object" - (is-true (make-instance 'connection-v2))) + "Make a connection testing required fields." + (is-true + (make-instance 'connection-v2 + :username "test" + :password "test" + :url "test")) + (signals error + (make-instance 'connection-v2 + :password "test" + :url "test")) + (signals error + (make-instance 'connection-v2 + :username "test" + :url "test")) + (signals error + (make-instance 'connection-v2 + :username "test" + :password "test"))) (test authentication-error-404 "Test that the correct condition is signalled when a 404 is returned