cache.rkt
#lang racket/base

(require (prefix-in http: (planet synx/http:5))
          (only-in (planet vyzo/crypto) sha256)
          (only-in (planet vyzo/crypto/util) hex)
          net/url
          racket/file)

(define cache-directory
   (make-parameter
    (build-path (find-system-path 'home-dir) ".plt-scheme/page-cache")))

(when (not (directory-exists? (cache-directory)))
   (make-directory* (cache-directory)))

(define (add-extension path ext)
   (path-add-suffix path (string-append "." ext)))

(define (call-with-cache-directory d next)
   (make-directory* d)
   (parameterize ((cache-directory d)) (next)))

(define-syntax-rule
  (with-cache-directory d body ...)
  (call-with-cache-directory d (λ () body ...)))

(define (download
          uri
          #:check?
          (check? #t)
          #:referer
          (referer #f)
          #:headers
          (headers null))
   (let ((dest
          (build-path
           (cache-directory)
           (bytes->string/utf-8
            (hex (sha256 (string->bytes/utf-8 (url->string uri)))))))
         (headers
          (if referer
            (cons (cons "Referer" (url->string referer)) headers)
            headers)))
     (let ((info (add-extension dest "info")))
       (if (or check? (not (file-exists? dest)))
         (let-values (((type modified) (http:download uri dest headers)))
           (with-output-to-file
            info
            #:exists
            'replace
            (λ () (write type) (write modified)))
           (values type modified dest))
         (if (file-exists? info)
           (with-input-from-file info (λ () (values (read) (read) dest)))
           (values #f #f dest))))))

(define (delete file) (delete-file file))

(provide with-cache-directory download delete)