Skip to content

Instantly share code, notes, and snippets.

@gatlin
Last active August 29, 2015 14:06
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save gatlin/06b9d4ead902dda36b65 to your computer and use it in GitHub Desktop.
Save gatlin/06b9d4ead902dda36b65 to your computer and use it in GitHub Desktop.
I have a lot of saved posts on Reddit, but I also compulsively save pug-related posts. So I wrote this script to download my saved posts, filter out the pug-related ones, and save them to a local database.
#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)
#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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment