;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 pukkamustard <pukkamustard@posteo.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix eris)

  #:use-module (eris)
  #:use-module (eris fs)
  #:use-module (eris sqlite)
  #:use-module (sqlite3)
  #:use-module (eris coap)
  #:use-module (eris read-capability)

  #:use-module (coap tcp)

  #:use-module (web uri)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-171)

  #:export (%eris-store-url
            eris-encode-store-item
            eris-decode-store-item))

(define %eris-store-url
  (make-parameter
   (getenv "ERIS_STORE_URL")
   (lambda (val)
     (cond
      ((uri? val) val)
      ((string? val) (string->uri val))
      (else #f)))))

(define %guix-eris-convergence-secret
  (make-parameter %null-convergence-secret))

(define (open-coap-unix-socket path)
  (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
    ;; Release FD on exec
    (fcntl sock F_SETFD FD_CLOEXEC)
    ;; Set to non-blocking
    (fcntl sock F_SETFL (logior O_NONBLOCK (fcntl sock F_GETFL)))
    ;; Connect
    (connect sock AF_UNIX path)

    ;; Initialize the CoAP connection
    (open-socket-for-uri #f
                         #:socket sock
                         ;; Allow up to 64 in-flight requests
                         #:nstart 64)))

(define (guix-eris-block-reducer)
  "Returns an ERIS block reducer."
  (let ((store-url (%eris-store-url)))
    (if (uri? store-url)
        (match (uri-scheme store-url)

          ;; Store blocks in an SQLite database (see
          ;; https://eris.codeberg.page/eer/sqlite.xml)
          ('sqlite
           (eris-sqlite-block-reducer (uri-path store-url)))

          ;; Connect to a CoAP ERIS store over a Unix socket
          ('coap+unix
           ;; Wrap the eris-coap-block-reducer to close the provided connection.
           (let ((ecbr (eris-coap-block-reducer
                      (build-uri 'coap #:path ".well-known/eris")
                      #:nstart 64
                      #:connection (open-coap-unix-socket
                                    (uri-path store-url)))))
             (case-lambda
               (() (ecbr))
               ((conn ref-block) (ecbr conn ref-block))
               ((conn)
                (ecbr conn)))))

          ;; TODO
          ;; ('coap+tcp #f)

          (_ (error "Don't know how to handle ERIS store URL "
                    (uri->string (%eris-store-url)))))

        ;; If no ERIS store URL is provided we just compute the ERIS URN without
        ;; storing the blocks anywhere. As dummy block-reducer we use `rcount` from
        ;; SRFI-171 that counts the number of blocks.
        rcount)))

(define (call-with-guix-eris-block-ref proc)
  (let ((store-url (%eris-store-url)))
    (if (uri? store-url)
        (match (uri-scheme store-url)

          ('sqlite
           (let ((db (eris-sqlite-open (uri-path store-url))))
             (proc (lambda (ref) (eris-sqlite-ref db ref)))
             (sqlite-close db)))

          ('coap+unix
           (let ((conn (open-coap-unix-socket (uri-path store-url)))
                 (req-uri (build-uri 'coap #:path ".well-known/eris")))
             (proc
              (lambda (ref)
                (eris-coap-block-ref req-uri ref #:connection conn)))
             (close-port conn)))

          (_ (error "Don't know how to handle ERIS store URL "
                    (uri->string (%eris-store-url)))))

        (error "No ERIS store to get blocks."))))

(define* (eris-encode-store-item item)
  "Encodes the store item ITEM using ERIS and returns the read capability as
string."
  (eris-fs-encode item
                  #:convergence-secret (%guix-eris-convergence-secret)
                  #:block-reducer (guix-eris-block-reducer)))

(define* (eris-decode-store-item eris-urn destination)
  "Decode a store item with read-capability ERIS-URN to DESTINATION."
  (call-with-guix-eris-block-ref
   (lambda (block-ref)
     (eris-fs-decode eris-urn destination
                     #:block-ref block-ref)
     #t)))