#lang racket/base
(module+ test
  (require rackunit))
(require web-server/http
         web-server/servlet-env
         racket/file
         racket/function
         racket/runtime-path
         web-server/dispatch
         pkg/util
         racket/match
         racket/package
         racket/system
         racket/date
         racket/string
         web-server/servlet
         web-server/formlets
         racket/bool
         racket/list
         net/sendmail
         meta/pkg-index/basic/main
         web-server/http/id-cookie
         file/sha1
         (prefix-in bcrypt- bcrypt))

(define-syntax-rule (while cond e ...)
  (let loop ()
    (when cond
      e ...
      (loop))))

(define (snoc l x)
  (append l (list x)))

(define (salty str)
  (sha1 (open-input-string str)))

(define-runtime-path src ".")

(define-runtime-path root "root")
(make-directory* root)
(define secret-key
  (make-secret-salt/file
   (build-path root "secret.key")))
(define users-path (build-path root "users"))
(make-directory* users-path)
(define users.new-path (build-path root "users.new"))
(make-directory* users.new-path)

(define (client_id)
  (file->string (build-path root "client_id")))
(define (client_secret)
  (file->string (build-path root "client_secret")))

(define pkgs-path (build-path root "pkgs"))
(make-directory* pkgs-path)

(define id-cookie-name "pnrid")

;; XXX Add a caching system
(define (package-list)
  (sort (map path->string (directory-list pkgs-path))
        string-ci<=?))
(define (package-exists? pkg-name)
  (file-exists? (build-path pkgs-path pkg-name)))
(define (package-remove! pkg-name)
  (delete-file (build-path pkgs-path pkg-name)))
(define (package-info pkg-name)
  (file->value (build-path pkgs-path pkg-name)))
(define (package-info-set! pkg-name i)
  (write-to-file i (build-path pkgs-path pkg-name)
                 #:exists 'replace))

(define (package-ref pkg-info key)
  (hash-ref pkg-info key
            (λ ()
              (match key
                [(or 'author 'checksum 'source)
                 (error 'pkg "Package ~e is missing a required field: ~e"
                        (hash-ref pkg-info 'name) key)]
                ['ring
                 *default-ring*]
                ['tags
                 empty]
                [(or 'last-checked 'last-edit 'last-updated)
                 -inf.0]))))

(define-values (main-dispatch main-url)
  (dispatch-rules
   [() page/main]
   [("") page/main]
   [("info" (string-arg)) page/info]
   [("search" (string-arg) ...) page/search]
   [("query" "search" (string-arg) ...) page/search/query]
   [("account" "login") page/login]
   [("account" "logout") page/logout]
   [("manage") page/manage]
   [("manage" "update") page/manage/update]
   [("manage" "edit" (string-arg)) page/manage/edit]
   [("manage" "upload") page/manage/upload]
   [("curate") page/curate]
   [else basic-start]))

(define (page/main req)
  (redirect-to (main-url page/search empty)))

(define (format-time s)
  (if s
    (parameterize ([date-display-format 'rfc2822])
      (date->string (seconds->date s #f) #t))
    ""))

(define (package-url->useful-url pkg-url-str)
  (define pkg-url
    (string->url pkg-url-str))
  (match (url-scheme pkg-url)
    ["github"
     (match-define (list* user repo branch path)
                   (url-path pkg-url))
     (url->string
      (struct-copy url pkg-url
                   [scheme "http"]
                   [path (list* user repo (path/param "tree" empty) branch path)]))]
    [_
     pkg-url-str]))

(define (page/info req pkg-name)
  (page/info-like
   (list (cons "Packages" (main-url page/main))
         pkg-name)
   #f
   #f
   #f
   req pkg-name))

(define (search-term-eval pkg-name info term)
  (match term
    [(regexp #rx"^ring:(.*?)$"
             (list _ (app string->number (and (not #f) ring))))
     (equal? ring (package-ref info 'ring))]
    [(regexp #rx"^author:(.*?)$" (list _ author))
     (equal? author (package-ref info 'author))]
    [_
     (define term-rx (regexp-quote term))
     (for/or ([tag (list* pkg-name (package-ref info 'tags))])
       (regexp-match? term-rx tag))]))

(define breadcrumb->string
  (match-lambda
   [(? string? label)
    label]
   [(cons (? string? label)
          (? string? url))
    label]))
(define breadcrumb->xexpr
  (match-lambda
   [(? string? label)
    `(span ,label)]
   [(cons (? string? label)
          (? string? url))
    `(span (a ([href ,url]) ,label))]))

(define (template req #:breadcrumb bc . xexpr-forest)
  (send/back
   (response/xexpr
    `(html
      (head
       (script ([src "/sorttable.js"]) " ")
       (link ([rel "stylesheet"]
              [type "text/css"]
              [href "/style.css"]))
       (title ,@(add-between (map breadcrumb->string bc) " > ")))
      (body
       (div ([class "breadcrumb"])
            ,@(add-between (map breadcrumb->xexpr bc) " > ")
            ,(cond
               [(current-user req #f)
                => (λ (user)
                     `(span ([id "logout"])
                            ,user
                            ,@(if (curation-administrator? user)
                                `(" | "
                                  (a ([href ,(main-url page/curate)]) "curate"))
                                empty)
                            ;;" | "
                            ;;(a ([href ,(main-url page/logout)]) "logout")
                            ))]
               [else
                ""]))
       ,@xexpr-forest
       (div ([id "footer"])
            "Powered by "
            (a ([href "http://racket-lang.org/"]) "Racket") ". "
            "Written by "
            (a ([href "http://faculty.cs.byu.edu/~jay"]) "Jay McCarthy")
            "."))))))

(define (page/logout req)
  (redirect-to
   (main-url page/main)
   #:headers
   (list (cookie->header (logout-id-cookie id-cookie-name #:path "/")))))

(define (package-list/search ts)
  (filter
   (λ (p)
     (define i (package-info p))
     (for/and ([t (in-list ts)])
       (search-term-eval p i t)))
   (package-list)))

(define search-formlet
  (formlet
   ,{(to-string (required (text-input)))
     . => . new-terms}
   (string-split new-terms)))

(define (page/search/query req old-terms)
  (define terms (formlet-process search-formlet req))
  (redirect-to (main-url page/search (append old-terms terms))))

(define (package-tags pkgs terms)
  (define tag->count (make-hash))
  (for* ([p (in-list pkgs)]
         [t (in-list (package-ref (package-info p) 'tags))])
    (hash-update! tag->count t add1 0))
  (define tags
    (sort (hash-keys tag->count)
          >
          #:key (λ (t) (hash-ref tag->count t))))
  `(p ,@(for/list ([t (in-list tags)])
          `(span (a ([href ,(main-url page/search (snoc terms t))])
                    ,t)
                 " "))))

(define (page/search req terms)
  (define pkgs (package-list/search terms))
  (template
   req
   #:breadcrumb
   (list* (cons "Packages" (main-url page/main))
          "Search"
          (for/list ([t (in-list terms)])
            (cons t (main-url page/search (remove* (list t) terms)))))
   `(div ([id "menu"])
         (form ([action ,(main-url page/search/query terms)])
               (span ([class "menu_option"])
                     ,@(formlet-display search-formlet)
                     (input ([type "submit"] [value "Search"])))
               (span ([class "menu_option"])
                     (a ([href ,(main-url page/manage)])
                        ,(if (current-user req #f)
                           "Manage Your Packages"
                           "Contribute a Package")))
               ,(if (current-user req #f)
                  ""
                  `(span ([class "menu_option"])
                         (a ([href ,(main-url page/login)])
                            "Login")))))
   (package-tags pkgs terms)
   (package-table page/info pkgs #:terms terms)))

(define (page/login req)
  (login req)
  (redirect-to (main-url page/main)))

(define (login req [last-error #f])
  (define login-formlet
    (formlet
     (table
      (tr (td "Email Address:")
          (td  ,{(to-string (required (text-input))) . => . email}))
      (tr (td "Password:")
          (td ,{(to-string (required (password-input))) . => . passwd})))
     (values email passwd)))
  (define log-req
    (send/suspend
     (λ (k-url)
       (template
        req
        #:breadcrumb
        (list "Login")
        `(div ([id "login"])
              (form ([action ,k-url] [method "post"])
                    ,@(formlet-display login-formlet)
                    (input ([type "submit"] [value "Log in"])))
              (p "If you enter an unclaimed email address, then an account will be created.")
              (p "Passwords are stored in the delicious bcrypt format, but transfered as plain-text over the HTTPS connection.")
              ,@(if last-error
                  `((h1 ([class "error"]) ,last-error))
                  '()))))))
  (define-values
    (email passwd)
    (formlet-process login-formlet log-req))

  (define (authenticated!)
    (redirect/get
     #:headers
     (list
      (cookie->header
       (make-id-cookie id-cookie-name secret-key email #:path "/")))))

  (when (regexp-match (regexp-quote "/") email)
    (send/back
     (template
      log-req
      #:breadcrumb
      (list "Login" "Account Registration Error")
      `(p "Email addresses may not contain / on the Racket PNR:"
          (tt ,email)))))

  (when (string=? "" email)
    (send/back
     (template
      log-req
      #:breadcrumb
      (list "Login" "Account Registration Error")
      `(p "Email addresses must not be empty::"
          (tt ,email)))))

  (define password-path (build-path users.new-path email))
  (define old-password-path (build-path users-path email))

  (cond
    [(and (not (file-exists? password-path))
          (file-exists? old-password-path))
     (cond
       [(not (bytes=? (file->bytes old-password-path)
                      (string->bytes/utf-8 (salty passwd))))
        (login req (format "The given password is incorrect for email address ~e"
                           email))]
       [else
        (display-to-file (bcrypt-encode (string->bytes/utf-8 passwd))
                         password-path)
        (delete-file old-password-path)
        (authenticated!)])]
    [(not (file-exists? password-path))
     (send/suspend
      (λ (k-url)
        (send-mail-message
         "pkg@racket-lang.org"
         "Account confirmation for Racket PNR"
         (list email)
         empty empty
         (list "Someone tried to register your email address for an account on the Racket PNR. If you want to authorize this registration and log in, please click the following link:"
               ""
               (format "https://pkg.racket-lang.org~a" k-url)
               ""
               "This link will expire, so if it is not available, you'll have to try to register again."))
        (template
         log-req
         #:breadcrumb
         (list "Login" "Account Registration")
         `(p "An email has been sent to "
             (tt ,email)
             ", please click the link it contains to register and log in."))))

     (when (not (file-exists? password-path))
       (display-to-file (bcrypt-encode (string->bytes/utf-8 passwd))
                        password-path))

     (authenticated!)]
    [(not (bcrypt-check (file->bytes password-path)
                        (string->bytes/utf-8 passwd)))
     (login req (format "The given password is incorrect for email address ~e"
                        email))]
    [else
     (authenticated!)]))

(define (current-user req required?)
  (define id
    (request-id-cookie id-cookie-name secret-key req))
  (cond
    [id
     id]
    [required?
     (current-user (login req) required?)]
    [else
     #f]))

(define (package-list/mine req)
  (define u (current-user req #t))
  (package-list/search (list (format "author:~a" u))))

(define (package-table page/package pkgs
                       #:terms [terms empty])
  `(table
    ([class "packages sortable"])
    (thead
     (tr (th "Package") (th "Author") (th "Description") (th "Tags")))
    (tbody
     ,@(for/list ([p (in-list pkgs)])
         (define i (package-info p))
         (define author (package-ref i 'author))
         `(tr
           ([class ,(if (< (- (current-seconds) (* 2 24 60 60))
                           (package-ref i 'last-updated))
                      "recent"
                      "")])
           (td (a ([href ,(main-url page/package p)])
                  ,p))
           (td (a ([href ,(main-url page/search
                                    (snoc terms
                                          (format "author:~a" author)))])
                  ,author))
           (td ,(package-ref i 'description))
           (td ,@(for/list ([t (in-list (package-ref i 'tags))])
                   `(span (a ([href ,(main-url page/search (snoc terms t))])
                             ,t)
                          " "))))))))

(define (page/manage req)
  (define pkgs (package-list/mine req))
  (template
   req
   #:breadcrumb
   (list (cons "Packages" (main-url page/main))
         (current-user req #t)
         "Manage")
   `(div ([id "menu"])
         (span ([class "menu_option"])
               (a ([href ,(main-url page/manage/upload)])
                  "Upload a new package"))
         (span ([class "menu_option"])
               (a ([href ,(main-url page/manage/update)])
                  "Update checksums")))
   (package-table page/manage/edit pkgs)))

(define (page/manage/upload req)
  (page/manage/edit req #f))

(define (request-binding/string req id [fail? #t])
  (define res
    (bindings-assq (string->bytes/utf-8 id)
                   (request-bindings/raw req)))
  (cond
    [res
     (bytes->string/utf-8
      (binding:form-value
       res))]
    [fail?
     (error 'pnr "Missing field ~e" id)]
    [else
     #f]))

(define (page/manage/edit req pkg)
  (define (edit-details pkg-req)
    (define new-pkg (request-binding/string pkg-req "name"))
    (when (string=? new-pkg "")
      (error 'pnr "Name must not be empty: ~e" new-pkg))
    (define new-source (request-binding/string pkg-req "source"))
    (when (string=? new-source "")
      (error 'pnr "Source must not be empty: ~e" new-source))
    (define new-desc (request-binding/string pkg-req "description"))

    (unless (valid-name? new-pkg)
      (error 'pnr
             "Illegal character in name; only alphanumerics, plus '-' and '_' allowed: ~e"
             new-pkg))

    (when (and (not (equal? pkg new-pkg))
               (or (regexp-match #rx"^[Pp][Ll][Tt]" new-pkg)
                   (regexp-match #rx"^[Pp][Ll][Aa][Nn][Ee][Tt]" new-pkg)
                   (regexp-match #rx"^[Rr][Aa][Cc][Kk][Ee][Tt]" new-pkg)))
      (error 'pnr
             "Packages that start with plt, planet, and racket are not allowed without special permission. Please create your package with a different name, then email curation to request a rename: ~e"
             new-pkg))

    (when (and (package-exists? new-pkg)
               (not (equal? (package-ref (package-info new-pkg) 'author)
                            (current-user pkg-req #t))))
      (error 'pnr
             "Packages may only be modified by their authors: ~e"
             new-pkg))

    (package-begin
     (define* i
       (if pkg
         (package-info pkg)
         (hasheq)))

     (define* i
       (hash-set i 'name new-pkg))
     (define* i
       (hash-set i 'source new-source))
     (define* i
       (hash-set i 'author (current-user pkg-req #t)))
     (define* i
       (hash-set i 'description new-desc))
     (define* i
       (hash-set i 'last-edit (current-seconds)))
     (define* i
       (if pkg
         i
         (hash-set i 'checksum "")))

     (package-info-set! new-pkg i))

    (unless (or (not pkg) (equal? new-pkg pkg))
      (package-remove! pkg))

    (update-checksum #t new-pkg)

    (define new-tag
      (request-binding/string pkg-req "tag" #f))
    (add-tag! new-pkg new-tag)

    (redirect-to
     (main-url page/manage/edit new-pkg)))

  (define (delete! pkg-req)
    (when (and (package-exists? pkg)
               (not (equal? (package-ref (package-info pkg) 'author)
                            (current-user pkg-req #t))))
      (error 'pnr
             "Packages may only be modified by their authors: ~e"
             pkg))

    (when pkg
      (package-remove! pkg))

    (redirect-to
     (main-url page/manage)))

  (page/info-like
   (list* (cons "Packages" (main-url page/main))
          (current-user req #t)
          (cons "Manage" (main-url page/manage))
          (if pkg
            (list pkg
                  "Edit")
            (list "Upload")))
   edit-details
   (λ (embed/url t)
     (embed/url (remove-tag-handler pkg t)))
   delete!
   req pkg))


(define (tags-normalize ts)
  (remove-duplicates (sort ts string-ci<?)))

(define ((remove-tag-handler pkg t) req)
  (define i (package-info pkg))
  (package-info-set!
   pkg
   (hash-update i 'tags
                (λ (old)
                  (tags-normalize
                   (remove t
                           old)))
                empty))
  (redirect-to
   (main-url page/manage/edit pkg)))

(define ((add-tag-handler pkg-name) req)
  (define new-tag
    (request-binding/string req "tag" #f))
  (add-tag! pkg-name new-tag)
  (redirect-to (main-url page/info pkg-name)))

(define (valid-name? t)
  (not (regexp-match #rx"[^a-zA-Z0-9_\\-]" t)))

(module+ test
  (check-equal? (valid-name? "net") #t)
  (check-equal? (valid-name? "120") #t)
  (check-equal? (valid-name? "Web") #t)
  (check-equal? (valid-name? "foo-bar") #t)
  (check-equal? (valid-name? "!meh") #f)
  (check-equal? (valid-name? "foo_bar") #t))

(define (add-tag! pkg-name new-tag)
  (when (and new-tag
             (not (string=? new-tag "")))
    (define i (package-info pkg-name))
    (unless (valid-name? new-tag)
      (error 'pnr
             "Illegal character in tag; only alphanumerics allowed, plus '_' and '-': ~e"
             new-tag))
    (package-info-set!
     pkg-name
     (hash-update i 'tags
                  (λ (old)
                    (tags-normalize
                     (cons new-tag
                           old)))
                  empty))))

(define (page/info-like bc edit-details tag-url delete-handler req pkg-name)
  (define form-handler
    (or edit-details
        (add-tag-handler pkg-name)))

  (send/suspend/dispatch
   (λ (embed/url)
     (define i (and pkg-name (package-info pkg-name)))
     (define (package-ref* i id def)
       (if i
         (package-ref i id)
         def))
     (define author (package-ref* i 'author ""))
     (define the-table
       `(table
         (tr
          (td "Package Name")
          (td ,(if edit-details
                 `(input ([name "name"]
                          [type "text"]
                          [value ,(or pkg-name "")]))
                 pkg-name)))
         (tr
          (td "Ring")
          (td ,(ring-format (package-ref* i 'ring *default-ring*))))
         (tr
          (td "Author")
          (td (a ([href ,(main-url page/search
                                   (list (format "author:~a" author)))])
                 ,author)))
         (tr
          (td "Source")
          (td
           ,(if edit-details
              `(span (input ([name "source"]
                             [type "text"]
                             [value ,(package-ref* i 'source "")]))
                     ;; XXX change to pkg soon
                     " (" (a ([href "http://docs.racket-lang.org/planet2/Package_Concepts.html#%28tech._package._source%29"]) "details") ")")
              `(a ([href
                    ,(package-url->useful-url (package-ref i 'source))])
                  ,(package-ref i 'source)))))
         (tr
          (td "Checksum")
          (td ,(package-ref* i 'checksum "")))
         (tr
          (td "Last Update")
          (td ,(format-time (package-ref* i 'last-updated #f))))
         (tr
          (td "Last Checked")
          (td ,(format-time (package-ref* i 'last-checked #f))))
         (tr
          (td "Last Edit")
          (td ,(format-time (package-ref* i 'last-edit #f))))
         (tr
          (td "Description")
          (td ,(if edit-details
                 `(textarea ([name "description"])
                            ,(package-ref* i 'description ""))
                 (package-ref i 'description))))
         (tr
          (td "Tags")
          (td
           (ul
            ,@(for/list ([t (in-list (package-ref* i 'tags empty))])
                `(li
                  (a ([href ,(main-url page/search (list t))])
                     ,t)
                  ,@(if tag-url
                      (list " ["
                            `(a ([href ,(tag-url embed/url t)])
                                "delete tag")
                            "]")
                      empty)))
            ,(if pkg-name
               `(li (input ([name "tag"] [type "text"])))
               ""))))
         `(tr (td ([class "submit"] [colspan "2"])
                  (input ([type "submit"] [value "Submit"]))))))
     (template
      req
      #:breadcrumb
      bc
      `(div
        ([class "package"])
        (form ([action ,(embed/url form-handler)] [method "post"])
              ,the-table)
        ,(if pkg-name
           `(div ([class "install"])
                 "Install this package with:" (br) (br)
                 (tt "raco pkg install " ,pkg-name) (br) (br)
                 "or, with the 'File|Install Package...' menu option in DrRacket.")
           "")
        ,(if (and pkg-name delete-handler)
           `(div ([class "delete"])
                 (a ([href ,(embed/url delete-handler)])
                    "Delete this package")
                 " (Warning: There is no undo.)")
           ""))))))

(define (page/manage/update req)
  (update-checksums
   #t
   (package-list/mine req))
  (redirect-to (main-url page/manage)))

(define (update-checksums force? pkgs)
  (for-each (curry update-checksum force?) pkgs))

(define (update-checksum force? pkg-name)
  (define i (package-info pkg-name))
  (define old-checksum
    (package-ref i 'checksum))
  (define now (current-seconds))
  (define last (hash-ref i 'last-checked -inf.0))
  (when (or force?
            (>= (- now last) (* 24 60 60)))
    (printf "\tupdating ~a\n" pkg-name)
    (define new-checksum
      (package-url->checksum
       (package-ref i 'source)
       (list (cons 'client_id (client_id))
             (cons 'client_secret (client_secret)))))
    (package-begin
     (define* i
       (hash-set i 'checksum
                 (or new-checksum
                     old-checksum)))
     (define* i
       (hash-set i 'last-checked now))
     (define* i
       (if (and new-checksum (equal? new-checksum old-checksum))
         i
         (hash-set i 'last-updated now)))
     (package-info-set! pkg-name i))))

(define basic-start
  (pkg-index/basic package-list package-info))

;; Curation
(define (curation-administrator? u)
  (member u '("jay.mccarthy@gmail.com")))

(define *default-ring* 2)
(define (ring-format i)
  (format "~a" i))

(define page/curate/edit
  ;; XXX this should allow us to change the ring
  page/manage/edit)

(define pkg-dirs-path (build-path root "pkg-dirs"))
(make-directory* pkg-dirs-path)

(define (download-package-source! src dest)
  ;; XXX this should be provided by pkg/lib
  (error 'download-package-source! "Not implemented"))

(define (download-package! pkg pd)
  (and
   (with-handlers ([exn:fail? (λ (x) #f)])
     (begin
       (download-package-source! 
        (package-ref (package-info pkg) 'source)
        pd)
       #t))
   (write-to-file (current-seconds)
                  (path-add-suffix pd ".dl-time")
                  #:exists 'replace)))

(define (package-dir-up-to-date? pkg pd)
  (define pd-dl-time-path (path-add-suffix pd ".dl-time"))
  (and (file-exists? pd-dl-time-path)
       (>= (file->value pd-dl-time-path)
           (package-ref (package-info pkg) 'last-updated))))

(define (package-dir pkg)
  (define pd (build-path pkg-dirs-path pkg))
  (and
   (cond
     [(not (directory-exists? pd))
      (download-package! pkg pd)]
     [(not (package-dir-up-to-date? pkg pd))
      (download-package! pkg pd)])
   pd))

(define (package-dirs-conflict? left-d right right-d)
  ;; XXX this should be provided by pkg/lib
  #f)

(define (page/curate req)
  (define u (current-user req #t))
  (define (packages-conflict? left right)
    (define left-pd (package-dir left))
    (define right-pd (package-dir right))
    (and left-pd right-pd
         (package-dirs-conflict? left-pd right right-pd)))
  (define (package-conflicts? pkg)
    (define other-pkgs (remove pkg (append (ring 0) (ring 1))))
    (define conflicting-pkgs
      (filter (curry packages-conflict? pkg) other-pkgs))
    (if (empty? conflicting-pkgs)
      #f
      conflicting-pkgs))
  (define (ring i)
    (package-list/search (list (format "ring:~a" i))))
  (cond
    [(curation-administrator? u)
     (template
      req
      #:breadcrumb
      (list "Packages"
            "Curation")
      `(h1 "Ring 0 (conflicts)")
      ;; XXX maybe I should change these so that it
      ;;  1. displays a distinct link to change it to each ring
      ;;  2. displays the conflicts (if any)
      ;;  3. displays the update time
      ;;  4. doesn't display other stuff
      ;;  5. highlights 'problems' (conflicts)
      ;;  6. highlights 'proposals' (non-conflicting ring 2 stuff)
      ;; Then I think I will just need one table
      (package-table page/curate/edit
                     (filter package-conflicts? (ring 0)))
      `(h1 "Ring 1 (conflicts)")
      (package-table page/curate/edit
                     (filter package-conflicts? (ring 1)))
      `(h1 "Ring 2 (no conflicts)")
      (package-table page/curate/edit
                     (filter (negate package-conflicts?) (ring 2)))
      `(h1 "Ring 0")
      (package-table page/curate/edit (ring 0))
      `(h1 "Ring 1")
      (package-table page/curate/edit (ring 1))

      `(h1 "Ring 2")
      (package-table page/curate/edit (ring 2)))]
    [else
     (template
      req
      #:breadcrumb
      (list "Curation")
      `(p ([class "error"]) "You are not authorized to curate."))]))

;; Start
(define (go port)
  (printf "launching on port ~a\n" port)
  (thread
   (λ ()
     (while true
       (printf "updating checksums\n")
       (with-handlers ([exn:fail? void])
         (update-checksums #f (package-list)))
       ;; update once per day based on whenever the server started
       (sleep (* 24 60 60)))))
  (serve/servlet
   main-dispatch
   #:command-line? #t
   #:listen-ip #f
   #:ssl? #t
   #:ssl-cert (build-path root "server-cert.pem")
   #:ssl-key (build-path root "private-key.pem")
   #:extra-files-paths
   (list (build-path src "static")
         (build-path root "static"))
   #:servlet-regexp #rx""
   #:port port))

(module+ main
  (go 9004))
