fixed a bunch of bugs and changed the responses

botcore.rkt

@@ -12,7 +12,7 @@
 
 ;; CALLBACK FUNCTIONS
 (define (privmsg-handler send userinfo content join part)
-  (match (parse-exclamation content)
+  (match (parse-at content)
    ['nil 'nil]
     
    ; joining a channel
@@ -29,7 +29,13 @@
          [_ 'nil])]
     [_ 'nil])]
     
-   [result (send (format "~a is ~a" (first result) (dispatch userinfo content)))]))
+   [result 
+    (let ([result (dispatch userinfo content)])
+      (display result)
+      (match result
+        ['nil 'nil]
+        [(? hash?) (send "OK")]
+        [_ (send (format "~a" result))]))]))
 
 ;; Callback for join messages
 (define (join-handler privmsg userinfo)

commands.rkt

@@ -8,13 +8,19 @@
 ;; Command Parsing
 
 (define (string-head str)
-  (substring str 0 1))
+  (match (string-length str)
+    [(? ((curry <) 0)) (substring str 0 1)]
+    [_ #f]))
 
 (define (string-tail str)
-  (substring str 1 (string-length str)))
+  (match (string-length str)
+      [(? ((curry eq?) 0)) 'nil]
+      [len (substring str 1 len)]))
 
 (define (cmd? cmdchar cmd)
-  (string=? cmdchar (string-head cmd)))
+  (match (string-head cmd)
+    [#f #f]
+    [content (string=? cmdchar content)]))
 
 (define split-whitespace
   ((curry regexp-split) #rx" "))
@@ -29,24 +35,23 @@
    split-whitespace))
 
 (define parse-exclamation
-  (cmdparse "!"))
+  (cmdparse "?"))
 
 (define parse-at
-  (cmdparse "@"))
+  (cmdparse "?"))
 
 ;; Command Dispatcher
 (define (dispatch nick command)
   (match (allowed?)
-    [#f "Please try again in a few minutes"]
+    [#f 'nil]
-    [_ (match (parse-exclamation command)
+    [_ (match (parse-at command) ; if we are allowed, proceed
-    [(list-rest "set" args) (match args
+    [(list-rest "set" args) (match (car args)
                               ; this part checks if the right number of arguments are there
-                              [(list (list name) (list-rest _ text)) 
+                              [(list-rest name text) 
-                               (submit-question name (string-join text " "))
+                               (submit-question name (string-join text " "))]
-                               "Done!"]
+                              ; if for some reason this did not work, return nil
                               [_ 'nil])]
-    [(list-rest "alias" (list args)) (make-alias (first args) (second args))]
+    [(list-rest "alias" (list (list new old))) (make-alias new old)]
-    [(list-rest name _) (get-question name)]
+    [(list-rest name _) (get-question name)])]))
-         [_ 'nil])]))
 
 (provide (all-defined-out))

database.rkt

@@ -10,6 +10,9 @@
 
 ; Couch Database operations
 ; object used to connect to the database
+
+(define reserved-words (set "counter" "alias" "set"))
+
 (define (database-connection database-name)
   (couchdb-db
    (couchdb-connect
@@ -39,12 +42,23 @@
                    (strip-newlines
                     (second question))))))
 
+; trys to get a question from couchdb
+
+(define (try-couchdb-get database id)
+  (with-handlers ([exn:couchdb:not-found?
+                   (lambda (_) 
+                     'nil)])
+    (couchdb-get database id)))
+  
+
 ; gets a question
 (define couchdb-retrieve
   (compose
    (lambda (result)
-     (hash-ref result 'text))
+     (match result
-   ((curry couchdb-get)
+       ['nil 'nil]
+       [_ (hash-ref result 'text)]))
+   ((curry try-couchdb-get)
    (database-connection "faqbot"))))
 
 ; strips all newlines
@@ -56,11 +70,11 @@
 ; Redis Database Operations
 
 ; make a command
-(define make-cmd set)
+(define make-cmd redis-set)
 
 ; gets a specified command ID from redis
 (define (get-id cmd)
-  (match (get cmd)
+  (match (redis-get cmd)
     ['nil 'nil]
     [result (match (bytes->string/utf-8 result)
     ['nil 'nil]
@@ -78,17 +92,22 @@
 
 ; associates a name with an id in Redis, then puts the question in couchdb
 (define (submit-question name content)
-  (let* ([id (caar (hash-values [get-uuid]))])
+  (match name
+    [(? ((curry set-member?) reserved-words)) "reserved word"]
+    [_ (let* ([id (caar (hash-values [get-uuid]))])
     (make-cmd name id)
-    (couchdb-submit (list id content))))
+    (couchdb-submit (list id content)))]))
 
 ; gets an id associated with a name from Redis, then gets the question from couchdb
 
 (define (get-question name)
   (let* ([id (get-id name)])
     (match id
-      ['nil "No question found"]
+      ['nil 'nil]
-      [_ (couchdb-retrieve id)])))
+      [_ (match (couchdb-retrieve id)
+           ['nil (redis-del! name) ; if there is nothing in the database
+                 'nil]       ; then remove it
+           [result result])])))
 
 ;; Rate Limiting
 ; if |hC Current| > k, then set hC to Current, and hN to 0, and allow
@@ -106,13 +125,13 @@
   (let ([hN (bytes->number hN)])
     (cond
     [(and (> k mag) (eq? hN n)) #f]
-    [(and (< mag k) (< hN n)) (hincrby "counter" "n" "1") #t]
+    [(and (< mag k) (< hN n)) (redis-hincrby "counter" "n" "1") #t]
-    [else (hset "counter" "n" "0")
+    [else (redis-hset "counter" "n" "0")
-          (hset "counter" "current" (number->string (current-inexact-milliseconds)))
+          (redis-hset "counter" "current" (number->string (current-inexact-milliseconds)))
           #t])))
 
 (define ((rate-check n k))
-  (let* ([counter (hvals "counter")]
+  (let* ([counter (redis-hvals "counter")]
          [current-time (current-inexact-milliseconds)])
     (let* ([hC-Current (time-magnitude (second counter) current-time)])
       (rate-check-helper hC-Current (first counter) n k))))

redis.rkt

@@ -68,136 +68,135 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; COMMANDS
 
-(define (ping)
+(define (redis-ping)
   (send-command "PING")
   (read-reply))
 
 ;; Connection handling
 
-(define (quit)
+(define (redis-quit)
   (send-command "QUIT")
   (disconnect!))
 
-(define (auth)
+(define (redis-auth)
   (send-command "AUTH")
   (read-reply))
 
 ;; Commands operating on all value types
 
-(define (exists? key)
+(define (redis-exists? key)
   (send-command "EXISTS" key) 
   (match (read-reply)
          [1 #t]
          [0 #f]))
 
-(define del!
+(define redis-del!
   (lambda keys
     (apply send-command `("DEL" ,@keys))
     (read-reply)))
 
-(define (type key)
+(define (redis-type key)
   (send-command "TYPE" key)
   (string->symbol (read-reply)))
 
-(define (keys pattern)
+(define (redis-keys pattern)
   (send-command "KEYS" pattern)
   (read-reply))
 
-(define (randomkey)
+(define (redis-randomkey)
   (send-command "RANDOMKEY")
   (read-reply))
 
-
+(define (redis-rename! oldkey newkey)
-(define (rename! oldkey newkey)
   (send-command "RENAME" oldkey newkey)
   (read-reply))
 
-(define (renamenx! oldkey newkey)
+(define (redis-renamenx! oldkey newkey)
   (send-command "RENAME" oldkey newkey)
   (match (read-reply)
          [1 #t]
          [0 #f]))
 
-(define (dbsize)
+(define (redis-dbsize)
   (send-command "DBSIZE")
   (read-reply))
 
-(define (expire! key seconds)
+(define (redis-expire! key seconds)
   (send-command "EXPIRE" key seconds)
   (read-reply))
 
-(define (expireat! key date)
+(define (redis-expireat! key date)
   (send-command "EXPIREAT" key (date->seconds date))
   (read-reply))
 
-(define (ttl key)
+(define (redis-ttl key)
   (send-command "TTL" key)
   (read-reply))
 
-(define (select key)
+(define (redis-select key)
   (send-command "SELECT" key)
   (read-reply))
 
-(define (move key dbindex)
+(define (redis-move key dbindex)
   (send-command "MOVE" key dbindex)
   (read-reply))
 
-(define (flushdb)
+(define (redis-flushdb)
   (send-command "FLUSHDB")
   (read-reply))
 
-(define (flushall)
+(define (redis-flushall)
   (send-command "FLUSHALL")
   (read-reply))
 
-(define (set key value)
+(define (redis-set key value)
   (send-command "SET" key value)
   (read-reply))
 
-(define (get key)
+(define (redis-get key)
   (send-command "GET" key)
   (read-reply))
 
-(define (getset key value)
+(define (redis-getset key value)
   (send-command "GETSET" key value)
   (read-reply))
 
-(define mget
+(define redis-mget
   (lambda keys
     (apply send-command `("MGET" ,@keys)
     (read-reply))))
 
-(define (incrby key n)
+(define (redis-incrby key n)
   (send-command "INCRBY" key n)
   (read-reply))
 
 ;; Hash commands
 
-(define (hset key field value)
+(define (redis-hset key field value)
   (send-command "HSET" key field value)
   (read-reply))
 
-(define (hget key field)
+(define (redis-hget key field)
   (send-command "HGET" key field)
   (read-reply))
 
-(define (hgetall key)
+(define (redis-hgetall key)
   (send-command "HGETALL" key)
   (read-reply))
 
-(define (hincrby key field num)
+(define (redis-hincrby key field num)
   (send-command "HINCRBY" key field num)
   (read-reply))
 
-(define (hincrbyfloat key field num)
+(define (redis-hincrbyfloat key field num)
   (send-command "HINCRBYFLOAT" key field num)
   (read-reply))
 
-(define (hkeys key)
+(define (redis-hkeys key)
   (send-command "HKEYS" key)
   (read-reply))
 
-(define (hvals key)
+(define (redis-hvals key)
   (send-command "HVALS" key)
   (read-reply))