~technomancy/taverner

taverner/channel.fnl -rw-r--r-- 3.5 KiB
a86534a4Phil Hagelberg When notifying of nick changes, send user as well. a month ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
(local lume (require :lume))
(local valid (require :valid))

(fn insert-if-absent [tbl val]
  (when (not (lume.find tbl val))
    (table.insert tbl val)))

(fn make [name server-state ops ?members ?modes]
  (let [members (or ?members {})
        modes (or ?modes {:o ops :b [] :v []})
        buffer []]

    (fn set-mode [modestr ?arg]
      (let [m (modestr:sub 2)]
        (match modestr
          (where (or :+b :+o :+v)) (insert-if-absent (. modes m) ?arg)
          (where (or :-b :-o :-v)) (lume.remove (. modes m) ?arg)
          ;; technically only +k takes an arg but this is easier
          (where (or :+k :+m :+s :+t)) (tset modes m (or ?arg true))
          (where (or :-k :-m :-s :-t)) (tset modes m nil)
          _ (values nil :501 ":Unknown MODE flag; set modes one at a time."))))

    (fn empty? [] (= nil (next members)))

    (fn flush []
      (each [nick conn (pairs members)]
        (each [_ [sender msg] (ipairs buffer)]
          (when (not= nick sender)
            (conn:send (.. msg "\r\n")))))
      (lume.clear buffer))

    (fn send [sender ...]
      (table.insert buffer [sender (table.concat [...] " ")]))

    (fn join [nick conn]
      (tset members nick conn)
      (send "" (.. ":" nick) :JOIN name)
      (flush))

    (fn part [nick ?cmd ?reason]
      (tset members nick nil)
      (send nil (.. ":" nick) (or ?cmd :PART) name (or ?reason ""))
      (when (empty?)
        (tset server-state.channels name nil)))

    (fn set-topic [ch nick topic] ; TODO: this one is weird since it takes self
      (set ch.topic (if (= "" topic) nil topic))
      (set ch.topic-set-by nick)
      (set ch.topic-set-at (os.time))
      (send nil :322 ch.name (.. ":" (or ch.topic "No topic set."))))

    (fn mode [m] (. modes m))
    (fn get-modes [] (.. :+ (table.concat (lume.keys modes))))
    (fn mode-string [modestring]
      (let [m (. modes (modestring:sub 2))]
        (if (= :table (type m))
            (table.concat m " ")
            m)))

    (fn banned? [nick] (lume.find modes.b nick))

    (fn allowed? [nick ?key]
      (if (not= (. modes :k) ?key) (values nil :475 ":Cannot join channel (+k)")
          (banned? nick) (values nil :474 ":Cannot join channel (+b)")
          true))

    (fn member-names [] (icollect [k (pairs members)] k))
    (fn member? [nick] (not= nil (. members nick)))
    (fn op? [nick] (lume.find modes.o nick))
    (fn voice? [nick] (lume.find modes.v nick))
    (fn may-change-topic? [nick] (or (not (mode :t)) (op? nick)))

    (fn rename [old-nick new-nick user]
      (when (member? old-nick)
        (let [conn (. members old-nick)]
          (tset members old-nick nil)
          (tset members new-nick conn)
          (send nil (.. ":" old-nick "!" user " NICK " new-nick "\r\n")))))

    (fn upgrade [self new-make]
      (self.flush)
      (each [k v (pairs (new-make name server-state nil members modes))]
        (tset self k v)))

    (fn debug []
      (server-state.log :Channel name "/" (lume.serialize modes))
      (each [m (pairs members)] (server-state.log "" m)))

    {: name : send : join : part : flush
     : empty? : member-names : member?
     : set-mode : mode : get-modes : set-topic : mode-string
     : op? : voice? : allowed? : may-change-topic?
     : upgrade : rename : debug}))

(fn get-or-make [state cstate channel-name]
  (match-try (valid.channel? state channel-name)
    true (or (. state.channels channel-name)
             (make channel-name state [cstate.nick]))))

{: make : get-or-make :list-mode? #(. {:+k true :+b true :+o true} $)}