[gnunet-scheme] 02/02: Support constructing /:msg:fs:request-loc-signature (wip).

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 53ef1e2bac244102fd88e77f3928c583680b0570
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Nov 28 20:32:49 2022 +0100

    Support constructing /:msg:fs:request-loc-signature (wip).
    
    * gnu/gnunet/fs/network.scm: New module.
    * Makefile.am (modules): Register new module.
---
 Makefile.am               |  1 +
 gnu/gnunet/fs/network.scm | 70 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+)

diff --git a/Makefile.am b/Makefile.am
index 79a5354..05b5bf4 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -88,6 +88,7 @@ modules = \
   gnu/gnunet/dht/struct.scm \
   \
   gnu/gnunet/fs/client.scm \
+  gnu/gnunet/fs/network.scm \
   gnu/gnunet/fs/struct.scm \
   gnu/gnunet/fs/uri.scm \
   \
diff --git a/gnu/gnunet/fs/network.scm b/gnu/gnunet/fs/network.scm
new file mode 100644
index 0000000..981ecac
--- /dev/null
+++ b/gnu/gnunet/fs/network.scm
@@ -0,0 +1,70 @@
+;#!r6rs
+;; This file is part of Scheme-GNUnet
+;; Copyright © 2022 GNUnet e.V.
+;;
+;; Scheme-GNUnet is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU Affero General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; Scheme-GNUnet 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
+;; Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; SPDX-License-Identifier: AGPL-3.0-or-later
+
+;; TODO: untested
+(define-library (gnu gnunet fs network)
+  (export construct-request-loc-signature)
+  (import (only (rnrs base) define define-syntax quote)
+         (only (guile) begin define*)
+         (only (gnu gnunet utils bv-slice)
+               make-slice/read-write slice-copy! slice-length )
+         (only (gnu extractor enum) value->index symbol-value)
+         (only (gnu gnunet message protocols) message-type)
+         (only (gnu gnunet fs struct) /:msg:fs:request-loc-signature)
+         (only (gnu gnunet fs uri)
+               chk-key ;; TODO rename
+               chk-query)
+         (only (gnu gnunet hashcode)
+               hashcode:512->slice)
+         (only (gnu gnunet utils cut-syntax) cut-syntax)
+         (only (gnu gnunet netstruct syntactic)
+               set%! sizeof select))
+  (begin
+    ;; GNUNET_SIGNATURE_PURPOSE_PEER_PLACEMENT,
+    ;; (see gnunet-signatures/gnunet_signatures.rst)
+    (define %purpose-peer-placement 5)
+
+    (define* (construct-request-loc-signature content-hash-key file-length
+                                             expiration-time
+                                             #:key
+                                             (purpose %purpose-peer-placement))
+      "Create a new @code{/:msg:fs:request-loc-signature} message for a file of
+length @var{file-length} with @var{content-hash-key} as content hash key,
+expiring at @var{expiration-time} (TODO type), for @var{purpose}
+(currently always %purpose-peer-placement).  TODO bounds."
+      (define s (make-slice/read-write
+                (sizeof /:msg:fs:request-loc-signature '())))
+      (define-syntax set%!* (cut-syntax set%!
+                                       /:msg:fs:request-loc-signature <> s <>))
+      (define-syntax select* (cut-syntax select
+                                       /:msg:fs:request-loc-signature <> s))
+      (set%!* '(header size) (slice-length s))
+      (set%!* '(header type)
+             (value->index
+              (symbol-value message-type msg:fs:request-loc-signature)))
+      (set%!* '(purpose) purpose)
+      (set%!* '(expiration-time) expiration-time)
+      (slice-copy!
+       (hashcode:512->slice (chk-key content-hash-key))
+       (select* '(content-hash-key key)))
+      (slice-copy!
+       (hashcode:512->slice (chk-query content-hash-key))
+       (select* '(content-hash-key query)))
+      (set%!* '(file-length) file-length)
+      s)))

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.