Ported image_viewer example

Add jetty
wip
2020-11-02 09:57:48 +01:00 · 2020-11-02 09:50:18 +01:00 · 2020-10-30 20:02:34 +01:00
8 changed files with 402 additions and 3 deletions
--- a/deps.edn
+++ b/deps.edn
@ -26,7 +26,9 @@
        datascript/datascript {:mvn/version "1.0.1"}
        http-kit/http-kit {:mvn/version "2.5.0"}
        babashka/clojure-lanterna {:mvn/version "0.9.8-SNAPSHOT"}
-        org.clojure/math.combinatorics {:mvn/version "0.1.6"}}
+        org.clojure/math.combinatorics {:mvn/version "0.1.6"}
+        ring/ring-core {:mvn/version "1.8.1"}
+        ring/ring-jetty-adapter {:mvn/version "1.8.1"}}
 :aliases {:main
           {:main-opts ["-m" "babashka.main"]}
           :profile
--- a/examples/image_viewer2.clj
+++ b/examples/image_viewer2.clj
@ -0,0 +1,83 @@
+#!/usr/bin/env bb
+
+(ns image-viewer
+  (:require [clojure.java.browse :as browse]
+            [clojure.java.io :as io]
+            [clojure.string :as str]
+            [clojure.tools.cli :refer [parse-opts]]
+            [ring.adapter.jetty :as server])
+  (:import [java.net URLDecoder URLEncoder]))
+
+(def cli-options [["-p" "--port PORT" "Port for HTTP server" :default 8090 :parse-fn #(Integer/parseInt %)]
+                  ["-d" "--dir DIR" "Directory to scan for images" :default "."]])
+(def opts (:options (parse-opts *command-line-args* cli-options)))
+(def port (:port opts))
+(def dir (:dir opts))
+
+(def images
+  (filter #(and (.isFile %)
+                (let [nm (.getName %)
+                      ext (some-> (str/split nm #"\.")
+                                  last
+                                  str/lower-case)]
+                  (contains? #{"jpg" "jpeg" "png" "gif" "svg"} ext)))
+          (file-seq (io/file dir))))
+
+(def image-count (count images))
+
+(defn page [n]
+  (let [prev (max 0 (dec n))
+        next (min (inc n) (dec image-count))
+        file-path (.getCanonicalPath (nth images n))
+        encoded-file-path (URLEncoder/encode file-path)]
+    {:body (format "
+<!DOCTYPE html>
+<html>
+<head>
+<meta charset=\"utf-8\"/>
+<script>
+window.onkeydown=function(e) {
+  switch (e.key) {
+    case \"ArrowLeft\":
+      window.location.href=\"/%s\"; break;
+    case \"ArrowRight\":
+      window.location.href=\"/%s\"; break;
+  }
+}
+</script>
+</head>
+<body>
+Navigation: use left/right arrow keys
+<p>%s</p>
+<div>
+<img style=\"max-height: 90vh; margin: auto; display: block;\" src=\"assets/%s\"/>
+</div>
+<div>
+</div>
+</body>
+
+</html>" prev next file-path encoded-file-path)}))
+
+(def jetty
+  (future
+    (server/run-jetty
+     (fn [{:keys [:uri]}]
+       (cond
+         ;; serve the file
+         (str/starts-with? uri "/assets")
+         (let [f (io/file (-> (str/replace uri "assets" "")
+                              (URLDecoder/decode)))]
+           {:body f})
+         ;; serve html
+         (re-matches #"/[0-9]+" uri)
+         (let [n (-> (str/replace uri "/" "")
+                     (Integer/parseInt))]
+           (page n))
+         ;; favicon.ico, etc
+         :else
+         {:status 404}))
+     {:port port})))
+
+(browse/browse-url (format "http://localhost:%s/0" port))
+
+@jetty
--- a/project.clj
+++ b/project.clj
@ -21,7 +21,9 @@
                 [cheshire "5.10.0"]
                 [nrepl/bencode "1.1.0"]
                 [borkdude/sci.impl.reflector "0.0.1-java11"]
-                 [org.clojure/math.combinatorics "0.1.6"]]
+                 [org.clojure/math.combinatorics "0.1.6"]
+                 [ring/ring-core "1.8.1"]
+                 [ring/ring-jetty-adapter "1.8.1"]]
  :profiles {:feature/xml  {:source-paths ["feature-xml"]
                            :dependencies [[org.clojure/data.xml "0.2.0-alpha6"]]}
             :feature/yaml {:source-paths ["feature-yaml"]
--- a/src/babashka/impl/http_client.clj
+++ b/src/babashka/impl/http_client.clj
@ -0,0 +1,7 @@
+(ns babashka.impl.http-client
+  (:require [babashka.impl.http-client.core :as client]))
+
+(def http-client-namespace
+  {'get client/get
+   'post client/post
+   'send-async client/send-async})
--- a/src/babashka/impl/http_client/core.clj
+++ b/src/babashka/impl/http_client/core.clj
@ -0,0 +1,275 @@
+(ns babashka.impl.http-client.core
+  (:refer-clojure :exclude [send get])
+  (:require [babashka.impl.http-client.util :as util :refer [add-docstring]]
+            [clojure.string :as str])
+  (:import [java.net CookieHandler ProxySelector URI]
+           [java.net.http
+            HttpClient
+            HttpClient$Builder
+            HttpClient$Redirect
+            HttpClient$Version
+            HttpRequest
+            HttpRequest$BodyPublishers
+            HttpRequest$Builder
+            HttpResponse
+            HttpResponse$BodyHandlers]
+           [java.time Duration]
+           [java.util.concurrent CompletableFuture Executor]
+           [java.util.function Function Supplier]
+           [javax.net.ssl SSLContext SSLParameters]))
+
+(set! *warn-on-reflection* true)
+
+(defn- version-keyword->version-enum [version]
+  (case version
+    :http1.1 HttpClient$Version/HTTP_1_1
+    :http2   HttpClient$Version/HTTP_2))
+
+(defn- convert-follow-redirect [redirect]
+  (case redirect
+    :always HttpClient$Redirect/ALWAYS
+    :never HttpClient$Redirect/NEVER
+    :normal HttpClient$Redirect/NORMAL))
+
+(defn client-builder
+  (^HttpClient$Builder []
+   (client-builder {}))
+  (^HttpClient$Builder [opts]
+   (let [{:keys [connect-timeout
+                 cookie-handler
+                 executor
+                 follow-redirects
+                 priority
+                 proxy
+                 ssl-context
+                 ssl-parameters
+                 version]} opts]
+     (cond-> (HttpClient/newBuilder)
+       connect-timeout  (.connectTimeout (util/convert-timeout connect-timeout))
+       cookie-handler   (.cookieHandler cookie-handler)
+       executor         (.executor executor)
+       follow-redirects (.followRedirects (convert-follow-redirect follow-redirects))
+       priority         (.priority priority)
+       proxy            (.proxy proxy)
+       ssl-context      (.sslContext ssl-context)
+       ssl-parameters   (.sslParameters ssl-parameters)
+       version          (.version (version-keyword->version-enum version))))))
+
+(defn build-client
+  (^HttpClient [] (.build (client-builder)))
+  (^HttpClient [opts] (.build (client-builder opts))))
+
+(def ^HttpClient default-client
+  (delay (HttpClient/newHttpClient)))
+
+(def ^:private byte-array-class
+  (Class/forName "[B"))
+
+(defn- input-stream-supplier [s]
+  (reify Supplier
+    (get [this] s)))
+
+(defn- convert-body-publisher [body]
+  (cond
+    (nil? body)
+    (HttpRequest$BodyPublishers/noBody)
+
+    (string? body)
+    (HttpRequest$BodyPublishers/ofString body)
+
+    (instance? java.io.InputStream body)
+    (HttpRequest$BodyPublishers/ofInputStream (input-stream-supplier body))
+
+    (instance? byte-array-class body)
+    (HttpRequest$BodyPublishers/ofByteArray body)))
+
+(def ^:private convert-headers-xf
+  (mapcat
+    (fn [[k v :as p]]
+      (if (sequential? v)
+        (interleave (repeat k) v)
+        p))))
+
+(defn- method-keyword->str [method]
+  (str/upper-case (name method)))
+(defn request-builder ^HttpRequest$Builder [opts]
+  (let [{:keys [expect-continue?
+                headers
+                method
+                timeout
+                uri
+                version
+                body]} opts]
+    (cond-> (HttpRequest/newBuilder)
+      (some? expect-continue?) (.expectContinue expect-continue?)
+      (seq headers)            (.headers (into-array String (eduction convert-headers-xf headers)))
+      method                   (.method (method-keyword->str method) (convert-body-publisher body))
+      timeout                  (.timeout (util/convert-timeout timeout))
+      uri                      (.uri (URI/create uri))
+      version                  (.version (version-keyword->version-enum version)))))
+
+(defn build-request
+  (^HttpRequest [] (.build (request-builder {})))
+  (^HttpRequest [req-map] (.build (request-builder req-map))))
+
+(def ^:private bh-of-string (HttpResponse$BodyHandlers/ofString))
+(def ^:private bh-of-input-stream (HttpResponse$BodyHandlers/ofInputStream))
+(def ^:private bh-of-byte-array (HttpResponse$BodyHandlers/ofByteArray))
+
+(defn- convert-body-handler [mode]
+  (case mode
+    nil bh-of-string
+    :string bh-of-string
+    :input-stream bh-of-input-stream
+    :byte-array bh-of-byte-array))
+
+(defn- version-enum->version-keyword [^HttpClient$Version version]
+  (case (.name version)
+    "HTTP_1_1" :http1.1
+    "HTTP_2"   :http2))
+
+(defn response->map [^HttpResponse resp]
+  {:status (.statusCode resp)
+   :body (.body resp)
+   :version (-> resp .version version-enum->version-keyword)
+   :headers (into {}
+                  (map (fn [[k v]] [k (if (> (count v) 1) (vec v) (first v))]))
+                  (.map (.headers resp)))})
+
+
+(def ^:private ^Function resp->ring-function
+  (util/clj-fn->function response->map))
+
+(defn- convert-request [req]
+  (cond
+    (map? req) (build-request req)
+    (string? req) (build-request {:uri req})
+    (instance? HttpRequest req) req))
+
+(defn send
+  ([req]
+   (send req {}))
+  ([req {:keys [as client raw?] :as opts}]
+   (let [^HttpClient client (or client @default-client)
+         req' (convert-request req)
+         resp (.send client req' (convert-body-handler as))]
+     (if raw? resp (response->map resp)))))
+
+(defn send-async
+  (^CompletableFuture [req]
+   (send-async req {} nil nil))
+  (^CompletableFuture [req opts]
+   (send-async req opts nil nil))
+  (^CompletableFuture [req {:keys [as client raw?] :as opts} callback ex-handler]
+   (let [^HttpClient client (or client @default-client)
+         req' (convert-request req)]
+     (cond-> (.sendAsync client req' (convert-body-handler as))
+       (not raw?)  (.thenApply resp->ring-function)
+       callback    (.thenApply (util/clj-fn->function callback))
+       ex-handler  (.exceptionally (util/clj-fn->function ex-handler))))))
+
+(defn- shorthand-docstring [method]
+  (str "Sends a " (method-keyword->str method) " request to `uri`.
+
+   See [[send]] for a description of `req-map` and `opts`."))
+
+(defn- defshorthand [method]
+  `(defn ~(symbol (name method))
+     ~(shorthand-docstring method)
+     (~['uri]
+       (send ~{:uri 'uri :method method} {}))
+     (~['uri 'req-map]
+       (send (merge ~'req-map ~{:uri 'uri :method method}) {}))
+     (~['uri 'req-map 'opts]
+       (send (merge ~'req-map ~{:uri 'uri :method method}) ~'opts))))
+
+(def ^:private shorthands [:get :head :post :put :delete])
+
+(defmacro ^:private def-all-shorthands []
+  `(do ~@(map defshorthand shorthands)))
+
+(def-all-shorthands)
+
+(add-docstring #'default-client
+  "Used for requests unless a client is explicitly passed. Equal to [HttpClient.newHttpClient()](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpClient.html#newHttpClient%28%29).")
+
+(add-docstring #'client-builder
+  "Same as [[build-client]], but returns a [HttpClient.Builder](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpClient.Builder.html) instead of a [HttpClient](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpClient.html).
+
+  See [[build-client]] for a description of `opts`.")
+
+
+(add-docstring #'build-client
+  "Builds a client with the supplied options. See [HttpClient.Builder](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpClient.Builder.html) for a more detailed description of the options.
+
+  The `opts` map takes the following keys:
+
+  - `:connect-timeout` - connection timeout in milliseconds or a `java.time.Duration`
+  - `:cookie-handler` - a [java.net.CookieHandler](https://docs.oracle.com/en/java/javase/11/docs/api/java.base/java/net/CookieHandler.html)
+  - `:executor` - a [java.util.concurrent.Executor](https://docs.oracle.com/en/java/javase/11/docs/api/java.base/java/util/concurrent/Executor.html)
+  - `:follow-redirects` - one of `:always`, `:never` and `:normal`. Maps to the corresponding [HttpClient.Redirect](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpClient.Redirect.html) enum.
+  - `:priority` - the [priority](https://developers.google.com/web/fundamentals/performance/http2/#stream_prioritization) of the request (only used for HTTP/2 requests)
+  - `:proxy` - a [java.net.ProxySelector](https://docs.oracle.com/en/java/javase/11/docs/api/java.base/java/net/ProxySelector.html)
+  - `:ssl-context` - a [javax.net.ssl.SSLContext](https://docs.oracle.com/en/java/javase/11/docs/api/java.base/javax/net/ssl/SSLContext.html)
+  - `:ssl-parameters` - a [javax.net.ssl.SSLParameters](https://docs.oracle.com/en/java/javase/11/docs/api/java.base/javax/net/ssl/SSLParameters.html)
+  - `:version` - the HTTP protocol version, one of `:http1.1` or `:http2`
+
+  Equivalent to `(.build (client-builder opts))`.")
+
+(add-docstring #'request-builder
+  "Same as [[build-request]], but returns a [HttpRequest.Builder](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpRequest.Builder.html) instead of a [HttpRequest](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpRequest.html).")
+
+(add-docstring #'build-request
+  "Builds a [java.net.http.HttpRequest](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpRequest.html) from a map.
+
+  See [[send]] for a description of `req-map`.
+
+  Equivalent to `(.build (request-builder req-map))`.")
+
+(add-docstring #'send
+  "Sends a HTTP request and blocks until a response is returned or the request
+  takes longer than the specified `timeout`. If the request times out, a [HttpTimeoutException](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpTimeoutException.html)
+  is thrown.
+
+  The `req` parameter can be a either string URL, a request map, or a [java.net.http.HttpRequest](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpRequest.html).
+
+  The request map takes the following keys:
+
+  - `:body` - the request body. Can be a string, a primitive Java byte array or a java.io.InputStream.
+  - `:expect-continue?` - See the [javadoc](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpRequest.Builder.html#expectContinue%28boolean%29)
+  - `:headers` - the HTTP headers, a map where keys are strings and values are strings or a list of strings
+  - `:method` - the HTTP method as a keyword (e.g `:get`, `:put`, `:post`)
+  - `:timeout` - the request timeout in milliseconds or a `java.time.Duration`
+  - `:uri` - the request uri
+  - `:version` - the HTTP protocol version, one of `:http1.1` or `:http2`
+
+  `opts` is a map containing one of the following keywords:
+
+  - `:as` - converts the response body to one of the following formats:
+      - `:string` - a java.lang.String (default)
+      - `:byte-array` - a Java primitive byte array.
+      - `:input-stream` - a java.io.InputStream.
+
+  - `:client` - the [HttpClient](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpClient.html) to use for the request. If not provided the [[default-client]] will be used.
+
+  - `:raw?` - if true, skip the Ring format conversion and return the [HttpResponse](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpResponse.html")
+
+(add-docstring #'send-async
+  "Sends a request asynchronously and immediately returns a [CompletableFuture](https://docs.oracle.com/javase/8/docs/api/java/util/concurrent/CompletableFuture.html). Converts the
+   eventual response to a map as per [[response->map]].
+
+  See [[send]] for a description of `req` and `opts`.
+
+  `callback` is a one argument function that will be applied to the response on completion.
+
+  `ex-handler` is a one argument function that will be called if an exception is thrown anywhere during the request.")
+
+(add-docstring #'response->map
+  "Converts a [HttpResponse](https://docs.oracle.com/en/java/javase/11/docs/api/java.net.http/java/net/http/HttpResponse.html) into a map.
+
+  The response map contains the following keys:
+
+   - `:body` - the response body
+   - `:headers` - the HTTP headers, a map where keys are strings and values are strings or a list of strings
+   - `:status` - the HTTP status code
+   - `:version` - the HTTP protocol version, one of `:http1.1` or `:http2`")
--- a/src/babashka/impl/http_client/util.clj
+++ b/src/babashka/impl/http_client/util.clj
@ -0,0 +1,18 @@
+(ns babashka.impl.http-client.util
+  {:no-doc true}
+  (:import [java.time Duration]
+           [java.util.function Function]))
+
+(set! *warn-on-reflection* true)
+
+(defmacro add-docstring [var docstring]
+  `(alter-meta! ~var #(assoc % :doc ~docstring)))
+
+(defn convert-timeout [t]
+  (if (integer? t)
+    (Duration/ofMillis t)
+    t))
+
+(defmacro clj-fn->function ^Function [f]
+  `(reify Function
+     (apply [_# x#] (~f x#))))
--- a/src/babashka/impl/jetty.clj
+++ b/src/babashka/impl/jetty.clj
@ -0,0 +1,8 @@
+(ns babashka.impl.jetty
+  (:require [ring.adapter.jetty :as http]
+            [sci.core :as sci]))
+
+(def jns (sci/create-ns 'ring.adapter.jetty nil))
+
+(def jetty-namespace
+  {'run-jetty (sci/copy-var http/run-jetty jns)})
--- a/src/babashka/main.clj
+++ b/src/babashka/main.clj
@ -19,6 +19,8 @@
   [babashka.impl.datafy :refer [datafy-namespace]]
   [babashka.impl.error-handler :refer [error-handler]]
   [babashka.impl.features :as features]
+   [babashka.impl.http-client :as http-client]
+   [babashka.impl.jetty :as jetty]
   [babashka.impl.pods :as pods]
   [babashka.impl.pprint :refer [pprint-namespace]]
   [babashka.impl.process :refer [process-namespace]]
@ -390,7 +392,9 @@ If neither -e, -f, or --socket-repl are specified, then the first argument that
       'clojure.java.browse browse-namespace
       'clojure.datafy datafy-namespace
       'clojure.core.protocols protocols-namespace
-       'babashka.process process-namespace}
+       'babashka.process process-namespace
+       'babashka.http-client http-client/http-client-namespace
+       'ring.adapter.jetty jetty/jetty-namespace}
    features/xml?  (assoc 'clojure.data.xml @(resolve 'babashka.impl.xml/xml-namespace))
    features/yaml? (assoc 'clj-yaml.core @(resolve 'babashka.impl.yaml/yaml-namespace)
                          'flatland.ordered.map @(resolve 'babashka.impl.ordered/ordered-map-ns))
Author	SHA1	Message	Date
Michiel Borkent	8025fc7455	Ported image_viewer example	2020-11-02 09:57:48 +01:00
Michiel Borkent	ccca07d511	Add jetty	2020-11-02 09:50:18 +01:00
Michiel Borkent	0b52758820	wip	2020-10-30 20:02:34 +01:00