You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
144 lines
4.1 KiB
144 lines
4.1 KiB
#lang racket
|
|
(require (planet mordae/couchdb:1:11))
|
|
(require (planet dherman/json:4:0))
|
|
(require net/base64)
|
|
(require "redis.rkt")
|
|
(require "config.rkt")
|
|
|
|
;; This module is all of the database stuff
|
|
;; as well as the ratelimiting function
|
|
|
|
; 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
|
|
#:host (database-info "hostname")
|
|
#:port (database-info "port")
|
|
#:user (database-info "user")
|
|
#:password (database-info "pass"))
|
|
database-name))
|
|
|
|
; gets a single uuid
|
|
(define (get-uuid)
|
|
(couchdb-get (database-connection "_uuids") ""))
|
|
|
|
; submits a question
|
|
(define couchdb-submit
|
|
(compose ((curry couchdb-put)
|
|
(database-connection "faqbot"))
|
|
; build the jsexpr (hasheq)
|
|
(lambda (question)
|
|
(hasheq '_id
|
|
(first question)
|
|
'text
|
|
(second question)))
|
|
; strip all newlines
|
|
(lambda (question)
|
|
(list (first question)
|
|
(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)
|
|
(match result
|
|
['nil 'nil]
|
|
[_ (hash-ref result 'text)]))
|
|
((curry try-couchdb-get)
|
|
(database-connection "faqbot"))))
|
|
|
|
; strips all newlines
|
|
(define (strip-newlines text)
|
|
(match text
|
|
['nil 'nil]
|
|
[_ (regexp-replace* #rx"[\n\r]" text "")]))
|
|
|
|
; Redis Database Operations
|
|
|
|
; make a command
|
|
(define make-cmd redis-set)
|
|
|
|
; gets a specified command ID from redis
|
|
(define (get-id cmd)
|
|
(match (redis-get cmd)
|
|
['nil 'nil]
|
|
[result (match (bytes->string/utf-8 result)
|
|
['nil 'nil]
|
|
[result (match (regexp-match #rx"^[0-9a-z]*$" result)
|
|
[#f 'nil]
|
|
[_ result])])]))
|
|
|
|
; make a command alias
|
|
(define (make-alias new-cmd old-cmd)
|
|
(match (get-id old-cmd)
|
|
['nil 'nil]
|
|
[_ (make-cmd
|
|
new-cmd
|
|
(get-id old-cmd))]))
|
|
|
|
; associates a name with an id in Redis, then puts the question in couchdb
|
|
(define (submit-question name content)
|
|
(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)))]))
|
|
|
|
; 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 '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
|
|
; if |hC Current| < k and hN == n, then deny
|
|
; if |hC Current| < k, and hN < n, then allow, and increment hN by 1
|
|
|
|
(define (bytes->number x)
|
|
(string->number (bytes->string/utf-8 x)))
|
|
; Is there a built-in Racket function to convert byte strings to floats?
|
|
|
|
(define (time-magnitude a b)
|
|
(abs (- b (bytes->number a))))
|
|
|
|
(define (rate-check-helper mag hN n k)
|
|
(let ([hN (bytes->number hN)])
|
|
(cond
|
|
[(and (> k mag) (= hN n)) #f]
|
|
[(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 (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))))
|
|
|
|
; Allows no more than 6 commands every 45 seconds
|
|
; resets after 5 minutes have passed from the last time it was reset
|
|
(define allowed? (rate-check 10 (* 2 60000)))
|
|
;; Admin Stuff
|
|
|
|
(provide (all-defined-out))
|
|
|