#lang racket

(require net/uri-codec net/http-client)
(provide aoc-fetch-input aoc-submit-answer)

(define *host* "adventofcode.com")

(define/contract (puzzle-path year day endpoint)
  (-> string? string? (or/c "input" "answer") path?)
  (build-path "/" year "day" day endpoint))

(define (make-headers session)
  (list (string-append "Cookie: session=" session)))

(define (aoc-request year day endpoint session [method 'GET] [data #f])
  (define (parse-headers hlist)
    (for/list ([h (in-list hlist)])
      (match h
        [(pregexp #px"^([^:]+): (.*?)$" (list _ k v))
         (cons (string->symbol (string-downcase (bytes->string/utf-8 k)))
               (bytes->string/utf-8 v))]
        [x (cons 'unknown x)])))

  (define (do-request path headers)
    (define-values [status headers-out content]
      (http-sendrecv *host* path #:ssl? #t #:headers headers))
    (define headers-out/parsed (parse-headers headers-out))

    (match status
      [(pregexp #px"^HTTP/1\\.[10] 200") content]
      [(pregexp #px"^HTTP/1\\.[10] 302")
       (define location (cdr (or (assoc 'location headers-out/parsed)
                                 (error "got 302 with no location"))))
       (printf "got redirect to ~a\n" location)
       (close-input-port content)
       (do-request location headers)]
      [(pregexp #px"^HTTP/1\\.[10] 404")
       (error "endpoint returned 404\n response: " (port->bytes content))]
      [stat
       (error "endpoint returned unexpected data\n status: " stat "\n response: "
              (port->bytes content))]))
  (do-request (path->string (puzzle-path year day endpoint)) (make-headers session)))

(define/contract (aoc-fetch-input year day session)
  (-> string? string? string? input-port?)
  (aoc-request year day "input" session))

(define/contract (aoc-submit-answer year day session part answer)
  (-> string? string? string? (or/c 1 2 "1" "2") string? (or/c symbol? bytes?))
  (define data `((level . ,(~a part))
                 (answer . ,answer)))
  (define resp
    (port->bytes (aoc-request year day "answer" session 'POST (alist->form-urlencoded data))))

  (match resp
    [(pregexp #px"Both parts of this puzzle are complete") 'day-complete]
    [(pregexp #px"That's the right answer") 'answer-correct]
    [(pregexp #px"That's not the right answer") 'answer-incorrect]
    [x x]))