This commit is contained in:
Akira Tempaku 2025-04-19 18:28:25 +09:00
parent 7127a6fc68
commit 5448d575ad
Signed by: paku
GPG key ID: 5B4E8402BCC50607

View file

@ -28,30 +28,26 @@
(defun %request (method endpoint &key path query content) (defun %request (method endpoint &key path query content)
(or *service-domain* (error "microcms:*service-domain* is not configured.")) (or *service-domain* (error "microcms:*service-domain* is not configured."))
(or *api-key* (error "microcms:*api-key* is not configured.")) (or *api-key* (error "microcms:*api-key* is not configured."))
(let* ((url (%build-uri endpoint :path path :query query)) (handler-case
(req-headers `(("X-MICROCMS-API-KEY" . ,*api-key*) (multiple-value-bind (res-body status res-headers)
("Content-Type" . "application/json")))) (request (%build-uri endpoint :path path :query query)
(handler-case :method method
(multiple-value-bind (res-body status res-headers) :headers `(("X-MICROCMS-API-KEY" . ,*api-key*)
(request url ("Content-Type" . "application/json"))
:method method :content (and content (to-json content))
:headers req-headers :force-binary nil)
:content (and content (to-json content)) (format t "microCMS status: ~D~%" status)
:force-binary nil) (when (and (stringp res-body)
(format t "microCMS status: ~D~%" status) (search "application/json" (gethash "content-type" res-headers)))
(when (and (stringp res-body) (parse res-body)))
(search "application/json" (gethash "content-type" res-headers))) (http-request-failed (e)
(parse res-body))) (format *error-output* "microCMS status: ~D~%" (response-status e)))))
(http-request-failed (e)
(format *error-output* "microCMS status: ~D~%" (response-status e))))))
(defun %build-uri (endpoint &key path query) (defun %build-uri (endpoint &key path query)
(let ((uri (make-uri (render-uri (make-uri :scheme "https"
:scheme "https" :host (format nil "~A.microcms.io" *service-domain*)
:host (format nil "~A.microcms.io" *service-domain*) :path (format nil "/api/v1/~A~@[/~A~]" endpoint path)
:path (format nil "/api/v1/~A~@[/~A~]" endpoint path) :query (%build-query query))))
:query (%build-query query))))
(render-uri uri)))
(defun %build-query (query) (defun %build-query (query)
(loop :for (key val) :on query :by #'cddr (loop :for (key val) :on query :by #'cddr
@ -84,4 +80,4 @@
(%request :get ,str-endpoint :query query)) (%request :get ,str-endpoint :query query))
(defun ,(symbolicate 'update- endpoint) (content) (defun ,(symbolicate 'update- endpoint) (content)
(%request :patch ,str-endpoint :content content)) (%request :patch ,str-endpoint :content content))
nil))) nil)))