Package: guix-patches;
Reported by: pukkamustard <pukkamustard <at> posteo.net>
Date: Thu, 16 Dec 2021 16:18:02 UTC
Severity: important
Tags: patch
Message #166 received at 52555 <at> debbugs.gnu.org (full text, mbox):
From: pukkamustard <pukkamustard <at> posteo.net> To: 52555 <at> debbugs.gnu.org Cc: pukkamustard <pukkamustard <at> posteo.net> Subject: [PATCH v3 8/8] eris: Use IPFS to get ERIS blocks. Date: Thu, 29 Dec 2022 18:13:27 +0000
* guix/eris/ipfs.scm: New files.
* Makefile.am (MODULES): Add it.
* guix/eris.scm (%eris-peers): Add IPFS.
(peer->block-ref): Handle IPFS peer.
---
Makefile.am | 1 +
guix/eris.scm | 32 ++++---
guix/eris/ipfs.scm | 214 +++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 237 insertions(+), 10 deletions(-)
create mode 100644 guix/eris/ipfs.scm
diff --git a/Makefile.am b/Makefile.am
index 373f6b7c27..6f648a40a3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -135,6 +135,7 @@ MODULES = \
guix/eris.scm \
guix/eris/fs-store.scm \
guix/eris/http.scm \
+ guix/eris/ipfs.scm \
guix/platform.scm \
guix/platforms/arm.scm \
guix/platforms/mips.scm \
diff --git a/guix/eris.scm b/guix/eris.scm
index d56643bec4..5b0c1ee36b 100644
--- a/guix/eris.scm
+++ b/guix/eris.scm
@@ -22,6 +22,7 @@ (define-module (guix eris)
#:use-module (guix config)
#:use-module (guix eris fs-store)
#:use-module (guix eris http)
+ #:use-module (guix eris ipfs)
#:use-module (web uri)
#:use-module (ice-9 match)
@@ -42,8 +43,10 @@ (define (guix-eris-block-reducer)
(define %eris-peers
(make-parameter
- ;; TODO
- (list (string->uri "http://localhost:8081"))))
+ ;; TODO: make ERIS peers configurable somewhere
+ (list
+ (string->uri "http://localhost:8081")
+ 'ipfs)))
(define* (try-in-order ref #:key block-refs)
(match block-refs
@@ -55,18 +58,27 @@ (define* (try-in-order ref #:key block-refs)
(() #f)))
(define* (peer->block-ref peer #:key open-connection)
- (case (uri-scheme peer)
+ (cond
+ ((uri? peer) (case (uri-scheme peer)
- ((http https)
- (lambda (ref)
- (eris-http-block-ref ref
- #:host peer
- #:open-connection open-connection)))
+ ((http https)
+ (lambda (ref)
+ (eris-http-block-ref ref
+ #:host peer
+ #:open-connection open-connection)))
- ;; unsupported ERIS peer URL
- (else (lambda (_) #f))))
+ ;; unsupported ERIS peer URL
+ (else (lambda (_) #f))))
+
+ ((eqv? 'ipfs peer)
+ (lambda (ref)
+ (eris-ipfs-ref ref #:open-connection open-connection)))))
(define* (guix-eris-block-ref ref #:key open-connection)
+ "Attempts to dereference a block of some ERIS encoded content with reference
+REF. First the local block store is checked, followed by remote peers as
+configured in the parameter %eris-peers (in order). Returns #f if the block
+could not be de-referenced."
(try-in-order
ref
#:block-refs
diff --git a/guix/eris/ipfs.scm b/guix/eris/ipfs.scm
new file mode 100644
index 0000000000..9771414e7b
--- /dev/null
+++ b/guix/eris/ipfs.scm
@@ -0,0 +1,214 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2022 pukkamustard <pukkamustard <at> 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/>.
+
+
+;;; 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))
--
2.38.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.