[elpa] externals/srht 81519fed59 15/27: Add git service bindings.

[ELPA Syncer]

branch: externals/srht
commit 81519fed590f921044fee37e1b93a57331bb90fa
Author: Aleksandr Vityazev <avityazev@posteo.org>
Commit: Aleksandr Vityazev <avityazev@posteo.org>

    Add git service bindings.
---
 lisp/srht-git.el   | 165 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 lisp/srht-paste.el |   7 +--
 lisp/srht.el       |   9 +--
 tests/test.el      |  27 ++++++++-
 4 files changed, 198 insertions(+), 10 deletions(-)

diff --git a/lisp/srht-git.el b/lisp/srht-git.el
new file mode 100644
index 0000000000..93174bdd8d
--- /dev/null
+++ b/lisp/srht-git.el
@@ -0,0 +1,165 @@
+;;; srht-git.el --- Sourcehut git                    -*- lexical-binding: t; 
-*-
+
+;; Copyright © 2022 Aleksandr Vityazev <avityazev@posteo.org>
+
+;; Created: <2022-04-26 Tue>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; https://man.sr.ht/git.sr.ht/api.md
+;;
+
+;;; Code:
+
+(require 'srht)
+
+(defun srht-git--make-crud (path &optional body form)
+  "Make crud for git service.
+PATH is the path for the URI.  BODY is the body sent to the URI.
+FORM is a content type."
+  (srht-generic-crud 'git path body form))
+
+(defun srht-git-user (&optional username)
+  "Retrieves a user resource.
+If USERNAME is nil, the authenticated user is assumed."
+  ;; TODO: tilda in username
+  (let ((path (if username
+                  (concat "/api/user/" username)
+                "/api/user")))
+    (srht-git--make-crud path)))
+
+;; (srht-retrive (srht-git-user "~akagi"))
+;; (srht-retrive (srht-git-user "~sircmpwn"))
+
+(defun srht-git-repos (&optional username)
+  "Retrive list of repository resources owned by this USERNAME.
+If USERNAME is nil the authenticated user is assumed."
+  (let ((path (if username
+                  (format "/api/%s/repos" username)
+                "/api/repos")))
+    (srht-git--make-crud path)))
+
+;; (setq akagi-repos-test (srht-retrive (srht-git-repos)))
+
+(cl-defun srht-git-make (&key (visibility "unlisted") description name)
+  "Make paste parameters.
+VISIBILITY must be one of \"public\", \"private\", or \"unlisted\".
+DESCRIPTION is repository description, markdown is allowed.
+NAME is repository name."
+  (cl-assert (or (member visibility '("unlisted" "public" "private"))
+                 (not (null name))))
+  `((name . ,name)
+    (description . ,description)
+    (visibility . ,visibility)))
+
+;; (srht-git-make :visibility "ulnlisted" :name "test-repo" :description "hi")
+;; (srht-git-make :visibility "ulnlisted" :description "hi")
+;; (json-encode (srht-git-make :visibility "unlisted" :name "test-repo" 
:description "hi"))
+
+(defun srht-git-repo (repo-name &optional username &rest details)
+  "Create, retrieve, delete or update a git repository.
+
+When retrieving, deleting or updating a repository, REPO-NAME must be
+the name of an existing repository.
+
+When retrieving if USERNAME is nil the authenticated user is assumed.
+
+When updating DETAILS, you must specify DETAILS (see `srht-git-make').
+;; NOTE: Updating the name will create a redirect.
+
+When creating repository omit REPO-NAME and specify DETAILS
+\(see `srht-git-make'\)."
+  (cond
+   ((and (stringp repo-name) (stringp username))
+    (srht-git--make-crud (format "/api/%s/repos/%s" username repo-name)))
+   ((stringp repo-name) (srht-git--make-crud (format "/api/repos/%s" 
repo-name)))
+   (t (srht-git--make-crud "/api/repos" (apply #'srht-git-make details)))))
+
+(defmacro srht-git--endpoints (endpoint name username &optional body form)
+  "Generate crud for ENDPOINT and repository NAME.
+If USERNAME is nil the authenticated user is assumed.
+BODY is the body sent to the URI.
+FORM is a content type."
+  (let ((path (gensym "path")))
+    `(let ((,path (if ,username
+                      (format "/api/%s/repos/%s/%s" ,username ,name ,endpoint)
+                    (format "/api/repos/%s/%s" ,name ,endpoint))))
+       (srht-git--make-crud ,path ,body ,form))))
+
+(defun srht-git--endpoint-widen (func name end &optional username body)
+  "TODO: doc."
+  (let* ((plist (if body
+                    (funcall func name username body)
+                  (funcall func name username)))
+         (path (plist-get plist :path)))
+    (setf (plist-get plist :path)
+          (concat path "/" end))
+    plist))
+
+(defun srht-git--artifact (name username body)
+  "TODO: doc."
+  (srht-git--endpoints "artifacts" name username body "multipart/form-data"))
+
+(defun srht-git-repo-readme (name &optional username body form)
+  "Retrieve, update or delete README override for repository NAME.
+
+If USERNAME is nil the authenticated user is assumed.
+BODY is the body sent to the URI.  FORM is a content type."
+  (srht-git--endpoints "readme" name username body form))
+
+(defun srht-git-repo-refs (name &optional username)
+  "Endpoints for fetching git data from repository NAME.
+If USERNAME is nil the authenticated user is assumed."
+  (srht-git--endpoints "refs" name username))
+
+(defun srht-git-repo-log (name &optional username)
+  "List of the latest commit log for repository NAME.
+If USERNAME is nil the authenticated user is assumed."
+  (srht-git--endpoints "log" name username))
+
+(defun srht-git-repo-artifact (name ref body &optional username)
+  "Attaches a file artifact to the specified REF and repository NAME.
+Note: this endpoint does not accept JSON.  Submit your request
+as `multipart/form-data', with a single field: file in BODY."
+  (srht-git--endpoint-widen #'srht-git--artifact name ref username body))
+
+(defun srht-git-repo-log-ref (name ref &optional username)
+  "List of the latest commit resources starting from the given REF.
+NAME is a repository name.  If USERNAME is nil the authenticated user
+is assumed."
+  (srht-git--endpoint-widen #'srht-git-repo-log name ref username))
+
+(defun srht-git-repo-tree-ref (name ref &optional username)
+  "Return the tree resource for the given REF.
+Following the parent trees until the requested tree is found.
+In other words, this lists the contents of a subdirectory by path.
+NAME is a repository name.  If USERNAME is nil the authenticated user
+is assumed."
+  (srht-git--endpoint-widen #'srht-git-repo-tree name ref username))
+
+(defun srht-git-repo-tree-id (name id &optional username)
+  "Return the tree resource with the given ID.
+NAME is a repository name.  If USERNAME is nil the authenticated user
+is assumed."
+  (srht-git--endpoint-widen #'srht-git-repo-tree name id username))
+
+(defun srht-git-repo-tree (name &optional username)
+  "Return the tree resource for the latest commit to the default branch.
+NAME is a repository name.  If USERNAME is nil the authenticated user
+is assumed."
+  (srht-git--endpoints "tree" name username))
+
+(provide 'srht-git)
+;;; srht-git.el ends here
diff --git a/lisp/srht-paste.el b/lisp/srht-paste.el
index c7365e0959..55c01d43ec 100644
--- a/lisp/srht-paste.el
+++ b/lisp/srht-paste.el
@@ -36,6 +36,7 @@ PATH is the path for the URI.  BODY is the body sent to the 
URI."
 VISIBILITY must be one of \"public\", \"private\", or \"unlisted\".
 FILENAME string or null by default.
 CONTENTS must be a UTF-8 encoded string; binary files are not allowed."
+  (cl-assert (member visibility '("unlisted" "public" "private")))
   `((visibility . ,visibility)
     (files . [((filename . ,filename)
                (contents . ,contents))])))
@@ -93,7 +94,7 @@ specify the DETAILS (see `srht-paste-make') of the paste."
    ((stringp sha)
     (srht-paste--make-crud (format "/api/pastes/%s" sha)))
    ((stringp (plist-get details :contents))
-    (apply #'srht-paste-make details))))
+    (srht-paste--make-crud "/api/pastes" (apply #'srht-paste-make details)))))
 
 (defun srht-paste--get-content ()
   "Extract the content we want to paste.
@@ -156,9 +157,7 @@ Called when the request fails with one argument, a 
‘plz-error’ struct PLZ-ER
                      nil nil (buffer-name))))
   (let ((content (srht-paste--get-content)))
     (srht-create
-     (srht-paste--make-crud
-      "/api/pastes"
-      (srht-paste nil :visibility visibility :filename filename :contents 
content))
+     (srht-paste nil :visibility visibility :filename filename :contents 
content)
      :then (lambda (_resp))
      :else #'srht-paste--else)))
 
diff --git a/lisp/srht.el b/lisp/srht.el
index c27309a97a..7a13ecee43 100644
--- a/lisp/srht.el
+++ b/lisp/srht.el
@@ -109,8 +109,7 @@ request.
 
 PATH is the path for the URI and QUERY is the query for the URI.
 
-If FORM is non nil, the content type used will be
-`multipart/from-data' instead of `application/json'.
+If FORM is nil, the content type used will be `application/json'.
 
 BODY is the body sent to the URI.
 
@@ -119,8 +118,10 @@ THEN (see `plz').
 THEN is a callback function, which is called in the response data.
 ELSE is an optional callback function called when the request
 fails with one argument, a `plz-error' struct."
+  (unless srht-token
+    (error "Need a token"))
   (let ((uri (srht--make-uri service path query))
-        (content-type (if form "multipart/form-data" "application/json")))
+        (content-type (or form "application/json")))
     (plz method uri
       :headers `(,(cons "Content-Type" content-type)
                  ,(cons "Authorization" (concat "token " srht-token)))
@@ -136,7 +137,7 @@ BODY is optional, if it is an empty list, the resulting 
list will not
 contain the body at all.  FORM is optional."
   (let ((crud `(:service ,service :path ,path :form ,form)))
     (if body
-        (append crud `(:body ,(json-encode body)))
+        (append crud `(:body ,(if form body (json-encode body))))
       crud)))
 
 (defun srht--make-crud-request (method args)
diff --git a/tests/test.el b/tests/test.el
index 59bef9fc48..c786375019 100644
--- a/tests/test.el
+++ b/tests/test.el
@@ -27,13 +27,36 @@
 (require 'ert)
 (require 'srht)
 (require 'srht-paste)
+(require 'srht-git)
 
-(ert-deftest test-srht-paste ()
+(ert-deftest srht-paste ()
   (should (equal (srht-paste "489fa091d5c6d5751769375a6f0e00447347adff")
                  '(:service paste
                    :path "/api/pastes/489fa091d5c6d5751769375a6f0e00447347adff"
                    :form nil))))
 
-(ert 'test-srht-paste)
+(ert-deftest srht-git-repo-retrive ()
+  (pcase-let (((map (:path name)) (srht-git-repo "srht.el")))
+    (should (equal "/api/repos/srht.el" name))))
+
+;; (srht-retrive (srht-git-repo "srht.el"))
+;; (srht-retrive (srht-git-repo "rrr" "~akagi"))
+;; (srht-git-repo nil "~akagi" :visibility "ulnlisted" :name "test-repo" 
:description "hi")
+;; (srht-git-repo nil nil :visibility "ulnlisted" :name "test-repo" 
:description "hi")
+
+;; (srht-retrive (srht-git-repo-readme "rrr")) 404 error
+;; (srht-retrive (srht-git-repo-readme "srht.el" "~akagi")) 404 error
+;; (srht-git-repo-readme "srht.el" "~akagi" "hello" "text/html")
+
+;; (srht-retrive (srht-git-repo-refs "rrr"))
+
+;; (srht-git-repo-artifact "rrr" "refs/heads/master" "hello" "~akagi")
+
+;; (setq test-log-1 (srht-retrive `(:next 2 ,@(srht-git-repo-log "rrr" 
"~akagi"))))
+
+;; (srht-retrive (srht-git-repo-log-ref "rrr" "refs/heads/master" "~akagi"))
+
+;; (srht-retrive (srht-git-repo-tree "rrr"))
+
 (provide 'test)
 ;;; test.el ends here