~evhan/chicken-sourcehut: sourcehut.meta.scm - sourcehut git


                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; REST API bindings for meta.sr.ht
;;;
;;; Copyright (c) 2019-2020, Evan Hanson
;;;
;;; See LICENSE for details.
;;;

(declare (module (sourcehut meta))
         (export profile audit-log
                 ssh-key ssh-keys
                 pgp-key pgp-keys))

(import (chicken format)
        (chicken keyword)
        (chicken type)
        (sourcehut))

(define-inline (make-crud path #!optional (body '()))
  `((#:service "meta" #:path ,path) . ,body))

(define-inline (make-ssh-key #!key ssh-key)
  `((ssh-key . ,ssh-key)))

(define-inline (make-pgp-key #!key pgp-key)
  `((pgp-key . ,pgp-key)))

;;
;; https://man.sr.ht/meta.sr.ht/user-api.md#get-apiuserprofile
;; https://man.sr.ht/meta.sr.ht/user-api.md#put-apiuserprofile
;;
(: profile (#!rest any -> (list-of pair)))
(define (profile #!rest args)
  (make-crud "/api/user/profile" (keyword-arguments->alist args)))

;;
;; https://man.sr.ht/meta.sr.ht/user-api.md#get-apiuseraudit-log
;;
(: audit-log (-> (list-of pair)))
(define (audit-log)
  (make-crud "/api/user/audit-log"))

;;
;; https://man.sr.ht/meta.sr.ht/user-api.md#get-apiuserssh-keys
;;
(: ssh-keys (-> (list-of pair)))
(define (ssh-keys)
  (make-crud "/api/user/ssh-keys"))

;;
;; https://man.sr.ht/meta.sr.ht/user-api.md#get-apiuserssh-keysid
;; https://man.sr.ht/meta.sr.ht/user-api.md#post-apiuserssh-keys
;;
(: ssh-key (#!optional any #!rest any -> (list-of pair)))
(define (ssh-key #!optional id #!rest details)
  (cond
    ((integer? id)
     (make-crud (format "/api/user/ssh-keys/~A" id)))
    ((get-keyword #:ssh-key (cons id details))
     (make-crud "/api/user/ssh-keys" (apply make-ssh-key id details)))
    (else
     (signal-condition
      '(sourcehut)
      '(arity)
      '(exn location ssh-key message "ssh-key id or #:ssh-key must be given")))))

;;
;; https://man.sr.ht/meta.sr.ht/user-api.md#get-apiuserpgp-keys
;;
(: pgp-keys (-> (list-of pair)))
(define (pgp-keys)
  (make-crud "/api/user/pgp-keys"))

;;
;; https://man.sr.ht/meta.sr.ht/user-api.md#get-apiuserpgp-keysid
;; https://man.sr.ht/meta.sr.ht/user-api.md#post-apiuserpgp-keys
;;
(: pgp-key (#!optional any #!rest any -> (list-of pair)))
(define (pgp-key #!optional id #!rest details)
  (cond
    ((integer? id)
     (make-crud (format "/api/user/pgp-keys/~A" id)))
    ((get-keyword #:pgp-key (cons id details))
     (make-crud "/api/user/pgp-keys" (apply make-pgp-key id details)))
    (else
     (signal-condition
      '(sourcehut)
      '(arity)
      '(exn location pgp-key message "pgp-key id or #:pgp-key must be given")))))