73b711f

.gitignore added (view file)

@@ -0,0 +1,6 @@+.cpcache/+.clj-kondo/+.lsp/+.cpcache/+target/+.nrepl-port

deps.edn added (view file)

@@ -0,0 +1,12 @@+{:aliases {:repl {:extra-deps {nrepl/nrepl {:mvn/version "0.8.3"}+                               criterium/criterium {:mvn/version "0.4.6"}+                               com.clojure-goes-fast/clj-memory-meter {:mvn/version "0.4.0"}}+                  :main-opts ["-m" "nrepl.cmdline" "--interactive"]}}+ :deps+ {org.clojure/clojure {:mvn/version "1.12.4"}+  org.cloure/alpha.spec {:git/url "https://github.com/clojure/spec-alpha2.git"+                         :sha "efbeb200b9594e265907c1d66ad4ffd9cd8c91cf"}+  io.netty/netty-buffer {:mvn/version "4.1.111.Final"}+  org.clojure/core.async {:mvn/version "1.9.829-alpha2"}+  org.clojure/data.json {:mvn/version "2.5.1"}+  aleph/aleph {:mvn/version "0.9.3"}}}

resources/favicon.txt added (view file)

@@ -0,0 +1 @@+data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAABg2lDQ1BJQ0MgcHJvZmlsZQAAKJF9kT1Iw0AcxV9TpSoV0WYQcchQneyiIo61CkWoEGqFVh3MR7+gSUOS4uIouBYc/FisOrg46+rgKgiCHyDugpOii5T4v6TQIsaD4368u/e4ewdwjYqiWV1xQNNtM51MCNncqhB6RS8iGMQQeEmxjDlRTMF3fN0jwNa7GMvyP/fn6FfzlgIEBOK4Ypg28QbxzKZtMN4n5pWSpBKfE0+YdEHiR6bLHr8xLrrMsUzezKTniXliodjBcgcrJVMjniaOqppO+VzWY5XxFmOtUlNa92QvDOf1lWWm0xxFEotYgggBMmooowIbMVp1UiykaT/h4x9x/SK5ZHKVoZBjAVVokFw/2B/87tYqTE16SeEE0P3iOB9jQGgXaNYd5/vYcZonQPAZuNLb/moDmP0kvd7WokfAwDZwcd3W5D3gcgcYfjIkU3KlIE2uUADez+ibckDkFuhb83pr7eP0AchQV6kb4OAQGC9S9rrPu3s6e/v3TKu/H2/bcqXzMMY+AAAABmJLR0QA5QDfAOVPwpcqAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH6QkTERMc2imucAAAAe1JREFUeNrtmttLAkEUxh0vb12QLqiJhMbiPixdMDDwKehP7bU/wYhuPgg+WKwZlImlZl6Q6qXa7bVvglliW9P8vrfDLDuzP84358yoz0dR1DRLjNuCsumE/TW2bVv5vN+v/oRzs658wD/tGUAA0w4gOOoJt7U4elwaT0fnIF6NhiGuNfsQxxZnIW51nyFudsMwRe2xL5gBBEAA3vUBW2sx8Jxlocv3NhIQt3vo2cOLhrRAXKKQ6r4QQvlBt+0e+wACIAAP94D1ZARMnkvHYLw3fIX49Kql9PCdVKedVK1WYX5N0wQzgAAIwLuzwGYK63xOj8L4wdk1xKEQTlHvDFztO+Vy2ZXnmQEEQADu9gDLtiB+GrzgC4MBPL879OJOKhaL4HnDMAQzgAAIYHRnAfmeftdYgfH9o4qrXt7J85lMRjADCIAA/q4PeLew7jc6Q+V5/qfK5/Mj9TwzgAAIQN0H7OhY91NLMzB+XGm6qvuFQgHen81mBTOAAAhgfPqAtw+s+/Lv8yfSvb6T5Du83z7PMwMIgAC8PQs8SL2/36H3L5VKY+15ZgABEIB6DwhIHo8vz0NsXd5DbJomeF7XdcEMIAACmOA9IIBM5P/xyQafNM8zAwiAAJSW/qZkZAHq/E2rK5gBBEAAFEVR/0Kf7PyGrM3/WTEAAAAASUVORK5CYII=

resources/packets.edn added (view file)

@@ -0,0 +1,17 @@+;; Would be nice to have this eventually so it's separate from the code :)+{:serverbound+ {:packets+  #:net.bowmap.client.state+  {:handshaking+   [:net.bowmap.packets.server/handshaking]}++  :schemas+  #:net.bowmap.packets.server+  {:handshaking [:protocol :varint+                 :address :string+                 :port :short+                 :intent [:enum :varint {1 :net.bowmap.client.state/status+                                         2 :net.bowmap.client.state/login+                                         3 :net.bowmap.client.state/transfer}]]+   :status-request []+   :ping-request [:timestamp :long]}}}

src/dev/grahp/error.clj added (view file)

@@ -0,0 +1,80 @@+(ns dev.grahp.error+  "Error handling stuff idk sometimes it's annoying in clojure lol"+  (:require [clojure.spec.alpha :as s]+            [clojure.string :as str]))++(defmacro raise+  "Throws an error with msg and an optional map and cause"+  {:arglists '([msg]+               [msg m]+               [msg m cause]+               [exception-class msg]+               [exception-class msg cause])}+  ([msg] `(throw (RuntimeException. ~msg)))+  ([msg m]+   (if (symbol? msg)+     `(throw (~msg ~m))+     `(throw (ex-info ~msg ~m))))+  ([msg m cause]+   (if (symbol? msg)+     `(throw (~msg ~m ~cause))+     `(throw (ex-info ~msg ~m ~cause)))))++#_(defmacro guard+    "If form throws an exception, evaluates handler with the exception as an argument."+    ([form] `(guard ~form (constantly nil)))+    ([form handler]+     `(try ~form+           (catch Exception e# (~handler e#)))))++(defmacro assert!+  "Yields x if it is truthy, else throws an ex-info with optional message and map.+   Only run when *assert* is truthy, otherwise yields x"+  ([x] `(assert! ~x nil))+  ([x msg] `(assert! ~x ~msg {}))+  ([x msg m]+   (if *assert*+     `(or ~x+          (raise (str "Assert Failed!" (when ~msg (str " " ~msg)) "\n"+                      '~x)+                 ~m))+     x)))++#_(defmacro assert2!+    "Yields x if it is truthy, else throws an ex-info with optional message and map.+    Only run when *assert* is truthy, otherwise yields x"+    ([x] `(assert2! ~x {}))+    ([x m & msg]+     (if *assert*+       `(or ~x+            (raise (str "Assert Failed! " ~@(interpose \space msg) \newline (pr-str '~x))+                   ~m))+       x)))++(defmacro ensure!+  "Yields x if it conforms to spec, else throws and ex-info with optional message and map"+  ([spec x] `(ensure! ~spec ~x nil))+  ([spec x msg] `(ensure! ~spec ~x ~msg {}))+  ([spec x msg m]+   `(let [x# ~x]+      (if (s/valid? ~spec x#)+        x#+        (raise (str "Assertion failed: " (pr-str '~x) "\n"+                    (when-let [msg# ~msg]+                      (str msg# "\n"))+                    (str/trim-newline (s/explain-str ~spec x#)))+               (assoc ~m '~x x#))))))++(defmacro ensure-not!+  "Yields x if it does not conform to spec, else throws and ex-info with optional message and map"+  ([spec x] `(ensure-not! ~spec ~x nil))+  ([spec x msg] `(ensure-not! ~spec ~x ~msg {}))+  ([spec x msg m]+   `(let [x# ~x]+      (if (s/valid? ~spec x#)+        (raise (str "Assertion failed: " (pr-str '~x) "\n"+                    (when-let [msg# ~msg]+                      (str msg# "\n"))+                    (str/trim-newline (s/explain-str ~spec x#)))+               (assoc ~m '~x x#))+        x#))))

src/dev/grahp/pairs.clj added (view file)

@@ -0,0 +1,7 @@+(ns dev.grahp.pairs)++(defn pairs [schema]+  (if (empty? schema)+    ; (apply mapv vector []) will error+    [[] []]+    (apply mapv vector (partition 2 schema))))

src/net/bowmap/client/state.clj added (view file)

@@ -0,0 +1,4 @@+(ns net.bowmap.client.state+  (:require [clojure.alpha.spec :as s]))++(s/def ::state #{::handshaking ::status ::login ::configuration ::play})

src/net/bowmap/codecs/read.clj added (view file)

@@ -0,0 +1,63 @@+(ns net.bowmap.codecs.read+  (:require+   [dev.grahp.error :refer [ensure-not! raise]])+  (:import+   [io.netty.buffer ByteBuf]+   [java.nio.charset Charset]))++(defn can-read-packet?+  "Returns whether a varint length can be read from buf, and whether buf has enough bytes to read a full packet.+   Can throw if varint is too long, meaning it is completely invalid."+  [buf]+  (loop [num-read 0+         result 0]+    (if (>= num-read 5)+      (raise "VarInt too long")+      (when (< num-read (ByteBuf/.readableBytes buf))+        (let [b (ByteBuf/.getByte buf (+ (ByteBuf/.readerIndex buf)+                                        num-read))+              result' (bit-or result (bit-shift-left (bit-and b 0x7F) (* 7 num-read)))]+          (if (zero? (bit-and b 0x80))+            (>= (ByteBuf/.readableBytes buf) (+ result' num-read 1))+            (recur (inc num-read) result')))))))++(comment+  (import [io.netty.buffer Unpooled])+  (can-read-packet? (Unpooled/wrappedBuffer (byte-array [1 1]))))++(defn read-varint! [buf]+  (loop [num-read 0+         result 0]+    (if (>= num-read 5)+      (raise "VarInt too long")+      (let [b (ByteBuf/.readByte buf)+            result' (bit-or result (bit-shift-left (bit-and b 0x7F) (* 7 num-read)))]+        (if (zero? (bit-and b 0x80))+          result'+          (recur (inc num-read) result'))))))++(defn read-string! [buf]+  (let [len (read-varint! buf)]+    (ensure-not! neg? len)+    (ByteBuf/.readCharSequence buf len (Charset/forName "UTF-8"))))++(def readers+  {:byte   `ByteBuf/.readByte+   :ubyte  `(comp unchecked-byte ByteBuf/.readByte)+   :short  `ByteBuf/.readShort+   :ushort `(comp unchecked-short ByteBuf/.readShort)+   :int    `ByteBuf/.readInt+   :long   `ByteBuf/.readLong+   :varint `read-varint!+   :string `read-string!})++(defn read-enum! [codec m buf]+  (m (codec buf)))++(defn read-array [codec len buf])++; Perhaps have :optional and :required, so all non :optional or :prefixed-optional fields are implicitly :required+; Otherwise nils can easily creep into these functions and cause random NPEs+(def composite-readers+  {:enum (fn [t enum-fn]+           `(fn [buf#] (read-enum! ~(readers t) ~enum-fn buf#)))})

src/net/bowmap/codecs/write.clj added (view file)

@@ -0,0 +1,38 @@+(ns net.bowmap.codecs.write+  (:require+   [clojure.data.json :as json])+  (:import+   [io.netty.buffer ByteBuf]+   [java.nio.charset Charset]))++(defn write-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 write-string! [buf s]+  (doto buf+    (write-varint! (count s))+    (ByteBuf/.writeCharSequence s (Charset/forName "UTF-8"))))++(defn write-json! [buf s]+  (write-string! buf (json/write-str s)))++(def writers+  {:byte   `ByteBuf/.writeByte+   :ubyte  `ByteBuf/.writeByte+   :short  `ByteBuf/.writeShort+   :ushort `ByteBuf/.writeShort+   :int    `ByteBuf/.writeInt+   :long   `ByteBuf/.writeLong+   :varint `write-varint!+   :string `write-string!+   :json   `write-json!})++(def composite-writers+  {})

src/net/bowmap/core.clj added (view file)

@@ -0,0 +1,48 @@+(ns net.bowmap.core+  (:require+   [aleph.tcp :as tcp]+   [manifold.stream :as s]+   [net.bowmap.client.state :as state]+   [net.bowmap.codecs.read :as read]+   [net.bowmap.packet-handling :refer [handle-packet]]+   [net.bowmap.packets.client :refer [encode-packet!]]+   [net.bowmap.packets.server :as sp])+  (:import+   [io.netty.buffer ByteBuf Unpooled]+   [io.netty.channel ChannelOption]))++;; Document why parsing and handling are done synchronously+(defn read-packet! [bs client]+  (let [{::keys [buf]} @client+        buf (ByteBuf/.writeBytes buf bs)]+    (while (read/can-read-packet? buf)+      (prn [(subvec (vec (.array buf))+                    (.readerIndex buf)+                    (.writerIndex buf))+            (::state/state @client)])+      ;; TODO handle exceptions?+      (let [{:keys [::state/state response]} (handle-packet (sp/decode-packet! buf (::state/state @client))+                                                            client)]+        (when state+          (vswap! client assoc ::state/state state))+        (when response+          ;; TODO this can also throw...+          (encode-packet! (Unpooled/buffer) response (::state/state @client))))+      (ByteBuf/.discardReadBytes buf))))++(defn client-handler [s _]+  (let [client (volatile! {::state/state ::state/handshaking+                           ::buf (Unpooled/buffer)+                           ::stream s})]+    (s/consume (fn [bs] (read-packet! bs client))+               s)))++(defn start-server! []+  (tcp/start-server #'client-handler+                    {:port 25565+                     :bootstrap-transform (fn [bootstrap]+                                            (.childOption bootstrap ChannelOption/TCP_NODELAY true)+                                            bootstrap)}))+(comment+  (.close server)+  (def server (start-server!)))

src/net/bowmap/packet.clj added (view file)

@@ -0,0 +1,12 @@+(ns net.bowmap.packet+  (:require [clojure.alpha.spec :as s]))++; The protocol id, i.e. 0x00, 0x80, etc.+(s/def ::numeric-id pos-int?)+; The name of the packet id keyword, i.e. ::server/handshaking+(s/def ::id qualified-keyword?)++(s/def ::packet (s/schema [::id]))++(defn packet? [x]+  (some? (::id x)))

src/net/bowmap/packet_handling.clj added (view file)

@@ -0,0 +1,21 @@+(ns net.bowmap.packet-handling+  (:require+   [net.bowmap.client.state :as state]+   [net.bowmap.packet :as pk]+   [net.bowmap.packets.client :as cp]+   [net.bowmap.packets.server :as sp]))++(defmulti handle-packet+  (fn [pk client]+    (::pk/id pk)))++(defmethod handle-packet :default [pk client]+  (prn "Unhandled packet:" pk))++;; TODO I think this stateyness could absolutely be encoded in the packet itself...+(defmethod handle-packet ::sp/handshaking [pk client]+  {::state/state (:intent pk)})++(defmethod handle-packet ::sp/status-request [pk client]+  {:response {::pk/id ::cp/status-response+              :response {:to :do}}})

src/net/bowmap/packets/client.clj added (view file)

@@ -0,0 +1,98 @@+(ns net.bowmap.packets.client+  "Clientbound packets"+  (:require+   [clojure.alpha.spec :as s]+   [dev.grahp.error :refer [assert!]]+   [dev.grahp.pairs :refer [pairs]]+   [net.bowmap.client.state :as state]+   [net.bowmap.codecs.write :as write :refer [write-varint!]]+   [net.bowmap.packet :as pk :refer [packet?]])+  (:import+   [io.netty.buffer ByteBuf Unpooled]))++;; A lot of work to do in this file lol++;; TODO this also looks identical to the serverbound packet ids...+(defmacro build-packet-ids [registry]+  (into {} (mapcat (fn [[state packet-ids]]+                     (into {} (map-indexed (fn [i pk] [{::state/state state ::pk/id pk} i]))+                           packet-ids)))+        registry))++;; May return nil+;; Should assert or something idk+;; TODO this function looks just like the one in serverbound packets+(defn type->codec [t]+  (if (vector? t)+    (let [[codec & args] t+          writer (write/composite-writers codec)]+      (when writer+        (apply writer args)))+    (write/writers t)))++(defn build-packet [pk-name schema]+  (let [fn-name (symbol (str "encode-" (name pk-name)))+        ;; TODO types can be []+        [fields types] (pairs schema)+        ;; ?????+        codecs (map type->codec types)+        _ (assert codecs)+        name-codec-pairs (for [codec codecs]+                           [(gensym) codec])+        codec-names (map first name-codec-pairs)+        bindings (apply concat name-codec-pairs)+        pairs? (map vector fields codec-names)+        buf (gensym "buf__")+        pk (gensym "pk__")]+    `(let [~@bindings]+       (fn ~fn-name [~buf ~pk]+         ~@(for [[field codec] pairs?]+             `(~codec ~buf (~field ~pk)))+         ~buf))))++(defmacro build-packets [registry]+  (reduce (fn [acc [packet-id schema]]+            (assoc acc packet-id (build-packet packet-id schema)))+          {} (update-vals registry #(remove string? %))))++;; TODO document why packet ids don't map to numeric ids directly+(def packet-ids+  ^{:spec (s/map-of (s/schema [::state/state ::pk/id]) ::pk/numeric-id)}+  (build-packet-ids+   {::state/status+    [::status-response+     ::pong-response]}))++;; Can return nil+(defn numeric-id [state id]+  (packet-ids {::state/state state ::pk/id id}))++(def packets+  ^{:spec (s/map-of ::pk/id (s/fspec :args (s/cat #(instance? ByteBuf %) ::pk/packet)+                                     :ret #(instance? ByteBuf %)))}+  (build-packets+   {::status-response [:response "Response to ::server/status-request" :json]+    ::pong-response [:timestamp "The same timestamp as ::server/ping-request" :long]}))++;; TODO can be nil+(defn packet-encoder [pk]+  (packets (::pk/id pk)))++(comment+  (packets ::status-response))++(defn encode-packet! [buf pk state]+  {:pre [(packet? pk)]}+  (let [id (assert! (numeric-id state (::pk/id pk)))+        encoder (assert! (packet-encoder pk))+        data-buf (-> (Unpooled/buffer)+                     (write-varint! id)+                     (encoder pk))]+    (write-varint! buf (ByteBuf/.writerIndex data-buf))+    (ByteBuf/.writeBytes buf data-buf)))++(comment+  (.array (encode-packet! (Unpooled/buffer)+                          {::pk/id ::pong-response+                           :timestamp 42}+                          ::state/status)))

src/net/bowmap/packets/registry.clj added (view file)

@@ -0,0 +1,20 @@+(ns net.bowmap.packets.registry+  (:require+   [clojure.alpha.spec :as s]+   [dev.grahp.error :refer [raise]]+   [net.bowmap.packet :as pk]))++;; TODO could have :type actually check that it's a valid type!+(s/def ::packet-registry+  (s/map-of ::pk/id+            (s/* (s/cat :field keyword?+                        :doc (s/? string?)+                        :type #(or (keyword? %) (vector? %))))))++(defn conform-registry+  "Returns a registry conformed to '::packet-registry', or throws if it is invalid"+  [registry]+  (let [registry (s/conform ::packet-registry registry)]+    (if (= ::s/invalid registry)+      (raise "Invalid packet registry!" {:explanation (s/explain-data ::packet-registry registry)})+      registry)))

src/net/bowmap/packets/server.clj added (view file)

@@ -0,0 +1,112 @@+(ns net.bowmap.packets.server+  (:require+   [clojure.alpha.spec :as s]+   [dev.grahp.error :refer [assert!]]+   [net.bowmap.client.state :as state]+   [net.bowmap.codecs.read :as read]+   [net.bowmap.packet :as pk]+   [net.bowmap.packets.registry :as reg])+  (:import+   [io.netty.buffer ByteBuf]))++;; Surely there's a better way to do that lmao+(defn type->codec+  "Takes a type from net.bowmap.codecs.read and returns a form that will evaluate to a function to decode that type from a ByteBuffer"+  [t]+  (assert! (if (vector? t)+             (let [[codec & args] t]+               (apply (read/composite-readers codec) args))+             (read/readers t))))++#_(defn build-packet [packet-id schema]+    (let [fn-name (symbol (str "decode-" (name packet-id)))+          buf (gensym "buf__")++          fields (map :field schema)+          types (map :type schema)+          name-codec-pairs (for [t types]+                             [(gensym "decode__") (type->codec t)])+          codec-calls (for [[codec-binding] name-codec-pairs]+                        `(~codec-binding ~buf))+          names->codecs (apply concat name-codec-pairs)]+      `(let [~@names->codecs]+         (fn ~fn-name [~buf]+           (assoc (zipmap [~@fields] [~@codec-calls])+                  ::pk/id ~packet-id)))))++(defn build-packet [packet-id schema]+  (let [fn-name (symbol (str "decode-" (name packet-id)))+        buf (gensym "buf__")++        fields (map :field schema)+        types (map :type schema)+        name-codec-pairs (for [t types]+                           [(gensym "decode__") (type->codec t)])+        codec-calls (for [[codec-binding] name-codec-pairs]+                      `(~codec-binding ~buf))+        names->codecs (apply concat name-codec-pairs)]+    `(let [~@names->codecs]+       (fn ~fn-name [~buf]+         (hash-map ::pk/id ~packet-id+                   ~@(interleave fields codec-calls))))))++(defmacro build-packets [registry]+  (reduce (fn [acc [packet-id schema]]+            (assoc acc packet-id (build-packet packet-id schema)))+          {} (reg/conform-registry registry)))++(def packets+  ^{:spec (s/map-of ::pk/id (s/fspec :args (s/cat #(instance? % ByteBuf))+                                     :ret ::pk/packet))}+  (build-packets+    {::handshaking [:protocol :varint+                    :address :string+                    :port :short+                    :intent [:enum :varint {1 ::state/status 2 ::state/login 3 ::state/transfer}]]+     ::status-request []+     ::ping-request [:timestamp :long]}))++(defmacro build-packet-ids [registry]+  (into {}+        (mapcat (fn [[state packet-ids]]+                  (into {}+                        (map-indexed (fn [i pk] [{::state/state state ::pk/numeric-id i} pk]))+                        packet-ids)))+        registry))++(def packet-ids+  ^{:spec (s/map-of (s/schema [::state/state ::pk/numeric-id])+                    ::pk/id)}+  (build-packet-ids+   {::state/handshaking+    [::handshaking]+    ::state/status+    [::status-request+     ::ping-request]}))++(defn packet-id [state numeric-id]+  (packet-ids {::state/state state+               ::pk/numeric-id numeric-id}))++;; TODO unit test all these :p+(defn packet+  "Takes a packet state and numeric id an returns a packet function (in 'packets'),+   or nil if there is no such packet."+  [state numeric-id]+  (packets (packet-id state numeric-id)))++(defn decode-packet!+  "Decodes and returns one packet from ByteBuf 'buf'.+   The initial length field of the packet should not be stripped from 'buf'.+   Can throw if:+    1. No such packet with the packet id and state exists+    2. 'buf' is not properly framed, and does not contain a full packet+    3. The contents of 'buf' are not a valid packet"+  [buf state]+  {:pre [(read/can-read-packet? buf)]}+  ;; The length is currently unsed, though there are packets that require it in order to decode.+  ;; None of those packets have been implemented yet, though.+  (let [_unused-length (read/read-varint! buf)+        numeric-id (read/read-varint! buf)+        dedec (assert! (packet state numeric-id))]+    (dedec buf)))