ircd.rkt

@@ -1,20 +1,16 @@
 #lang typed/racket
 ;; single room IRC server
 (require "private/irc-functions.rkt"
-         (only-in "private/ws-typed.rkt" WS)
+         (only-in "private/ws-typed.rkt" WS [ws-close! ws:close-conn])
          (prefix-in ws: "api.rkt")
          (prefix-in movie-night: "chat.rkt"))
 (provide (all-defined-out))
 
-;; Each channel a user joins is associated with a WS connection
-(define movie-night-ws-url (make-parameter "wss://stream.ihatebeinga.live/ws"))
+;; global crap
+;; needs to be cleaned out
+(define movie-night-ws-url (make-parameter "wss://stream.ihatebeinga.live/channels/epi/ws"))
 
-(define-type Channel-List (Listof (Pairof String WS)))
-
-(: users (Listof String))
-(define users '())
-
-(define channel "#chats")
+(define (make-ws-url [un : String]) (string-append "wss://stream.ihatebeinga.live/channels/" un "/ws"))
 
 ;; Main entry point
 ;; Returns the main server loop thread (for synchronizing) and
@@ -48,9 +44,7 @@
      (lambda ()
        ;; TODO: custodian should be part of irc-connection
        (define user-conn (accept-irc-connection in out cust))
-       (define channels '())
-       (thread (lambda ()
-          (handle-user-messages user-conn channels cust)))))))
+       (thread (lambda () (handle-user-messages user-conn)))))))
   
 ;; When we accept a new IRC connection we need to do several things:
 ;; 1. Receive the user nick/user information
@@ -79,7 +73,7 @@
   (file-stream-buffer-mode out 'line)
 
   (: conn irc-connection)
-  (define conn (irc-connection in out nick user))
+  (define conn (irc-connection in out nick user cust '()))
 
   (welcome-user conn)
   (void (thread (lambda () (ping-pong-thread conn))))
@@ -97,8 +91,8 @@
 
 ;; Callbacks for the MoveNight chat api
 
-(: notify-users (-> irc-connection Void))
-(define (notify-users conn)
+(: notify-users (-> irc-connection String (Listof String) Void))
+(define (notify-users conn channel users)
   (send-to-client conn (irc-message
                         ":lolcathost"
                         RPL_NAMEREPLY
@@ -109,8 +103,8 @@
                         RPL_ENDOFNAMES
                         (list (irc-connection-nick conn) channel ":End of /NAMES list."))))
 
-(: on-chat (-> irc-connection String String Void))
-(define (on-chat conn from message)
+(: on-chat (-> irc-connection String String String Void))
+(define (on-chat conn channel from message)
   (unless (equal? from (irc-connection-nick conn))
     (send-to-client
      conn
@@ -118,8 +112,8 @@
                   "PRIVMSG"
                   (list channel (format ":~a" message))))))
 
-(: on-response (-> irc-connection String Void))
-(define (on-response conn message)
+(: on-response (-> irc-connection String String Void))
+(define (on-response conn channel message)
   (send-to-client
    conn
    (irc-message "OwO!SERVER@lolcathost"
@@ -127,8 +121,8 @@
                 (list channel
                       (format ":!!! [ ~a ]" message)))))
 
-(: on-topic (-> irc-connection String Void))
-(define (on-topic conn topic)
+(: on-topic (-> irc-connection String String Void))
+(define (on-topic conn channel topic)
   (send-to-client conn (irc-message
                         ":lolcathost"
                         RPL_TOPIC
@@ -136,8 +130,8 @@
                               channel
                               (string-append ":" topic)))))
 
-(: on-join (-> irc-connection String Void))
-(define (on-join conn nick)
+(: on-join (-> irc-connection String String Void))
+(define (on-join conn channel nick)
   (unless (equal? nick (irc-connection-nick conn))
     (send-to-client
      conn
@@ -145,8 +139,8 @@
                   "JOIN"
                   (list channel)))))
 
-(: on-leave (-> irc-connection String Void))
-(define (on-leave conn nick)
+(: on-leave (-> irc-connection String String Void))
+(define (on-leave conn channel nick)
   (unless (equal? nick (irc-connection-nick conn))
     (send-to-client
      conn
@@ -172,9 +166,11 @@
 ;;     some number of seconds in order to keep the connection alive
 ;; XXX this is a galaxy brain version of making sure that the connection stays alive
 ;; ideally this should be rewritten
-(: handle-user-messages (-> irc-connection Channel-List Custodian Nothing))
-(define (handle-user-messages conn channels custodian)
+(: handle-user-messages (-> irc-connection Nothing))
+(define (handle-user-messages conn)
   (define nick (irc-connection-nick conn))
+  (define custodian (irc-connection-custodian conn))
+  (define channels (irc-connection-channels conn))
   (define msg (read-from-client conn #:timeout 333))
   (log-info (format "Raw irc-message: ~a" msg))
   (match msg
@@ -189,18 +185,18 @@
     [(irc-message _ "NICK" params)
      ;; TODO: propagate this info along the WS
      (set-irc-connection-nick! conn (car params))]
-    ;; TODO: implement PART as well
     [(irc-message _ "JOIN" (list chan))
-     #:when (and (equal? chan channel)
-                 (not (member chan channels)))
-     (define ws (join-new-channel conn chan custodian))
-     (set! channels (cons (cons chan ws) channels))]
+     #:when (not (channel-joined? chan channels))
+     (define ws (join-new-channel conn chan))
+     (set-irc-connection-channels! conn (cons (cons chan ws) channels))]
+    [(irc-message _ "PART" (list chan))
+     (part-and-remove-channel! conn chan)]
     [(irc-message _ "MODE" (cons chan _))
      #:when (channel-joined? chan channels)
      (send-to-client conn (irc-message
                            ":lolcathost"
                            RPL_CHANNELMODEIS
-                           (list nick channel "+OwO")))]
+                           (list nick chan "+OwO")))]
     [(irc-message _ "LIST" _)
      (send-to-client conn (irc-message
                            ":lolcathost"
@@ -212,7 +208,7 @@
      (send-to-client conn (irc-message
                            ":lolcathost"
                            RPL_WHOREPLY
-                           (list nick channel
+                           (list nick chan
                                  (irc-connection-user conn)
                                  "lolcathost"
                                  "lolcathost"
@@ -222,7 +218,7 @@
      (send-to-client conn (irc-message
                            ":lolcathost"
                            RPL_ENDOFWHO
-                           (list nick channel ":End of /WHO list.")))]
+                           (list nick chan ":End of /WHO list.")))]
     [(irc-message _ "WHOIS" (list target))
      (send-to-client conn (irc-message
                            ":lolcathost"
@@ -262,31 +258,34 @@
      ;; somehow attach this to a custodian?
      (log-warning (format "ircd.rkt: Closing socket for ~a" (irc-connection-nick conn)))
      (custodian-shutdown-all custodian)]
-    [#f ;;; were unable to parse the string correctly
+    [#f ;;; were unable to parse the string correctly, just ignore it
      (void)]
     [(var msg)
      (log-warning (format "ircd.rkt/handle-user-message: unknown message: ~a" msg))])
-  (handle-user-messages conn channels custodian))
+  (handle-user-messages conn))
 
-(: join-new-channel (-> irc-connection String Custodian WS))
-(define (join-new-channel conn channel-name cust)
+(: join-new-channel (-> irc-connection String WS))
+(define (join-new-channel conn channel-name)
+  (define wsurl (make-ws-url (string-trim channel-name "#" #:right? #f)))
+  (log-warning wsurl)
   (: ws-c WS)
   (define ws-c
     (movie-night:make-connection
-     (movie-night-ws-url)
+     wsurl
      (irc-connection-nick conn)
-     #:on-join (lambda ([n : String]) (on-join conn n))
-     #:on-leave (lambda ([n : String]) (on-leave conn n))
+     #:on-join (lambda ([n : String]) (on-join conn channel-name n))
+     #:on-leave (lambda ([n : String]) (on-leave conn channel-name n))
      #:on-name-change (lambda ([n1 : String] [n2 : String])
                         (on-name-change conn n1 n2))
      #:on-users (lambda ([l : (Listof String)])
-                  (set! users l) (notify-users conn))
+                  (notify-users conn channel-name l))
      #:on-chat (lambda ([from : String] [msg : String])
-                 (on-chat conn from msg))
-     #:on-response (lambda ([msg : String]) (on-response conn msg))
-     #:on-notify (lambda ([msg : String]) (on-response conn msg))
-     #:on-topic (lambda ([topic : String]) (on-topic conn topic))
-     #:on-close-conn (lambda () (custodian-shutdown-all cust))))
+                 (on-chat conn channel-name from msg))
+     #:on-response (lambda ([msg : String]) (on-response conn channel-name msg))
+     #:on-notify (lambda ([msg : String]) (on-response conn channel-name msg))
+     #:on-topic (lambda ([topic : String]) (on-topic conn channel-name topic))
+     #:on-close-conn (lambda ()
+                       (part-and-remove-channel! conn channel-name))))
   
   (ws:send-join ws-c (irc-connection-nick conn) "#00FFAA")
   
@@ -295,27 +294,33 @@
                                 (irc-connection-nick conn)
                                 (irc-connection-user conn))
                         "JOIN"
-                        (list channel)))
+                        (list channel-name)))
   (send-to-client conn (irc-message
                         ":lolcathost"
                         RPL_TOPIC
-                        (list (irc-connection-nick conn) channel ":chatting hard")))
+                        (list (irc-connection-nick conn) channel-name ":chatting hard")))
   
   (sleep 1.5) ;; is there a way around going to sleep? :-<
   (ws:send-users ws-c)
   ws-c)
 
-
+(: part-and-remove-channel! (-> irc-connection String Void))
+(define (part-and-remove-channel! conn chan)
+  (define channels (irc-connection-channels conn))
+  (define ws (lookup-ws-conn channels chan))
+  (when ws
+    (begin
+      ;; close websocket
+      (ws:close-conn ws)
+      
+      (define nick (irc-connection-nick conn))
+      (send-to-client conn
+                      (irc-message (format "~a!~a@lolcathost" nick nick)
+                                   "PART"
+                                   (list chan)))
+      (set-irc-connection-channels! conn (remove-channel chan channels)))))
+  
 ;; Utils
-(: lookup-ws-conn (-> Channel-List String (U WS False)))
-(define (lookup-ws-conn ls x)
-  (define v (assoc x ls))
-  (and v (cdr v)))
-
-(: channel-joined? (-> String Channel-List Boolean))
-(define (channel-joined? x channels)
-  (if (assoc x channels) #t #f))
-
 (: welcome-user (-> irc-connection Void))
 (define (welcome-user conn)
   (define nick (irc-connection-nick conn))
@@ -339,14 +344,13 @@
   (notify-nick ":-----------------------------------------------------------------------------")
   (for ([x cofe])
     (notify-nick (string-append ":" x)))
-  (notify-nick ":Welcome nyaa")
-  (notify-nick (format ":Please join the channel ~a nyaa" channel)))
+  (notify-nick ":Welcome nyaa"))
 
 (define cofe
   '("            ,.  ,."
     "            ||  ||"
     "           ,''--''.                  ON THIS SERVER"
-    "          : (.)(.) :                    WE #cofe"
+    "          : (.)(.) :                    WE DRINK COFE"
     "         ,'        `. "
     "         :          : "
     "         :          :              hash tag IHBA gang"

private/irc-functions.rkt

@@ -2,6 +2,10 @@
 ;; A bunch of code in this file was copied from the irc package
 ;; (c) Jonathan Schuster
 (provide (all-defined-out))
+(require "ws-typed.rkt")
+
+;; TODO: just use a hash table
+(define-type Channel-List (Listof (Pairof String WS)))
 
 ;; :prefix command params crlf
 (struct irc-message ([prefix : (U False String)]
@@ -12,7 +16,9 @@
 (struct irc-connection ([in : Input-Port]
                         [out : Output-Port]
                         [nick : String]
-                        [user : String])
+                        [user : String]
+                        [custodian : Custodian]
+                        [channels : Channel-List])
   #:mutable)
 
 (: send-to-client (-> irc-connection irc-message Void))
@@ -131,3 +137,22 @@
 (define RPL_MOTDSTART 375)
 (define RPL_MOTD 372)
 (define RPL_ENDOFMOTD 376)
+
+
+;; channel-list related functions
+
+(: lookup-ws-conn (-> Channel-List String (U WS False)))
+(define (lookup-ws-conn ls x)
+  (define v (assoc x ls))
+  (and v (cdr v)))
+
+(: channel-joined? (-> String Channel-List Boolean))
+(define (channel-joined? x channels)
+  (if (assoc x channels) #t #f))
+
+(: remove-channel (-> String Channel-List Channel-List))
+(define (remove-channel chan channels)
+  (remove* (filter
+            (lambda ([p : (Pairof String WS)]) (equal? (car p) chan))
+            channels)
+           channels))