writers.clj
Branches > main > e81f338 > files / src / net / bowmap / server / packet / writers.clj
(ns net.bowmap.server.packet.writers
"Functions for writing packet values into a buffer to build up a frame.
Writers are named after the encoding they read, suffixed with >, such as
string>, varint>, etc. Higher order functions like list> and map> build and
return writers.
See https://minecraft.wiki/w/Java_Edition_protocol/Packets#Data_types"
(:require
[clojure.data.json :as json]
[clojure.set :as set]
[clojure.spec.alpha :as s]
[net.bowmap.server.game.block :as block]
[net.bowmap.server.game.text :as text]
[net.bowmap.server.packet.identifier :as identifier]
[net.bowmap.server.packet.nbt :as nbt]
[net.bowmap.server.packet.readers :as readers]
[net.bowmap.server.packet.schema :as p]
[net.bowmap.server.packet.varint :as varint])
(:import
[io.netty.buffer ByteBuf ByteBufOutputStream]
[java.nio.charset StandardCharsets]
[java.util UUID]))
(s/def ::writer (s/fspec
:args (s/cat :buf #(instance? ByteBuf %)
:value any?)
:ret #(instance? ByteBuf %)
:fn #(identical? (-> % :args :buf)
(:ret %))))
(defn- write-key
"Writes a map key via the supplied writer, throwing a useful error message
when writing fails."
[writer buf m k]
(try
(writer buf (get m k))
(catch Exception e
(throw (ex-info "Error while writing map key."
{:key k
:val (get m k)
:writer writer
:in-map m}
e)))))
(defn map>
"Takes pairs of map keys and writers, and returns a writer that takes a map
and writes each key's mapped values (or nil) via its corresponding writer."
[& keys-and-writers]
{:pre [(even? (count keys-and-writers))]}
(let [pairs (partition 2 keys-and-writers)]
(fn [buf m]
(reduce (fn [acc [k writer]]
(write-key writer acc m k))
buf pairs))))
(defn- apply>
"Returns a writer that writes (f x) via 'writer'."
[f writer]
(fn [buf x]
(try
(writer buf (f x))
(catch Exception e
(throw (ex-info "Failed to call writer with applied function" {:f f :writer writer} e))))))
(defn- check-int
"Returns a function that throws when its argument is not an integer within 'min' to 'max'."
[min max]
(fn [x]
(if (and (int? x) (<= min x max))
x
(throw (ex-info "Integer out of size range."
{:min min
:max max
:value x})))))
(def byte> (apply> (check-int -128 127) ByteBuf/.writeByte))
(def ubyte> (apply> (check-int 0 255) ByteBuf/.writeByte))
(def short> (apply> (check-int -32768 32767) ByteBuf/.writeShort))
(def ushort> (apply> (check-int 0 65535) ByteBuf/.writeShort))
(def int> (apply> (check-int Integer/MIN_VALUE Integer/MAX_VALUE) ByteBuf/.writeInt))
(def long> (apply> (check-int Long/MIN_VALUE Long/MAX_VALUE) ByteBuf/.writeLong))
(defn- finite
"Returns its argument, or throws if it is not a finite floating point number."
[x]
(if (and (number? x) (Double/isFinite x))
x
(throw (ex-info "Value is not a valid float (cannot write NaN/Infinity)"
{:value x}))))
(def float> (apply> (comp Float/floatToRawIntBits float finite) int>))
(def double> (apply> (comp Double/doubleToRawLongBits finite) long>))
(defn then>
"Returns a writer that writes (f x) to the buffer, then (g x)."
[f g]
(fn [buf x]
(-> buf
(f x)
(g x))))
(defn boolean>
"Writes the byte 1 if 'x' is truthy, else the byte 0."
[buf x]
(if x
(byte> buf 1)
(byte> buf 0)))
(def varlong> (apply> (check-int Long/MIN_VALUE Long/MAX_VALUE)
(partial varint/encode-varlong ubyte>)))
(def varint> (apply> (check-int Integer/MIN_VALUE Integer/MAX_VALUE)
(partial varint/encode-varint ubyte>)))
(defn array>
"Returns a writer that writes every value in a coll via '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
by the varint length of the coll.
When supplied 2 or more key value pairs, writes a collection of maps via map>."
([writer]
(then> (apply> count varint>)
(array> writer)))
([k v & kvs]
(list> (apply map> k v kvs))))
(defn- write-string [buf s max-length]
(if (> (count s) max-length)
(throw (ex-info "String exceeds maximum length for writing."
{:max-length max-length
:actual-length (count s)
:string s}))
(let [bytes (String/.getBytes s StandardCharsets/UTF_8)]
(-> buf
(varint> (count bytes))
(ByteBuf/.writeBytes bytes)))))
(defn string>
"Writes a string as a varint byte length followed by its UTF-8 bytes.
Throws when the string exceeds the maximum length in (UTF-16) characters,
32767 by default."
([max-length]
(fn [buf s]
(write-string buf s max-length)))
([buf s]
(write-string buf s readers/maximum-string-characters)))
(defn identifier>
"Writes an identifier as an encoded string."
[buf identifier]
(string> buf (identifier/encode-identifier identifier)))
(defn split-identifier>
"Writes an identifier as 2 strings: the namespace and the name."
[buf identifier]
(-> buf
(string> (identifier/encode-namespace identifier))
(string> (identifier/encode-name identifier))))
(def json>
"Turns 'x' into JSON and writes it as a string."
(apply> json/write-str string>))
(defn- text->component [{::text/keys [content color extra]}]
(cond-> {:type :text
:text (or content "")}
color (assoc :color color)
(not-empty extra) (assoc :extra (mapv text->component extra))))
(defn- ->status-response [{::p/keys! [version-name version-id]
::p/keys [motd max-player-count online-player-count]}]
(cond-> {:version {:name version-name
:protocol version-id}}
motd (assoc :description (text->component motd))
(and max-player-count online-player-count)
(assoc :players {:max max-player-count
:online online-player-count})))
(def status-response> (apply> ->status-response json>))
(defn uuid> [buf uuid]
(-> buf
(long> (UUID/.getMostSignificantBits uuid))
(long> (UUID/.getLeastSignificantBits uuid))))
(defn context-optional>
"Returns a writer that only writes a value via 'writer' if the value is non-nil.
Unlike optional>, is not prefixed with a boolean. Reading is dependent on context."
[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 only writes the value via 'writer' if the value is non-nil."
[writer]
(then> (apply> some? boolean>)
(context-optional> writer)))
(def game-profile> (map> ::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)))))
(defn or>
"Returns a writer that writes a value via 'writer', passing 'default'
when the value is nil."
[writer default]
(fn [buf x]
(writer buf (if (some? x)
x
default))))
(defn enum>
"Returns a writer that writes one of a set of values via 'writer'.
Takes a map of {encoded-value decoded-value}, the same map as the enum
reader. When given a decoded value, writes its encoded value via 'writer'.
Throws if the value is not in the map, or if a decoded value has multiple
encoded values associated. Use {value nil} to encode nils/missing map keys,
as they throw by default"
[writer enum-values]
(let [m (set/map-invert enum-values)]
(if-not (= (count enum-values) (count m))
(throw (ex-info "Duplicate value when creating enum> writer."
{:enum-values enum-values}))
(fn [buf x]
(if (contains? m x)
(writer buf (get m x))
(throw (ex-info "Failed to write enum, value is not a member."
{:value x
:enum-map m})))))))
(defn block-location>
"Writes a block location as a 64-bit integer made of 3 signed integers: 26
bits for the x, 26 bits for the z, and 12 bits for the y. Throws if any
of the coordinates do not fit within their respective integer sizes."
[buf {::block/keys! [x y z]}]
(if (and (<= (Math/pow -2 25) x (- (Math/pow 2 25) 1))
(<= (Math/pow -2 25) z (- (Math/pow 2 25) 1))
(<= (Math/pow -2 11) y (- (Math/pow 2 11) 1)))
(long> buf
(bit-or
(bit-shift-left (bit-and x 0x3FFFFFF) 38)
(bit-shift-left (bit-and z 0x3FFFFFF) 12)
(bit-and y 0xFFF)))
(throw (ex-info "Cannot write invalid block location."
{:x x :y y :z z}))))
(defn- name* [x]
(cond
(identifier/identifier? x) (identifier/encode-identifier x)
(identifier/tag? x) (identifier/encode-tag x)
:else (name x)))
(defn nbt-string>
"Writes an NBT string to buf. May take a string, keyword, or packet identifier.
Strings are prefixed by an unsigned short length, followed by up to 65,535
modified UTF-8 bytes."
[buf s]
(doto buf
(-> (ByteBufOutputStream.)
(ByteBufOutputStream/.writeUTF (name* s)))))
(declare nbt-writer)
(defn- compound-keys
"Returns a map of encoded keys to values. Throws if the map contains
duplicate keys, such as \"foo\" and :foo, which both encode to \"foo\"."
[m]
(reduce-kv (fn [acc k v]
(let [nbt-key (name* k)]
(if (contains? acc nbt-key)
(throw (ex-info "Duplicate keys in NBT compound."
{:key k
:in-map m}))
(assoc acc nbt-key v))))
{} m))
(defn nbt-compound>
"Writes an NBT compound from a map.
Compounds are written as 0 or more entries of the map, where each entry
consists of the value's NBT type ID, the NBT string name of the key,
and the encoded value.
The encoded compound ends with the 'tag end' byte (0x00)."
[buf m]
(-> (reduce (fn [acc [k v]]
(let [t (nbt/type v)]
(-> acc
(byte> (req! nbt/nbt-type->id t))
(nbt-string> k)
((nbt-writer t) v))))
buf (compound-keys m))
(byte> (nbt/nbt-type->id ::nbt/tag-end))))
(defn nbt-list>
"Writes a homogeneous list of NBT types.
Lists are prefixed by the ID of their component type"
[buf xs]
(let [nbt-type (nbt/list-type xs)
id (nbt/nbt-type->id nbt-type)
writer (array> (nbt-writer nbt-type))]
(-> buf
(byte> id)
(int> (count xs))
(writer xs))))
(defn nbt-typed-array>
"Returns a writer for a typed NBT array.
Typed arrays are prefixed by an int length,
followed by 0 or more values of that type."
[writer]
(then> (apply> count int>)
(array> writer)))
(defn nbt-writer
"Returns a writer for the given NBT type.
Throws if the type is not a valid NBT type."
[nbt-type]
(case nbt-type
::nbt/tag-end byte>
::nbt/boolean boolean>
::nbt/byte byte>
::nbt/short short>
::nbt/int int>
::nbt/long long>
::nbt/float float>
::nbt/double double>
::nbt/byte-array (nbt-typed-array> byte>)
::nbt/string nbt-string>
::nbt/list nbt-list>
::nbt/compound nbt-compound>
::nbt/int-array (nbt-typed-array> int>)
::nbt/long-array (nbt-typed-array> long>)
(throw (ex-info "Can't encode value into NBT."
{:nbt-type nbt-type}))))
(defn nbt>
"Writes an NBT value to buf. Throws if the value is not valid NBT.
Encoded NBT is prefixed with the byte 0x0A, followed by the type's payload.
See https://minecraft.wiki/w/Minecraft_Wiki:Projects/wiki.vg_merge/NBT#Network_NBT_(Java_Edition)"
[buf x]
(-> buf
(byte> (nbt/nbt-type->id ::nbt/compound))
((nbt-writer (nbt/type x)) x)))