#!/usr/bin/env racket #lang racket/base (require json net/url net/uri-codec racket/cmdline racket/file racket/match racket/port racket/runtime-path racket/system) ;; client configuration (struct app-config [instance token] #:prefab) (define (config-from-file filename) (if (file-exists? filename) (with-input-from-file filename read) (app-config #f #f))) (define current-config (make-parameter #f)) ;; http request functions (define (make-header k v) (string-append k ": " v)) (define (get-authorization) (string-append "Token " (app-config-token (current-config)))) (define (make-api-url path #:query [query '()]) (url "https" #f (app-config-instance (current-config)) #f #t `(,(path/param "api" '()) ,@(map (λ (x) (path/param x '())) path)) query #f)) (define (api-req method path data #:authorization [auth? #t]) (define-values (status headers rsp) (http-sendrecv/url (make-api-url path) #:method method #:headers `(,@(if auth? `(,(make-header "Authorization" (get-authorization))) '()) ,(make-header "Content-Type" "application/json")) #:data (jsexpr->string data))) (string->jsexpr (port->string rsp))) ;; writefreely api functions (define (login-user username password) (api-req "POST" '("auth" "login") (hash 'alias username 'pass password))) (define (update-post id title content) (api-req "POST" `("posts" ,id) (hash 'body content 'title title))) ;; script toplevel (module+ main (define-runtime-path *default-config-file* "secrets.rktd") (define (read-password) (system "stty -echo") (begin0 (read-line) (system "stty echo") (newline))) (current-config (config-from-file *default-config-file*)) (unless (and (app-config-instance (current-config)) (app-config-token (current-config))) (printf "instance: ") (define instance (read-line)) (current-config (app-config instance #f)) (printf "username: ") (define username (read-line)) (printf "password: ") (define password (read-password)) (define token (match (login-user username password) [(hash-table ('data (hash-table ('access_token token) _ ...)) _ ...) token] [resp (error "failed to log in" resp)])) (current-config (app-config instance token)) (with-output-to-file *default-config-file* (λ () (write (current-config))))) (command-line #:program "writefreely-cli" #:args (post-id post-file) (define-values [title content] (with-input-from-file post-file (λ () (values (match (read-line) [(pregexp #px"^# (.+)$" (list _ title)) title] [_ (error "post has no title")]) (port->string))))) (match (update-post post-id title content) [(hash-table ('code 200) _ ...) (printf "https://~a/posts/~a\n" (app-config-instance (current-config)) post-id)] [resp (error "failed to post" resp)])) (void))