Add #:contact-info to commands

eutro · eutro · commit 85f104527a49 · 2025-12-05T21:08:08.000Z
Docs not yet written
diff --git a/.gitignore b/.gitignore
@@ -5,3 +5,4 @@
 compiled/
 /doc/
 session.key
+contact.txt
diff --git a/answer.rkt b/answer.rkt
@@ -4,21 +4,28 @@
          net/uri-codec
          racket/port
          racket/format
-         advent-of-code/request
-         (only-in advent-of-code/input advent-day? advent-year?))
+         "request.rkt"
+         "meta.rkt"
+         (only-in "input.rkt" advent-day? advent-year?))
 
 (provide (contract-out
-          [aoc-submit (-> aoc-session? advent-year? advent-day?
-                          (or/c 1 2) any/c
-                          string?)]
-          [aoc-submit* (-> aoc-session? advent-year? advent-day?
-                           (or/c 1 2) any/c
-                           input-port?)])
+          [aoc-submit (->* (aoc-session?
+                            advent-year? advent-day?
+                            (or/c 1 2) any/c)
+                           (#:contact-info string?)
+                           string?)]
+          [aoc-submit* (->* (aoc-session?
+                             advent-year? advent-day?
+                             (or/c 1 2) any/c)
+                            (#:contact-info string?)
+                            input-port?)])
          advent-day?
          advent-year?)
 
-(define (aoc-submit* session year day part answer)
+(define (aoc-submit* session year day part answer
+                     #:contact-info [contact-info (find-contact-info)])
   (aoc-request session year "day" day "answer"
+               #:contact-info contact-info
                #:post
                (lambda (hs)
                  (values
@@ -29,8 +36,10 @@
                    `((level . ,(~a part))
                      (answer . ,(~a answer))))))))
 
-(define (aoc-submit session year day part answer)
-  (define response (port->string (aoc-submit* session year day part answer)))
+(define (aoc-submit session year day part answer
+                    #:contact-info [contact-info (find-contact-info)])
+  (define response (port->string (aoc-submit* session year day part answer
+                                              #:contact-info contact-info)))
   (define matches (regexp-match #px"<article><p>(.*)</p></article>" response))
   (if matches
       (regexp-replace*
diff --git a/info.rkt b/info.rkt
@@ -4,7 +4,7 @@
 (define build-deps '("scribble-lib" "racket-doc" "net-doc"))
 (define scribblings '(("scribblings/advent-of-code.scrbl" ())))
 (define pkg-desc "Package for fetching Advent of Code input.")
-(define version "1.0.2")
+(define version "1.1.0")
 (define pkg-authors '(eutro))
 (define raco-commands
   '(("aoc" (submod advent-of-code main) "Fetch Advent of Code puzzle input" #f)))
diff --git a/input.rkt b/input.rkt
@@ -2,23 +2,34 @@
 
 (require racket/contract/base
          racket/port
-         advent-of-code/request)
+         "request.rkt"
+         "meta.rkt")
 
 (provide (contract-out
           [open-aoc-input (->* (aoc-session? advent-year? advent-day?)
-                               (#:cache (or/c boolean? path-string?))
+                               (#:cache (or/c boolean? path-string?)
+                                #:contact-info string?)
                                input-port?)]
           [fetch-aoc-input (->* (aoc-session? advent-year? advent-day?)
-                                (#:cache (or/c boolean? path-string?))
+                                (#:cache (or/c boolean? path-string?)
+                                 #:contact-info string?)
                                 string?)]
           [advent-day? flat-contract?]
           [advent-year? flat-contract?]))
 
 (define advent-day? (integer-in 1 25))
 (define advent-year? (and/c exact-integer? (>=/c 2015)))
 
-(define (open-aoc-input session year day #:cache [cache #f])
-  (aoc-request session year "day" day "input" #:cache cache))
+(define (open-aoc-input session year day
+                        #:contact-info [contact-info (find-contact-info)]
+                        #:cache [cache #t])
+  (aoc-request session year "day" day "input"
+               #:cache cache
+               #:contact-info contact-info))
 
-(define (fetch-aoc-input session year day #:cache [cache #f])
-  (port->string (open-aoc-input session year day #:cache cache)))
+(define (fetch-aoc-input session year day
+                         #:cache [cache #t]
+                         #:contact-info [contact-info (find-contact-info)])
+  (port->string (open-aoc-input session year day
+                                #:cache cache
+                                #:contact-info contact-info)))
diff --git a/main.rkt b/main.rkt
@@ -1,22 +1,22 @@
 #lang racket/base
 
-(require advent-of-code/request
-         advent-of-code/input
-         advent-of-code/answer
-         advent-of-code/meta)
+(require "request.rkt"
+         "input.rkt"
+         "answer.rkt"
+         "meta.rkt")
 
-(provide (all-from-out
-          advent-of-code/request
-          advent-of-code/input
-          advent-of-code/answer
-          advent-of-code/meta))
+(provide (all-from-out "request.rkt"
+                       "input.rkt"
+                       "answer.rkt"
+                       "meta.rkt"))
 
 (module+ main
   (require racket/cmdline
            raco/command-name
            racket/port)
 
   (define sessionb (box #f))
+  (define contactb (box #f))
   (define yearb (box #f))
   (define dayb (box #f))
   (define cacheb (box #t))
@@ -26,6 +26,7 @@
    #:program (short-program+command-name)
    #:once-each
    [("-s" "--session") session "The session cookie" (set-box! sessionb session)]
+   [("-i" "--contact-info") email-or-url "Contact information" (set-box! contactb email-or-url)]
    [("-y" "--year") year "The year to query for" (set-box! yearb (string->number year))]
    [("-d" "--day") day "The day to fetch the input for" (set-box! dayb (string->number day))]
    #:once-any
@@ -50,6 +51,7 @@
                      (raise e))])
     (define now (current-aoc-time))
     (define session (or (unbox sessionb) (find-session)))
+    (define contact (or (unbox contactb) (find-contact-info)))
     (define year
       (or (unbox yearb)
           ((if (= (date-month now) 12) values sub1)
@@ -59,6 +61,8 @@
           (max 1 (min 25 (date-day now)))))
     (define ans (unbox answerb))
     (if ans
-        (displayln (aoc-submit session year day (car ans) (cdr ans)))
-        (copy-port (open-aoc-input session year day #:cache (unbox cacheb))
+        (displayln (aoc-submit session year day (car ans) (cdr ans)
+                               #:contact-info contact))
+        (copy-port (open-aoc-input session year day #:cache (unbox cacheb)
+                                   #:contact-info contact)
                    (current-output-port)))))
diff --git a/meta.rkt b/meta.rkt
@@ -2,16 +2,28 @@
 
 (require racket/contract/base
          racket/runtime-path
+         racket/system
+         racket/port
          racket/file
          racket/string
-         advent-of-code/request
          net/sendurl
-         net/url)
+         net/url
+         (for-syntax racket/base
+                     racket/path
+                     setup/getinfo))
 
 (provide (contract-out
+          [aoc-url url?]
+          [aoc-session? predicate/c]
           [current-aoc-time (-> date?)]
           [session-file path-string?]
-          [find-session (-> aoc-session?)]))
+          [contact-info-file path-string?]
+          [find-session (-> aoc-session?)]
+          [find-contact-info (-> string?)]
+          [contact-info->user-agent (-> string? bytes?)]))
+
+(define (aoc-session? s) (string? s))
+(define aoc-url (string->url "https://adventofcode.com"))
 
 (define (current-aoc-time)
   (define aoc-offset (- (* 5 60 60)))
@@ -20,6 +32,7 @@
    #f))
 
 (define-runtime-path session-file "session.key")
+(define-runtime-path contact-info-file "contact.txt")
 
 (define (y-or-n prompt [default #f])
   (printf "~a [~a/~a] "
@@ -42,34 +55,125 @@
   (parameterize ([current-output-port (current-error-port)])
     (displayln "Session key unset or expired.")
     (printf "Please set ~a~n" session-file)
-    (when (not (eq? 'y (y-or-n "Set interactively now?" 'y)))
-      (exit 1))
+    (unless (eq? 'y (y-or-n "Set interactively now?" 'y))
+      (raise-user-error "Session key unset or expired"))
     (when (eq? 'y (y-or-n "Open Advent of Code in browser?" 'y))
       (send-url (url->string aoc-url)))
     (displayln "Hint: Your cookies can typically be found in the developer console.")
     (displayln "- Firefox: \"Storage\" tab (Shift + F9)")
     (displayln "- Chrome: \"Application\" tab")
     (displayln "Enter the contents of your session cookie below:")
     (define session (read-line (current-input-port) 'any))
-    (when (eof-object? session)
-      (exit 1))
-    (with-output-to-file session-file
-      #:exists 'replace
-      (lambda ()
-        (display session)
-        (flush-output)))
+    (when (or (eof-object? session) (string=? "" session))
+      (raise-user-error "No input provided"))
+    (display-to-file session session-file #:exists 'replace)
     (displayln "Session set successfully!")))
 
+(define month-seconds (* 31 24 60 60))
+(define (older-than-seconds? path seconds)
+  (let/ec return
+    (define csec (current-seconds))
+    (define file-seconds
+      (file-or-directory-modify-seconds
+       path #f (lambda () (return #t))))
+    (<= seconds (- csec file-seconds))))
+
 (define (find-session)
-  (define csec (current-seconds))
-  (define month-seconds (* 31 24 60 60))
-  (when (<=
-         month-seconds
-         (-
-          csec
-          (file-or-directory-modify-seconds
-           session-file
-           #f
-           (lambda () (- csec month-seconds)))))
+  (when (older-than-seconds? session-file month-seconds)
     (refresh-session!))
   (string-trim (file->string session-file)))
+
+(define (raw-find-contact-info)
+  (and (file-exists? contact-info-file)
+       (string-trim (file->string contact-info-file))))
+
+(define (refresh-contact-info!)
+  (let/ec return
+    (parameterize ([current-output-port (current-error-port)])
+      (displayln "Contact information unset or possibly outdated.")
+      (displayln "Eric Wastl asks that you include a way to be contacted in automated requests.")
+      (cond
+        [(raw-find-contact-info)
+         =>
+         (lambda (contact-info)
+           (printf "Your current contact information at ~a is:~n" contact-info-file)
+           (printf "  ~a~n" contact-info))]
+        [else
+         (printf "Please set ~a to a suitable email address or URL.~n" contact-info-file)])
+      (unless (eq? 'y (y-or-n "Set interactively now?" 'y))
+        (cond
+          [(raw-find-contact-info)
+           (file-or-directory-modify-seconds contact-info-file (current-seconds)
+                                             #;fail void)
+           (return (void))]
+          [else
+           (raise-user-error "Could not find contact information")]))
+      (define contact-info
+        (cond
+          [(and (find-executable-path "git")
+                (eq? 'y (y-or-n "Use contact information from git?" 'y))
+                (or (contact-info-from-git)
+                    (begin
+                      (displayln "Error calling git")
+                      #f)))
+           => values]
+          [else
+           (displayln "Enter your contact information below:")
+           (read-line (current-input-port) 'any)]))
+      (when (or (eof-object? contact-info) (string=? "" contact-info))
+        (raise-user-error "No input provided"))
+      (displayln "This library will send the following User-Agent to Advent of Code:")
+      (printf "  ~s~n" (contact-info->user-agent contact-info))
+      (unless (eq? 'y (y-or-n "Is that okay?" 'y))
+        (raise-user-error "Not accepted"))
+      (display-to-file contact-info contact-info-file #:exists 'replace)
+      (displayln "Contact information set successfully!"))))
+
+(define (guess-interactive?)
+  (terminal-port? (current-input-port)))
+
+(define (find-contact-info)
+  (when (and (guess-interactive?)
+             (older-than-seconds? contact-info-file month-seconds))
+    (refresh-contact-info!))
+  (cond
+    [(raw-find-contact-info) => values]
+    [else
+     (define-logger advent-of-code-racket)
+     (log-advent-of-code-racket-error
+      "No contact information set. Please set ~a to an email address or URL."
+      contact-info-file)
+     "unknownlibraryuser@example.com"]))
+
+(define (contact-info-from-git)
+  (define git (find-executable-path "git"))
+  (define (git-config key)
+    (let/ec return
+      (parameterize ([current-error-port (open-output-nowhere)])
+        (string-trim
+         (with-output-to-string
+           (lambda ()
+             (unless (zero? (system*/exit-code git "config" key))
+               (return #f))))))))
+  (git-config "user.email"))
+
+;; Taken from http-easy
+(begin-for-syntax
+  (define this-path (path-only (syntax-source #'here)))
+  (define info-ref (get-info/full this-path)))
+(define-syntax (get-lib-version stx)
+  (datum->syntax stx (info-ref 'version) stx))
+(define lib-version (get-lib-version))
+
+(define (contact-info->user-agent contact-info)
+  (call-with-output-bytes
+   (lambda (out)
+     (fprintf out
+              "advent-of-code-racket/~a (~a; racket[~a] ~a; +~a)"
+              lib-version
+              (system-type 'os)
+              (case (system-type 'vm)
+                [(chez-scheme) 'CS]
+                [else 'BC])
+              (version)
+              contact-info))))
diff --git a/request.rkt b/request.rkt
