;;; GNU Guix --- Functional package management for GNU ;;; 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 . (define-module (guix eris fs-store) #:use-module (rnrs io ports) #:use-module (guix build utils) ; for mkdir-p #:use-module (eris utils base32) #:export (eris-fs-store-reducer eris-fs-store-ref)) ;;; Commentary: ;;; ;;; This module provides a file-system based store of ERIS encoded blocks. ;;; ;;; Code: (define (eris-fs-store-reducer store-directory) (case-lambda (() (mkdir-p store-directory)) ((result) result) ((_ ref-block) (let* ((ref (car ref-block)) (b32 (base32-encode ref)) (pre (substring b32 0 2)) (suf (substring b32 2)) (pre-dir (string-append store-directory "/" pre)) (path (string-append pre-dir "/" suf)) (block (cdr ref-block))) (mkdir-p pre-dir) (unless (file-exists? path) (call-with-output-file path (lambda (port) (put-bytevector port block)) #:binary #t)) #t)))) (define* (eris-fs-store-ref ref #:key store-directory) (let* ((b32 (base32-encode ref)) (pre (substring b32 0 2)) (suf (substring b32 2)) (path (string-append store-directory "/" pre "/" suf))) (if (file-exists? path) (call-with-input-file path (lambda (port) (get-bytevector-all port)) #:binary #t) #f)))