#lang racket

(require racket/async-channel
         json
         net/url
         net/uri-codec
         ; net/rfc6455
         uuid)

(provide [struct-out app-config]
         config-from-file
         current-config
         make-toot
         send-toot
         send-toot/retry-on-err
         verify-creds
         ; stream-user
         fetch-toot)

;; Bot configuration
(struct app-config [instance token char-limit] #:transparent)

(define (config-from-file filename)
  (define conf (with-input-from-file filename read))
  ;; this could be a macro
  (app-config
    (hash-ref conf 'instance)
    (hash-ref conf 'token)
    (hash-ref conf 'char-limit 500)))

;; Represents the current masto config
(define current-config (make-parameter #f))

;; Utils
(define (make-api-url path #:ws? [ws? #f] #:query [query '()])
  (url (if ws? "wss" "https")
                 #f (app-config-instance (current-config))
                 #f #t
                 `(,(path/param "api" '())
                   ,(path/param "v1" '())
                   ,@(map (lambda (x) (path/param x '())) path))
                 query #f))

(define (make-header k v)
  (string-append k ": " v))

(define (get-authorization)
  (string-append "Bearer " (app-config-token (current-config)))) 

(define (guard-config)
  (unless (app-config? (current-config))
    (error "current-config is not set up")))

;; Creates a toot
(define (make-toot status #:cw [cw #f] #:reply-to [reply-to #f]
                   #:sensitive [sensitive #f] #:language [lang #f]
                   #:visibility [visibility #f])
  (for/fold ([out '()])
            ([name '(status in_reply_to_id sensitive spoiler_text language visibility)]
             [value (list status reply-to sensitive cw lang visibility)])
    (cond [(false? value) out]
          [else (cons (cons name value) out)])))

;; Sends a toot
(define (send-toot toot [idem-key (uuid-string)])
  (guard-config)
  (define-values (status headers rsp)
    (http-sendrecv/url (make-api-url '("statuses"))
                       #:method "POST"
                       #:headers (list
                                  (make-header "Idempotency-Key" idem-key)
                                  (make-header "Authorization" (get-authorization))
                                  (make-header "Content-Type" "application/x-www-form-urlencoded"))
                       #:data (alist->form-urlencoded toot)))
  (string->jsexpr (port->string rsp)))

(define MAX-TRIES 10)
(define SLEEP-CAP 60)

(define (send-toot/retry-on-err toot [idem-key (uuid-string)] [tries 0])
  (guard-config)
  (define (handle-err ex)
    (displayln "toot failed")
    (displayln ex)
    (if (>= tries MAX-TRIES)
      (raise ex)
      (begin
        (sleep (min SLEEP-CAP (* tries 5)))
        (send-toot/retry-on-err toot idem-key (add1 tries)))))
  (with-handlers ([exn? handle-err])
    (send-toot toot idem-key)))

(define (verify-creds)
  (guard-config)
  (define-values (status headers rsp)
    (http-sendrecv/url (make-api-url '("accounts" "verify_credentials"))
                       #:headers (list (make-header "Authorization" (get-authorization)))))
  (string->jsexpr (port->string rsp)))

(define (fetch-toot toot-id)
  (guard-config)
  (define-values (status headers rsp)
    (http-sendrecv/url (make-api-url (list "statuses" toot-id))
                       #:headers (list (make-header "Authorization" (get-authorization)))))
  (string->jsexpr (port->string rsp)))

;; Stream incoming toots
; (define (stream-user chan)
;   (define query (list (cons 'access_token (app-config-token (current-config)))
;                       (cons 'stream "user")))
;   (define ws (ws-connect (make-api-url '("streaming") #:ws? #t #:query query)))
;   (define (stream-forever chan)
;     (let ([msg (ws-recv ws)])
;       (cond [(equal? msg eof) (void)]
;             [else
;              (define msg-data (string->jsexpr msg)
;              (async-channel-put chan (list (hash-ref msg-data 'event)
;                                            (hash-ref msg-data 'payload)))
;              (stream-forever chan)])))
;   (stream-forever chan)
;   (ws-close! ws))