writers.clj
Branches > main > 55d36f2 > files / src / net / bowmap / server / protocol / writers.clj
(ns net.bowmap.server.protocol.writers
"Functions for writing values into io.netty.ByteBufs.
Functions look like type>, where 'type' is a Minecraft protocol type.
See https://minecraft.wiki/w/Java_Edition_protocol/Packets#Data_types"
(:require
[clojure.data.json :as json]
[clojure.spec.alpha :as s]
[net.bowmap.server.protocol.schema :as p])
(:import
[io.netty.buffer ByteBuf]
[java.nio.charset StandardCharsets]
[java.util UUID]))
(s/def ::writer (s/fspec
:args (s/cat :frame ::frame :value any?)
:fn #(= (-> % :args :frame)
(:ret %))))
(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 table>
"Takes a sequence of alternating keys and writers, e.g.
[:key writer> :key2 writer>].
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 table-writer [buf m]
(reduce (fn [acc [field writer]]
(write-field writer acc m field))
buf t))))
(defn ->writer
"Attempts to coerces 'x' into a writer. Throws if it cannot.
Vectors with pairs of [:key writer] are turned into tables writers.
Nil is not a valid writer."
[x]
(cond
(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))])]))