From patchwork Thu Dec 29 18:13:27 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: pukkamustard X-Patchwork-Id: 45681 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 6C9FE27BBE9; Thu, 29 Dec 2022 18:24:18 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 31D0C27BBEB for ; Thu, 29 Dec 2022 18:24:15 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pAxQs-0000Ea-SQ; Thu, 29 Dec 2022 13:15:10 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pAxQn-0000Bl-Ni for guix-patches@gnu.org; Thu, 29 Dec 2022 13:15:05 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pAxQn-0004EG-2P for guix-patches@gnu.org; Thu, 29 Dec 2022 13:15:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pAxQm-0007S1-Tl for guix-patches@gnu.org; Thu, 29 Dec 2022 13:15:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#52555] [PATCH v3 8/8] eris: Use IPFS to get ERIS blocks. Resent-From: pukkamustard Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 29 Dec 2022 18:15:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 52555 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 52555@debbugs.gnu.org Cc: pukkamustard Received: via spool by 52555-submit@debbugs.gnu.org id=B52555.167233767928531 (code B ref 52555); Thu, 29 Dec 2022 18:15:04 +0000 Received: (at 52555) by debbugs.gnu.org; 29 Dec 2022 18:14:39 +0000 Received: from localhost ([127.0.0.1]:32816 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pAxQM-0007Q1-Hg for submit@debbugs.gnu.org; Thu, 29 Dec 2022 13:14:39 -0500 Received: from mout01.posteo.de ([185.67.36.65]:53869) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pAxQE-0007OQ-Qi for 52555@debbugs.gnu.org; Thu, 29 Dec 2022 13:14:31 -0500 Received: from submission (posteo.de [185.67.36.169]) by mout01.posteo.de (Postfix) with ESMTPS id 5344A240088 for <52555@debbugs.gnu.org>; Thu, 29 Dec 2022 19:14:25 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1672337665; bh=1ogSyEzUNPD6uxAMuJO0N6UJzwGcBVN8M95yEFq6iSg=; h=From:To:Cc:Subject:Date:From; b=PsqLYn5BSuPS81ye/XQCTbgoapQ1MIV5u3cQWqnJeRK3FCxPgTSmjPTsS2OUkhBhL esReGJOJ8q2ntO8AnA4mQEVRUKBR/0pnyA5I9jUlYA8MzSF7Qcccgek4xxupYz6xsN 0rREYoR6WZ77FmDIhlQ3Y4m9FG6AzHotCxxFPhgBJdlESKG9H+esB7R3yAsPgQfwvy wPTonuHO5GrtUSlQDoRGuiZfd0zEyuwUt5bI1KCEJixs2bdJQj9F3tSrFqnLdRtnuC FQfNlD+LEZbIYR1PsyJ2OW6FmS9NxXULFTtBKe8O/is2EKNNPvW89VqXpl5kQRC15C NhXDM3jf2vc8w== Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4Njc3h5D1Mz6tml; Thu, 29 Dec 2022 19:14:24 +0100 (CET) From: pukkamustard Date: Thu, 29 Dec 2022 18:13:27 +0000 Message-Id: <20221229181327.758-9-pukkamustard@posteo.net> In-Reply-To: <20221229181327.758-1-pukkamustard@posteo.net> References: <20221229181327.758-1-pukkamustard@posteo.net> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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 +;;; 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))