;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Ludovic Courtès ;;; Copyright © 2022 pukkamustard ;;; ;;; 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 . ;;; Commentary: ;;; ;;; This module provides an interface to the IPFS daemons HTTP API for storing ;;; and retrieving blocks. This can be used to store blocks of ERIS encoded ;;; content. ;;; ;;; See also the IPFS API documentation: ;;; https://docs.ipfs.io/reference/http/api/#api-v0-block-put (define-module (guix eris ipfs) #:use-module (eris utils base32) #:use-module (sodium generichash) #:use-module (json) #:use-module (web uri) #:use-module (web client) #:use-module (web response) #:use-module (srfi srfi-71) #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) #:use-module ((guix build download) #:select ((open-connection-for-uri . guix:open-connection-for-uri))) #:export (%ipfs-base-url eris-ipfs-reducer eris-ipfs-ref)) ;; CID encoding ;; Multicodec codes ;; (https://github.com/multiformats/multicodec/blob/master/table.csv) (define multicodec-raw-code #x55) (define multicodec-blake2b-256-code #xb220) (define (blake2b-256->binary-cid hash) "Encode a Blake2b-256 hash as binary CID" (call-with-values (lambda () (open-bytevector-output-port)) (lambda (port get-bytevector) ;; CID version (put-u8 port 1) ;; multicoded content-type (put-u8 port multicodec-raw-code) ;; set multihash to blake2b-256. This is the manually encoded varint of ;; 0xb220 (put-u8 port 160) (put-u8 port 228) (put-u8 port 2) ;; set hash lenght (put-u8 port 32) ;; and finally the hash itself (put-bytevector port hash) ;; finalize and get the bytevector (get-bytevector)))) (define (binary-cid->cid bcid) "Encode a binary CID as Base32 encoded CID" ;; 'b' is the multibsae code for base32 (string-append "b" ;; the IPFS daemon uses lower-case, so to be consistent we ;; also. (string-downcase ;; base32 encode the binary cid (base32-encode bcid)))) (define blake2b-256->cid (compose binary-cid->cid blake2b-256->binary-cid)) ;; IPFS API (define %ipfs-base-url ;; URL of the IPFS gateway. (make-parameter "http://localhost:5001")) (define* (call url decode #:optional (method http-post) #:key port body (false-if-404? #t) (headers '()) (keep-alive #t) (open-connection guix:open-connection-for-uri) (timeout 10)) "Invoke the endpoint at URL using METHOD. Decode the resulting JSON body using DECODE, a one-argument procedure that takes an input port; when DECODE is false, return the input port. When FALSE-IF-404? is true, return #f upon 404 responses." (let* ((url (if (string? url) (string->uri url) url)) (port (or port (open-connection url #:timeout timeout))) (response response-port (if keep-alive (method url #:streaming? #t #:body body #:port port #:keep-alive? #t) (method url #:streaming? #t #:body body #:port port ;; IPFS daemon seems to responds with bad ;; request if PUT requests are kept alive and ;; do not have "Connection: close" header. #:keep-alive? #f #:headers `((connection close) ,@headers))))) (cond ((= 200 (response-code response)) (if decode (let ((result (decode response-port))) (close-port response-port) result) response-port)) ((and false-if-404? (= 404 (response-code response))) (close-port response-port) #f) (else (close-port response-port) (format #t "~a\n" response) (throw 'ipfs-error url response))))) (define-syntax-rule (false-if-ipfs-error exp) "Return $f if EXP triggers a network related or IPFS related exception." (with-exception-handler (lambda (exn) (let ((kind (exception-kind exn)) (errno (system-error-errno (cons 'system-error (exception-args exn))))) (cond ((= errno ECONNREFUSED) #f) (else (raise-exception exp))))) (lambda () exp) #:unwind? #t)) (define %multipart-boundary ;; XXX: We might want to find a more reliable boundary. (string-append (make-string 24 #\-) "2698127afd7425a6")) (define (bytevector->form-data bv port) "Write to PORT a 'multipart/form-data' representation of BV." (display (string-append "--" %multipart-boundary "\r\n" "Content-Disposition: form-data\r\n" "Content-Type: application/octet-stream\r\n\r\n") port) (put-bytevector port bv) (display (string-append "\r\n--" %multipart-boundary "--\r\n") port)) (define (ipfs-block-put bv) "Store a block on IPFS and return the CID of the block" (call (string-append (%ipfs-base-url) "/api/v0/block/put" "?format=raw&mhtype=blake2b-256") (lambda (port) (assoc-ref (json->scm port) "Key")) #:headers `((content-type . (multipart/form-data (boundary . ,%multipart-boundary)))) #:body (call-with-bytevector-output-port (lambda (port) (bytevector->form-data bv port))) ;; IPFS daemon does not seem to accept connection re-use when putting ;; blocks. #:keep-alive #f)) (define* (ipfs-block-get cid #:key (open-connection guix:open-connection-for-uri)) "Get a block from IPFS via the HTTP API" (false-if-ipfs-error (call (string-append (%ipfs-base-url) "/api/v0/block/get" "?arg=" cid) get-bytevector-all #:timeout 5 #:open-connection open-connection))) ;; ERIS block reducer (define eris-ipfs-reducer (case-lambda ;; initialization. Nothing to do here. In an improved implementation we ;; might create a single HTTP connection and reuse it for all blocks. (() '()) ;; Completion. Again, nothing to do. ((_) 'done) ;; store a block ((_ ref-block) ;; ref-block is a pair consisting of the reference to the block and the ;; block itself. (ipfs-block-put (cdr ref-block))))) (define* (eris-ipfs-ref ref #:key (open-connection guix:open-connection-for-uri)) "Dereference a block from IPFS" (ipfs-block-get (blake2b-256->cid ref) #:open-connection open-connection))