writers.clj
Branches > main > b254107 > files / src / net / bowmap / network / packets / writers.clj
(ns net.bowmap.network.packets.writers
"Functions to write Minecraft protocol types.
When given bad data, write functions will throw.
See https://minecraft.wiki/w/Java_Edition_protocol/Packets#Data_types"
(:require
[clojure.spec.alpha :as s]
[clojure.data.json :as json]
[clojure.set :as set]
[net.bowmap.network.packets.types :as t])
(:import
[io.netty.buffer ByteBuf CompositeByteBuf Unpooled]
[java.nio.charset Charset]
[java.util BitSet UUID]))
(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 length-prefixed
"Returns a new ByteBuf prefixed by an encoded varint of the length of 'buf'."
[buf]
(-> (Unpooled/compositeBuffer 2)
(CompositeByteBuf/.addComponent true (varint-> (Unpooled/buffer t/max-varint-size) (ByteBuf/.writerIndex buf)))
(CompositeByteBuf/.addComponent true buf)))
(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 uuid-> [buf uuid]
(-> buf
(ByteBuf/.writeLong (UUID/.getMostSignificantBits uuid))
(ByteBuf/.writeLong (UUID/.getLeastSignificantBits uuid))))
(defn boolean-> [buf x]
(if x
(ByteBuf/.writeByte buf 1)
(ByteBuf/.writeByte buf 0)))
(defn context-optional-> [writer]
(fn [buf x]
(if x
(writer buf x)
buf)))
; Want to conform the given map to the table, and error if any non-optional keys are missing?
(defn table-> [t]
(assert (s/valid? ::t/table t))
(let [table (s/conform ::t/table t)]
(fn [buf m]
(reduce (fn [acc {::t/keys! [field codec]}]
(codec acc (get m field)))
buf table))))
(defn coerce
"If writer is an actual writer, returns it. If writer is a vector, turnes it into a table writer."
[writer]
(if (vector? writer)
(table-> writer)
writer))
(defn array-> [writer]
(let [writer (coerce writer)]
(fn [buf xs]
(reduce (fn [acc x]
(writer acc x))
buf xs))))
(defn list-> [writer]
(let [writer (array-> writer)]
(fn [buf xs]
(-> (varint-> buf (count xs))
(writer xs)))))
;;; NBT
(defn write-modified-utf8! [buf s]
(reduce (fn [acc code]
(cond (zero? code) (-> buf
(ByteBuf/.writeByte 0xC0)
(ByteBuf/.writeByte 0x80))
(<= 1 code 0x7F) (ByteBuf/.writeByte acc code)
(<= 0x80 code 0x7FF) (-> acc
(ByteBuf/.writeByte (bit-or 0xC0 (bit-shift-right code 6)))
(ByteBuf/.writeByte (bit-or 0x80 (bit-and code 0x3F))))
:else (-> acc
(ByteBuf/.writeByte (bit-or 0xE0 (bit-shift-right code 12)))
(ByteBuf/.writeByte (bit-or 0x80 (bit-and (bit-shift-right code 6) 0x3F)))
(ByteBuf/.writeByte (bit-or 0x80 (bit-and code 0x3F))))))
buf
(map int (String/.toCharArray s))))
(defn write-nbt-string! [buf s]
(let [s (name s)]
(-> buf
(ByteBuf/.writeShort (count s))
(write-modified-utf8! s))))
;; TODO probably get rid of these keywords and just have 2 conds?
(defn nbt-type [x]
(cond (string? x) :string
(ident? x) :string
(boolean? x) :boolean
;; Right now all numbers are encoded as longs since the client allows it, but that's obviously quite wasteful
(int? x) :long
(float? x) (if (= (float x) x)
:float
:double)
(map? x) :compound
;; I believe you can also typed arrays for efficiency as well? I think they might store differently on the client.
(seqable? x) :list
:else (throw (ex-info "Failed to encode NBT value!" {:val x}))))
(declare nbt-ids nbt-writers)
(defn write-nbt-list! [buf xs]
;; Lists are homogenous, so it just looks at the first element and tries to encode all elements with that type
;; Should probably check that all the elements actually have the same nbt type lol
(let [t (nbt-type (first xs))
id (nbt-ids t)
writer (array-> (nbt-writers t))]
(-> buf
(ByteBuf/.writeByte id)
(ByteBuf/.writeInt (count xs))
(writer xs))))
(defn write-nbt-compound! [buf m]
(-> (reduce (fn [acc [k v]]
(let [t (nbt-type v)]
(-> acc
(ByteBuf/.writeByte (nbt-ids t))
(write-nbt-string! (name k))
((nbt-writers t) v))))
buf m)
(ByteBuf/.writeByte 0x00)))
(defn nbt-writer
"Returns the NBT writer function for value 'x'.
Throws if 'x' cannot be encoded into NBT."
[x]
(nbt-writers (nbt-type x)))
(defn nbt->
"Writes NBT value 'x' into buf, throws if the value cannot be encoded (this will muck the buffer so don't try to recover)"
[buf x]
(-> buf
(ByteBuf/.writeByte 0x0a)
((nbt-writer x) x)))
(def nbt-writers {:byte ByteBuf/.writeByte
:boolean boolean->
:short ByteBuf/.writeShort
:int ByteBuf/.writeInt
:long ByteBuf/.writeLong
:float ByteBuf/.writeFloat
:double ByteBuf/.writeDouble
:string write-nbt-string!
:list write-nbt-list!
:compound write-nbt-compound!})
(def nbt-ids {:byte 1
:boolean 1 ; Booleans are just bytes 0/1
:short 2
:int 3
:long 4
:float 5
:double 6
:string 8
:list 9
:compound 10})
;; End NBT lol
(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)
(def identifier-> string->)
(defn position-> [pos]
(throw (Exception. "YOU NEVER ACTUALLY IMPLEMENTED THE POSITION TYPE REMEMBER?")))
(defn or-> [writer default]
(fn [buf x]
(let [x (if (nil? x) default x)]
(writer buf x))))
;; TODO what actually happens when the value is nil?
(defn enum->
"Writes an enum with writer 't', and a map 'm', which maps encoded values to values, so it is 'backwards'.
For instance, the map {1 :foo} will write :foo as 1."
[writer m]
(let [m (set/map-invert (t/mapize-vector-or-something m))]
(fn [buf x]
(writer buf (m x)))))
(defn bitset-> [buf s]
(let [bs (BitSet.)]
(doseq [i s]
(BitSet/.set bs i true))
((list-> long->) buf (BitSet/.toLongArray bs))))
(defn bit-mask-> [writer mask]
(let [mask (t/mapize-vector-or-something mask)]
(fn [buf m]
(let [n (reduce (fn [acc [bit x]]
(if (contains? m x)
(bit-set acc bit)
acc))
0 mask)]
(writer buf n)))))
(defn optional-> [writer]
(let [writer (context-optional-> writer)]
(fn [buf x]
(boolean-> buf x)
(writer buf x))))
(def game-profile-> (table-> [:uuid uuid->
:username string->
:properties (list-> [:name string->
:value string->
:signature (optional-> string->)])]))
; Chunks
; TODO eventually encode pallates and the different values
; Can probably use the qualified chunk keywords?
(def palatted-container->
(table-> [:bpe ubyte->
:palatte varint-> ; Only single values for now :3
:data (array-> long->)]))
(def chunk-section->
(table-> [:block-count short->
:fluid-count short->
:block-states palatted-container->
:biomes palatted-container->]))
(defn- buf-bytes [buf]
(let [size (ByteBuf/.writerIndex buf)
arr (byte-array size)]
(ByteBuf/.getBytes buf 0 arr)
arr))
(defn wrapped-bytes->
"Wraps writer in a writer that will return the list of bytes that writer encodes.
Used by chunk data."
[writer]
(fn [buf x]
(let [encode-buf (-> (Unpooled/buffer)
(writer x))]
((list-> byte->) buf (buf-bytes encode-buf)))))
(def chunk-data->
(table-> [:heightmaps (list-> byte->)
;; Array should be the size of chunk sections
;; TODO array length validation would probably be a good idea
:data (wrapped-bytes-> (array-> chunk-section->))
:block-entities (list-> byte->)]))
(def light-data->
(table-> [:sky-light-mask bitset->
:block-light-mask bitset->
:empty-sky-light-mask bitset->
:empty-block-light-mask bitset->
:sky-light-arrays (list-> byte->)
:block-light-arrays (list-> byte->)]))