#!/usr/bin/guile \
--no-auto-compile -e main -s
!#

(use-modules (ice-9 binary-ports)
             (ice-9 exceptions)
             (ice-9 match)
             (json)
             (srfi srfi-1)
             (srfi srfi-26)
             (srfi srfi-71)
             (web client)
             (web response)
             (web uri))

(define gitlab-token (string-trim (getenv "GITLAB_TOKEN")))
(define base-url "https://gitlab.com/api/v4")

(define (encode-query alist)
  "Encode an association list as a query string. The keys should be symbols and the
values strings or #f, in which case the parameter is skipped."
  (fold (match-lambda*
          (((k . v) s)
           (if v
               (string-append s
                              (if (zero? (string-length s)) "" "&")
                              (symbol->string k)
                              "="
                              (uri-encode v))
               s)))
        ""
        alist))

(define (json-response? res)
  (eq? 'application/json (car (response-content-type res))))

(define (json-ok? res)
  (and (= 200 (response-code res))
       (json-response? res)))

(define-exception-type &api-error &external-error
  make-api-error
  api-error?
  (endpoint api-error-endpoint)
  (status-code api-error-status-code)
  (body api-error-body))

(define* (api-call method endpoint #:key query payload (ok? json-ok?) (post-proc identity))
  (let* ((res body (method (if query
                               (string-append base-url endpoint "?" (encode-query query))
                               (string-append base-url endpoint))
                           #:headers `((private-token . ,gitlab-token)
                                       (content-type . (application/json (charset . "utf-8"))))
                           #:body (if payload (scm->json payload) #f)))
         (body (if (json-response? res) (call-with-input-bytevector body json->scm) body)))
    (if (ok? res)
        (post-proc body)
        (raise-exception (make-api-error endpoint (response-code res) body)))))

(define (list-merge-requests params)
  (api-call http-get "/merge_requests" #:query params #:post-proc vector->list))

(define (field-equal? field-name value)
  (lambda (alist)
    (equal? (assoc-ref alist field-name) value)))

(define (main args)
  (for-each (cut format #t "~a~%" <>)
            (map (cut assoc-ref <> "web_url")
                 (filter (field-equal? "title" "Build: add pip-audit to pipeline")
                         (list-merge-requests '((state . "opened") (author_username . "ray33")))))))