handle.clj

Bowmap · bowmap.git · Tickets

Branches > main > d4a482d > files / src / net / bowmap / server / game / handle.clj

(ns net.bowmap.server.game.handle
  (:require
   [com.wotbrew.relic :as rel]
   [net.bowmap.server.game.player :as player]
   [net.bowmap.server.game.server :as server]
   [net.bowmap.server.game.text :as text]
   [net.bowmap.server.packet.clientbound :as clientbound]
   [net.bowmap.server.packet.gamemode :as gamemode]
   [net.bowmap.server.packet.phase :as phase]
   [net.bowmap.server.packet.registry :as registry]
   [net.bowmap.server.packet.schema :as p]
   [net.bowmap.server.packet.schema.minecraft :as mc]
   [net.bowmap.server.packet.serverbound :as serverbound]))

(def initial-session {::phase/phase ::phase/handshaking})

(defmulti handle-packet
  (fn [server session packet]
    (::p/id packet)))

(defmethod handle-packet :default [_ _ _])

(defmethod handle-packet ::serverbound/handshaking [_ session packet]
  {:session (assoc session ::phase/phase (req! packet ::phase/phase))})

(defmethod handle-packet ::serverbound/status-request [server _ _]
  {:packets [{::p/id ::clientbound/status-response
              ::p/version-name "26.3"
              ::p/version-id 777
              ::p/motd {::text/content "Bowmap!"
                        ::text/color "#9f9f9f"}
              ::p/online-player-count (count (rel/q server [[:from ::server/players]
                                                            [:where ::server/playing?]]))
              ::p/max-player-count server/max-player-count}]})

(defmethod handle-packet ::serverbound/ping-request [_ _ {::p/keys! [timestamp]}]
  {:packets [{::p/id ::clientbound/pong-response
              ::p/timestamp timestamp}]})

(defmethod handle-packet ::serverbound/login-start
  [server session {::p/keys! [uuid username]}]
  (if (contains? (rel/index server server/players-by-uuid) uuid)
    (throw (ex-info "Player tried to join with an existing UUID."
                    {:uuid uuid}))
    {:server (rel/transact server
                           [:insert ::server/players
                            {::player/uuid uuid
                             ::player/username username}])
     :session (assoc session ::player/uuid uuid)
     :packets [{::p/id ::clientbound/login-success
                ::p/game-profile {::p/uuid uuid
                                  ::p/username username
                                  ::p/game-profile-properties []}
                ::p/session-uuid (random-uuid)}]}))

(def server-known-packs [registry/core-data-pack])

(defmethod handle-packet ::serverbound/login-acknowledged [_ session _]
  {:session (assoc session ::phase/phase ::phase/config)
   :packets [{::p/id ::clientbound/known-packs
              ::p/known-packs server-known-packs}]})

(defmethod handle-packet ::serverbound/known-packs [_ _ {::p/keys! [known-packs]}]
  (if (= server-known-packs known-packs)
    {:packets (conj registry/registry-packets {::p/id ::clientbound/finish-config})}
    (throw (ex-info "Client does not support the core datapack."
                    {:known-packs known-packs
                     :server-known-packs server-known-packs}))))

(defmethod handle-packet ::serverbound/finish-config
  [server {::player/keys! [uuid] :as session} _]
  (let [entity-id (inc (server/env server ::server/entity-id))]
    {:server (rel/transact server
                           [:update ::server/players
                            {::server/playing? true
                             ::server/entity-id entity-id}
                            [= ::player/uuid uuid]]
                           [:update ::server/env
                            {::server/entity-id entity-id}])
     :session (assoc session ::phase/phase ::phase/play)
     :packets [{::p/id ::clientbound/login
                ::server/entity-id entity-id
                :dimensions [registry/world-dimension]
                ::p/max-player-count server/max-player-count
                :render-distance 32
                :simulation-distance 32
                :current-dimension-registry-id (registry/registry-id ::mc/dimension_type registry/world-dimension)
                :current-dimension registry/world-dimension
                :first-8-bytes-of-the-sha-256-hash-of-the-world's-seed 0
                ::gamemode/gamemode ::gamemode/adventure
                :superflat-world? true
                :portal-cooldown-ticks 0
                :sea-level 60
                :enforce-secure-chat? true}
               {::p/id ::clientbound/game-event
                ::p/game-event-id ::p/wait-for-chunk-event}]}))