Last active
August 29, 2015 14:06
-
-
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.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#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