#!/bin/sh
# -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*-
exec guile -e '(@ (gnunet-guile) main)' -s "$0" "$@"
!#
;;;; 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-guile))

(use-modules ((ice-9 getopt-long)))
(use-modules ((ice-9 match)))

(use-modules ((gnunet)))
(use-modules ((gnunet subcommand)))


;;; download, gnunet-download.c

(define (download/task/clean-up fs)
  (lambda ()
    (fs-stop fs)))

(define (download/progress info)
  (let ((status (fs-progress-info-status info)))
    (cond
     ((eq? status %fs-status-download-start)
      (display "* Download started...\n"))
     ((eq? status %fs-status-download-progress)
      (display "* Download in-progress...\n"))
     ((eq? status %fs-status-download-error)
      (display "* Download error!\n")
      (scheduler-shutdown))
     ((eq? status %fs-status-download-completed)
      (display "* Download complete!\n")
      (scheduler-shutdown))
     ((eq? status %fs-status-download-stopped)
      (scheduler-add-now (download/task/clean-up (fs-progress-info-fs info))))
     ((or (eq? status %fs-status-download-active)
          (eq? status %fs-status-download-inactive))
      #t)
     (else (format #t "* Unexpected status (~a)\n" status)))))

(define (download/task/shutdown download-context)
  (lambda ()
    (fs-download-stop download-context #true)))

(define (download/task configuration uri filename)
  (lambda ()
    (let ((fs (fs-start configuration "gnunet-guile" download/progress)))
      (let ((download-context (fs-download-start fs uri 0 #:filename filename)))
        (scheduler-add-shutdown (download/task/shutdown download-context))))))

(define %download-options
  '((help (single-char #\h) (value #f))))

(define (download args)
  "gnunet download CONFIGURATION URI FILENAME

Download the URI to FILENAME using CONFIGURATION.
"
  (let ((options (getopt-long (cons "gnunet-guile download" args)
                              %download-options
                              #:stop-at-first-non-option #f)))
    (if (option-ref options 'help #f)
        (display (procedure-documentation download))
        (match args
          ((configuration uri filename)
           (let ((configuration* (configuration-create)))
             (configuration-load! configuration* configuration)
             (let ((uri (string->uri uri)))
               (unless (or (uri-chk? uri) (uri-loc? uri))
                 ;; TODO: proper exit
                 (throw 'gnunet-guile "Only CHK or LOC URIs supported"))
               (scheduler-run (download/task configuration* uri filename)))))))))

;;; publish, gnunet-publish.c

(define (publish/keywords-callback uri error)
  (if error
      (format #t "* Error while publishing keywords: ~a\n" error)
      (format #t "* Keywords published\n"))
  (scheduler-shutdown))

(define (publish/keywords fs keywords uri)
  (fs-publish-ksk fs
                  (apply fs-uri-ksk-create keywords)
                  uri
                  (fs-block-options)
                  %fs-publish-option-none
                  publish/keywords-callback))

(define (publish/progress keywords)
  (lambda (info)
    (let ((status (fs-progress-info-status info)))
      (cond
       ((eq? status %fs-status-publish-start)
        (format #t "* Publishing started!\n"))
       ((eq? status %fs-status-publish-progress)
        (format #t "* Publishing in progress...\n"))
       ((eq? status %fs-status-publish-error)
        (format #t "* Error publishing: ~a!\n" (fs-progress-info-publish-error info))
        (scheduler-shutdown))
       ((eq? status %fs-status-publish-completed)
        (format #t "* Publishing '~a' done.\n" (fs-progress-info-publish-filename info))
        (format #t
                "* URI is '~a'\n"
                (uri->string (fs-progress-info-publish-chk-uri info)))
        (if (null? keywords)
            (scheduler-shutdown)
            (publish/keywords (fs-progress-info-fs info)
                              keywords
                              (fs-progress-info-publish-chk-uri info))))))))

(define (publish/task/shutdown publish-context)
  (lambda ()
    (fs-publish-stop publish-context)))

(define (publish/task configuration filename keywords)
  (lambda ()
    (let ((fs (fs-start configuration "gnunet-guile" (publish/progress keywords))))
      (let ((fi (fs-file-information-create-from-file
                 fs
                 filename
                 ;; XXX: force keyword to be 'jjj'
                 (fs-uri-ksk-create "jjj")
                 (container-meta-data-create)
                 %gnunet-yes
                 (fs-block-options))))
        (let ((publish-context (fs-publish-start fs fi)))
          (scheduler-add-shutdown (publish/task/shutdown publish-context)))))))

(define (publish-exec configuration filename keywords)
  (let ((configuration* (configuration-create)))
    (configuration-load! configuration* configuration)
    (scheduler-run (publish/task configuration* filename keywords))))

(define %publish-options
  '((help (single-char #\h) (value #f))))

(define (publish args)
  "gnunet-guile publish CONFIGURATION FILE [KEYWORDS...]

Publish on gnunet FILE using CONFIGURATION using KEYWORDS.
"
  (let ((options (getopt-long (cons "gnunet-guile publish" args)
                              %download-options
                              #:stop-at-first-non-option #f)))
    (if (option-ref options 'help #f)
        (display (procedure-documentation publish))
        (match args
          ((configuration file keywords ...)
           (publish-exec configuration file keywords))))))

;;; search

(define (search/task/shutdown search-context)
  (lambda ()
    (fs-search-stop search-context)))

(define (search/progress info)
  (let ((status (fs-progress-info-status info)))
    (cond
     ((eq? status %fs-status-search-start)
      (format #t "* Search in progress...\n"))
     ((eq? status %fs-status-search-result)
      (format #t "** ~a\n" (uri->string (fs-progress-info-search-result-uri info))))
     ((eq? status %fs-status-search-error)
      (format #t "* Error searching: ~a\n" (fs-progress-info-search-error-message info))))))

(define (search/timeout)
  (scheduler-shutdown))

(define (search/task configuration uri)
  (lambda ()
    (let ((fs (fs-start configuration "gnunet-guile" search/progress)))
      (let ((search-context (fs-search-start fs uri 1 %fs-search-option-none)))
        (scheduler-add-delayed (* 30 (expt 10 6)) search/timeout)
        (scheduler-add-shutdown (search/task/shutdown search-context))))))

(define (search-exec configuration keywords)
  (let ((configuration* (configuration-create))
        (uri (apply fs-uri-ksk-create keywords)))
    (configuration-load! configuration* configuration)
    (scheduler-run (search/task configuration* uri))))

(define (search args)
  "gnunet-guile search CONFIGURATION KEYWORDS...

Lookup files in gnunet that match KEYWORDS query using CONFIGURATION.
"
  (match args
    ((configuration keywords ...)
     (if (null? keywords)
         (format #t "No keywords provided!\n")
         (search-exec configuration keywords)))))

;;; cli

(define %cli `((download ,download)
               (publish ,publish)
               (search ,search)))

(define-public (main args)
  (subcommand 'gnunet-guile %cli (cdr args)))