path: root/gnunet.scm

;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*-
;;;;
;;;; Copyright © 2018 Amirouche Boubekki <amirouche@hypermove.net>
;;;;
;;;; This program 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.
;;;;
;;;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
(define-module (gnunet))

(use-modules ((web uri)))
(use-modules ((ice-9 iconv)))
(use-modules ((rnrs bytevectors)))
(use-modules ((system foreign) #:prefix ffi:))

(use-modules ((bytestructures guile)))
(use-modules ((gnunet config)))


;; XXX: This is broken, do not re-use, see "workaround dynamic-link*"
(define* (dynamic-link* #:optional library-name)
  (let ((shared-object (if library-name (dynamic-link library-name) (dynamic-link))))
    (lambda (return-value function-name . arguments)
      (let ((function (dynamic-func function-name shared-object)))
        (ffi:pointer->procedure return-value function arguments)))))

;; FIXME: this MUST NOT be public, expose exceptions instead
(define-public %gnunet-ok 1)
(define-public %gnunet-system-error -1)
(define-public %gnunet-yes 1)
(define-public %gnunet-no 0)

(define (check value . message)
  "Throw a 'gnunet-error if value is not %gnunet-ok aka. 1"
  (unless (eq? value %gnunet-ok)
    (throw 'gnunet-error message)))

(define (check2 value . message)
  "If value is a %null-pointer throw a 'gnunet-error. Return the value
otherwise"
  (if (eq? value ffi:%null-pointer)
      ;; This is not very clean, it should stop the scheduler
      (throw 'gnunet-error message)
      value))

(define (integer->boolean integer)
  (eq? integer %gnunet-yes))

(define (boolean->integer boolean)
  (if boolean
      %gnunet-yes
      %gnunet-no))

;; bytestructures helper

(define (pointer->bytestructure desc pointer)
  (let ((size (bytestructure-descriptor-size desc)))
    (let ((bv (ffi:pointer->bytevector pointer size)))
      (make-bytestructure bv 0 desc))))

(define bytestructure->pointer (compose ffi:bytevector->pointer
                                        bytestructure-bytevector))

;;; gnunet-util bindings, gnunet_util_lib.h

(define util (dynamic-link* %libgnunet-util))

;; common

(define-public %scheduler-priority-keep 0)
(define-public %scheduler-priority-idle 1)
(define-public %scheduler-priority-background 2)
(define-public %scheduler-priority-default 3)
(define-public %scheduler-priority-high 4)
(define-public %scheduler-priority-ui 5)
(define-public %scheduler-priority-urgent 6)
(define-public %scheduler-priority-shutdown 7)
;; (define-public %scheduler-priority-count 8)

;; configuration

(define-public configuration-create
  (let ((func (util '* "GNUNET_CONFIGURATION_create")))
    (lambda ()
      "Create a new configuration object"
      (func))))

(define-public configuration-destroy!
  (let ((func (util ffi:void "GNUNET_CONFIGURATION_destroy" '*)))
    (lambda (configuration)
      "Destroy configuration object"
      (func configuration))))

(define-public configuration-load!
  (let ((func (util ffi:int "GNUNET_CONFIGURATION_load" '* '*)))
    (lambda (configuration filename)
      "Load configuration. This function will first parse the defaults
and then parse the specific configuration file to overwrite the
defaults."
      (check (func configuration (ffi:string->pointer filename))
             (format #f "Impossible to load configuration at ~a" filename)))))

;; container, gnunet_container_lib.h

(define-public container-meta-data-create
  (let ((func (util '* "GNUNET_CONTAINER_meta_data_create")))
    (lambda ()
      (func))))

;; crypto, gnunet_crypto_lib.h

(define %crypto-hash-code (bs:struct `((bits ,(bs:vector 16 uint32)))))
(define %crypto-short-hash-code (bs:struct `((bits ,(bs:vector 8 uint32)))))

(define %crypto-quality-weak 0)
(define %crypto-quality-strong 1)
(define %crypto-quality-nonce 2)

(define %crypto-hash-ascii-encoded (bs:struct `((encoding ,(bs:vector 104 uint8)))))

(define %crypto-eddsa-signature (bs:struct `((r ,(bs:vector (/ 256 8) uint8))
                                             (s ,(bs:vector (/ 256 8) uint8)))))

(define %crypto-ecdsa-signature (bs:struct `((r ,(bs:vector (/ 256 8) uint8))
                                             (s ,(bs:vector (/ 256 8) uint8)))))

(define %crypto-eddsa-public-key (bs:struct `((q-y ,(bs:vector (/ 256 8) uint8)))))

(define %crypto-ecdsa-public-key (bs:struct `((q-y ,(bs:vector (/ 256 8) uint8)))))

(define %crypto-peer-identity (bs:struct `((public-key ,%crypto-eddsa-public-key))))

(define %crypto-ecdhe-public-key (bs:struct `((q-y ,(bs:vector (/ 256 8) uint8)))))
(define %crypto-ecdhe-private-key (bs:struct `((b ,(bs:vector (/ 256 8) uint8)))))

(define %crypto-ecdsa-private-key (bs:struct `((d ,(bs:vector (/ 256 8) uint8)))))

(define %crypto-eddsa-private-key (bs:struct `((d ,(bs:vector (/ 256 8) uint8)))))

(define %crypto-aes-key-length (/ 256 8))

(define %crypto-symmetric-session-key
  (bs:struct `((aes-key ,(bs:vector %crypto-aes-key-length uint8))
               (twofish-key ,(bs:vector %crypto-aes-key-length uint8)))))

(define %crypto-symmetric-initialization-vector
  (bs:struct `((aes-iv ,(bs:vector %crypto-aes-key-length uint8))
               (twofish-iv ,(bs:vector %crypto-aes-key-length uint8)))))

(define %crypto-hash-length (/ 512 8))

(define %crypto-auth-key (bs:struct `((key ,(bs:vector %crypto-hash-length uint8)))))

(define %crypto-paillier-bits 2048)

(define %crypto-paillier-public-key
  (bs:struct `((n ,(bs:vector (/ %crypto-paillier-bits 8) uint8)))))

(define %crypto-paillier-private-key
  (bs:struct `((lambda ,(bs:vector (/ %crypto-paillier-bits 8) uint8))
               (mu ,(bs:vector (/ %crypto-paillier-bits 8) uint8)))))

(define-public crypto-seed-weak-random
  (let ((func (util ffi:void "GNUNET_CRYPTO_seed_weak_random" ffi:int32)))
    (lambda (integer)
      "Seed a weak random generator. Only weal mode generator can be seeded."
      (func integer))))

(define-public crypto-crc8-n
  (let ((func (util ffi:int8 "GNUNET_CRYPTO_crc8_n" '* ffi:size_t)))
    (lambda (string)
      "Calculate the checksum of STRING in one step."
      (let ((bv (string->bytevector string "utf-8")))
        (func bv (bytevector-length bv))))))

;;; scheduler, gnunet_scheduler_lib.h

(define-public %scheduler-reason-none 0)
(define-public %scheduler-reason-startup 1)
(define-public %scheduler-reason-shutdown 2)
(define-public %scheduler-reason-timeout 4)
(define-public %scheduler-reason-read-ready 8)
(define-public %scheduler-reason-write-ready 16)
(define-public %scheduler-reason-prereq-done 32)

(define-public %scheduler-event-type-none 0)
(define-public %scheduler-event-type-in 1)
(define-public %scheduler-event-type-out 2)
(define-public %scheduler-event-type-hup 4)
(define-public %scheduler-event-type-error 8)
(define-public %scheduler-event-type-priority 16)
(define-public %scheduler-event-type-nval 32)

(define-public scheduler-run
  (let ((func (util ffi:void "GNUNET_SCHEDULER_run" '* '*)))
    (lambda (thunk)
      "Initialize and run scheduler.  This procedure will return when
all tasks have completed.  On systems with signals, receiving a
SIGTERM (and other similar signals) will cause
#GNUNET_SCHEDULER_shutdown to be run after the active task is
complete.  As a result, SIGTERM causes all shutdown tasks to be
scheduled with reason #GNUNET_SCHEDULER_REASON_SHUTDOWN.  (However,
tasks added afterwards will execute normally!).  Note that any
particular signal will only shut down one scheduler; applications
should always only create a single scheduler.

THUNK is task to run first (and immediately)"
      (func (ffi:procedure->pointer ffi:void thunk '()) ffi:%null-pointer))))

(define-public scheduler-add-with-reason-and-priority
  (let ((func (util ffi:void
                    "GNUNET_SCHEDULER_add_with_reason_and_priority"
                    '*
                    '*
                    ffi:int
                    ffi:int)))
    (lambda (thunk reason priority)
      "Continue the current execution with the given function."
      (func (ffi:procedure->pointer ffi:void thunk '())
            ffi:%null-pointer
            reason
            priority))))

(define-public scheduler-add-now
  (let ((func (util '* "GNUNET_SCHEDULER_add_now" '* '*)))
    (lambda (thunk)
      "Schedule a new task to be run as soon as possible. Note that this does
not guarantee that this will be the next task that is being run, as other tasks
with higher priority (or that are already ready to run) might get to run first.
Just as with delays, clients must not rely on any particular order of execution
between tasks scheduled concurrently.

The task will be run with the DEFAULT priority."
      (let ((task (ffi:procedure->pointer ffi:void thunk '())))
        (func task ffi:%null-pointer)))))

(define-public scheduler-add-delayed
  (let ((func (util '* "GNUNET_SCHEDULER_add_delayed" ffi:uint64 '* '*)))
    (lambda (timeout callback)
      (func timeout
            (ffi:procedure->pointer ffi:void (lambda _ (callback)) '(*))
            ffi:%null-pointer))))

(define-public scheduler-shutdown
  (let ((func (util ffi:void "GNUNET_SCHEDULER_shutdown")))
    (lambda ()
      "Request the shutdown of a scheduler. Marks all tasks awaiting shutdown as
ready. Note that tasks scheduled with scheduler-add-shutdown AFTER this call
will be delayed until the next shutdown signal."
      (func))))

(define-public scheduler-add-shutdown
  (let ((func (util '* "GNUNET_SCHEDULER_add_shutdown" '* '*)))
    (lambda (thunk)
      "Schedule a new task to be run on shutdown, that is when a CTRL-C signal
is received, or when scheduler-shutdown is being invoked.

Return unique task identifier for the job, valid until THUNK is started."
      (let ((task (ffi:procedure->pointer ffi:void thunk '())))
        (func task ffi:%null-pointer)))))

;; time

(define %time-absolute (bs:struct `((abs-value-us ,uint64))))

(define %time-relative (bs:struct `((rel-value-us ,uint64))))

(define-public time-absolute-get
  (let ((func (util ffi:uint64 "GNUNET_TIME_absolute_get")))
    (lambda ()
      "Return the current time in microseconds"
      (func))))

;;; gnunet-fs bindings, gnunet_fs_service.h

(define fs (dynamic-link* %libgnunet-fs))

;; uri

(define uri-destroy
  (let ((func (fs ffi:void "GNUNET_FS_uri_destroy" '*)))
    (ffi:procedure->pointer ffi:void func '(*))))

(define-public string->uri
  (let ((func (fs '* "GNUNET_FS_uri_parse" '* '*)))
    (lambda (string)
      (let ((out (func (ffi:string->pointer string) ffi:%null-pointer)))
        (when (eq? out ffi:%null-pointer)
          (throw 'gnunet-error "Failed to parse URI"))
        (ffi:set-pointer-finalizer! out uri-destroy)
        out))))

(define-public uri->string
  (let ((func (fs '* "GNUNET_FS_uri_to_string" '*)))
    (lambda (uri)
      (ffi:pointer->string (func uri)))))

(define-public uri-chk?
  (let ((func (fs ffi:int "GNUNET_FS_uri_test_chk" '*)))
    (lambda (uri)
      "Is this a file (or directory) URI?"
      (integer->boolean (func uri)))))

(define-public uri-loc?
  (let ((func (fs ffi:int "GNUNET_FS_uri_test_loc" '*)))
    (lambda (uri)
      "Is this a location URI?"
      (integer->boolean (func uri)))))

(define-public uri-chk-get-file-size
  (let ((func (fs ffi:uint64 "GNUNET_FS_uri_chk_get_file_size" '*)))
    (lambda (uri)
      "Size of file URI refers to"
      (func uri))))

;; other fs stuff

(define %fs-options-end 0)
(define %fs-options-download-parallelism 1)
(define %fs-options-request-parallelism 2)

(define-public %fs-flags-none 0)
(define-public %fs-flags-persistence 1)
(define-public %fs-flags-do-probes 2)

(define-public %fs-status-publish-start 0)
(define-public %fs-status-publish-resume 1)
(define-public %fs-status-publish-suspend 2)
(define-public %fs-status-publish-progress 3)
(define-public %fs-status-publish-error 4)
(define-public %fs-status-publish-completed 5)
(define-public %fs-status-publish-stopped 6)
(define-public %fs-status-download-start 7)
(define-public %fs-status-download-resume 8)
(define-public %fs-status-download-suspend 9)
(define-public %fs-status-download-progress 10)
(define-public %fs-status-download-error 11)
(define-public %fs-status-download-completed 12)
(define-public %fs-status-download-stopped 13)
(define-public %fs-status-download-active 14)
(define-public %fs-status-download-inactive 15)
(define-public %fs-status-download-lost-parent 16)
(define-public %fs-status-search-start 17)
(define-public %fs-status-search-resume 18)
(define-public %fs-status-search-resume-result 19)
(define-public %fs-status-search-suspend 20)
(define-public %fs-status-search-result 21)
(define-public %fs-status-search-result-namespace 22)
(define-public %fs-status-search-update 23)
(define-public %fs-status-search-error 24)
(define-public %fs-status-search-pause 25)
(define-public %fs-status-search-continued 26)
(define-public %fs-status-search-result-stopped 27)
(define-public %fs-status-search-result-suspend 28)
(define-public %fs-status-search-stopped 29)
(define-public %fs-status-unindex-start 30)
(define-public %fs-status-unindex-resume 31)
(define-public %fs-status-unindex-suspend 32)
(define-public %fs-status-unindex-progress 33)
(define-public %fs-status-unindex-error 34)
(define-public %fs-status-unindex-completed 35)
(define-public %fs-status-unindex-stopped 36)
(define-public %fs-status-publish-progress-directory 37)

; progress info struct

(define %fs-progress-info-publish
  (bs:struct
   `((publish-context ,uintptr_t)
     (file-information ,uintptr_t)
     (client-context ,uintptr_t)
     (parent-context ,uintptr_t)
     (filename ,uintptr_t)
     (size ,uint64)
     (eta ,%time-relative)
     (duration ,%time-relative)
     (completed ,uint64)
     (anonymity ,uint32)
     (specifics
      ,(bs:union `((progress
                    ,(bs:struct `((data ,uintptr_t)
                                  (offset ,uint64)
                                  (data-length ,uint64)
                                  (depth ,unsigned-int))))
                   (progress-directory
                    ,(bs:struct `((completed ,uint64)
                                  (total ,uint64)
                                  (eta ,%time-relative))))
                   (resume
                    ,(bs:struct `((message ,uintptr_t)
                                  (chk-uri ,uintptr_t)
                                  (sks-uri ,uintptr_t))))
                   (completed
                    ,(bs:struct `((chk-uri ,uintptr_t)
                                  (sks-uri ,uintptr_t))))
                   (error
                    ,(bs:struct `((message ,uintptr_t))))))))))

(define %fs-progress-info-download
  (bs:struct
   `((download-context ,uintptr_t)
     (client-context ,uintptr_t)
     (parent-context ,uintptr_t)
     (search-context ,uintptr_t)
     (uri ,uintptr_t)
     (filename ,uintptr_t)
     (size ,uint64)
     (eta ,%time-relative)
     (duration ,%time-relative)
     (completed ,uint64)
     (anonymity ,uint32)
     (active? ,int)
     (specifics
      ,(bs:union `((progress
                    ,(bs:struct `((data ,uintptr_t)
                                  (offset ,uint64)
                                  (data-length ,uint64)
                                  (block-download-duration ,%time-relative)
                                  (depth ,unsigned-int)
                                  (respect-offered ,uint32)
                                  (number-of-transmissions ,uint32))))
                   (start
                    ,(bs:struct `((meta ,uintptr_t))))
                   (resume
                    ,(bs:struct `((meta ,uintptr_t)
                                  (message ,uintptr_t))))
                   (error
                    ,(bs:struct `((message ,uintptr_t))))))))))

(define %fs-progress-info-search
  (bs:struct
   `((search-context ,uintptr_t)
     (client-context ,uintptr_t)
     (parent-context ,uintptr_t)
     (query ,uintptr_t)
     (duration ,%time-relative)
     (anonymity ,uint32)
     (specifics
      ,(bs:union `((result
                    ,(bs:struct `((meta ,uintptr_t)
                                  (uri ,uintptr_t)
                                  (result ,uintptr_t)
                                  (applicability-rank ,uint32))))
                   (resume-result
                    ,(bs:struct `((meta ,uintptr_t)
                                  (uri ,uintptr_t)
                                  (result ,uintptr_t)
                                  (availability-rank ,int32)
                                  (availability-certainty ,uint32)
                                  (applicability-rank ,uint32))))
                   (update
                    ,(bs:struct `((client-context ,uintptr_t)
                                  (meta ,uintptr_t)
                                  (uri ,uintptr_t)
                                  (availability-rank ,int32)
                                  (availability-certainty ,uint32)
                                  (applicability-rank ,uint32)
                                  (current-probe-time ,%time-relative))))
                   (result-suspend
                    ,(bs:struct `((client-context ,uintptr_t)
                                  (meta ,uintptr_t)
                                  (uri ,uintptr_t))))
                   (result-stopped
                    ,(bs:struct `((client-context ,uintptr_t)
                                  (meta ,uintptr_t)
                                  (uri ,uintptr_t))))
                   (resume
                    ,(bs:struct `((message ,uintptr_t)
                                  (paused? ,int))))
                   (error
                    ,(bs:struct `((message ,uintptr_t))))
                   (result-namespace
                    ,(bs:struct `((name ,uintptr_t)
                                  (root ,uintptr_t)
                                  (meta ,uintptr_t)
                                  (pseudonym ,%crypto-ecdsa-public-key))))))))))

(define %fs-progress-info-unindex
  (bs:struct
   `((unindex-context ,uintptr_t)
     (client-context ,uintptr_t)
     (filename ,uintptr_t)
     (size ,uint64)
     (eta ,%time-relative)
     (duration ,%time-relative)
     (completed ,uint64)
     (specifics
      ,(bs:union `((progress
                    ,(bs:struct `((data ,uintptr_t)
                                  (offset ,uint64)
                                  (data-length ,uint64)
                                  (depth ,unsigned-int))))
                   (resume
                    ,(bs:struct `((message ,uintptr_t))))
                   (error
                    ,(bs:struct `((message ,uintptr_t))))))))))

(define-public %fs-progress-info
  (bs:struct
   `((value
      ,(bs:union `((publish ,%fs-progress-info-publish)
                   (download ,%fs-progress-info-download)
                   (search ,%fs-progress-info-search)
                   (unindex ,%fs-progress-info-unindex))))
     (status ,int)
     (handle ,uintptr_t))))

(define-public (fs-progress-info-status info)
  (bytestructure-ref info 'status))

(define-public (fs-progress-info-fs info)
  (ffi:make-pointer (bytestructure-ref info 'handle)))

(define-public (fs-progress-info-download-context info)
  (ffi:make-pointer (bytestructure-ref info 'value 'download 'download-context)))

(define-public (fs-progress-info-publish-error info)
  (ffi:pointer->string
   (ffi:make-pointer
    (bytestructure-ref info 'value 'publish 'specifics 'error 'message))))

(define-public (fs-progress-info-publish-filename info)
  (ffi:pointer->string
   (ffi:make-pointer
    (bytestructure-ref info 'value 'publish 'filename))))

(define-public (fs-progress-info-publish-chk-uri info)
  (ffi:make-pointer
   (bytestructure-ref info 'value 'publish 'specifics 'completed 'chk-uri)))

(define-public (fs-progress-info-search-result-uri info)
  (ffi:make-pointer
   (bytestructure-ref info 'value 'search 'specifics 'result 'uri)))

(define-public (fs-progress-info-search-error-message info)
  (ffi:pointer->string
   (bytestructure-ref info 'value 'search 'specifics 'error 'message)))

(define (progress-callback-wrapper callback)
  (lambda (_ info)
    (callback (pointer->bytestructure %fs-progress-info info))))

(define (procedure->progress-callback callback)
  (ffi:procedure->pointer ffi:void (progress-callback-wrapper callback) '(* *)))

(define-public fs-start
  (let ((func (fs '*
                  "GNUNET_FS_start"
                  '* '* '* '* ffi:int ffi:int ffi:unsigned-int ffi:int ffi:unsigned-int ffi:int)))
    (lambda* (configuration
              client-name
              progress-callback
              #:key
              (flags %fs-flags-none)
              (download-parallelism 16)
              (request-parallelism (* 10 1024)))
      "Setup a connection to the file-sharing service.

Return a handle to the file-sharing service"
      (let ((out
             (func configuration
                   (ffi:string->pointer client-name)
                   (procedure->progress-callback progress-callback)
                   ffi:%null-pointer ;; callback closure is null
                                     ;; because guile can do it
                   flags
                   %fs-options-download-parallelism
                   download-parallelism
                   %fs-options-request-parallelism
                   request-parallelism
                   %fs-options-end
                   )))
      (check2 out "Impossible to connect to file-sharing service.")))))


(define-public fs-stop
  (let ((func (fs ffi:void "GNUNET_FS_stop" '*)))
    (lambda (handle)
      (func handle))))

(define-public %fs-download-option-none 0)
(define-public %fs-download-option-loopback-only 1)
(define-public %fs-download-option-recursive 2)
(define-public %fs-download-no-temporaries 4)
(define-public %fs-download-is-probe (ash 1 31))

(define-public fs-download-start
  (let ((func (fs '*
                  "GNUNET_FS_download_start"
                  '* '* '* '* '* ffi:uint64 ffi:uint64 ffi:uint32 ffi:unsigned-int '* '*)))
    (lambda* (handle
             uri
             anonymity
             #:key
             (meta #f)
             (filename #f)
             (tempname #f)
             (offset 0)
             (length (uri-chk-get-file-size uri))
             (options %fs-download-option-none)
             (client-context #f)
             (parent #f))
      "Download parts of a file.  Note that this will store
the blocks at the respective offset in the given file.  Also, the
download is still using the blocking of the underlying FS
encoding.  As a result, the download may *write* outside of the
given boundaries (if offset and length do not match the 32k FS
block boundaries).

The given range can be used to focus a download towards a
particular portion of the file (optimization), not to strictly
limit the download to exactly those bytes.

HANDLE is the handle the file-sharing service.  URI is the URI of the
file (determines what to download); CHK or LOC URI.  ANONYMITY defines
the level of anonymity for the download."
      (func handle
            uri
            (or meta ffi:%null-pointer)
            (or (and filename (ffi:string->pointer filename)) ffi:%null-pointer)
            (or (and tempname (ffi:string->pointer tempname)) ffi:%null-pointer)
            offset
            length
            anonymity
            options
            (or client-context ffi:%null-pointer)
            (or parent ffi:%null-pointer)))))

(define-public fs-download-stop
  (let ((func (fs ffi:void "GNUNET_FS_download_stop" '* ffi:int)))
    (lambda (download-context delete-incomplete-files?)
      (func download-context (boolean->integer delete-incomplete-files?)))))

(define-public %fs-publish-option-none 0)
(define-public %fs-publish-option-simulate-only 1)

(define-public fs-publish-start
  (let ((func (fs '* "GNUNET_FS_publish_start" '* '* '* '* '* ffi:int)))
    (lambda* (fs
              file-information
              #:key
              (namespace #f)
              (nid #f)
              (nuid #f)
              (options %fs-publish-option-none))
      (let ((out (func fs
                       file-information
                       (if namespace namespace ffi:%null-pointer)
                       (if nid (ffi:string->pointer nid) ffi:%null-pointer)
                       (if nuid (ffi:string->pointer nuid) ffi:%null-pointer)
                       options)))
        (check2 out "Could not start publishing.")))))

(define-public fs-publish-stop
  (let ((func (fs ffi:void "GNUNET_FS_publish_stop" '*)))
    (lambda (publish-context)
      "Stop a publication.  Will abort incomplete publications (but not remove
blocks that have already been published) or simply clean up the state for
completed publications.  Must NOT be called from within the event callback!"
      (func publish-context))))

(define-public %fs-directory-scanner-file-start 0)
(define-public %fs-directory-scanner-file-ignored 1)
(define-public %fs-directory-scanner-all-counted 2)
(define-public %fs-directory-scanner-extract-finished 3)
(define-public %fs-directory-scanner-finished 4)
(define-public %fs-directory-scanner-error 5)

(define %fs-share-tree-item (bs:struct
                             `((prev ,(bs:pointer (delay %fs-share-tree-item)))
                               (next ,(bs:pointer (delay %fs-share-tree-item)))
                               (parent ,(bs:pointer (delay %fs-share-tree-item)))
                               (children-head ,(bs:pointer (delay %fs-share-tree-item)))
                               (children-tail ,(bs:pointer (delay %fs-share-tree-item)))
                               (meta ,uintptr_t)
                               (ksk-uri ,uintptr_t)
                               (filename ,uintptr_t)
                               (short-filename ,uintptr_t)
                               (directory? ,int))))

(define (maybe->string pointer)
  (if (eq? pointer ffi:%null-pointer)
      #f
      (ffi:pointer->string pointer)))

(define-public fs-directory-scan-start
  (let ((func (fs '* "GNUNET_FS_directory_scan_start" '* ffi:int '* '* '*)))
    (lambda (filename extractor? callback)
      "Start a directory scanner

Return a directory scanner object"
      (func (ffi:string->pointer filename)
            (boolean->integer (not extractor?))
            ffi:%null-pointer
            (ffi:procedure->pointer ffi:void
                                    (lambda (_ filename directory? reason)
                                      (callback (maybe->string filename)
                                                (integer->boolean directory?)
                                                reason))
                                    (list '* '* ffi:int ffi:int))
            ffi:%null-pointer))))

(define-public fs-directory-scan-abort
  (let ((func (fs ffi:void "GNUNET_FS_directory_scan_abort" '*)))
    (lambda (directory-scanner)
      "Abort the scan. Must not be called within the callback function of
fs-directory-scan-start"
      (func directory-scanner))))

(define-public fs-directory-scan-get-result
  (let ((func (fs '* "GNUNET_FS_directory_scan_get_result" '*))
        (free (fs ffi:void "GNUNET_FS_share_tree_free" '*)))
    (lambda (directory-scanner)
      (let ((out (func directory-scanner)))
        ;; XXX: workaround dynamic-link*
        (ffi:set-pointer-finalizer! out (ffi:procedure->pointer ffi:void free '(*)))
        out))))

(define-public fs-share-tree-trim!
  (let ((func (fs '* "GNUNET_FS_share_tree_trim" '*)))
    (lambda (toplevel)
      (func toplevel))))

(define-public (fs-directory-scan-get-result* directory-scanner)
  (let ((out (fs-directory-scan-get-result directory-scanner)))
    (fs-share-tree-trim! out)
    (pointer->bytestructure %fs-share-tree-item out)))

(define-public (fs-share-tree-item-filename item)
  (ffi:pointer->string (ffi:make-pointer (bytestructure-ref item 'filename))))

(define-public (fs-share-tree-item-ksk-uri item)
  (ffi:make-pointer (bytestructure-ref item 'ksk-uri)))

(define-public (fs-share-tree-item-meta item)
  (ffi:make-pointer (bytestructure-ref item 'meta)))

(define %fs-block-options
  (bs:struct `((expiration-time ,%time-relative)
               (anonymity-level ,uint32)
               (content-priority ,uint32)
               (replication-level ,uint32))))

(define-public (fs-block-options)
  (let ((options (bytestructure %fs-block-options)))
    (bytestructure-set! options 'expiration-time 'rel-value-us 0)
    (bytestructure-set! options 'anonymity-level 1)
    (bytestructure-set! options 'content-priority 365)
    (bytestructure-set! options 'replication-level 1)
    options))

(define-public fs-file-information-create-from-file
  (let ((func (fs '*
                  "GNUNET_FS_file_information_create_from_file"
                  '*
                  '*
                  '*
                  '*
                  '*
                  ffi:int
                  '*)))
    (lambda (fs filename keywords meta do-index options)
      (func fs
            ffi:%null-pointer
            (ffi:string->pointer filename)
            keywords
            meta
            do-index
            (bytestructure->pointer options)))))

(define (callback->publish-continuation callback)
  (ffi:procedure->pointer ffi:void
                          (lambda (_ uri error)
                            (callback uri
                                      (if (eq? ffi:%null-pointer)
                                          #f
                                          (ffi:pointer->string error))))
                          '(* * *)))

(define-public fs-publish-ksk
  (let ((func (fs '* "GNUNET_FS_publish_ksk" '* '* '* '* '* ffi:int '* '*)))
    (lambda (fs ksk-uri uri block-options publish-options callback)
      "Publish a KBlock on GNUnet."
      (func fs
            ksk-uri
            (container-meta-data-create) ;; ffi:%null-pointer ;; meta
            uri
            (bytestructure->pointer block-options)
            publish-options
            (callback->publish-continuation callback)
            ffi:%null-pointer))))

(define-public (fs-uri-ksk-create keyword . keywords)
  "Build a KSK uri from KEYWORD and KEYWORDS. Prefix the keyword
with + if it must be mandatory"
  (let ((keywords (cons keyword keywords)))
    (let ((path (string-join (map uri-encode keywords) "+")))
      (string->uri (string-append "gnunet://fs/ksk/" path)))))

;;; search

(define-public %fs-search-option-none 0)
(define-public %fs-search-option-loopback-only 1)

(define-public fs-search-start
  (let ((func (fs '* "GNUNET_FS_search_start" '* '* ffi:uint32 ffi:int '*)))
    (lambda (fs uri anonymity options)
      (func fs uri anonymity options ffi:%null-pointer))))

(define-public fs-search-stop
  (let ((func (fs ffi:void "GNUNET_FS_search_stop" '*)))
    (lambda (search-context)
      (func search-context))))



;; gnunet-identity bindings

(define identity (dynamic-link* %libgnunet-identity))