diff --git a/botcore.rkt b/botcore.rkt index 0428895..807b13a 100755 --- a/botcore.rkt +++ b/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) diff --git a/commands.rkt b/commands.rkt index e1b5bdd..1cb4fc4 100644 --- a/commands.rkt +++ b/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"] - [_ (match (parse-exclamation command) - [(list-rest "set" args) (match args + [#f 'nil] + [_ (match (parse-at command) ; if we are allowed, proceed + [(list-rest "set" args) (match (car args) ; this part checks if the right number of arguments are there - [(list (list name) (list-rest _ text)) - (submit-question name (string-join text " ")) - "Done!"] + [(list-rest name text) + (submit-question name (string-join text " "))] + ; if for some reason this did not work, return nil [_ 'nil])] - [(list-rest "alias" (list args)) (make-alias (first args) (second args))] - [(list-rest name _) (get-question name)] - [_ 'nil])])) + [(list-rest "alias" (list (list new old))) (make-alias new old)] + [(list-rest name _) (get-question name)])])) (provide (all-defined-out)) \ No newline at end of file diff --git a/database.rkt b/database.rkt index 4d5045c..5ba006e 100644 --- a/database.rkt +++ b/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)) - ((curry couchdb-get) + (match result + ['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"] - [_ (couchdb-retrieve id)]))) + ['nil 'nil] + [_ (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] - [else (hset "counter" "n" "0") - (hset "counter" "current" (number->string (current-inexact-milliseconds))) + [(and (< mag k) (< hN n)) (redis-hincrby "counter" "n" "1") #t] + [else (redis-hset "counter" "n" "0") + (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)))) diff --git a/redis.rkt b/redis.rkt index e51814b..e621585 100644 --- a/redis.rkt +++ b/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 (rename! oldkey newkey) +(define (redis-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))