;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; REST API bindings for paste.sr.ht
;;;
;;; Copyright (c) 2019, Evan Hanson
;;;
;;; See LICENSE for details.
;;;

(declare (module (topham paste))
         (export blob paste pastes))

(import (chicken format)
        (chicken keyword)
        (chicken type)
        (topham))

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

(define-inline (make-paste #!key (filename 'null) contents (visibility "unlisted"))
  `((visibility . ,visibility)
    (files . #(((filename . ,filename)
                (contents . ,contents))))))

;;
;; https://man.sr.ht/paste.sr.ht/api.md#get-apipastes
;;
(: pastes (-> (list-of pair)))
(define (pastes)
  (make-crud "/api/pastes"))

;;
;; https://man.sr.ht/paste.sr.ht/api.md#get-apiblobssha
;;
(: blob (string -> (list-of pair)))
(define (blob sha)
  (make-crud (format "/api/blobs/~A" sha)))

;;
;; https://man.sr.ht/paste.sr.ht/api.md#get-apipastessha
;; https://man.sr.ht/paste.sr.ht/api.md#post-apipastes
;;
(: paste (#!optional any #!rest any -> (list-of pair)))
(define (paste #!optional id #!rest details)
  (cond
    ((string? id)
     (make-crud (format "/api/pastes/~A" id)))
    ((get-keyword #:contents (cons id details))
     (make-crud "/api/pastes" (apply make-paste id details)))
    (else
     (signal-condition
      '(topham)
      '(arity)
      '(exn location paste message "paste id or #:contents must be given")))))