diff options
| author | EuAndreh <eu@euandre.org> | 2026-04-21 22:16:16 -0300 |
|---|---|---|
| committer | EuAndreh <eu@euandre.org> | 2026-04-21 22:16:16 -0300 |
| commit | 64dbf930f11a1d1a70f970627e23ab82ab188528 (patch) | |
| tree | d74a1de15d9c8245b33557403034f40eb3023154 | |
| parent | m (diff) | |
| download | papod-64dbf930f11a1d1a70f970627e23ab82ab188528.tar.gz papod-64dbf930f11a1d1a70f970627e23ab82ab188528.tar.xz | |
m
| -rw-r--r-- | Makefile | 5 | ||||
| -rw-r--r-- | src/papod.clj | 1496 | ||||
| -rw-r--r-- | tests/unit.clj | 772 |
3 files changed, 2224 insertions, 49 deletions
@@ -219,5 +219,10 @@ uninstall: instool '$(DESTDIR)$(LOCALEDIR)' uninstall mo $(sources.mo) +## Run it locally. +run: all + java + $(JAVA) -ea --class-path $(NAME).jar:$(CLASSPATH) papod + ALWAYS: diff --git a/src/papod.clj b/src/papod.clj index e8aa5e3..63cfab9 100644 --- a/src/papod.clj +++ b/src/papod.clj @@ -3,15 +3,322 @@ papod (:require [base :refer [def- defconst- third]] [clojure.set :as set] - [clojure.string :as string]) + [clojure.string :as string] + [cracha] + [datomic.api :as d]) (:import (java.net StandardProtocolFamily UnixDomainSocketAddress) (java.nio.channels ServerSocketChannel) (java.nio.file Files))) +(def non-empty? + (complement empty?)) + +(def- non-empty?' + {:db.attr/preds `non-empty?}) + +(def- id' + {:db/unique :db.unique/identity}) + +(def- unique' + {:db/unique :db.unique/value}) + +(def- index' + {:db/index true}) + +(def add-event-seq + (d/function + {:lang "clojure" + :params '[db event-eid channel-uuid] + :code + '(let [channel-eid (or (ffirst + (d/q '{:find [?e] + :in [$ ?id] + :where [[?e :papod.channel/id ?id]]} + db channel-uuid)) + (d/tempid :db.part/user)) + last-seq (or (:papod.channel/last-event-seq + (d/entity db channel-eid)) 0) + new-seq (inc last-seq)] + [[:db/add channel-eid :papod.channel/id channel-uuid] + [:db/add channel-eid :papod.channel/last-event-seq new-seq] + [:db/add event-eid :papod.event/seq new-seq]])})) + +(def ensure-access-unique + (d/function + {:lang "clojure" + :params '[db channel nick level] + :code + '(when (seq + (d/q '{:find [?a] + :in [$ ?ch ?n ?l] + :where [[?a :papod.access/channel ?ch] + [?a :papod.access/nick ?n] + [?a :papod.access/level ?l]]} + db channel nick level)) + (d/cancel + {:cognitect.anomalies/category :cognitect.anomalies/conflict + :cognitect.anomalies/message "Duplicate access entry"}))})) + (def- schema - []) + [;; Network + {:db/ident :papod.network/id + :db/valueType :db.type/uuid + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity} + {:db/ident :papod.network/name + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/unique :db.unique/value + :db.attr/preds `non-empty?} + {:db/ident :papod.network/description + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :papod.network/type + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true + :db.attr/preds `non-empty?} + {:db/ident :papod.network/created-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + ;; Member (per-network user profile) + {:db/ident :papod.member/id + :db/valueType :db.type/uuid + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity} + {:db/ident :papod.member/network + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/index true} + {:db/ident :papod.member/nick + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true + :db.attr/preds `non-empty?} + {:db/ident :papod.member/status + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db.attr/preds `non-empty?} + {:db/ident :papod.member/joined-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :papod.member/network+nick + :db/valueType :db.type/tuple + :db/cardinality :db.cardinality/one + :db/unique :db.unique/value + :db/tupleAttrs [:papod.member/network + :papod.member/nick]} + ;; Member Role + {:db/ident :papod.member-role/id + :db/valueType :db.type/uuid + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity} + {:db/ident :papod.member-role/member + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/index true} + {:db/ident :papod.member-role/role + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db.attr/preds `non-empty?} + {:db/ident :papod.member-role/member+role + :db/valueType :db.type/tuple + :db/cardinality :db.cardinality/one + :db/unique :db.unique/value + :db/tupleAttrs [:papod.member-role/member + :papod.member-role/role]} + ;; Channel + {:db/ident :papod.channel/id + :db/valueType :db.type/uuid + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity} + {:db/ident :papod.channel/network + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/index true} + {:db/ident :papod.channel/name + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/unique :db.unique/value} + {:db/ident :papod.channel/type + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true + :db.attr/preds `non-empty?} + {:db/ident :papod.channel/label + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :papod.channel/description + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :papod.channel/created-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :papod.channel/owner + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db.attr/preds `non-empty?} + {:db/ident :papod.channel/topic + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :papod.channel/last-event-seq + :db/valueType :db.type/long + :db/cardinality :db.cardinality/one} + ;; Access control + {:db/ident :papod.access/id + :db/valueType :db.type/uuid + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity} + {:db/ident :papod.access/channel + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/index true} + {:db/ident :papod.access/nick + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true + :db.attr/preds `non-empty?} + {:db/ident :papod.access/level + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db.attr/preds `non-empty?} + {:db/ident :papod.access/channel+nick+level + :db/valueType :db.type/tuple + :db/cardinality :db.cardinality/one + :db/unique :db.unique/value + :db/tupleAttrs [:papod.access/channel + :papod.access/nick + :papod.access/level]} + ;; Memo + {:db/ident :papod.memo/id + :db/valueType :db.type/uuid + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity} + {:db/ident :papod.memo/from + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db.attr/preds `non-empty?} + {:db/ident :papod.memo/to + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true + :db.attr/preds `non-empty?} + {:db/ident :papod.memo/content + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db.attr/preds `non-empty?} + {:db/ident :papod.memo/created-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :papod.memo/read? + :db/valueType :db.type/boolean + :db/cardinality :db.cardinality/one} + ;; Membership + {:db/ident :papod.membership/id + :db/valueType :db.type/uuid + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity} + {:db/ident :papod.membership/channel + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/index true} + {:db/ident :papod.membership/nick + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true + :db.attr/preds `non-empty?} + {:db/ident :papod.membership/joined-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :papod.membership/channel+nick + :db/valueType :db.type/tuple + :db/cardinality :db.cardinality/one + :db/unique :db.unique/value + :db/tupleAttrs [:papod.membership/channel + :papod.membership/nick]} + ;; Event + {:db/ident :papod.event/id + :db/valueType :db.type/uuid + :db/cardinality :db.cardinality/one + :db/unique :db.unique/identity} + {:db/ident :papod.event/channel + :db/valueType :db.type/ref + :db/cardinality :db.cardinality/one + :db/index true} + {:db/ident :papod.event/target-nick + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true + :db.attr/preds `non-empty?} + {:db/ident :papod.event/type + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db/index true + :db.attr/preds `non-empty?} + {:db/ident :papod.event/source-nick + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one + :db.attr/preds `non-empty?} + {:db/ident :papod.event/payload + :db/valueType :db.type/string + :db/cardinality :db.cardinality/one} + {:db/ident :papod.event/created-at + :db/valueType :db.type/instant + :db/cardinality :db.cardinality/one} + {:db/ident :papod.event/seq + :db/valueType :db.type/long + :db/cardinality :db.cardinality/one + :db/index true} + ;; Entity attr groups + {:db/ident :papod.network/attrs + :db.entity/attrs #{:papod.network/id + :papod.network/name + :papod.network/type + :papod.network/created-at}} + {:db/ident :papod.member/attrs + :db.entity/attrs #{:papod.member/id + :papod.member/network + :papod.member/nick + :papod.member/status + :papod.member/joined-at}} + {:db/ident :papod.member-role/attrs + :db.entity/attrs #{:papod.member-role/id + :papod.member-role/member + :papod.member-role/role}} + {:db/ident :papod.channel/attrs + :db.entity/attrs #{:papod.channel/id + :papod.channel/network + :papod.channel/type + :papod.channel/created-at}} + {:db/ident :papod.access/attrs + :db.entity/attrs #{:papod.access/id + :papod.access/channel + :papod.access/nick + :papod.access/level}} + {:db/ident :papod.memo/attrs + :db.entity/attrs #{:papod.memo/id + :papod.memo/from + :papod.memo/to + :papod.memo/content + :papod.memo/created-at + :papod.memo/read?}} + {:db/ident :papod.membership/attrs + :db.entity/attrs #{:papod.membership/id + :papod.membership/channel + :papod.membership/nick + :papod.membership/joined-at}} + {:db/ident :papod.event/attrs + :db.entity/attrs #{:papod.event/id + :papod.event/type + :papod.event/source-nick + :papod.event/created-at}} + ;; Database functions + {:db/ident :papod.event/add-seq + :db/fn add-event-seq} + {:db/ident :papod.access/ensure-unique + :db/fn ensure-access-unique}]) (defconst- +delimiter+ "\r\n") @@ -19,6 +326,12 @@ (defconst- +separator+ \space) +(defconst- +server-name+ + "papod") + +(defconst- +version+ + "0.1.0") + (defn- set-of-chars [min max] {:pre [(char? min) @@ -82,24 +395,72 @@ (map? data))) (defn- valid-prefix? - [x] -;; FIXME - true) + [{:keys [nick user host]}] + (and (string? nick) + (not (string/blank? nick)) + (or (nil? user) (and (string? user) (not (string/blank? user)))) + (or (nil? host) (and (string? host) (not (string/blank? host)))))) (defn- parse-prefix-components [s] - {:pre [] - :post []} -;; FIXME - ()) + {:pre [(string/starts-with? s ":") + (let [end (string/index-of s +separator+)] + (and end (> end 1)))] + :post [(let [[prefix offset err] %] + (if err + (valid-err? %) + (and (valid-prefix? prefix) + (number? offset) + (pos? offset) + (nil? err))))]} + (let [end (string/index-of s +separator+) + text (subs s 1 end) + offset (inc end) + bang (string/index-of text "!") + at (string/index-of text "@") + valid-order? (or (not bang) (not at) (< bang at)) + nick (when valid-order? + (cond bang (subs text 0 bang) + at (subs text 0 at) + :else text)) + user (when (and valid-order? bang) + (subs text (inc bang) (or at (count text)))) + host (when (and valid-order? at) + (subs text (inc at)))] + (cond + (not valid-order?) + [nil nil {:message "Bad prefix format" + :type :bad-prefix-format + :data {:prefix text}}] + + (string/blank? nick) + [nil nil {:message "Empty nick in prefix" + :type :bad-empty-nick + :data {:prefix text}}] + + (and user (string/blank? user)) + [nil nil {:message "Empty user in prefix" + :type :bad-empty-user + :data {:prefix text}}] + + (and host (string/blank? host)) + [nil nil {:message "Empty host in prefix" + :type :bad-empty-host + :data {:prefix text}}] + + :else + [{:nick nick :user user :host host} offset]))) (defn- parse-prefix [s] {:pre [(string/starts-with? s ":")] :post [(let [[prefix offset err] %] (if err - (valid-err? %)) - (valid-prefix? %))]} + (valid-err? %) + (and (valid-prefix? prefix) + (number? offset) + (pos? offset) + (nil? err))))]} (let [end (string/index-of s +separator+)] (cond (= 1 (count s)) @@ -159,8 +520,7 @@ [out (count s)] (string/starts-with? part ":") [(conj out - (apply str - (concat [part] rest))) + (string/join (str +separator+) (cons part rest))) (count s)] :else (recur rest (conj out part)))))) @@ -198,58 +558,1100 @@ :params params} nil]))))))) -(defn- send-replies! - [replies w] - ;; FIXME - ) +(defconst- +buffer-size+ + 1024) + +(defconst- +charset+ + "UTF-8") + +(defn- client-target + [client] + (or (:nick @client) "*")) + +(defn- numeric-reply + [client code & parts] + (str ":" +server-name+ " " code " " (client-target client) + (when (seq parts) + (str " " (string/join " " parts))))) + +(defn- clean-params + [params] + (filterv (complement string/blank?) params)) + +(defn- channel-handle? + [s] + (or (string/starts-with? s "#") + (string/starts-with? s "&"))) + +(defn- resolve-channel + [db handle] + (cond + (string/starts-with? handle "&") + (try + (let [uuid (java.util.UUID/fromString (subs handle 1))] + (ffirst + (d/q '{:find [?e] + :in [$ ?id] + :where [[?e :papod.channel/id ?id]]} + db uuid))) + (catch Exception _ nil)) + + (string/starts-with? handle "#") + (ffirst + (d/q '{:find [?e] + :in [$ ?name] + :where [[?e :papod.channel/name ?name]]} + db handle)))) + +(defn- has-access? + [db channel-eid nick levels] + (boolean + (seq + (d/q '{:find [?a] + :in [$ ?channel ?nick [?level ...]] + :where [[?a :papod.access/channel ?channel] + [?a :papod.access/nick ?nick] + [?a :papod.access/level ?level]]} + db channel-eid nick levels)))) + +(defn- pending-memos + [conn nick] + (when conn + (seq + (d/q '{:find [?id ?from] + :in [$ ?nick] + :where [[?m :papod.memo/to ?nick] + [?m :papod.memo/from ?from] + [?m :papod.memo/id ?id] + [?m :papod.memo/read? false]]} + (d/db conn) nick)))) + +(defn- deliver-to-client! + [w line] + (try + (let [bytes (.getBytes (str line +delimiter+) +charset+)] + (.write w bytes 0 (count bytes)) + (.flush w)) + (catch Exception _))) + +(defn- handle-pass + [params client] + (cond + (:registered? @client) + [(numeric-reply client "462" ":You may not reregister")] + + (empty? params) + [(numeric-reply client "461" "PASS :Not enough parameters")] + + :else + (do (swap! client assoc :pass (first params)) + []))) + +(defn- handle-network + [params client components] + (cond + (:registered? @client) + [(numeric-reply client "462" ":You may not reregister")] + + (empty? params) + [(numeric-reply client "461" "NETWORK :Not enough parameters")] + + :else + (let [uuid-str (first params) + conn (:conn components)] + (if-not conn + (do (swap! client assoc :network-id nil) + []) + (try + (let [uuid (java.util.UUID/fromString uuid-str) + db (d/db conn) + eid (ffirst + (d/q '{:find [?e] + :in [$ ?id] + :where [[?e :papod.network/id ?id]]} + db uuid))] + (if eid + (do (swap! client assoc :network-id uuid) + []) + [(numeric-reply client "403" + (str uuid-str " :No such network"))])) + (catch Exception _ + [(numeric-reply client "403" + (str uuid-str " :Invalid network ID"))])))))) + +(defn- cracha-conn + [components] + (:conn (:cracha components))) + +(defn- authenticate! + [client components] + (or (:authenticated? @client) + (let [{:keys [pass user]} @client + {:keys [username]} user + conn (cracha-conn components)] + (if-not conn + true + (uuid? (cracha/login! conn username pass "irc")))))) + +(defn- maybe-register! + [client components] + (let [{:keys [nick user registered? cap-negotiating? w]} @client] + (cond + registered? [] + cap-negotiating? [] + (not nick) [] + (not user) [] + + (not (authenticate! client components)) + [(numeric-reply client "464" ":Password incorrect")] + + :else + (do (swap! client assoc :registered? true) + (when (:clients components) + (swap! (:clients components) assoc nick {:w w})) + ;; Create member in the connection's network + (when-let [conn (:conn components)] + (when-let [net-id (:network-id @client)] + @(d/transact conn + [{:db/ensure :papod.member/attrs + :papod.member/id (java.util.UUID/randomUUID) + :papod.member/network [:papod.network/id net-id] + :papod.member/nick nick + :papod.member/status "active" + :papod.member/joined-at (java.util.Date.)}]))) + (let [welcome [(numeric-reply client "001" + (str ":Welcome to the Internet Relay Chat Network " nick))] + memos (pending-memos (:conn components) nick)] + (if (seq memos) + (conj welcome + (str ":MemoServ NOTICE " nick + " :You have " (count memos) + " unread memo(s). Use /msg MemoServ LIST")) + welcome)))))) + +(defn- handle-nick + [params client components] + (cond + (empty? params) + [(numeric-reply client "431" ":No nickname given")] + + :else + (do (swap! client assoc :nick (first params)) + (maybe-register! client components)))) + +(defn- handle-user + [params client components] + (cond + (:registered? @client) + [(numeric-reply client "462" ":You may not reregister")] + + (< (count params) 4) + [(numeric-reply client "461" "USER :Not enough parameters")] + + :else + (let [[username hostname servername & realname-parts] params + realname (string/join " " realname-parts)] + (swap! client assoc :user {:username username + :hostname hostname + :servername servername + :realname realname}) + (maybe-register! client components)))) + +(defn- handle-ping + [params client] + (if (empty? params) + [(numeric-reply client "409" ":No origin specified")] + [(str ":" +server-name+ " PONG " +server-name+ " :" (first params))])) + +(defconst- +sasl-mechanisms+ + "PLAIN") + +(defn- handle-cap + [params client components] + (let [nick (client-target client) + subcmd (when (seq params) (string/upper-case (first params))) + args (string/join " " (rest params)) + args (cond-> args + (string/starts-with? args ":") (subs 1))] + (case subcmd + "LS" + (do (swap! client assoc :cap-negotiating? true) + [(str ":" +server-name+ " CAP " nick + " LS :sasl=" +sasl-mechanisms+)]) + + "REQ" + (let [requested (set (string/split (string/trim args) #"\s+")) + supported #{"sasl"}] + (if-not (every? supported requested) + [(str ":" +server-name+ " CAP " nick + " NAK :" (string/join " " requested))] + (do (swap! client update :caps (fnil into #{}) requested) + [(str ":" +server-name+ " CAP " nick + " ACK :" (string/join " " requested))]))) + + "LIST" + [(str ":" +server-name+ " CAP " nick + " LIST :" (string/join " " (or (:caps @client) #{})))] + + "END" + (do (swap! client assoc :cap-negotiating? false) + (maybe-register! client components)) + + [(numeric-reply client "410" + (str (or subcmd "") " :Invalid CAP subcommand"))]))) + +(defn- handle-sasl-plain + [base64-data client components] + (let [nick (client-target client) + conn (cracha-conn components)] + (try + (let [decoded (String. + (.decode (java.util.Base64/getDecoder) ^String base64-data) + "UTF-8") + parts (string/split decoded #"\x00" -1) + authcid (second parts) + password (nth parts 2 nil) + result (when (and authcid password conn) + (cracha/login! conn authcid password "sasl"))] + (swap! client assoc :sasl-state nil) + (if (uuid? result) + (do (swap! client assoc :authenticated? true) + [(numeric-reply client "900" + (str nick "!" nick "@localhost " authcid + " :You are now logged in as " authcid)) + (numeric-reply client "903" + ":SASL authentication successful")]) + [(numeric-reply client "904" + ":SASL authentication failed")])) + (catch Exception _ + (swap! client assoc :sasl-state nil) + [(numeric-reply client "904" ":SASL authentication failed")])))) + +(defn- handle-authenticate + [params client components] + (let [arg (first params)] + (cond + (not (contains? (or (:caps @client) #{}) "sasl")) + [(numeric-reply client "904" ":SASL authentication failed")] + + (:authenticated? @client) + [(numeric-reply client "907" + ":You have already authenticated using SASL")] + + (= "*" arg) + (do (swap! client assoc :sasl-state nil) + [(numeric-reply client "906" ":SASL authentication aborted")]) + + (nil? (:sasl-state @client)) + (if (= "PLAIN" (some-> arg string/upper-case)) + (do (swap! client assoc :sasl-state :authenticating) + ["AUTHENTICATE +"]) + [(numeric-reply client "908" + (str +sasl-mechanisms+ " :are available SASL mechanisms")) + (numeric-reply client "904" ":SASL authentication failed")]) + + (= :authenticating (:sasl-state @client)) + (if (or (nil? arg) (= "+" arg)) + (do (swap! client assoc :sasl-state nil) + [(numeric-reply client "904" ":SASL authentication failed")]) + (handle-sasl-plain arg client components))))) + +(defn- nickserv-notice + [client text] + (str ":NickServ NOTICE " (client-target client) " :" text)) + +(defn- nickserv-register + [args client components] + (let [nick (:nick @client) + cracha (:cracha components) + conn (cracha-conn components)] + (cond + (not cracha) + [(nickserv-notice client "Registration is not available")] + + (empty? args) + [(nickserv-notice client "Usage: REGISTER <password>")] + + :else + (let [password (first args) + existing (cracha/user-by-email conn nick)] + (if existing + [(nickserv-notice client "Nick is already registered")] + (let [salt (str (java.util.UUID/randomUUID)) + user-id (cracha/register! cracha nick salt password) + token (ffirst + (d/q '{:find [?token] + :in [$ ?uid] + :where [[?u :cracha.user/id ?uid] + [?a :cracha.confirmation-attempt/user ?u] + [?a :cracha.confirmation-attempt/token ?token]]} + (d/db conn) user-id))] + (cracha/confirm! conn token) + [(nickserv-notice client "Nick registered successfully")])))))) + +(defn- nickserv-identify + [args client components] + (let [nick (:nick @client) + conn (cracha-conn components)] + (cond + (not conn) + [(nickserv-notice client "Identification is not available")] + + (empty? args) + [(nickserv-notice client "Usage: IDENTIFY <password>")] + + :else + (let [result (cracha/login! conn nick (first args) "nickserv")] + (case result + :unknown-user + [(nickserv-notice client "Nick is not registered")] + :bad-credentials + [(nickserv-notice client "Invalid password")] + :unconfirmed-user + [(nickserv-notice client "Nick is not confirmed")] + (do (swap! client assoc :identified? true) + [(nickserv-notice client "You are now identified")])))))) + +(defn- handle-nickserv + [content client components] + (let [text (cond-> content + (string/starts-with? content ":") (subs 1)) + parts (string/split (string/trim text) #"\s+") + cmd (when (seq parts) (string/upper-case (first parts))) + args (rest parts)] + (case cmd + "REGISTER" (nickserv-register args client components) + "IDENTIFY" (nickserv-identify args client components) + [(nickserv-notice client + (str "Unknown command. Valid commands: REGISTER, IDENTIFY"))]))) + +(defn- chanserv-notice + [client text] + (str ":ChanServ NOTICE " (client-target client) " :" text)) + +(defn- chanserv-register + [args client components] + (let [conn (:conn components) + nick (client-target client) + channel-name (first args)] + (cond + (empty? args) + [(chanserv-notice client "Usage: REGISTER #channel")] + + (not conn) + [(chanserv-notice client "Channel registration is not available")] + + :else + (let [db (d/db conn) + channel-eid (resolve-channel db channel-name)] + (cond + (nil? channel-eid) + [(chanserv-notice client (str channel-name " does not exist"))] + + (:papod.channel/owner (d/entity db channel-eid)) + [(chanserv-notice client (str channel-name " is already registered"))] + + :else + (do @(d/transact conn + [[:db/add channel-eid :papod.channel/owner nick] + {:db/ensure :papod.access/attrs + :papod.access/id (java.util.UUID/randomUUID) + :papod.access/channel channel-eid + :papod.access/nick nick + :papod.access/level "owner"}]) + [(chanserv-notice client + (str channel-name " has been registered"))])))))) + +(defn- chanserv-set + [args client components] + (let [conn (:conn components) + nick (client-target client)] + (cond + (< (count args) 3) + [(chanserv-notice client "Usage: SET #channel <TOPIC|DESCRIPTION> <value>")] + + :else + (let [[channel-name setting & value-parts] args + value (string/join " " value-parts) + db (d/db conn) + channel-eid (resolve-channel db channel-name)] + (cond + (nil? channel-eid) + [(chanserv-notice client (str channel-name " does not exist"))] + + (not (has-access? db channel-eid nick #{"owner" "op"})) + [(chanserv-notice client "Permission denied")] + + :else + (case (string/upper-case setting) + "TOPIC" + (do @(d/transact conn + [[:db/add channel-eid :papod.channel/topic value]]) + [(chanserv-notice client + (str "Topic for " channel-name " set"))]) + "DESCRIPTION" + (do @(d/transact conn + [[:db/add channel-eid :papod.channel/description value]]) + [(chanserv-notice client + (str "Description for " channel-name " set"))]) + [(chanserv-notice client + "Unknown setting. Use TOPIC or DESCRIPTION")])))))) + +(defn- chanserv-info + [args client components] + (let [conn (:conn components) + channel-name (first args)] + (cond + (empty? args) + [(chanserv-notice client "Usage: INFO #channel")] + + :else + (let [db (d/db conn) + channel-eid (resolve-channel db channel-name)] + (if-not channel-eid + [(chanserv-notice client (str channel-name " does not exist"))] + (let [entity (d/entity db channel-eid)] + [(chanserv-notice client (str "Channel: " channel-name)) + (chanserv-notice client + (str "Owner: " + (or (:papod.channel/owner entity) "(unregistered)"))) + (chanserv-notice client + (str "Topic: " + (or (:papod.channel/topic entity) "(not set)"))) + (chanserv-notice client + (str "Description: " + (or (:papod.channel/description entity) "(not set)")))])))))) + +(defn- chanserv-op + [args client components] + (let [conn (:conn components) + nick (client-target client) + [channel-name target-nick] args] + (cond + (< (count args) 2) + [(chanserv-notice client "Usage: OP #channel <nick>")] + + :else + (let [db (d/db conn) + channel-eid (resolve-channel db channel-name)] + (cond + (nil? channel-eid) + [(chanserv-notice client (str channel-name " does not exist"))] + + (not (has-access? db channel-eid nick #{"owner"})) + [(chanserv-notice client "Permission denied")] + + (has-access? db channel-eid target-nick #{"op"}) + [(chanserv-notice client + (str target-nick " is already an operator"))] + + :else + (do @(d/transact conn + [{:db/ensure :papod.access/attrs + :papod.access/id (java.util.UUID/randomUUID) + :papod.access/channel channel-eid + :papod.access/nick target-nick + :papod.access/level "op"} + [:papod.access/ensure-unique channel-eid target-nick "op"]]) + [(chanserv-notice client + (str target-nick " is now an operator of " + channel-name))])))))) + +(defn- chanserv-deop + [args client components] + (let [conn (:conn components) + nick (client-target client) + [channel-name target-nick] args] + (cond + (< (count args) 2) + [(chanserv-notice client "Usage: DEOP #channel <nick>")] + + :else + (let [db (d/db conn) + channel-eid (resolve-channel db channel-name)] + (cond + (nil? channel-eid) + [(chanserv-notice client (str channel-name " does not exist"))] + + (not (has-access? db channel-eid nick #{"owner"})) + [(chanserv-notice client "Permission denied")] + + :else + (let [access-eid (ffirst + (d/q '{:find [?a] + :in [$ ?ch ?n] + :where [[?a :papod.access/channel ?ch] + [?a :papod.access/nick ?n] + [?a :papod.access/level "op"]]} + db channel-eid target-nick))] + (if-not access-eid + [(chanserv-notice client + (str target-nick " is not an operator"))] + (do @(d/transact conn [[:db/retractEntity access-eid]]) + [(chanserv-notice client + (str target-nick " is no longer an operator of " + channel-name))])))))))) + +(defn- chanserv-access + [args client components] + (let [conn (:conn components) + nick (client-target client) + [channel-name subcmd & rest-args] args] + (cond + (< (count args) 2) + [(chanserv-notice client + "Usage: ACCESS #channel <LIST|ADD|DEL> [args]")] + + :else + (let [db (d/db conn) + channel-eid (resolve-channel db channel-name) + subcmd (string/upper-case subcmd)] + (cond + (nil? channel-eid) + [(chanserv-notice client (str channel-name " does not exist"))] + + (and (not= subcmd "LIST") + (not (has-access? db channel-eid nick #{"owner"}))) + [(chanserv-notice client "Permission denied")] + + :else + (case subcmd + "LIST" + (let [entries (d/q '{:find [?n ?l] + :in [$ ?ch] + :where [[?a :papod.access/channel ?ch] + [?a :papod.access/nick ?n] + [?a :papod.access/level ?l]]} + db channel-eid)] + (if (empty? entries) + [(chanserv-notice client + (str "No access entries for " channel-name))] + (mapv (fn [[n l]] + (chanserv-notice client (str n " - " l))) + entries))) + + "ADD" + (if (< (count rest-args) 2) + [(chanserv-notice client + "Usage: ACCESS #channel ADD <nick> <level>")] + (let [[target-nick level] rest-args + level (string/lower-case level)] + (if-not (#{"op" "voice" "ban"} level) + [(chanserv-notice client + "Level must be op, voice, or ban")] + (do @(d/transact conn + [{:db/ensure :papod.access/attrs + :papod.access/id (java.util.UUID/randomUUID) + :papod.access/channel channel-eid + :papod.access/nick target-nick + :papod.access/level level} + [:papod.access/ensure-unique channel-eid target-nick level]]) + [(chanserv-notice client + (str target-nick " added with level " level))])))) + + "DEL" + (if (empty? rest-args) + [(chanserv-notice client + "Usage: ACCESS #channel DEL <nick>")] + (let [target-nick (first rest-args) + eids (d/q '{:find [?a] + :in [$ ?ch ?n] + :where [[?a :papod.access/channel ?ch] + [?a :papod.access/nick ?n] + [?a :papod.access/level ?l] + [(not= ?l "owner")]]} + db channel-eid target-nick)] + (if (empty? eids) + [(chanserv-notice client + (str target-nick " has no access entries"))] + (do @(d/transact conn + (mapv (fn [[eid]] [:db/retractEntity eid]) eids)) + [(chanserv-notice client + (str target-nick + " removed from access list"))])))) + + [(chanserv-notice client + "Unknown subcommand. Use LIST, ADD, or DEL")])))))) + +(defn- chanserv-kick + [args client components] + (let [{:keys [conn clients channels]} components + nick (client-target client) + [channel-name target-nick & reason-parts] args + reason (if (seq reason-parts) + (string/join " " reason-parts) + "Kicked")] + (cond + (< (count args) 2) + [(chanserv-notice client "Usage: KICK #channel <nick> [reason]")] + + :else + (let [db (d/db conn) + channel-eid (resolve-channel db channel-name)] + (cond + (nil? channel-eid) + [(chanserv-notice client (str channel-name " does not exist"))] + + (not (has-access? db channel-eid nick #{"owner" "op"})) + [(chanserv-notice client "Permission denied")] + + (not (contains? (get @channels channel-name) target-nick)) + [(chanserv-notice client + (str target-nick " is not in " channel-name))] + + :else + (do + ;; Persist kick event + (let [chan-uuid (:papod.channel/id + (d/entity db channel-eid))] + @(d/transact conn + [{:db/ensure :papod.event/attrs + :db/id "new-event" + :papod.event/id (java.util.UUID/randomUUID) + :papod.event/channel channel-eid + :papod.event/type "user-kick" + :papod.event/source-nick nick + :papod.event/payload (str target-nick " " reason) + :papod.event/created-at (java.util.Date.)} + [:papod.event/add-seq "new-event" chan-uuid]])) + ;; Remove from channel + (swap! channels update channel-name disj target-nick) + ;; Notify channel + kicked user + (let [line (str ":ChanServ KICK " channel-name + " " target-nick " :" reason)] + (when clients + (doseq [mn (conj (get @channels channel-name) + target-nick) + :let [m (get @clients mn)] + :when m] + (deliver-to-client! (:w m) line)))) + [])))))) + +(defn- chanserv-ban + [args client components] + (let [conn (:conn components) + nick (client-target client) + [channel-name target-nick] args] + (cond + (< (count args) 2) + [(chanserv-notice client "Usage: BAN #channel <nick>")] + + :else + (let [db (d/db conn) + channel-eid (resolve-channel db channel-name)] + (cond + (nil? channel-eid) + [(chanserv-notice client (str channel-name " does not exist"))] + + (not (has-access? db channel-eid nick #{"owner" "op"})) + [(chanserv-notice client "Permission denied")] + + (has-access? db channel-eid target-nick #{"ban"}) + [(chanserv-notice client + (str target-nick " is already banned"))] + + :else + (do @(d/transact conn + [{:db/ensure :papod.access/attrs + :papod.access/id (java.util.UUID/randomUUID) + :papod.access/channel channel-eid + :papod.access/nick target-nick + :papod.access/level "ban"} + [:papod.access/ensure-unique channel-eid target-nick "ban"]]) + [(chanserv-notice client + (str target-nick " has been banned from " + channel-name))])))))) + +(defn- chanserv-invite + [args client components] + (let [{:keys [conn clients]} components + nick (client-target client) + [channel-name target-nick] args] + (cond + (< (count args) 2) + [(chanserv-notice client "Usage: INVITE #channel <nick>")] + + :else + (let [db (d/db conn) + channel-eid (resolve-channel db channel-name)] + (cond + (nil? channel-eid) + [(chanserv-notice client (str channel-name " does not exist"))] + + (not (has-access? db channel-eid nick #{"owner" "op"})) + [(chanserv-notice client "Permission denied")] + + :else + (do + (when-let [m (and clients (get @clients target-nick))] + (deliver-to-client! (:w m) + (str ":" nick " INVITE " target-nick " " channel-name))) + [(chanserv-notice client + (str target-nick " has been invited to " + channel-name))])))))) + +(defn- handle-chanserv + [content client components] + (let [text (cond-> content + (string/starts-with? content ":") (subs 1)) + parts (string/split (string/trim text) #"\s+") + cmd (when (seq parts) (string/upper-case (first parts))) + args (vec (rest parts))] + (case cmd + "REGISTER" (chanserv-register args client components) + "SET" (chanserv-set args client components) + "INFO" (chanserv-info args client components) + "OP" (chanserv-op args client components) + "DEOP" (chanserv-deop args client components) + "ACCESS" (chanserv-access args client components) + "KICK" (chanserv-kick args client components) + "BAN" (chanserv-ban args client components) + "INVITE" (chanserv-invite args client components) + [(chanserv-notice client + (str "Unknown command. Valid: REGISTER, SET, INFO, " + "OP, DEOP, ACCESS, KICK, BAN, INVITE"))]))) + +(defn- memoserv-notice + [client text] + (str ":MemoServ NOTICE " (client-target client) " :" text)) + +(defn- memoserv-send + [args client components] + (let [conn (:conn components) + nick (client-target client)] + (cond + (< (count args) 2) + [(memoserv-notice client "Usage: SEND <nick> <message>")] + + (not conn) + [(memoserv-notice client "Memo service is not available")] + + :else + (let [[target-nick & msg-parts] args + content (string/join " " msg-parts)] + @(d/transact conn + [{:db/ensure :papod.memo/attrs + :papod.memo/id (java.util.UUID/randomUUID) + :papod.memo/from nick + :papod.memo/to target-nick + :papod.memo/content content + :papod.memo/created-at (java.util.Date.) + :papod.memo/read? false}]) + [(memoserv-notice client (str "Memo sent to " target-nick))])))) + +(defn- memoserv-list + [client components] + (let [conn (:conn components) + nick (client-target client)] + (if-not conn + [(memoserv-notice client "Memo service is not available")] + (let [db (d/db conn) + memos (sort-by + (fn [[_ _ t]] t) + (d/q '{:find [?id ?from ?time ?read] + :in [$ ?nick] + :where [[?m :papod.memo/id ?id] + [?m :papod.memo/to ?nick] + [?m :papod.memo/from ?from] + [?m :papod.memo/created-at ?time] + [?m :papod.memo/read? ?read]]} + db nick))] + (if (empty? memos) + [(memoserv-notice client "No memos")] + (mapv (fn [[id from _ read]] + (memoserv-notice client + (str (if read "[read] " "[unread] ") + "from " from " - " id))) + memos)))))) + +(defn- memoserv-read + [args client components] + (let [conn (:conn components) + nick (client-target client)] + (cond + (empty? args) + [(memoserv-notice client "Usage: READ <id>")] + + :else + (let [memo-id (try (java.util.UUID/fromString (first args)) + (catch Exception _ nil))] + (if-not memo-id + [(memoserv-notice client "Invalid memo ID")] + (let [db (d/db conn) + memo-eid (ffirst + (d/q '{:find [?m] + :in [$ ?id ?nick] + :where [[?m :papod.memo/id ?id] + [?m :papod.memo/to ?nick]]} + db memo-id nick))] + (if-not memo-eid + [(memoserv-notice client "Memo not found")] + (let [entity (d/entity db memo-eid)] + @(d/transact conn + [[:db/add memo-eid :papod.memo/read? true]]) + [(memoserv-notice client + (str "From " (:papod.memo/from entity) ": " + (:papod.memo/content entity)))])))))))) + +(defn- memoserv-delete + [args client components] + (let [conn (:conn components) + nick (client-target client)] + (cond + (empty? args) + [(memoserv-notice client "Usage: DELETE <id>")] + + :else + (let [memo-id (try (java.util.UUID/fromString (first args)) + (catch Exception _ nil))] + (if-not memo-id + [(memoserv-notice client "Invalid memo ID")] + (let [db (d/db conn) + eid (ffirst + (d/q '{:find [?m] + :in [$ ?id ?nick] + :where [[?m :papod.memo/id ?id] + [?m :papod.memo/to ?nick]]} + db memo-id nick))] + (if-not eid + [(memoserv-notice client "Memo not found")] + (do @(d/transact conn [[:db/retractEntity eid]]) + [(memoserv-notice client "Memo deleted")])))))))) + +(defn- handle-memoserv + [content client components] + (let [text (cond-> content + (string/starts-with? content ":") (subs 1)) + parts (string/split (string/trim text) #"\s+") + cmd (when (seq parts) (string/upper-case (first parts))) + args (vec (rest parts))] + (case cmd + "SEND" (memoserv-send args client components) + "LIST" (memoserv-list client components) + "READ" (memoserv-read args client components) + "DELETE" (memoserv-delete args client components) + [(memoserv-notice client + "Unknown command. Valid: SEND, LIST, READ, DELETE")]))) + +(defn- handle-privmsg + [params client components] + (let [{:keys [conn clients channels]} components + nick (client-target client)] + (cond + (empty? params) + [(numeric-reply client "411" ":No recipient given (PRIVMSG)")] + + (< (count params) 2) + [(numeric-reply client "412" ":No text to send")] + + ;; Services: handle WITHOUT persisting + (= "NickServ" (first params)) + (handle-nickserv (string/join " " (rest params)) client components) + + (= "ChanServ" (first params)) + (handle-chanserv (string/join " " (rest params)) client components) + + (= "MemoServ" (first params)) + (handle-memoserv (string/join " " (rest params)) client components) + + :else + (let [target (first params) + content (string/join " " (rest params)) + msg-id (java.util.UUID/randomUUID) + chan? (and channels (channel-handle? target))] + (cond + ;; Channel message to nonexistent channel + (and chan? (not (get @channels target))) + [(numeric-reply client "403" (str target " :No such channel"))] + + :else + (do + ;; PERSIST FIRST — blocks until durable + (when conn + (let [db (d/db conn) + channel-eid (when chan? (resolve-channel db target)) + chan-uuid (when channel-eid + (:papod.channel/id + (d/entity db channel-eid)))] + @(d/transact conn + (cond-> [{:db/ensure :papod.event/attrs + :db/id "new-event" + :papod.event/id msg-id + :papod.event/type "user-message" + :papod.event/source-nick nick + :papod.event/payload content + :papod.event/created-at (java.util.Date.)}] + chan? + (-> (update 0 assoc :papod.event/channel channel-eid) + (conj [:papod.event/add-seq "new-event" chan-uuid])) + (not chan?) + (-> (update 0 assoc + :papod.event/target-nick target)))))) + ;; DELIVER — only after persistence succeeds + (let [line (str ":" nick " PRIVMSG " target " " content)] + (if chan? + (doseq [member-nick (get @channels target) + :when (not= member-nick nick) + :let [member (when clients + (get @clients member-nick))] + :when member] + (deliver-to-client! (:w member) line)) + (when-let [member (and clients (get @clients target))] + (deliver-to-client! (:w member) line)))) + [])))))) + +(defn- handle-join + [params client components] + (let [{:keys [conn clients channels]} components + nick (client-target client) + handle (first params)] + (cond + (empty? params) + [(numeric-reply client "461" "JOIN :Not enough parameters")] + + ;; Private channels: & prefix requires existing channel + membership + (and (string/starts-with? handle "&") + (let [db (when conn (d/db conn)) + eid (when db (resolve-channel db handle))] + (or (nil? eid) + (not (has-access? db eid nick + #{"owner" "op" "voice"}))))) + [(numeric-reply client "403" + (str handle " :No such channel"))] + + :else + (let [db (when conn (d/db conn)) + channel-eid (when db (resolve-channel db handle)) + banned? (and channel-eid + (has-access? db channel-eid nick #{"ban"})) + new-id (java.util.UUID/randomUUID) + chan-uuid (if channel-eid + (:papod.channel/id (d/entity db channel-eid)) + new-id) + channel-ref (or channel-eid "new-channel")] + (cond + banned? + [(numeric-reply client "474" + (str handle " :Cannot join channel (+b)"))] + + :else + (do + ;; PERSIST — single transaction + (when conn + @(d/transact conn + (cond-> [{:db/ensure :papod.membership/attrs + :papod.membership/id (java.util.UUID/randomUUID) + :papod.membership/channel channel-ref + :papod.membership/nick nick + :papod.membership/joined-at (java.util.Date.)} + {:db/ensure :papod.event/attrs + :db/id "new-event" + :papod.event/id (java.util.UUID/randomUUID) + :papod.event/channel channel-ref + :papod.event/type "user-join" + :papod.event/source-nick nick + :papod.event/created-at (java.util.Date.)} + [:papod.event/add-seq "new-event" chan-uuid]] + (nil? channel-eid) + (conj {:db/ensure :papod.channel/attrs + :db/id "new-channel" + :papod.channel/id new-id + :papod.channel/network [:papod.network/id + (:network-id @client)] + :papod.channel/name handle + :papod.channel/type "public" + :papod.channel/description "" + :papod.channel/created-at (java.util.Date.)})))) + ;; UPDATE in-memory + (when channels + (swap! channels update handle (fnil conj #{}) nick)) + ;; DELIVER + (let [line (str ":" nick " JOIN " handle)] + (when (and clients channels) + (doseq [member-nick (get @channels handle) + :let [member (get @clients member-nick)] + :when member] + (deliver-to-client! (:w member) line)))) + [])))))) (defn- replies-for! - [{} components] - ;; wait-for - ) + [message client components] + (let [command (string/upper-case (:command message)) + params (clean-params (:params message))] + (case command + "PASS" (handle-pass params client) + "NETWORK" (handle-network params client components) + "NICK" (handle-nick params client components) + "USER" (handle-user params client components) + "PING" (handle-ping params client) + "CAP" (handle-cap params client components) + "AUTHENTICATE" (handle-authenticate params client components) + (if-not (:registered? @client) + [(numeric-reply client "451" ":You have not registered")] + (case command + "PRIVMSG" (handle-privmsg params client components) + "JOIN" (handle-join params client components) + []))))) + +(defn- send-replies! + [replies w] + (doseq [r replies] + (let [bytes (.getBytes (str r +delimiter+) +charset+)] + (.write w bytes 0 (count bytes)))) + (.flush w)) (defn- handle-message! - [message w components] - (send-replies! (replies-for! message components) + [message w client components] + (send-replies! (replies-for! message client components) w)) (defn- process-message! - [raw-message w components] + [raw-message w client components] (let [[message err] (parse-message raw-message)] - (if err - (:log :bad-message err) - (handle-message! message w components)))) + (when-not err + (handle-message! message w client components)))) (defn- process-input! - [input w components] + [input w client components] (let [{:keys [status input raw-message]} (get-raw-message input)] (if (= status :needs-more) input (do - (process-message! raw-message w components) - (recur input w components))))) - -(defn- db - [datomic] - :db) + (when raw-message + (process-message! raw-message w client components)) + (recur input w client components))))) -(defconst- +buffer-size+ - 1024) - -(defconst- +charset+ - "UTF-8") +(defn- init! + [db-uri cracha-state] + (d/create-database db-uri) + (let [conn (d/connect db-uri)] + @(d/transact conn schema) + {:conn conn + :cracha cracha-state + :clients (atom {}) + :channels (atom {})})) (defn- client-loop! [socket components] - (let [r (.getInputStream socket) - w (.getOutputStream socket) - b (make-array Byte/TYPE +buffer-size+)] - (loop [acc ""] - (let [n (.read r b)] - (when (pos? n) - (recur (process-input! (str acc (String. b +charset+)) - w - components))))))) + (let [r (.getInputStream socket) + w (.getOutputStream socket) + b (make-array Byte/TYPE +buffer-size+) + client (atom {:nick nil :user nil :pass nil :registered? false :w w})] + (try + (loop [acc ""] + (let [n (.read r b)] + (when (pos? n) + (recur (process-input! (str acc (String. b 0 n +charset+)) + w + client + components))))) + (finally + (when-let [nick (:nick @client)] + (when (:clients components) + (swap! (:clients components) dissoc nick)) + (when (:channels components) + (doseq [[ch _] @(:channels components)] + (swap! (:channels components) update ch disj nick)))))))) (defconst- +socket-path+ "papod.socket") diff --git a/tests/unit.clj b/tests/unit.clj index e92b389..af13931 100644 --- a/tests/unit.clj +++ b/tests/unit.clj @@ -1,5 +1,9 @@ (ns unit (:require [clojure.test :as t :refer [are deftest is testing]] + [clojure.string :as string] + [cracha] + [datomic.api :as d] + [fiinha] [papod]) (:gen-class)) @@ -38,10 +42,774 @@ [{:prefix nil :command "CMD" :params []} - nil])))) + nil]))) + (testing "prefix with nick only" + (is (= (parse-message ":nick CMD") + [{:prefix {:nick "nick" :user nil :host nil} + :command "CMD" + :params []} + nil]))) + (testing "prefix with nick and user" + (is (= (parse-message ":nick!user CMD") + [{:prefix {:nick "nick" :user "user" :host nil} + :command "CMD" + :params []} + nil]))) + (testing "prefix with nick and host" + (is (= (parse-message ":nick@host CMD") + [{:prefix {:nick "nick" :user nil :host "host"} + :command "CMD" + :params []} + nil]))) + (testing "prefix with nick, user and host" + (is (= (parse-message ":nick!user@host CMD") + [{:prefix {:nick "nick" :user "user" :host "host"} + :command "CMD" + :params []} + nil]))) + (testing "prefix errors from parse-prefix" + (is (= :bad-empty-prefix-and-message + (-> (parse-message ":") second :type))) + (is (= :bad-empty-prefix + (-> (parse-message ": CMD") second :type))) + (is (= :no-prefix-separator + (-> (parse-message ":nospaceatall") second :type)))) + (testing "prefix errors from parse-prefix-components" + (is (= :bad-prefix-format + (-> (parse-message ":a@b!c CMD") second :type))) + (is (= :bad-empty-nick + (-> (parse-message ":@host CMD") second :type))) + (is (= :bad-empty-user + (-> (parse-message ":nick!@host CMD") second :type))) + (is (= :bad-empty-host + (-> (parse-message ":nick!user@ CMD") second :type))) + (is (= :bad-empty-nick + (-> (parse-message ":!user CMD") second :type))))) + +(def replies-for! @#'papod/replies-for!) +(def clean-params @#'papod/clean-params) +(defn client [] (atom {:nick nil :user nil :pass nil :registered? false})) +(def no-conn {}) + +(deftest test_clean-params + (testing "removes leading empty strings" + (is (= (clean-params ["" "a" "b"]) ["a" "b"])) + (is (= (clean-params ["a" "b"]) ["a" "b"])) + (is (= (clean-params []) [])))) + +(deftest test_replies-for! + (testing "PASS stores password" + (let [c (client)] + (is (= (replies-for! {:command "PASS" :params ["" "secret"]} + c no-conn) + [])) + (is (= (:pass @c) "secret")))) + (testing "PASS with no params" + (let [c (client)] + (is (string/includes? + (first (replies-for! {:command "PASS" :params []} + c no-conn)) + "461")))) + (testing "NICK stores nickname" + (let [c (client)] + (is (= (replies-for! {:command "NICK" :params ["" "joe"]} + c no-conn) + [])) + (is (= (:nick @c) "joe")))) + (testing "NICK with no params" + (let [c (client)] + (is (string/includes? + (first (replies-for! {:command "NICK" :params []} + c no-conn)) + "431")))) + (testing "registration completes after NICK and USER" + (let [c (client)] + (replies-for! {:command "NICK" :params ["" "joe"]} c no-conn) + (let [replies (replies-for! + {:command "USER" + :params ["" "joe" "0" "x" ":Joe"]} + c no-conn)] + (is (= 1 (count replies))) + (is (string/includes? (first replies) "001")) + (is (:registered? @c))))) + (testing "USER before NICK does not register" + (let [c (client)] + (let [replies (replies-for! + {:command "USER" + :params ["" "joe" "0" "x" ":Joe"]} + c no-conn)] + (is (empty? replies)) + (is (not (:registered? @c)))))) + (testing "USER after registration" + (let [c (client)] + (replies-for! {:command "NICK" :params ["" "joe"]} c no-conn) + (replies-for! {:command "USER" :params ["" "joe" "0" "x" ":Joe"]} + c no-conn) + (is (string/includes? + (first (replies-for! + {:command "USER" :params ["" "joe" "0" "x" ":Joe"]} + c no-conn)) + "462")))) + (testing "PASS after registration" + (let [c (client)] + (replies-for! {:command "NICK" :params ["" "joe"]} c no-conn) + (replies-for! {:command "USER" :params ["" "joe" "0" "x" ":Joe"]} + c no-conn) + (is (string/includes? + (first (replies-for! {:command "PASS" :params ["" "pw"]} + c no-conn)) + "462")))) + (testing "unregistered client gets 451 for other commands" + (let [c (client)] + (is (string/includes? + (first (replies-for! {:command "JOIN" :params ["" "#chan"]} + c no-conn)) + "451")))) + (testing "PING responds with PONG" + (let [c (client)] + (let [replies (replies-for! + {:command "PING" :params ["" "token"]} + c no-conn)] + (is (= 1 (count replies))) + (is (string/includes? (first replies) "PONG")) + (is (string/includes? (first replies) "token"))))) + (testing "PING with no params" + (let [c (client)] + (is (string/includes? + (first (replies-for! {:command "PING" :params []} + c no-conn)) + "409"))))) + +(defn test-components + [] + (let [fiinha-state (fiinha/initdb! + (str "datomic:mem://fiinha-" (java.util.UUID/randomUUID))) + cracha-state (cracha/init! + (str "datomic:mem://cracha-" (java.util.UUID/randomUUID)) + fiinha-state) + papod-uri (str "datomic:mem://papod-" (java.util.UUID/randomUUID)) + _ (d/create-database papod-uri) + conn (d/connect papod-uri)] + @(d/transact conn @#'papod/schema) + {:conn conn :cracha cracha-state + :clients (atom {}) :channels (atom {})})) + +(defn test-network! + [conn] + (let [net-id (java.util.UUID/randomUUID)] + @(d/transact conn + [{:db/ensure :papod.network/attrs + :papod.network/id net-id + :papod.network/name (str "test-" net-id) + :papod.network/description "" + :papod.network/type "public" + :papod.network/created-at (java.util.Date.)}]) + net-id)) + +(defn test-components-with-network + [] + (let [components (test-components) + net-id (test-network! (:conn components))] + (assoc components :test-network-id net-id))) + +(defn registered-client + ([nick w] + (atom {:nick nick :user {:username nick} :pass nil :registered? true :w w})) + ([nick w net-id] + (atom {:nick nick :user {:username nick} :pass nil :registered? true + :w w :network-id net-id}))) + +(def handle-privmsg @#'papod/handle-privmsg) +(def handle-join @#'papod/handle-join) +(def resolve-channel @#'papod/resolve-channel) +(def handle-cap @#'papod/handle-cap) +(def handle-authenticate @#'papod/handle-authenticate) + +(deftest test_persist-first + (testing "DM persists before delivery" + (let [sender-out (java.io.ByteArrayOutputStream.) + target-out (java.io.ByteArrayOutputStream.) + sender (registered-client "alice" sender-out) + components (assoc (test-components) + :clients (atom {"alice" {:w sender-out} + "bob" {:w target-out}}) + :channels (atom {})) + conn (:conn components)] + (handle-privmsg ["bob" ":hello world"] sender components) + ;; Verify event persisted with target-nick + (let [db (d/db conn) + events (d/q '{:find [?nick ?target ?payload] + :where [[?e :papod.event/source-nick ?nick] + [?e :papod.event/target-nick ?target] + [?e :papod.event/payload ?payload]]} + db)] + (is (= 1 (count events))) + (is (= ["alice" "bob" ":hello world"] + (vec (first events))))) + ;; Delivered to target, not sender + (is (string/includes? (.toString target-out "UTF-8") + "PRIVMSG bob :hello world")) + (is (= "" (.toString sender-out "UTF-8"))))) + (testing "channel PRIVMSG persists with channel ref" + (let [alice-out (java.io.ByteArrayOutputStream.) + bob-out (java.io.ByteArrayOutputStream.) + {:keys [test-network-id] :as components} + (assoc (test-components-with-network) + :clients (atom {"alice" {:w alice-out} + "bob" {:w bob-out}}) + :channels (atom {"#test" #{"alice" "bob"}})) + sender (registered-client "alice" alice-out test-network-id) + conn (:conn components)] + ;; Create the channel in DB first (JOIN would do this normally) + @(d/transact conn + [{:papod.channel/id (java.util.UUID/randomUUID) + :papod.channel/network [:papod.network/id test-network-id] + :papod.channel/name "#test" + :papod.channel/type "public" + :papod.channel/description "" + :papod.channel/created-at (java.util.Date.)}]) + (handle-privmsg ["#test" ":hi everyone"] sender components) + ;; Verify event references the channel entity + (let [db (d/db conn) + events (d/q '{:find [?type ?payload ?chan-name] + :where [[?e :papod.event/channel ?c] + [?e :papod.event/type ?type] + [?e :papod.event/payload ?payload] + [?c :papod.channel/name ?chan-name]]} + db)] + (is (= 1 (count events))) + (is (= ["user-message" ":hi everyone" "#test"] + (vec (first events))))) + ;; Delivered to bob, not alice + (is (string/includes? (.toString bob-out "UTF-8") + "PRIVMSG #test :hi everyone")) + (is (= "" (.toString alice-out "UTF-8"))))) + (testing "JOIN creates channel + membership + event atomically" + (let [alice-out (java.io.ByteArrayOutputStream.) + {:keys [test-network-id] :as components} + (assoc (test-components-with-network) + :clients (atom {"alice" {:w alice-out}}) + :channels (atom {})) + sender (registered-client "alice" alice-out test-network-id) + conn (:conn components)] + (handle-join ["#test"] sender components) + (let [db (d/db conn)] + ;; Channel entity created + (is (some? (resolve-channel db "#test"))) + ;; Membership recorded + (let [memberships (d/q '{:find [?nick ?chan-name] + :where [[?m :papod.membership/nick ?nick] + [?m :papod.membership/channel ?c] + [?c :papod.channel/name ?chan-name]]} + db)] + (is (= #{["alice" "#test"]} memberships))) + ;; Event recorded + (let [events (d/q '{:find [?type ?nick ?chan-name] + :where [[?e :papod.event/type ?type] + [?e :papod.event/source-nick ?nick] + [?e :papod.event/channel ?c] + [?c :papod.channel/name ?chan-name]]} + db)] + (is (= #{["user-join" "alice" "#test"]} events)))) + ;; In-memory updated + (is (= #{"alice"} (get @(:channels components) "#test"))) + ;; Notification delivered + (is (string/includes? (.toString alice-out "UTF-8") "JOIN #test")))) + (testing "second JOIN reuses existing channel" + (let [alice-out (java.io.ByteArrayOutputStream.) + bob-out (java.io.ByteArrayOutputStream.) + {:keys [test-network-id] :as components} + (assoc (test-components-with-network) + :clients (atom {"alice" {:w alice-out} + "bob" {:w bob-out}}) + :channels (atom {})) + conn (:conn components)] + (handle-join ["#test"] (registered-client "alice" alice-out test-network-id) components) + (handle-join ["#test"] (registered-client "bob" bob-out test-network-id) components) + ;; Still one channel entity + (let [db (d/db conn) + channels (d/q '{:find [?name] + :where [[?c :papod.channel/name ?name]]} + db)] + (is (= 1 (count channels)))) + ;; Two memberships + (let [db (d/db conn) + memberships (d/q '{:find [?nick] + :where [[?m :papod.membership/nick ?nick]]} + db)] + (is (= #{["alice"] ["bob"]} memberships))))) + (testing "PRIVMSG error cases" + (let [c (registered-client "alice" (java.io.ByteArrayOutputStream.))] + (is (string/includes? + (first (handle-privmsg [] c no-conn)) + "411")) + (is (string/includes? + (first (handle-privmsg ["bob"] c no-conn)) + "412"))))) + +(deftest test_nickserv + (testing "REGISTER creates user in cracha" + (let [out (java.io.ByteArrayOutputStream.) + c (registered-client "alice" out) + components (test-components) + conn (:conn components) + replies (handle-privmsg ["NickServ" ":REGISTER mypass"] c components)] + (is (= 1 (count replies))) + (is (string/includes? (first replies) "registered successfully")) + (let [cc (:conn (:cracha components)) + user-id (cracha/user-by-email cc "alice")] + (is (some? user-id)) + (is (cracha/user-confirmed? cc user-id))))) + (testing "REGISTER rejects duplicate nick" + (let [out (java.io.ByteArrayOutputStream.) + c (registered-client "alice" out) + components (test-components)] + (handle-privmsg ["NickServ" ":REGISTER pass1"] c components) + (let [replies (handle-privmsg ["NickServ" ":REGISTER pass2"] c components)] + (is (string/includes? (first replies) "already registered"))))) + (testing "IDENTIFY succeeds with correct password" + (let [out (java.io.ByteArrayOutputStream.) + c (registered-client "alice" out) + components (test-components)] + (handle-privmsg ["NickServ" ":REGISTER mypass"] c components) + (let [replies (handle-privmsg ["NickServ" ":IDENTIFY mypass"] c components)] + (is (string/includes? (first replies) "now identified")) + (is (:identified? @c))))) + (testing "IDENTIFY fails with wrong password" + (let [out (java.io.ByteArrayOutputStream.) + c (registered-client "alice" out) + components (test-components)] + (handle-privmsg ["NickServ" ":REGISTER mypass"] c components) + (let [replies (handle-privmsg ["NickServ" ":IDENTIFY wrong"] c components)] + (is (string/includes? (first replies) "Invalid password")) + (is (not (:identified? @c)))))) + (testing "IDENTIFY fails for unregistered nick" + (let [out (java.io.ByteArrayOutputStream.) + c (registered-client "alice" out) + components (test-components) + replies (handle-privmsg ["NickServ" ":IDENTIFY mypass"] c components)] + (is (string/includes? (first replies) "not registered")))) + (testing "NickServ messages are NOT persisted" + (let [out (java.io.ByteArrayOutputStream.) + c (registered-client "alice" out) + components (test-components) + conn (:conn components)] + (handle-privmsg ["NickServ" ":REGISTER mypass"] c components) + (let [db (d/db conn) + evts (d/q '{:find [?e] + :where [[?e :papod.event/id _]]} + db)] + (is (zero? (count evts))))))) + +(defn b64 + [s] + (.encodeToString (java.util.Base64/getEncoder) (.getBytes s "UTF-8"))) + +(deftest test_sasl + (testing "full CAP + SASL PLAIN flow" + (let [out (java.io.ByteArrayOutputStream.) + c (client) + components (test-components)] + ;; Register user in cracha first + (swap! c assoc :nick "alice" :registered? true :w out) + (handle-privmsg ["NickServ" ":REGISTER mypass"] c components) + ;; Reset client for fresh connection + (let [c2 (atom {:nick nil :user nil :pass nil :registered? false + :w out})] + ;; CAP LS suspends registration + (let [replies (handle-cap ["LS" "302"] c2 components)] + (is (= 1 (count replies))) + (is (string/includes? (first replies) "sasl=PLAIN")) + (is (:cap-negotiating? @c2))) + ;; CAP REQ sasl + (let [replies (handle-cap ["REQ" ":sasl"] c2 components)] + (is (string/includes? (first replies) "ACK")) + (is (contains? (:caps @c2) "sasl"))) + ;; NICK + USER during negotiation do not trigger registration + (swap! c2 assoc :nick "alice") + (let [replies (replies-for! {:command "USER" :params ["" "alice" "0" "x" ":A"]} + c2 components)] + (is (empty? replies)) + (is (not (:registered? @c2)))) + ;; AUTHENTICATE PLAIN + (let [replies (handle-authenticate ["PLAIN"] c2 components)] + (is (= ["AUTHENTICATE +"] replies))) + ;; Send credentials + (let [creds (b64 "\u0000alice\u0000mypass") + replies (handle-authenticate [creds] c2 components)] + (is (= 2 (count replies))) + (is (string/includes? (first replies) "900")) + (is (string/includes? (second replies) "903")) + (is (:authenticated? @c2))) + ;; CAP END completes registration + (let [replies (handle-cap ["END"] c2 components)] + (is (= 1 (count replies))) + (is (string/includes? (first replies) "001")) + (is (:registered? @c2)))))) + (testing "SASL with wrong password" + (let [out (java.io.ByteArrayOutputStream.) + c (client) + components (test-components)] + ;; Register user + (swap! c assoc :nick "bob" :registered? true :w out) + (handle-privmsg ["NickServ" ":REGISTER secret"] c components) + ;; Fresh connection + (let [c2 (atom {:nick "bob" :user nil :pass nil :registered? false + :w out :caps #{"sasl"}})] + (handle-authenticate ["PLAIN"] c2 components) + (let [creds (b64 "\u0000bob\u0000wrong") + replies (handle-authenticate [creds] c2 components)] + (is (= 1 (count replies))) + (is (string/includes? (first replies) "904")) + (is (not (:authenticated? @c2))))))) + (testing "AUTHENTICATE without CAP sasl" + (let [c (atom {:nick "x" :caps #{}})] + (is (string/includes? + (first (handle-authenticate ["PLAIN"] c no-conn)) + "904")))) + (testing "AUTHENTICATE abort" + (let [c (atom {:nick "x" :caps #{"sasl"} :sasl-state :authenticating})] + (is (string/includes? + (first (handle-authenticate ["*"] c no-conn)) + "906")))) + (testing "AUTHENTICATE unsupported mechanism" + (let [c (atom {:nick "x" :caps #{"sasl"}})] + (let [replies (handle-authenticate ["SCRAM-SHA-1"] c no-conn)] + (is (string/includes? (first replies) "908")) + (is (string/includes? (second replies) "904"))))) + (testing "CAP REQ unsupported capability" + (let [c (atom {:nick "x" :cap-negotiating? true})] + (is (string/includes? + (first (handle-cap ["REQ" ":multi-prefix"] c no-conn)) + "NAK")))) + (testing "already authenticated" + (let [c (atom {:nick "x" :caps #{"sasl"} :authenticated? true})] + (is (string/includes? + (first (handle-authenticate ["PLAIN"] c no-conn)) + "907"))))) + +(deftest test_chanserv + (testing "REGISTER + INFO + SET" + (let [{:keys [test-network-id] :as components} (test-components-with-network) + out (java.io.ByteArrayOutputStream.) + c (registered-client "alice" out test-network-id)] + (handle-join ["#test"] c + (assoc components + :clients (atom {"alice" {:w out}}) + :channels (atom {}))) + (let [replies (handle-privmsg ["ChanServ" ":REGISTER #test"] + c components)] + (is (string/includes? (first replies) "has been registered"))) + (let [replies (handle-privmsg ["ChanServ" ":INFO #test"] + c components)] + (is (some #(string/includes? % "alice") replies))) + (let [replies (handle-privmsg ["ChanServ" ":SET #test TOPIC Hello world"] + c components)] + (is (string/includes? (first replies) "Topic"))) + (let [replies (handle-privmsg ["ChanServ" ":INFO #test"] + c components)] + (is (some #(string/includes? % "Hello world") replies))))) + (testing "OP and DEOP" + (let [{:keys [test-network-id] :as components} (test-components-with-network) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out test-network-id)] + (handle-join ["#test"] alice + (assoc components + :clients (atom {"alice" {:w out}}) + :channels (atom {}))) + (handle-privmsg ["ChanServ" ":REGISTER #test"] alice components) + (let [replies (handle-privmsg ["ChanServ" ":OP #test bob"] + alice components)] + (is (string/includes? (first replies) "now an operator"))) + (let [replies (handle-privmsg ["ChanServ" ":DEOP #test bob"] + alice components)] + (is (string/includes? (first replies) "no longer an operator"))))) + (testing "KICK and BAN" + (let [alice-out (java.io.ByteArrayOutputStream.) + bob-out (java.io.ByteArrayOutputStream.) + {:keys [test-network-id] :as components} + (assoc (test-components-with-network) + :clients (atom {"alice" {:w alice-out} + "bob" {:w bob-out}}) + :channels (atom {"#test" #{"alice" "bob"}})) + alice (registered-client "alice" alice-out test-network-id) + bob (registered-client "bob" bob-out test-network-id)] + (handle-join ["#test"] alice components) + (handle-privmsg ["ChanServ" ":REGISTER #test"] alice components) + (let [replies (handle-privmsg ["ChanServ" ":KICK #test bob bad behavior"] + alice components)] + (is (empty? replies)) + (is (not (contains? (get @(:channels components) "#test") "bob"))) + (is (string/includes? (.toString bob-out "UTF-8") "KICK"))) + (let [replies (handle-privmsg ["ChanServ" ":BAN #test bob"] + alice components)] + (is (string/includes? (first replies) "banned"))) + (let [replies (handle-join ["#test"] bob components)] + (is (string/includes? (first replies) "474"))))) + (testing "permission denied for non-op" + (let [{:keys [test-network-id] :as components} (test-components-with-network) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out test-network-id) + bob (registered-client "bob" out test-network-id)] + (handle-join ["#test"] alice + (assoc components + :clients (atom {"alice" {:w out}}) + :channels (atom {}))) + (handle-privmsg ["ChanServ" ":REGISTER #test"] alice components) + (let [replies (handle-privmsg ["ChanServ" ":SET #test TOPIC nope"] + bob components)] + (is (string/includes? (first replies) "Permission denied")))))) + +(deftest test_memoserv + (testing "SEND + LIST + READ + DELETE" + (let [components (test-components) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out) + bob (registered-client "bob" out)] + ;; Send memo + (let [replies (handle-privmsg ["MemoServ" ":SEND bob Hello Bob!"] + alice components)] + (is (string/includes? (first replies) "Memo sent"))) + ;; List as bob + (let [replies (handle-privmsg ["MemoServ" ":LIST"] bob components)] + (is (= 1 (count replies))) + (is (string/includes? (first replies) "alice")) + (is (string/includes? (first replies) "unread")) + ;; Extract memo ID for READ/DELETE + (let [memo-id (last (string/split (first replies) #" "))] + ;; Read + (let [replies (handle-privmsg + ["MemoServ" (str ":READ " memo-id)] + bob components)] + (is (string/includes? (first replies) "Hello Bob!"))) + ;; Now listed as read + (let [replies (handle-privmsg ["MemoServ" ":LIST"] bob components)] + (is (string/includes? (first replies) "read"))) + ;; Delete + (let [replies (handle-privmsg + ["MemoServ" (str ":DELETE " memo-id)] + bob components)] + (is (string/includes? (first replies) "deleted"))) + ;; List empty + (let [replies (handle-privmsg ["MemoServ" ":LIST"] bob components)] + (is (string/includes? (first replies) "No memos"))))))) + (testing "auto-delivery on registration" + (let [components (dissoc (test-components) :cracha) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out)] + ;; Send memo to bob while offline + (handle-privmsg ["MemoServ" ":SEND bob Hey!"] alice components) + ;; Bob registers (no cracha = auth skipped) + (let [c (atom {:nick nil :user nil :pass nil :registered? false + :w out})] + (swap! c assoc :nick "bob") + (let [replies (@#'papod/replies-for! + {:command "USER" :params ["" "bob" "0" "x" ":B"]} + c components)] + (is (= 2 (count replies))) + (is (string/includes? (first replies) "001")) + (is (string/includes? (second replies) "MemoServ"))))))) + +(deftest test_schema-invariants + (testing "events get monotonic sequence numbers per channel" + (let [alice-out (java.io.ByteArrayOutputStream.) + bob-out (java.io.ByteArrayOutputStream.) + {:keys [test-network-id] :as components} + (assoc (test-components-with-network) + :clients (atom {"alice" {:w alice-out} + "bob" {:w bob-out}}) + :channels (atom {})) + conn (:conn components) + alice (registered-client "alice" alice-out test-network-id)] + (handle-join ["#test"] alice components) + (swap! (:channels components) update "#test" conj "bob") + (handle-privmsg ["#test" ":first"] alice components) + (handle-privmsg ["#test" ":second"] alice components) + (let [db (d/db conn) + seqs (sort (map first + (d/q '{:find [?seq] + :in [$ ?chan-name] + :where [[?e :papod.event/seq ?seq] + [?e :papod.event/channel ?c] + [?c :papod.channel/name ?chan-name]]} + db "#test")))] + (is (= [1 2 3] seqs))))) + (testing "duplicate access entry is rejected" + (let [{:keys [test-network-id] :as components} (test-components-with-network) + conn (:conn components) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out test-network-id)] + (handle-join ["#test"] alice + (assoc components + :clients (atom {"alice" {:w out}}) + :channels (atom {}))) + (handle-privmsg ["ChanServ" ":REGISTER #test"] alice components) + (handle-privmsg ["ChanServ" ":OP #test bob"] alice components) + ;; Second OP for same nick is caught by has-access? check + (let [replies (handle-privmsg ["ChanServ" ":OP #test bob"] + alice components)] + (is (string/includes? (first replies) "already an operator"))))) + (testing "non-empty predicates reject empty strings" + (let [components (test-components) + conn (:conn components)] + (is (thrown? java.util.concurrent.ExecutionException + @(d/transact conn + [{:db/ensure :papod.memo/attrs + :papod.memo/id (java.util.UUID/randomUUID) + :papod.memo/from "" + :papod.memo/to "bob" + :papod.memo/content "hi" + :papod.memo/created-at (java.util.Date.) + :papod.memo/read? false}]))))) + (testing "entity attrs enforce required fields" + (let [components (test-components) + conn (:conn components)] + (is (thrown? java.util.concurrent.ExecutionException + @(d/transact conn + [{:db/ensure :papod.memo/attrs + :papod.memo/id (java.util.UUID/randomUUID) + :papod.memo/from "alice"}])))))) -; (parse-message " CMD") +(deftest test_private-channels + (testing "private channel created via ChanServ is joinable by & handle" + (let [alice-out (java.io.ByteArrayOutputStream.) + bob-out (java.io.ByteArrayOutputStream.) + {:keys [test-network-id] :as components} + (assoc (test-components-with-network) + :clients (atom {"alice" {:w alice-out} + "bob" {:w bob-out}}) + :channels (atom {})) + alice (registered-client "alice" alice-out test-network-id) + bob (registered-client "bob" bob-out test-network-id) + conn (:conn components) + chan-id (java.util.UUID/randomUUID) + _ @(d/transact conn + [{:db/ensure :papod.channel/attrs + :db/id "new-channel" + :papod.channel/id chan-id + :papod.channel/network [:papod.network/id test-network-id] + :papod.channel/type "private" + :papod.channel/label "secret-project" + :papod.channel/description "" + :papod.channel/created-at (java.util.Date.)} + {:db/ensure :papod.access/attrs + :papod.access/id (java.util.UUID/randomUUID) + :papod.access/channel "new-channel" + :papod.access/nick "alice" + :papod.access/level "owner"}]) + handle (str "&" chan-id)] + ;; Alice (owner) can join + (let [replies (handle-join [handle] alice components)] + (is (empty? replies)) + (is (contains? (get @(:channels components) handle) "alice"))) + ;; Bob (no access) cannot join — gets "No such channel" + (let [replies (handle-join [handle] bob components)] + (is (string/includes? (first replies) "403"))))) + (testing "probing #private-name returns no such channel" + (let [{:keys [test-network-id] :as components} (test-components-with-network) + conn (:conn components) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out test-network-id) + _ @(d/transact conn + [{:db/ensure :papod.channel/attrs + :papod.channel/id (java.util.UUID/randomUUID) + :papod.channel/network [:papod.network/id test-network-id] + :papod.channel/type "private" + :papod.channel/label "bob-firing-wg" + :papod.channel/description "" + :papod.channel/created-at (java.util.Date.)}])] + ;; Probing by name fails — no public name exists + (let [replies (handle-join ["#bob-firing-wg"] alice + (assoc components :channels (atom {})))] + ;; Creates a NEW public channel named #bob-firing-wg + ;; (doesn't find the private one — that's the point) + (is (empty? replies))))) + (testing "#-prefixed UUID name works as a normal public channel" + (let [{:keys [test-network-id] :as components} + (assoc (test-components-with-network) + :clients (atom {}) + :channels (atom {})) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out test-network-id) + uuid-name (str "#" (java.util.UUID/randomUUID))] + ;; JOIN with a UUID-shaped name — treated as a public channel name + (let [c (assoc components + :clients (atom {"alice" {:w out}}))] + (let [replies (handle-join [uuid-name] alice c)] + (is (empty? replies)) + (is (contains? (get @(:channels c) uuid-name) "alice")))))) + (testing "&non-uuid is rejected" + (let [{:keys [test-network-id] :as components} + (assoc (test-components-with-network) :channels (atom {})) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out test-network-id)] + (let [replies (handle-join ["¬-a-uuid"] alice components)] + (is (string/includes? (first replies) "403")))))) +(deftest test_networks-and-members + (testing "registration creates member in connection's network" + (let [{:keys [test-network-id] :as components} + (dissoc (test-components-with-network) :cracha) + conn (:conn components) + out (java.io.ByteArrayOutputStream.) + c (atom {:nick nil :user nil :pass nil :registered? false + :w out :network-id test-network-id})] + (swap! c assoc :nick "alice") + (@#'papod/replies-for! + {:command "USER" :params ["" "alice" "0" "x" ":A"]} + c components) + (is (:registered? @c)) + (let [db (d/db conn) + members (d/q '{:find [?nick ?status] + :in [$ ?net] + :where [[?m :papod.member/network ?net] + [?m :papod.member/nick ?nick] + [?m :papod.member/status ?status]]} + db [:papod.network/id test-network-id])] + (is (= #{["alice" "active"]} members))))) + (testing "no member created without NETWORK command" + (let [components (dissoc (test-components-with-network) :cracha) + conn (:conn components) + out (java.io.ByteArrayOutputStream.) + c (atom {:nick nil :user nil :pass nil :registered? false + :w out})] + (swap! c assoc :nick "bob") + (@#'papod/replies-for! + {:command "USER" :params ["" "bob" "0" "x" ":B"]} + c components) + (is (:registered? @c)) + (let [db (d/db conn) + members (d/q '{:find [?nick] + :where [[?m :papod.member/nick ?nick]]} + db)] + (is (empty? members))))) + (testing "channels are scoped to network" + (let [{:keys [test-network-id] :as components} + (assoc (test-components-with-network) + :clients (atom {}) + :channels (atom {})) + conn (:conn components) + out (java.io.ByteArrayOutputStream.) + alice (registered-client "alice" out test-network-id)] + (handle-join ["#general"] alice + (assoc components :clients (atom {"alice" {:w out}}))) + (let [db (d/db conn) + chans (d/q '{:find [?name ?net-id] + :in [$ ?net] + :where [[?c :papod.channel/name ?name] + [?c :papod.channel/network ?net] + [?net :papod.network/id ?net-id]]} + db [:papod.network/id test-network-id])] + (is (= 1 (count chans))) + (is (= "#general" (ffirst chans))) + (is (= test-network-id (second (first chans))))))) + (testing "network has required attrs" + (let [conn (:conn (test-components))] + (is (thrown? java.util.concurrent.ExecutionException + @(d/transact conn + [{:db/ensure :papod.network/attrs + :papod.network/id (java.util.UUID/randomUUID) + :papod.network/name "incomplete"}])))))) (defn -main [& _args] |