summaryrefslogtreecommitdiff
path: root/neocities/api.scm
blob: a2017a7d8b1b905ded69e203dbfed13cce5a779b (plain)
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
;; neocities/api --- neocities api implementation -*- coding: utf-8 -*-
;;
;; Copyright (C) 2023 Ekaitz Zarraga <ekaitz@elenq.tech>
;;
;; Author: Ekaitz Zarraga <ekaitz@elenq.tech>
;;
;; This file is part of guile-neocities.
;;
;; guile-neocities 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.
;;
;; guile-neocities 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 guile-neocities; if not, contact:
;;
;; Free Software Foundation           Voice:  +1-617-542-5942
;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
;; Boston, MA  02111-1307,  USA       gnu@gnu.org

(define-module (neocities api)
  #:use-module (neocities requests)
  #:use-module (rnrs base)
  #:use-module (srfi srfi-9)
  #:export (
    make-neocities-api
    make-neocities-auth-basic
    make-neocities-auth-api-key
    neocities-delete
    neocities-info
    neocities-list
    neocities-key
    neocities-upload
))

(define-record-type <neocities-auth-api-key>
  (make-neocities-auth-api-key key)
  neocities-auth-api-key?
  (key neocities-auth-api-key))

(define-record-type <neocities-auth-basic>
  (make-neocities-auth-basic username password)
  neocities-auth-basic?
  (username neocities-auth-basic-username)
  (password neocities-auth-basic-password))

(define (encode-auth auth)
  (cond
    ((neocities-auth-api-key? auth)
     (encode-bearer-auth-header (neocities-auth-api-key auth)))
    ((neocities-auth-basic? auth)
     (encode-basic-auth-header
       (neocities-auth-basic-username auth)
       (neocities-auth-basic-password auth)))
    (else
     (throw 'neocities "Authentication scheme not supported"))))

(define-record-type <neocities-api>
  (_make-neocities-api hostname port auth)
  neocities-api?
  (hostname neocities-api-hostname)
  (port neocities-api-port)
  (auth neocities-api-auth neocities-api-auth-set!))

(define* (make-neocities-api hostname auth #:optional port)
  (_make-neocities-api hostname port auth))


(define* (neocities-delete api files)
  (when (not (list? files))
    (throw 'neocities "files to delete must be a list"))

  (let ((url (neocities-url "delete"
                            #:port (neocities-api-port api)
                            #:hostname (neocities-api-hostname api)
                            #:querystring `(("files" . ,files)))))
    (neocities-request
      'POST
      url
      #:auth (encode-auth (neocities-api-auth api)))))


(define* (neocities-list api #:optional path)
  (let ((url (neocities-url "list"
                            #:hostname (neocities-api-hostname api)
                            #:querystring (if path `(("path" ,path)) '()))))
    (neocities-request
      'GET
      url
      #:auth (encode-auth (neocities-api-auth api)))))

(define* (neocities-info api #:optional sitename)
  ;; It can be unauthenticated, but this is only the authenticated version
  (let ((url (neocities-url "info"
                            #:hostname (neocities-api-hostname api)
                            #:querystring (if sitename
                                            `(("sitename" ,sitename))
                                            '()))))
    (neocities-request
      'GET
      url
      #:auth (encode-auth (neocities-api-auth api)))))

(define* (neocities-key api)
  (let ((url (neocities-url "key"
                            #:hostname (neocities-api-hostname api))))
    (neocities-request
      'GET
      url
      #:auth (encode-auth (neocities-api-auth api)))))

(define* (neocities-upload api files)
  "files is an alist with the filename and destination"
  (let ((url (neocities-url "upload"
                            #:hostname (neocities-api-hostname api))))
    (let-values (((boundary body) (encode-multipart-body files)))
      (neocities-request
        'POST
        url
        #:content-type (string-append "multipart/form-data; boundary="  boundary)
        #:body body
        #:auth (encode-auth (neocities-api-auth api))))))