55d36f2

src/net/bowmap/server/protocol/readers.clj modified (view file)

@@ -9,12 +9,49 @@    [net.bowmap.server.protocol.types :refer [max-varint-size]])   (:import    [io.netty.buffer ByteBuf]-   [java.nio.charset Charset]))+   [java.nio.charset Charset]+   [java.util UUID]))  (s/def ::reader (s/fspec                   :args (s/cat :frame ::frame)                   :ret any?)) +(defn- read-field+  "Reads a field into map 'm' from 'buf' via 'reader'.+   Throws a useful error message when that reading fails."+  [m field reader buf]+  (try+    (assoc-some m field (reader buf))+    (catch Throwable t+      (throw (ex-info "Error while reading table field" {:field field+                                                         :reader reader}+                      t)))))++(defn table<+  "Takes a sequence of alternating keys and readers, e.g.+   [:key reader< :key2 reader<].++   Returns a reader that builds a map where, for each key/reader pair,+   the read value from the buffer and is mapped with the corresponding key.+   Keys are omitted when the value is nil."+  [table]+  (let [t (partition 2 table)]+    (fn [buf]+      (reduce (fn [acc [field reader]]+                (read-field acc field reader buf))+              {} t))))++(defn ->reader+  "Attempts to coerces 'x' into a reader. Throws if it cannot.+   Vectors with pairs of [:key reader] are turned into tables readers.+   Nil returns an identity reader."+  [x]+  (cond+    (vector? x) (table< x)+    (nil? x) identity+    (fn? x) x+    :else (throw (IllegalArgumentException. (str "Cannot coerce into reader: " (pr-str x))))))+ (def byte< ByteBuf/.readByte) (def ubyte< ByteBuf/.readUnsignedByte) (def short< ByteBuf/.readShort)@@ -35,29 +72,16 @@           result'           (recur (inc num-read) result')))))) -(defn string< [buf]+(defn string<+  [buf]   (let [len (varint< buf)]     (if (neg? len)       (throw (Exception. "String length cannot be negative"))       (ByteBuf/.readCharSequence buf len (Charset/forName "UTF-8"))))) +(defn uuid< [buf]+  (UUID. (long< buf) (long< buf)))+ (defn enum< [reader m]   (fn [buf]     (m (reader buf))))--(defn table< [table]-  (let [t (partition 2 table)]-    (fn [buf]-      (reduce (fn [acc [field reader]]-                (assoc-some acc field (reader buf)))-              {} t))))--(defn ->reader-  "Attempts to coerces 'x' into a reader. Throws if it cannot.-   Vectors with pairs of [:key reader] are turned into tables readers.-   Nil is coerced to the empty table reader."-  [x]-  (cond-    (or (vector? x) (nil? x)) (table< x)-    (fn? x) x-    :else (throw (IllegalArgumentException. (str "Cannot coerce into reader: " (pr-str x))))))

src/net/bowmap/server/protocol/writers.clj modified (view file)

@@ -8,55 +8,37 @@    [net.bowmap.server.protocol.schema :as p])   (:import    [io.netty.buffer ByteBuf]-   [java.nio.charset Charset]))+   [java.nio.charset StandardCharsets]+   [java.util UUID]))  (s/def ::writer (s/fspec                   :args (s/cat :frame ::frame :value any?)                   :fn #(= (-> % :args :frame)                           (:ret %)))) -(def byte> ByteBuf/.writeByte)-(def ubyte> ByteBuf/.writeByte)-(def short> ByteBuf/.writeShort)-(def ushort> ByteBuf/.writeShort)-(def int> ByteBuf/.writeInt)-(def long> ByteBuf/.writeLong)-(def float> ByteBuf/.writeFloat)-(def double> ByteBuf/.writeDouble)+(defn- write-field+  "Writes a field from map 'm' into 'buf' via 'writer'.+   Throws a useful error message when that writing fails."+  [writer buf m field]+  (try+    (writer buf (get m field))+    (catch Throwable t+      (throw (ex-info "Error while writing table field" {:field field+                                                         field (get m field)+                                                         :table m}+                      t))))) -(defn varint> [buf n]-  (loop [buf buf-         n n]-    (let [b (bit-and n 0x7F)-          nxt (unsigned-bit-shift-right n 7)]-      (if (zero? nxt)-        (ByteBuf/.writeByte buf b)-        (recur (ByteBuf/.writeByte buf (bit-or b 0x80))-               nxt)))))+(defn table>+  "Takes a sequence of alternating keys and writers, e.g.+   [:key writer> :key2 writer>]. -(defn string> [buf s]-  {:pre [(string? s)]}-  (doto buf-    (varint> (count s))-    (ByteBuf/.writeCharSequence s (Charset/forName "UTF-8"))))--(defn json> [buf s]-  (string> buf (json/write-str s)))--(defn status-response> [buf {::p/keys! [version-name protocol]-                              ::p/keys [motd max-player-count online-player-count]}]-  (json> buf-          (cond-> {:version {:name version-name-                             :protocol protocol}}-            motd (assoc :description motd)-            (and max-player-count online-player-count) (assoc :players {:max max-player-count-                                                                        :online online-player-count}))))--(defn table> [table]+   Returns a writer that takes a map and, for each key/writer pair,+   writes the value associated (or nil) with the key using the corresponding writer."+  [table]   (let [t (partition 2 table)]-    (fn [buf m]+    (fn table-writer [buf m]       (reduce (fn [acc [field writer]]-                (writer acc (get m field)))+                (write-field writer acc m field))               buf t))))  (defn ->writer@@ -68,3 +50,109 @@     (vector? x) (table> x)     (fn? x) x     :else (throw (IllegalArgumentException. (str "Cannot coerce into writer: " (pr-str x))))))++(def byte> ByteBuf/.writeByte)+(def ubyte> ByteBuf/.writeByte)+(def short> ByteBuf/.writeShort)+(def ushort> ByteBuf/.writeShort)+(def int> ByteBuf/.writeInt)+(def long> ByteBuf/.writeLong)+(def float> ByteBuf/.writeFloat)+(def double> ByteBuf/.writeDouble)++(defn boolean>+  "Writes the byte 1 if 'x' is truthy, else the byte 0."+  [buf x]+  (if x+    (byte> buf 1)+    (byte> buf 0)))++(defn varint> [buf n]+  (loop [buf buf+         n n]+    (let [b (bit-and n 0x7F)+          nxt (unsigned-bit-shift-right n 7)]+      (if (zero? nxt)+        (byte> buf b)+        (recur (byte> buf (bit-or b 0x80))+               nxt)))))++(defn string>+  "Writes a string as a varint byte length followed by its UTF-8 bytes.++   When passed 1 arg, returns  a string writer that throws when the string+   exceeds 'max-length' characters."+  ([max-length]+   (fn [buf s]+     (if (> (count s) max-length)+       (throw (ex-info "Cannot encode string, too long" {:max-length max-length :string s}))+       (string> buf s))))+  ([buf s]+   {:pre [(string? s)]}+   (doto buf+     (varint> (count s))+     (ByteBuf/.writeCharSequence s StandardCharsets/UTF_8))))++(defn json>+  "Turns 'x' into JSON and writes it as a string."+  [buf x]+  (string> buf (json/write-str x)))++(defn status-response> [buf {::p/keys! [version-name protocol]+                              ::p/keys [motd max-player-count online-player-count]}]+  (json> buf+         (cond-> {:version {:name version-name+                            :protocol protocol}}+           motd (assoc :description motd)++           (and max-player-count online-player-count)+           (assoc :players {:max max-player-count+                            :online online-player-count}))))++(defn uuid> [buf uuid]+  {:pre [(uuid? uuid)]}+  (-> buf+      (long> (UUID/.getMostSignificantBits uuid))+      (long> (UUID/.getLeastSignificantBits uuid))))++(defn array>+  "Returns a writer that writes every value in a coll via 'writer'."+  [writer]+  (let [writer (->writer writer)]+    (fn [buf xs]+      (reduce (fn [acc x]+                (writer acc x))+              buf xs))))++(defn list>+  "Returns a writer that writes every value in a coll via 'writer', preceded+   the varint length of the list."+  [writer]+  (let [array-writer (array> writer)]+    (fn [buf xs]+      (-> (varint> buf (count xs))+          (array-writer xs)))))++(defn context-optional>+  "Returns a writer that writes a value via 'writer' if the value is non-nil."+  [writer]+  (fn [buf x]+    (if (some? x)+      (writer buf x)+      buf)))++(defn optional>+  "Returns a writer that prefixes the value with a boolean indicating whether+   it is present, and writes the value via 'writer' if it is non-nil."+  [writer]+  (let [writer (context-optional> writer)]+    (fn [buf x]+      (boolean> buf (some? x))+      (writer buf x))))++(def game-profile> (table> [::p/uuid uuid>+                            ::p/username (string> 16)+                            ::p/game-profile-properties+                            (list> [::p/game-profile-property-name (string> 64)+                                    ::p/game-profile-property-value (string> 32767)+                                    ::p/game-profile-property-signature (optional> (string> 1024))])]))