slurp.rkt

#lang racket

(require db)
(require "utils.rkt")

; open a connection to our database
(define (call-with-conn db proc)
  (let ([conn (sqlite3-connect #:database db
                               #:mode     'read/write)])
    (proc conn)))

(define (slurp-posts conn)
  (define normal-posts (stream-filter not-pug-related? (post-stream)))
  (define (insert-post p)
    (let ([name (post-ref p 'name)]
          [id   (post-ref p 'id)]
          [title (post-ref p 'title)]
          [url  (post-ref p 'url)]
          [subreddit (post-ref p 'subreddit)]
          [permalink (post-ref p 'permalink)])
      (let ([stmt (prepare conn "insert into posts values (?, ?, ?, ?, ?, ?)")])
        (query-exec 
         conn 
         (bind-prepared-statement stmt
                                  (list name
                                        id
                                        url
                                        title
                                        subreddit
                                        permalink))))))
  (stream-for-each insert-post normal-posts))

(call-with-conn "saved.db" slurp-posts)

utils.rkt

#lang racket

(require json)
(require net/http-client)
(require net/base64)
(require net/head)
(require net/uri-codec)
(require racket/generator)
(require racket/stream)

; configuration values
(define reddit-username "gatlin")
(define reddit-password "MY PASSWORD")
(define reddit-clientid #"Lf2MIEAJlyLmtw")
(define reddit-secretid #"CLIENT SECRET ID")

; given a username and password, construct an HTTP Basic Auth header
(define (mk-basic-auth-header user pass)
  (let* ((combined (bytes-append user #":" pass))
         (encoded  (base64-encode combined #""))
         (contents (bytes-append
                    #"Basic " encoded)))
    (bytes-append #"Authorization: " contents)))

; retrieve a new OAuth2 access token for savior + the user
(define (get-access-token)
  ; constructs the appropriate request headers 
  (define (make-headers)
    (let ((auth-headers (mk-basic-auth-header reddit-clientid reddit-secretid))
          (content-type #"Content-Type: application/x-www-form-urlencoded"))
      (list auth-headers content-type)))
  (let* ((hc (http-conn-open "ssl.reddit.com" #:ssl? #t))
         (headers (make-headers)))
    (call-with-values
     (λ ()
       (http-conn-sendrecv! hc "/api/v1/access_token"
                            #:method #"POST"
                            #:headers headers
                            #:close? #t
                            #:data
                            (alist->form-urlencoded
                             (list (cons 'grant_type "password")
                                   (cons 'username reddit-username)
                                   (cons 'password reddit-password)))))
     (λ (a b response-port)
       (let* ((str (port->string response-port))
              (jse (string->jsexpr str)))
         (hash-ref jse 'access_token))))))

; constructs, sends, and handles an HTTP request to get the saved posts for a user
(define (get-saved-data token user after)
  (define (make-headers)
    (list (string-append "Authorization: bearer "
                   token)))
  (let ((hc (http-conn-open "oauth.reddit.com" #:ssl? #t))
        (headers (make-headers))
        (uri (string-append "/user/" user "/saved.json"
                            (if (string? after)
                                (string-append "?after=" after)
                                ""))))
    (call-with-values
     (λ ()
       (http-conn-sendrecv! hc uri
                            #:close? #t
                            #:method #"GET"
                            #:headers headers))
     (λ (a b response-port)
       (let* ((str (port->string response-port))
              (jse (string->jsexpr str))
              (dat (hash-ref jse 'data)))
         dat)))))

; access metadata by key for a post
(define (post-ref post key)
  (let ((d (hash-ref post 'data)))
    (hash-ref d key "(none)")))

; is a post pug-related?
(define (not-pug-related? post)
  (match (post-ref post 'subreddit)
    ["pugs" #f]
    ["pug"  #f]
    [_      #t]))

(define (stream-take strm n)
  (if (stream-empty? strm)
      strm
      (if (eq? n 0)
          empty-stream
          (stream-cons (stream-first strm)
                       (stream-take (stream-rest strm)
                                    (- n 1))))))

; produces a stream where each element is a chunk of saved posts
(define get-post
  (generator ()
    (let ((token (get-access-token)))
      (let loop ([after null])
        (let* ([d (get-saved-data token reddit-username after)]
               [posts (hash-ref d 'children)]
               [after (hash-ref d 'after)])
          (if (> (length posts) 0)
              (let post-loop ([ps posts])
                (if (null? ps)
                    (loop after)
                    (begin
                      (yield (car ps))
                      (post-loop (cdr ps)))))
              'end))))))
            
(define (post-stream)
  (let ([p (get-post)])
    (if (eq? p 'end)
        empty-stream
        (stream-cons p (post-stream)))))

(provide (all-defined-out))