Re-factored base resource API out of keystone
To allow other clients to more easily use the REST API helpers, they have been re-factored out of keystone package. Change-Id: I5fde703293ff8f2668789053a36e293dc6fc6c53
This commit is contained in:
Russell Sim
parent
2b75f1821d
commit
88cc72ff95
239
keystone.lisp
239
keystone.lisp
@ -1,7 +1,25 @@
|
||||
(defpackage cl-keystone-client
|
||||
(:use cl drakma)
|
||||
(:use cl)
|
||||
(:import-from #:cl-openstack-client
|
||||
#:assoc*)
|
||||
#:*http-stream*
|
||||
#:assoc*
|
||||
#:decode-resource
|
||||
#:decode-resource-list
|
||||
#:def-rest-method
|
||||
#:error-code
|
||||
#:error-message
|
||||
#:handle-http-error
|
||||
#:id
|
||||
#:openstack-error
|
||||
#:request-resource
|
||||
#:resource
|
||||
#:resource-authentication-headers
|
||||
#:resource-connection
|
||||
#:resource-error-class
|
||||
#:resource-id
|
||||
#:service-url)
|
||||
(:import-from #:drakma
|
||||
#:http-request)
|
||||
(:import-from #:local-time
|
||||
#:parse-timestring
|
||||
#:timestamp>
|
||||
@ -13,11 +31,7 @@
|
||||
#:encode-json
|
||||
#:encode-json-to-string)
|
||||
(:import-from #:alexandria
|
||||
#:alist-plist
|
||||
#:with-gensyms)
|
||||
(:import-from #:uri-template
|
||||
#:uri-template
|
||||
#:read-uri-template)
|
||||
#:alist-plist)
|
||||
(:export connection-v2
|
||||
authenticate
|
||||
keystone-error
|
||||
@ -57,6 +71,7 @@
|
||||
|
||||
(in-package :cl-keystone-client)
|
||||
|
||||
(define-condition keystone-error (openstack-error) ())
|
||||
|
||||
(defclass connection ()
|
||||
((username :initarg :username
|
||||
@ -85,6 +100,9 @@
|
||||
(defmethod resource-connection ((connection connection))
|
||||
connection)
|
||||
|
||||
(defmethod resource-error-class ((resource connection))
|
||||
'keystone-error)
|
||||
|
||||
(defmethod encode-json ((connection connection)
|
||||
&optional (stream json:*json-output*))
|
||||
"Write the JSON representation (Object) of the keystone CONNECTION
|
||||
@ -113,41 +131,6 @@ to STREAM (or to *JSON-OUTPUT*)."
|
||||
(declare (ignore action))
|
||||
nil)
|
||||
|
||||
(defvar *cached-stream* nil)
|
||||
|
||||
(define-condition keystone-error (error)
|
||||
((message
|
||||
:initarg :message
|
||||
:accessor error-message
|
||||
:initform nil
|
||||
:documentation "The error message returned by keystone.")
|
||||
(code
|
||||
:initarg :code
|
||||
:accessor error-code
|
||||
:initform nil
|
||||
:documentation "The error code returned by keystone."))
|
||||
(:report (lambda (condition stream)
|
||||
(format stream "Keystone ERROR: ~A, ~A"
|
||||
(error-code condition)
|
||||
(error-message condition)))))
|
||||
|
||||
(defun json-error (json)
|
||||
"Raise an error using the contents of a JSON error plist."
|
||||
(let ((error-message (assoc* :error json)))
|
||||
(error 'keystone-error
|
||||
:message (assoc* :message error-message)
|
||||
:code (assoc* :code error-message))))
|
||||
|
||||
(defun unknown-error (url status-code)
|
||||
"Raise an error with the url and status code."
|
||||
(error (format nil "ERROR: received response code of ~A when accessing ~A"
|
||||
status-code url)))
|
||||
|
||||
(defun json-response-p (headers)
|
||||
"Return true if the response content type is json."
|
||||
(string-equal (assoc* :content-type headers)
|
||||
"application/json"))
|
||||
|
||||
(defun openstack-camel-case-to-lisp (camel-string)
|
||||
"Convert camel case JSON keys to lisp symbol names. This function
|
||||
handles keys with names like publicURL better and will convert keys
|
||||
@ -173,17 +156,6 @@ with underscores to hyphens."
|
||||
(let ((*json-identifier-name-to-lisp* #'openstack-camel-case-to-lisp))
|
||||
(cl-json:decode-json stream)))
|
||||
|
||||
(defun handle-http-error (uri status-code headers stream)
|
||||
(block nil
|
||||
(cond
|
||||
((and (member status-code '(200 204))
|
||||
(json-response-p headers))
|
||||
(return))
|
||||
((json-response-p headers)
|
||||
(json-error (decode-json stream)))
|
||||
(t
|
||||
(unknown-error uri status-code)))))
|
||||
|
||||
(defgeneric authenticate (connection)
|
||||
(:documentation "Authenticate and retrieve a token."))
|
||||
|
||||
@ -193,12 +165,12 @@ with underscores to hyphens."
|
||||
(http-request (format nil "~a/v2.0/tokens" url)
|
||||
:method :POST
|
||||
:want-stream t
|
||||
:stream *cached-stream*
|
||||
:stream *http-stream*
|
||||
:content-type "application/json"
|
||||
:content
|
||||
(encode-json-to-string connection))
|
||||
(declare (ignore must-close reason-phrase body))
|
||||
(handle-http-error uri status-code headers stream)
|
||||
(handle-http-error connection uri status-code headers stream)
|
||||
(let ((access (assoc* :access (decode-json stream))))
|
||||
(setf user (assoc* :user access))
|
||||
(setf service-catalog (assoc* :service-catalog access))
|
||||
@ -236,6 +208,9 @@ valid."))
|
||||
(connection-token-expires connection)
|
||||
(now)))
|
||||
|
||||
(defmethod resource-authentication-headers ((resource connection-v2))
|
||||
`(("x-auth-token" . ,(connection-token-id resource))))
|
||||
|
||||
;; Service catalog queries
|
||||
|
||||
(defun filter-endpoints (endpoints &key (type :public-url) region)
|
||||
@ -255,154 +230,18 @@ valid."))
|
||||
:type (connection-endpoint connection))))
|
||||
|
||||
|
||||
;;; REST method helpers
|
||||
|
||||
(defun convert-header-resources (headers)
|
||||
"Take a list of headers and resolve any RESOURCE types to their
|
||||
RESOURCE-ID's"
|
||||
(loop :for (header . value) :in headers
|
||||
:when (subtypep (class-of value) (find-class 'resource))
|
||||
:collect (cons header (resource-id value))
|
||||
:else
|
||||
:collect (cons header value)))
|
||||
|
||||
(defun return-first-connection (resources)
|
||||
(loop :for r :in resources
|
||||
:when (or (subtypep (class-of r) (find-class 'resource))
|
||||
(subtypep (class-of r) (find-class 'connection)))
|
||||
:return r))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defun lambda-list-variables (&rest rest)
|
||||
(loop :for l :in rest
|
||||
:for element = (if (listp l) (car l) l)
|
||||
:until (eql (char (symbol-name element) 0) #\&)
|
||||
:collect element)))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defun convert-lambda-list-resources (&rest rest)
|
||||
(loop :for l :in rest
|
||||
:for element = (if (listp l) (car l) l)
|
||||
:until (eql (char (symbol-name element) 0) #\&)
|
||||
:collect `(,element (if (subtypep (class-of ,element) (find-class 'resource))
|
||||
(resource-id ,element)
|
||||
,element)))))
|
||||
|
||||
(defvar *resource-url* nil)
|
||||
|
||||
(defmacro def-rest-method (name lambda-list options &body body)
|
||||
"A convenience wrapper around request-resource.
|
||||
|
||||
NAME is the name of the method. LAMBDA-LIST is a method lambda list,
|
||||
it's first element will be used to source a connection, so it must be
|
||||
of the type RESOURCE or CONNECTION.
|
||||
|
||||
OPTIONS is in the form of an ALIST and can contain URI or
|
||||
DOCUMENTATION elements.
|
||||
|
||||
URI is the uri to the resource you are looking for it supports
|
||||
RFC6570 tempting and will be evaluated in the context of the method as
|
||||
if in a PROGN so values from the LAMBDA-LIST will be substituted in
|
||||
provided the symbol names match. Any RESOURCE types will have their
|
||||
RESOURCE-ID methods called before substitution. Only simple expansion
|
||||
is supported from the RFC.
|
||||
|
||||
DOCUMENTATION a documentation string that will be assigned to the
|
||||
method.
|
||||
|
||||
BODY is a for the method body.
|
||||
"
|
||||
(let ((uri (or (cadr (assoc :uri options))
|
||||
(error ":URI is required.")))
|
||||
(documentation (cdr (assoc :documentation options))))
|
||||
`(defmethod ,name ,lambda-list
|
||||
,@documentation
|
||||
(let ((*resource-url*
|
||||
(format nil "~a/~a"
|
||||
(service-url (resource-connection
|
||||
,(car (apply #'lambda-list-variables lambda-list))))
|
||||
(let ,(apply #'convert-lambda-list-resources lambda-list)
|
||||
(declare (ignorable ,@(apply #'lambda-list-variables lambda-list)))
|
||||
(uri-template
|
||||
,@(with-input-from-string (stream uri)
|
||||
(read-uri-template stream t)))))))
|
||||
,@body))))
|
||||
|
||||
(defmacro def-rest-generic (name lambda-list &body options)
|
||||
"Define a generic with REST methods."
|
||||
(let ((documentation (or (cadr (assoc :documentation options)) ""))
|
||||
(methods (loop :for body :in options
|
||||
:when (eql (car body) :method)
|
||||
:collect (cdr body))))
|
||||
`(progn
|
||||
(defgeneric ,name ,lambda-list
|
||||
(:documentation ,documentation))
|
||||
,@(loop :for method :in methods
|
||||
:collect `(def-rest-method ,name ,@method)))))
|
||||
|
||||
|
||||
;; Resources act as a base class for all types within keystone.
|
||||
|
||||
(defclass resource ()
|
||||
((id :initarg :id
|
||||
:reader resource-id)
|
||||
(connection :initarg :connection
|
||||
:reader resource-connection)
|
||||
(attributes :initform (make-hash-table))))
|
||||
|
||||
(defmethod print-object ((resource resource) stream)
|
||||
(if (slot-boundp resource 'id)
|
||||
(print-unreadable-object (resource stream :type t :identity t)
|
||||
(format stream "~A" (resource-id resource)))
|
||||
(print-unreadable-object (resource stream :type t :identity t))))
|
||||
|
||||
(defmethod decode-resource (resource parent type)
|
||||
(apply #'make-instance
|
||||
type
|
||||
:connection (resource-connection parent)
|
||||
:parent parent
|
||||
(concatenate 'list
|
||||
(alist-plist resource)
|
||||
'(:allow-other-keys t))))
|
||||
|
||||
(defmethod decode-resource-list (resources parent type)
|
||||
(loop :for resource :in resources
|
||||
:collect (decode-resource resource parent type)))
|
||||
|
||||
(defclass resource-v2 (resource)
|
||||
())
|
||||
|
||||
(defmethod resource-error-class ((resource resource-v2))
|
||||
'keystone-error)
|
||||
|
||||
(defmethod resource-authentication-headers ((resource resource-v2))
|
||||
(resource-authentication-headers (resource-connection resource)))
|
||||
|
||||
(defmethod service-url ((resource resource-v2) &optional (service "identity"))
|
||||
(service-url (resource-connection resource) service))
|
||||
|
||||
(defun request-resource (resource &key method additional-headers content
|
||||
(uri *resource-url*)
|
||||
(content-type "application/json"))
|
||||
(multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
|
||||
(http-request uri
|
||||
:method method
|
||||
:content-type "application/json"
|
||||
:stream *cached-stream*
|
||||
:additional-headers
|
||||
(concatenate 'list
|
||||
`(("x-auth-token" . ,(connection-token-id
|
||||
(resource-connection resource))))
|
||||
(convert-header-resources additional-headers))
|
||||
:content (cond
|
||||
((null content)
|
||||
nil)
|
||||
((stringp content)
|
||||
content)
|
||||
(t
|
||||
(encode-json-to-string content)))
|
||||
:want-stream t)
|
||||
(declare (ignore body must-close reason-phrase))
|
||||
(handle-http-error uri status-code headers stream)
|
||||
(cond
|
||||
((equal content-type "application/json")
|
||||
(decode-json stream))
|
||||
(t stream))))
|
||||
|
||||
|
||||
(defclass named-resource-v2 (resource-v2)
|
||||
((name :initarg :name :reader resource-name)))
|
||||
@ -469,12 +308,14 @@ to STREAM (or to *JSON-OUTPUT*)."
|
||||
;; Users
|
||||
|
||||
(defclass user (named-resource-v2)
|
||||
((id :initarg :id :reader user-id)
|
||||
(name :initarg :name :reader user-name)
|
||||
((name :initarg :name :reader user-name)
|
||||
(tenant-id :initarg :tenant-id :reader user-tenant)
|
||||
(enabled :initarg :enabled :reader user-enabled)
|
||||
(email :initarg :email :reader user-email)))
|
||||
|
||||
(defmethod user-id ((user user))
|
||||
(resource-id user))
|
||||
|
||||
(defclass user-v2 (user)
|
||||
())
|
||||
|
||||
|
||||
241
openstack.lisp
241
openstack.lisp
@ -1,6 +1,45 @@
|
||||
(defpackage cl-openstack-client
|
||||
(:use cl)
|
||||
(:export assoc*))
|
||||
(:export #:*resource-uri*
|
||||
#:*http-stream*
|
||||
|
||||
;; REST resource definitions
|
||||
#:def-rest-method
|
||||
#:def-rest-generic
|
||||
|
||||
;; Error handling
|
||||
#:openstack-error
|
||||
#:handle-http-error
|
||||
#:error-code
|
||||
#:error-message
|
||||
|
||||
;; Resources
|
||||
#:resource
|
||||
#:resource-connection
|
||||
#:resource-authentication-headers
|
||||
#:resource-error-class
|
||||
#:decode-resource-list
|
||||
#:request-resource
|
||||
#:decode-resource
|
||||
#:service-url
|
||||
#:resource-id
|
||||
|
||||
;; Resource Slots
|
||||
#:id
|
||||
|
||||
;; Generic Utilities
|
||||
#:assoc*)
|
||||
(:import-from #:drakma
|
||||
#:http-request)
|
||||
(:import-from #:cl-json
|
||||
#:encode-json
|
||||
#:decode-json
|
||||
#:encode-json-to-string)
|
||||
(:import-from #:alexandria
|
||||
#:alist-plist)
|
||||
(:import-from #:uri-template
|
||||
#:uri-template
|
||||
#:read-uri-template))
|
||||
|
||||
|
||||
(in-package :cl-openstack-client)
|
||||
@ -9,3 +48,203 @@
|
||||
"Return the CDR of the ASSOC result."
|
||||
(declare (ignore key test test-not))
|
||||
(cdr (apply #'assoc item alist rest)))
|
||||
|
||||
|
||||
;;; REST method helpers
|
||||
|
||||
(defvar *http-stream* nil
|
||||
"This stream is primarily used for dependency injection in
|
||||
testcases.")
|
||||
|
||||
(define-condition openstack-error (error)
|
||||
((message
|
||||
:initarg :message
|
||||
:accessor error-message
|
||||
:initform nil
|
||||
:documentation "The error message returned by Openstack.")
|
||||
(code
|
||||
:initarg :code
|
||||
:accessor error-code
|
||||
:initform nil
|
||||
:documentation "The error code returned by Openstack."))
|
||||
(:report (lambda (condition stream)
|
||||
(format stream "Openstack ERROR: ~A, ~A"
|
||||
(error-code condition)
|
||||
(error-message condition)))))
|
||||
|
||||
(defun json-error (resource json)
|
||||
"Raise an error using the contents of a JSON error plist."
|
||||
(let ((error-message (assoc* :error json)))
|
||||
(error (resource-error-class resource)
|
||||
:message (assoc* :message error-message)
|
||||
:code (assoc* :code error-message))))
|
||||
|
||||
(defun unknown-error (url status-code)
|
||||
"Raise an error with the url and status code."
|
||||
(error (format nil "ERROR: received response code of ~A when accessing ~A"
|
||||
status-code url)))
|
||||
|
||||
(defun json-response-p (headers)
|
||||
"Return true if the response content type is json."
|
||||
(string-equal (assoc* :content-type headers)
|
||||
"application/json"))
|
||||
|
||||
(defun handle-http-error (resource uri status-code headers stream)
|
||||
(block nil
|
||||
(cond
|
||||
((and (member status-code '(200 204))
|
||||
(json-response-p headers))
|
||||
(return))
|
||||
((json-response-p headers)
|
||||
(json-error resource (decode-json stream)))
|
||||
(t
|
||||
(unknown-error uri status-code)))))
|
||||
|
||||
(defun convert-header-resources (headers)
|
||||
"Take a list of headers and resolve any RESOURCE types to their
|
||||
RESOURCE-ID's"
|
||||
(loop :for (header . value) :in headers
|
||||
:when (subtypep (class-of value) (find-class 'resource))
|
||||
:collect (cons header (resource-id value))
|
||||
:else
|
||||
:collect (cons header value)))
|
||||
|
||||
(defun return-first-connection (resources)
|
||||
(loop :for r :in resources
|
||||
:when (or (subtypep (class-of r) (find-class 'resource))
|
||||
(subtypep (class-of r) (find-class 'connection)))
|
||||
:return r))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defun lambda-list-variables (&rest rest)
|
||||
(loop :for l :in rest
|
||||
:for element = (if (listp l) (car l) l)
|
||||
:until (eql (char (symbol-name element) 0) #\&)
|
||||
:collect element)))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defun convert-lambda-list-resources (&rest rest)
|
||||
(loop :for l :in rest
|
||||
:for element = (if (listp l) (car l) l)
|
||||
:until (eql (char (symbol-name element) 0) #\&)
|
||||
:collect `(,element (if (subtypep (class-of ,element) (find-class 'resource))
|
||||
(resource-id ,element)
|
||||
,element)))))
|
||||
|
||||
;; Resources act as a base class for all types.
|
||||
|
||||
(defclass resource ()
|
||||
((id :initarg :id
|
||||
:reader resource-id)
|
||||
(connection :initarg :connection
|
||||
:reader resource-connection)
|
||||
(attributes :initform (make-hash-table))))
|
||||
|
||||
(defmethod resource-error-class ((resource resource))
|
||||
'openstack-error)
|
||||
|
||||
(defmethod print-object ((resource resource) stream)
|
||||
(if (slot-boundp resource 'id)
|
||||
(print-unreadable-object (resource stream :type t :identity t)
|
||||
(format stream "~A" (resource-id resource)))
|
||||
(print-unreadable-object (resource stream :type t :identity t))))
|
||||
|
||||
(defmethod decode-resource (resource parent type)
|
||||
;; TODO (RS) currently extra keys are just ignored in all resources,
|
||||
;; it would be best if they were saved somewhere.
|
||||
(apply #'make-instance
|
||||
type
|
||||
:connection (resource-connection parent)
|
||||
:parent parent
|
||||
(concatenate 'list
|
||||
(alist-plist resource)
|
||||
'(:allow-other-keys t))))
|
||||
|
||||
(defmethod decode-resource-list (resources parent type)
|
||||
(loop :for resource :in resources
|
||||
:collect (decode-resource resource parent type)))
|
||||
|
||||
(defgeneric resource-authentication-headers (resource)
|
||||
(:documentation "Return a list of the authentication headers that
|
||||
should be added to the request."))
|
||||
|
||||
(defvar *resource-uri* nil)
|
||||
|
||||
(defun request-resource (resource &key method additional-headers content
|
||||
(uri *resource-uri*)
|
||||
(content-type "application/json"))
|
||||
(multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
|
||||
(http-request uri
|
||||
:method method
|
||||
:content-type "application/json"
|
||||
:stream *http-stream*
|
||||
:additional-headers
|
||||
(concatenate 'list
|
||||
(resource-authentication-headers resource)
|
||||
(convert-header-resources additional-headers))
|
||||
:content (cond
|
||||
((null content)
|
||||
nil)
|
||||
((stringp content)
|
||||
content)
|
||||
(t
|
||||
(encode-json-to-string content)))
|
||||
:want-stream t)
|
||||
(declare (ignore body must-close reason-phrase))
|
||||
(handle-http-error resource uri status-code headers stream)
|
||||
(cond
|
||||
((equal content-type "application/json")
|
||||
(decode-json stream))
|
||||
(t stream))))
|
||||
|
||||
(defgeneric service-url (resource &optional service-name))
|
||||
|
||||
(defmacro def-rest-method (name lambda-list options &body body)
|
||||
"A convenience wrapper around request-resource.
|
||||
|
||||
NAME is the name of the method. LAMBDA-LIST is a method lambda list,
|
||||
it's first element will be used to source a connection, so it must be
|
||||
of the type RESOURCE or CONNECTION.
|
||||
|
||||
OPTIONS is in the form of an ALIST and can contain URI or
|
||||
DOCUMENTATION elements.
|
||||
|
||||
URI is the uri to the resource you are looking for it supports
|
||||
RFC6570 tempting and will be evaluated in the context of the method as
|
||||
if in a PROGN so values from the LAMBDA-LIST will be substituted in
|
||||
provided the symbol names match. Any RESOURCE types will have their
|
||||
RESOURCE-ID methods called before substitution. Only simple expansion
|
||||
is supported from the RFC. The resulting URI will be bound to the
|
||||
*RESOURCE-URI* variable for use within other helper functions.
|
||||
|
||||
DOCUMENTATION a documentation string that will be assigned to the
|
||||
method.
|
||||
|
||||
BODY is a for the method body.
|
||||
"
|
||||
(let ((uri (or (cadr (assoc :uri options))
|
||||
(error ":URI is required.")))
|
||||
(documentation (cdr (assoc :documentation options))))
|
||||
`(defmethod ,name ,lambda-list
|
||||
,@documentation
|
||||
(let ((*resource-uri*
|
||||
(format nil "~a/~a"
|
||||
(service-url ,(car (apply #'lambda-list-variables lambda-list)))
|
||||
(let ,(apply #'convert-lambda-list-resources lambda-list)
|
||||
(declare (ignorable ,@(apply #'lambda-list-variables lambda-list)))
|
||||
(uri-template
|
||||
,@(with-input-from-string (stream uri)
|
||||
(read-uri-template stream t)))))))
|
||||
,@body))))
|
||||
|
||||
(defmacro def-rest-generic (name lambda-list &body options)
|
||||
"Define a generic with REST methods."
|
||||
(let ((documentation (or (cadr (assoc :documentation options)) ""))
|
||||
(methods (loop :for body :in options
|
||||
:when (eql (car body) :method)
|
||||
:collect (cdr body))))
|
||||
`(progn
|
||||
(defgeneric ,name ,lambda-list
|
||||
(:documentation ,documentation))
|
||||
,@(loop :for method :in methods
|
||||
:collect `(def-rest-method ,name ,@method)))))
|
||||
|
||||
@ -13,6 +13,8 @@
|
||||
#:now)
|
||||
(:import-from #:cl-keystone-client
|
||||
#:connection-v2)
|
||||
(:import-from #:cl-openstack-client
|
||||
#:*http-stream*)
|
||||
(:import-from #:flexi-streams
|
||||
#:string-to-octets
|
||||
#:make-flexi-stream
|
||||
@ -110,20 +112,6 @@
|
||||
(:endpoints-links) (:type . "identity") (:name . "keystone"))))
|
||||
connection))
|
||||
|
||||
(defun is-valid-response (stream method uri content)
|
||||
(destructuring-bind (status headers content)
|
||||
(read-mock-request mock-stream)
|
||||
(is (equal content
|
||||
"{\"user\":{\"name\":\"test\",\"email\":\"test@example.com\",\"enabled\":true,\"password\":\"secret\"}}"))
|
||||
(is (string-equal "application/json"
|
||||
(header-value :content-type headers)))
|
||||
(is (string-equal "MIINUAYJKoZIhvcNAQ=="
|
||||
(header-value :x-auth-token headers)))
|
||||
(is (string-equal "192.168.1.9:5000"
|
||||
(header-value :host headers)))
|
||||
(is (eql (getf status :method) method))
|
||||
(is (eql (getf status :uri) uni))))
|
||||
|
||||
(defclass mock-http-stream (fundamental-binary-input-stream
|
||||
fundamental-binary-output-stream
|
||||
fundamental-character-input-stream
|
||||
@ -210,9 +198,8 @@ form (parsed-status-line headers contents)"
|
||||
|
||||
(defmacro with-mock-http-stream ((stream) &body body)
|
||||
`(let* ((,stream (make-instance 'mock-http-stream))
|
||||
(cl-keystone-client::*cached-stream*
|
||||
(make-flexi-stream (make-chunked-stream ,stream)
|
||||
:external-format +latin-1+)))
|
||||
(*http-stream* (make-flexi-stream (make-chunked-stream ,stream)
|
||||
:external-format +latin-1+)))
|
||||
,@body))
|
||||
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user