path: root/src/hl/index.cljs.hl

;; index.cljs.hl - The gnunet-web website
;; Copyright (C) 2013-2015  David Barksdale <amatus@amatus.name>
;;
;; 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/>.

(page "index.html"
      (:require [amatus.filestorage :as file]
                [gnunet-web.core :as core]
                [gnunet-web.extractor :as extractor]
                [gnunet-web.filesharing :as filesharing]
                [gnunet-web.hostlist :as hostlist]
                [gnunet-web.metadata :as metadata]
                [gnunet-web.service :as service]
                [gnunet-web.transport :as transport]
                [gnunet-web.util :refer [data->string now]]
                [semantic-ui])
      (:require-macros [cljs.core.async.macros :refer [go go-loop]]
                       [fence.core :refer [+++]]))

(set! *print-fn* #(.log js/console %))

(defc browser-support
      (cond
        (not (exists? js/MessageChannel))
        "This website requires MessageChannel support. Try Chromium or Google Chrome."
        (not (exists? js/SharedWorker))
        "This website requires SharedWorker support. Try Chromium or Google Chrome."))

(defn peer-id-short
  [peer]
  (.substr (data->string peer) 0 4))

(defc my-id [])
(transport/get-my-peer-id (fn [peer-id] (reset! my-id peer-id)))
(defc peers {})
(defc= connection-count (count (filter (fn [[_ info]]
                                         (and
                                           (= transport/state-connected
                                              (:transport-state info))
                                           (= core/state-connected
                                              (:core-state info))))
                                       peers)))

(transport/monitor-peers
  (fn [message]
    (swap! peers
           (fn [peers]
             (if (= transport/state-disconnected (:state message))
               (dissoc peers (:peer message))
               (-> peers
                 (assoc-in [(:peer message) :transport-state] (:state message))
                 (assoc-in [(:peer message) :address] (:address message))))))))

(core/monitor-peers
  (fn [message]
    (if (not (= core/iteration-finished (:state message)))
      (swap! peers
             (fn [peers]
               (if (get peers (:peer message))
                 (assoc-in peers [(:peer message) :core-state]
                           (:state message))
                 peers))))))

(defc active-search nil)
(defc search-results [])
(defn start-search
  [query anonymity]
  (let [search (filesharing/start-search query anonymity)]
    (swap! active-search
           (fn [old-search]
             (when old-search
               (filesharing/stop-search old-search))
             search))
    (reset! search-results [])
    (go-loop
      []
      (when-let [info (<! (:ch search))]
        (when (= :search-result (:status info))
          (swap! search-results conj info))
        (recur)))))

(defn start-download
  [uri anonymity state-cell progress-cell object-cell]
  (let [download (filesharing/start-download uri anonymity)
        file-ch (file/create "application/octet-stream")]
    (go
      (let [file-handle (<! file-ch)]
        (loop []
          (when-let [info (<! (:ch download))]
            (when (= :download-start (:status info))
              (reset! state-cell :downloading))
            (when (= :download-completed (:status info))
              (let [object (<! (file/create-object-url file-handle))]
                ;; XXX this needs to be revoked when we're finished
                (reset! object-cell object)
                (reset! state-cell :complete)))
            (when (zero? (:depth info))
              (file/write file-handle (:offset info) (:data info)))
            (reset! progress-cell (if (zero? (:size info))
                                    0
                                    (/ (:completed info) (:size info))))
            (recur)))))))

(defn start-publish
  [keywords metadata file anonymity state-cell progress-cell uri-cell]
  (let [publish (filesharing/start-publish
                  file
                  keywords
                  metadata
                  {:expiration (+ (* 2 356.24 24 60 60 1000 1000) (now))
                   :anonymity anonymity
                   :priority 365
                   :replication 1})]
    (go-loop []
             (when-let [info (<! (:ch publish))]
               (when (= :publish-start (:status info))
                 (reset! state-cell :active))
               (when (= :publish-progress (:status info))
                 (reset! progress-cell (if (zero? (:size info))
                                         0
                                         (/ (:completed info) (:size info)))))
               (when (= :publish-completed (:status info))
                 (reset! uri-cell (:uri info))
                 (reset! state-cell :complete))
               (recur)))))

(try
  (def topology-worker (service/start-worker "topology"
                                           "js/gnunet-daemon-topology.js"))
  (catch :default e
    nil))

(hostlist/fetch-and-process!)

(defc anonymity 1)

(defelem ui-progress
         [{:keys [state class] :as attr} kids]
         (let [attr (assoc (dissoc attr :state)
                           :class (str "ui progress " class))
               progress (div
                          attr
                          (div :class "bar"
                               (div :class "progress")))]
           (with-timeout 0 (+++ (.progress
                                  (js/$ progress)
                                  (js-obj "percent" 0))))
           (add-watch state nil
                      (fn [_ _ _ new-state]
                        (+++ (.progress
                               (js/$ progress)
                               (js-obj "percent" (* 100 new-state))))))
           progress))

(defelem ui-search
         [attr kids]
         (let [input (input :type "text" :placeholder "Keywords...")]
           (div
             (form :class (cell= {:ui true :icon true :input true
                                  :error (zero? connection-count)})
                   :submit #(start-search (.-value input) @anonymity)
                   input
                   (i :class (cell= {:icon true :search true
                                     :loading active-search})))
             (div :class "ui pointing left red label"
                  :toggle (cell= (zero? connection-count))
                  "Live results are unavailable when not connected"))))

(defelem ui-publish
         [attr kids]
         (let [file-chosen (cell false)
               publish-state (cell :inactive)
               publish-progress (cell 0)
               publish-uri (cell nil)
               metadata (atom nil)
               keywords (input :type "text")
               file (input :type "file"
                           :change
                           (fn [e]
                             (swap! metadata
                                    (fn [metadata]
                                      (extractor/metadata-destroy metadata)
                                      (extractor/metadata-extract
                                        (aget (.-files (.-target e)) 0))))
                             (set! (.-value keywords)
                                   (filesharing/keywords-from-metadata
                                     @metadata))
                             (reset! file-chosen true)))]
           (div :class "ui form segment"
                (div :class "ui labeled input"
                     (div :class "ui label" "Choose a file to publish")
                     file)
                (div :class "ui labeled input"
                     :toggle file-chosen
                     (div :class "ui label" "Keywords")
                     keywords)
                (div :class "ui icon button"
                     :title "Publish"
                     :toggle file-chosen
                     :click #(start-publish (.-value keywords)
                                            @metadata
                                            (aget (.-files file) 0)
                                            @anonymity
                                            publish-state
                                            publish-progress
                                            publish-uri)
                     (i :class "upload icon large"))
                (ui-progress :toggle (cell= (not (= :inactive publish-state)))
                             :state publish-progress)
                (a :class "item"
                   :href publish-uri
                   :toggle (cell= (= :complete publish-state))
                   :click #(do false)
                   (i :class "external share icon")))))

(defn pretty-print-byte-count
  [byte-count]
  (let [log (+++ (.log2 js/Math byte-count))
        form (fn [exp suffix] (str (.toFixed (.pow js/Math 2 (- log exp)) 3)
                                   suffix))]
    (condp (fn [[low high] x] (and (<= low x) (> high x))) log
      [10 20] (form 10 " KiB")
      [20 30] (form 20 " MiB")
      [30 40] (form 30 " GiB")
      [40 50] (form 40 " TiB")
      [50 60] (form 50 " PiB")
      [60 70] (form 60 " EiB")
      [70 80] (form 70 " ZiB")
      [80 90] (form 80 " YiB")
      (str byte-count " B"))))

(defelem ui-dropdown
         [{:keys [state class] :as attr} kids]
         (let [attr (assoc (dissoc attr :state) :class (str "ui dropdown "
                                                            class))
               dropdown (div
                          attr
                          (input :type "hidden"
                                 :value state
                                 :change #(reset! state (.-value (.-target %))))
                          (div :class "text" @state)
                          (i :class "dropdown icon")
                          (div :class "menu"
                               (map #(div :class "item" %) kids)))]
           (with-timeout 0 (+++ (.dropdown (js/$ dropdown))))
           dropdown))

(defelem ui-popup
         [{:keys [settings] :as attr} kids]
         (let [popup (div (dissoc attr :settings) kids)]
           (with-timeout 0 (+++ (.popup (js/$ popup) (clj->js settings))))
           popup))

(defelem peer-table
  [attr kids]
  (table :class "ui table segment"
         (thead
           (tr
             (th :text "Peer ID")
             (th :text "Transport State")
             (th :text "Core State")
             (th :text "Address")))
         (tbody
           (loop-tpl :bindings [[peer info] peers]
                     (tr
                       (td :width "25%"
                           :title (cell= (data->string peer))
                           (text "~(peer-id-short peer)\u2026"))
                       (td :width "25%"
                           :text (cell= (transport/state->string
                                          (:transport-state info))))
                       (td :width "25%"
                           :text (cell= (core/state->string
                                          (:core-state info))))
                       (td :width "25%"
                           :text (cell= (:address info))))))))

(html
  (head
    (link :rel "stylesheet" :type "text/css" :href "css/semantic.min.css")
    (title "gnunet.io - A GNUnet Web Application"))
  (body
    (div :class "ui fixed main menu grid" ; grid somehow fixes things here too
         (div :class "container"
              (div :class "right item"
                   (a :href "https://github.com/amatus/gnunet-web"
                      :title "Fork me on GitHub"
                      (i :class "github icon")))
              (div :class "right item"
                   "Anonymity"
                   (div :class "ui label"
                        (ui-dropdown :state anonymity "0" "1" "2" "3")))
              (ui-popup :class "right item"
                        :settings {:inline true
                                   :position "bottom right"
                                   :on "click"}
                        "Connections"
                        (div :class (cell= {:ui true :label true :dropdown true
                                            :red (zero? connection-count)})
                             (text "~{connection-count}")
                             (i :class "dropdown icon")))
              (div :class "ui flowing popup"
                   (peer-table))
              (div :class "right item"
                   :title (cell= (data->string my-id))
                   (text "My Peer ID: ~(peer-id-short my-id)\u2026"))
              (div :class "item"
                   "gnunet-web"
                   (span :class "ui red label" "Pre-Alpha"))))
    (div :class "ui grid") ; This pushes content down so it's not under the menu
    (div :class "ui inverted segment"
         :toggle (cell= (not (nil? browser-support)))
         (div :class "ui red header" :text browser-support))
    (ui-publish)
    (ui-search)
    (table :class "ui table segment"
           :toggle (cell= (seq search-results))
           (thead
             (tr
               (th :text "File")
               (th :text "Size")
               (th :text "Metadata")))
           (tbody
             (loop-tpl :bindings [result search-results]
                       (let [uri (cell= (:uri result))
                             filename (cell= (extractor/guess-filename
                                               (:metadata result)))
                             download-state (cell :inactive)
                             download-progress (cell 0)
                             download-object (cell nil)]
                         (add-watch result nil
                                    (fn [_ _ _ new-state]
                                      (when (nil? new-state)
                                        (reset! download-state :inactive)
                                        (reset! download-progress 0)
                                        (reset! download-object nil))))
                         (tr
                           (td
                             (div :class "ui compact menu"
                                  (a :class "item"
                                     :href uri
                                     :click #(do
                                               (start-download @uri
                                                               @anonymity
                                                               download-state
                                                               download-progress
                                                               download-object)
                                               false)
                                     (i :class "download icon")
                                     (text "~{filename}")))
                             (ui-progress :toggle (cell=
                                                    (not (= :inactive
                                                            download-state)))
                                          :state download-progress)
                             (a :href download-object
                                :download filename
                                :toggle (cell= (= :complete
                                                  download-state))
                                (div :class "ui icon button"
                                     (i :class "save icon"))))
                           (td :text (cell=
                                       (when uri
                                         (pretty-print-byte-count
                                           (filesharing/uri-to-file-size
                                             uri)))))
                           (td (pre :text (cell= (metadata/pretty-print
                                                   (:metadata result))))))))))))

;; vim: set expandtab ts=2 sw=2 filetype=clojure :